From 8324cc91dbdb33bfd5799067e96c62769b8fb9c9 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 1 Nov 2012 20:40:55 +0000
Subject: Working towards a BCCed [next]. This version <i>almost</i> works,
 except for a problem with restoring the context namespace upon return (which
 produces very strange results!)

---
 generic/tclCompCmds.c | 29 +++++++++++++++++++++++++
 generic/tclCompile.c  |  4 ++++
 generic/tclCompile.h  |  5 ++++-
 generic/tclExecute.c  | 59 +++++++++++++++++++++++++++++++++++++++++++++++++--
 generic/tclInt.h      |  4 ++++
 generic/tclOO.c       |  9 ++++----
 generic/tclOOBasic.c  | 12 +++++------
 7 files changed, 108 insertions(+), 14 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5beb7bd..96bb9a4 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -5535,6 +5535,35 @@ IndexTailVarIfKnown(
     return localIndex;
 }
 
+/*
+ * Compilations of commands relating to TclOO.
+ */
+
+int
+TclCompileObjectNextCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    int i;
+
+    if (parsePtr->numWords > 255) {
+	return TCL_ERROR;
+    }
+
+    for (i=0 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt1(	INST_TCLOO_NEXT, i,		envPtr);
+    return TCL_OK;
+}
+
 int
 TclCompileObjectSelfCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index ee8511c..188b3f8 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -484,9 +484,13 @@ InstructionDesc const tclInstructionTable[] = {
 	 * qualified version, or produces the empty string if no such command
 	 * exists. Never generates errors.
 	 * Stack:  ... cmdName => ... fullCmdName */
+
     {"tclooSelf",	 1,	+1,	  0,	{OPERAND_NONE}},
 	/* Push the identity of the current TclOO object (i.e., the name of
 	 * its current public access command) on the stack. */
+    {"tclooNext",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
+	/* Push the identity of the current TclOO object (i.e., the name of
+	 * its current public access command) on the stack. */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 08d59fd..e623e87 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -698,10 +698,13 @@ typedef struct ByteCode {
 #define INST_INFO_LEVEL_NUM		150
 #define INST_INFO_LEVEL_ARGS		151
 #define INST_RESOLVE_COMMAND		152
+
+/* For compilation relating to TclOO */
 #define INST_TCLOO_SELF			153
+#define INST_TCLOO_NEXT			154
 
 /* The last opcode */
-#define LAST_INST_OPCODE		153
+#define LAST_INST_OPCODE		154
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1e24cb3..f6b99bf 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4208,10 +4208,18 @@ TEBCresume(
 	TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr);
 	NEXT_INST_F(1, 1, 1);
     }
-    case INST_TCLOO_SELF: {
-	CallFrame *framePtr = iPtr->varFramePtr;
+
+    /*
+     * -----------------------------------------------------------------
+     *	   Start of TclOO support instructions.
+     */
+
+    {
+	CallFrame *framePtr;
 	CallContext *contextPtr;
 
+    case INST_TCLOO_SELF:
+	framePtr = iPtr->varFramePtr;
 	if (framePtr == NULL ||
 		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
 	    TRACE(("=> ERROR: no TclOO call context\n"));
@@ -4230,9 +4238,56 @@ TEBCresume(
 	objResultPtr = TclOOObjectName(interp, contextPtr->oPtr);
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
+
+    case INST_TCLOO_NEXT:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	framePtr = iPtr->varFramePtr;
+	if (framePtr == NULL ||
+		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	    TRACE(("%d => ERROR: no TclOO call context\n", opnd));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "next may only be called from inside a method",
+		    -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+	    goto gotError;
+	}
+	contextPtr = framePtr->clientData;
+
+	bcFramePtr->data.tebc.pc = (char *) pc;
+	iPtr->cmdFramePtr = bcFramePtr;
+
+	if (iPtr->flags & INTERP_DEBUG_FRAME) {
+	    TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
+		    codePtr, bcFramePtr, pc - codePtr->codeStart);
+	}
+
+	pcAdjustment = 2;
+	cleanup = opnd;
+	DECACHE_STACK_INFO();
+
+	/*
+	 * BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG BUG
+	 *
+	 * Bug somewhere near here. The iPtr->varFramePtr must be updated as
+	 * below, but TclOONextRestoreFrame (in tclOOBasic.c) seems to be
+	 * unable to restore the frame upon return...
+	 *
+	 * If TclOONextRestoreFrame is wrong for use here (and it might be!)
+	 * it should be copied to this file and adjusted afterwards. It is
+	 * *correct* for its other uses.
+	 */
+
+	iPtr->varFramePtr = framePtr->callerVarPtr;
+	TclNRAddCallback(interp, TclOONextRestoreFrame, framePtr,
+		NULL, NULL, NULL);
+	pc += pcAdjustment;
+	TEBC_YIELD();
+	return TclNRObjectContextInvokeNext(interp,
+		(Tcl_ObjectContext) contextPtr, opnd, &OBJ_AT_DEPTH(opnd-1), 1);
     }
 
     /*
+     *     End of TclOO support instructions.
      * -----------------------------------------------------------------
      *	   Start of INST_LIST and related instructions.
      */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1fffa1f..549ada9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2804,6 +2804,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
+MODULE_SCOPE Tcl_NRPostProc TclOONextRestoreFrame;
 
 MODULE_SCOPE void  TclSpliceTailcall(Tcl_Interp *interp,
 	               struct NRE_callback *tailcallPtr);
@@ -3620,6 +3621,9 @@ MODULE_SCOPE int	TclCompileNamespaceWhichCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileNoOp(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileObjectNextCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileObjectSelfCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
diff --git a/generic/tclOO.c b/generic/tclOO.c
index d6d2d6a..68ed766 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -437,10 +437,11 @@ InitFoundation(
      * ensemble.
      */
 
-    Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
-	    NULL);
-    Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd,
-	    NULL, NULL);
+    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
+	    NULL, TclOONextObjCmd, NULL, NULL);
+    cmdPtr->compileProc = TclCompileObjectNextCmd;
+    Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
+	    NULL, TclOONextToObjCmd, NULL, NULL);
     cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
 	    TclOOSelfObjCmd, NULL, NULL);
     cmdPtr->compileProc = TclCompileObjectSelfCmd;
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 0676618..cd57063 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -25,8 +25,6 @@ static int		FinalizeConstruction(ClientData data[],
 			    Tcl_Interp *interp, int result);
 static int		FinalizeEval(ClientData data[],
 			    Tcl_Interp *interp, int result);
-static int		RestoreFrame(ClientData data[],
-			    Tcl_Interp *interp, int result);
 
 /*
  * ----------------------------------------------------------------------
@@ -805,7 +803,7 @@ TclOONextObjCmd(
      * that this is like [uplevel 1] and not [eval].
      */
 
-    TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
+    TclNRAddCallback(interp, TclOONextRestoreFrame, framePtr, NULL,NULL,NULL);
     iPtr->varFramePtr = framePtr->callerVarPtr;
     return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
 }
@@ -874,8 +872,8 @@ TclOONextToObjCmd(
 	     * context. Note that this is like [uplevel 1] and not [eval].
 	     */
 
-	    TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
-		    INT2PTR(contextPtr->index), NULL);
+	    TclNRAddCallback(interp, TclOONextRestoreFrame, framePtr,
+		    contextPtr, INT2PTR(contextPtr->index), NULL);
 	    contextPtr->index = i-1;
 	    iPtr->varFramePtr = framePtr->callerVarPtr;
 	    return TclNRObjectContextInvokeNext(interp,
@@ -904,8 +902,8 @@ TclOONextToObjCmd(
     return TCL_ERROR;
 }
 
-static int
-RestoreFrame(
+int
+TclOONextRestoreFrame(
     ClientData data[],
     Tcl_Interp *interp,
     int result)
-- 
cgit v0.12


From 72901fb88ca266a88a78b0a34c4db3b3c386e367 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 2 Nov 2012 16:50:06 +0000
Subject: Work on compilation of [string is]. Hit some problem edge cases with
 differences in strictness of edge cases that will force a rethink ([string is
 boolean] is significantly more strict than Tcl_GetBooleanFromObj).

---
 generic/tclCmdMZ.c      |   2 +-
 generic/tclCompCmdsSZ.c | 190 ++++++++++++++++++++++++++++++++++++++++++++++++
 generic/tclInt.h        |   3 +
 3 files changed, 194 insertions(+), 1 deletion(-)

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index de32fce..0526325 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3306,7 +3306,7 @@ TclInitStringCmd(
 	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
 	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
 	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
-	{"is",		StringIsCmd,	NULL, NULL, NULL, 0},
+	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
 	{"last",	StringLastCmd,	NULL, NULL, NULL, 0},
 	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},
 	{"map",		StringMapCmd,	TclCompileStringMapCmd, NULL, NULL, 0},
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 57cb992..b9309ec 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -451,6 +451,196 @@ TclCompileStringIndexCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileStringIsCmd --
+ *
+ *	Procedure called to compile the simplest and most common form of the
+ *	"string is" command.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "string is" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileStringIsCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    int numWords = parsePtr->numWords;
+    enum IsType {
+	TypeBool, TypeBoolFalse, TypeBoolTrue,
+	TypeFloat,
+	TypeInteger, TypeNarrowInt, TypeWideInt,
+	TypeList /*, TypeDict */
+    };
+    enum IsType t;
+    JumpFixup jumpFixup;
+    int start, range;
+    int allowEmpty = 0;
+
+    if (numWords < 2 || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	return TCL_ERROR;
+    }
+#define GotLiteral(tokenPtr,word) \
+    ((tokenPtr)[1].size > 1 && (tokenPtr)[1].start[0] == word[0] &&	\
+	    strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
+
+    if (GotLiteral(tokenPtr, "boolean")) {
+	t = TypeBool;
+    } else if (GotLiteral(tokenPtr, "double")) {
+	t = TypeFloat;
+    } else if (GotLiteral(tokenPtr, "entier")) {
+	t = TypeInteger;
+    } else if (GotLiteral(tokenPtr, "false")) {
+	t = TypeBoolFalse;
+    } else if (GotLiteral(tokenPtr, "integer")) {
+	t = TypeNarrowInt;
+	return TCL_ERROR; // Not yet implemented
+    } else if (GotLiteral(tokenPtr, "list")) {
+	t = TypeList;
+    } else if (GotLiteral(tokenPtr, "true")) {
+	t = TypeBoolTrue;
+    } else if (GotLiteral(tokenPtr, "wideinteger")) {
+	t = TypeWideInt;
+	return TCL_ERROR; // Not yet implemented
+    } else {
+	/*
+	 * We don't handle character class checks in bytecode currently.
+	 */
+
+	return TCL_ERROR;
+    }
+    if (numWords != 3 && numWords != 4) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(tokenPtr);
+    if (numWords == 3) {
+	allowEmpty = (t != TypeList);
+    } else {
+	if (!GotLiteral(tokenPtr, "-strict")) {
+	    return TCL_ERROR;
+	}
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+#undef GotLiteral
+
+    /*
+     * Push the word to check.
+     */
+
+    CompileWord(envPtr, tokenPtr, interp, numWords-1);
+
+    /*
+     * Next, do the type check. First, we push a catch range; most of the
+     * type-check operations throw an exception on failure.
+     */
+
+    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+    start = 0;
+    TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
+    ExceptionRangeStarts(envPtr, range);
+
+    /*
+     * Issue the type-check itself for the specific type.
+     */
+
+    switch (t) {
+    case TypeBool:
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_LNOT,			envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+	break;
+    case TypeBoolFalse:
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	start = CurrentOffset(envPtr);
+	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
+	break;
+    case TypeBoolTrue:
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	start = CurrentOffset(envPtr);
+	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
+	break;
+    case TypeFloat:
+	/*
+	 * Careful! Preserve behavior of NaN which is a double (that is, true
+	 * for the purposes of a type check) but most math ops fail on it. The
+	 * key is that it is not == to itself (and is the only value which
+	 * this is true for).
+	 */
+
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_NEQ,			envPtr);
+	TclEmitInstInt1(	INST_JUMP_TRUE1, 5,		envPtr);
+
+	/*
+	 * Type check for all other double values.
+	 */
+
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_UMINUS,			envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+	break;
+    case TypeInteger:
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_BITNOT,			envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+	break;
+    case TypeNarrowInt:
+	Tcl_Panic("not yet implemented");
+    case TypeWideInt:
+	Tcl_Panic("not yet implemented");
+    case TypeList:
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+	break;
+    }
+
+    /*
+     * Based on whether the exception was thrown (or conditional branch taken,
+     * in the case of true/false checks), push the correct boolean value. This
+     * is also where we deal with what happens with empty values in non-strict
+     * mode.
+     */
+
+    ExceptionRangeEnds(envPtr, range);
+    TclEmitOpcode(		INST_END_CATCH,			envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+    PushLiteral(envPtr, "1", 1);
+    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+    ExceptionRangeTarget(envPtr, range, catchOffset);
+    if (start != 0) {
+	TclStoreInt1AtPtr(CurrentOffset(envPtr) - start,
+		envPtr->codeStart + start + 1);
+    }
+    TclEmitOpcode(		INST_END_CATCH,			envPtr);
+    if (allowEmpty) {
+	PushLiteral(envPtr, "", 0);
+	TclEmitOpcode(		INST_STR_EQ,			envPtr);
+    } else {
+	TclEmitOpcode(		INST_POP,			envPtr);
+	PushLiteral(envPtr, "0", 1);
+    }
+    TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileStringMatchCmd --
  *
  *	Procedure called to compile the simplest and most common form of the
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1fffa1f..e513a6e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3647,6 +3647,9 @@ MODULE_SCOPE int	TclCompileStringFirstCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileStringIndexCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringIsCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileStringLenCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12


From eaaed023dfb41a1d60c320fccf77c54204c4143e Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 2 Nov 2012 20:39:10 +0000
Subject: reorder to preserve main BC development branch sequence better

---
 generic/tclCompile.c | 10 +++++-----
 generic/tclCompile.h |  6 +++---
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 7036f6a..c390971 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -488,17 +488,17 @@ InstructionDesc const tclInstructionTable[] = {
     {"tclooSelf",	 1,	+1,	  0,	{OPERAND_NONE}},
 	/* Push the identity of the current TclOO object (i.e., the name of
 	 * its current public access command) on the stack. */
-    {"tclooNext",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
-	/* Push the identity of the current TclOO object (i.e., the name of
-	 * its current public access command) on the stack. */
-   {"tclooClass",	 1,	0,	  0,	{OPERAND_NONE}},
+    {"tclooClass",	 1,	0,	  0,	{OPERAND_NONE}},
 	/* Push the class of the TclOO object named at the top of the stack
 	 * onto the stack.
 	 * Stack:  ... object => ... class */
-   {"tclooNamespace",	 1,	0,	  0,	{OPERAND_NONE}},
+    {"tclooNamespace",	 1,	0,	  0,	{OPERAND_NONE}},
 	/* Push the namespace of the TclOO object named at the top of the
 	 * stack onto the stack.
 	 * Stack:  ... object => ... namespace */
+    {"tclooNext",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
+	/* Push the identity of the current TclOO object (i.e., the name of
+	 * its current public access command) on the stack. */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index cab517d..c860307 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -701,9 +701,9 @@ typedef struct ByteCode {
 
 /* For compilation relating to TclOO */
 #define INST_TCLOO_SELF			153
-#define INST_TCLOO_NEXT			154
-#define INST_TCLOO_CLASS		155
-#define INST_TCLOO_NS			156
+#define INST_TCLOO_CLASS		154
+#define INST_TCLOO_NS			155
+#define INST_TCLOO_NEXT			156
 
 /* The last opcode */
 #define LAST_INST_OPCODE		156
-- 
cgit v0.12


From 7ef78ec33dcd4cf57d272e36d542a1c3c088495a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 21 Aug 2013 09:35:50 +0000
Subject: define tests for this bug; no fix yet

---
 tests/oo.test | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

diff --git a/tests/oo.test b/tests/oo.test
index e0e0791..054bc46 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1839,6 +1839,36 @@ test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup {
 } -returnCodes error -cleanup {
     Foo destroy
 } -result {wrong # args: should be "::bar <cloned> a b"}
+test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
+    oo::class create FooClass
+    set result {}
+} -body {
+    set obj1 [FooClass new]
+    oo::objdefine $obj1 {
+	variable var 
+	method m {} {
+	    set var foo
+	}
+	method get {} {
+	    return $var
+	}
+	export eval
+    }
+
+    $obj1 m
+    lappend result [$obj1 get]
+    set obj2 [oo::copy $obj1]
+    $obj2 eval {
+	set var bar
+    }
+    lappend result [$obj2 get]
+    $obj1 eval {
+	set var grill
+    }
+    lappend result [$obj1 get] [$obj2 get]
+} -cleanup {
+    FooClass destroy
+} -result {foo bar grill bar}
 
 test oo-16.1 {OO: object introspection} -body {
     info object
-- 
cgit v0.12


From a1f0dd74ffe8b407f725f089784f2dd51c2ab548 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 30 Aug 2013 22:04:12 +0000
Subject: Bump version number to 8.6.1.

---
 ChangeLog         | 12 ++++++++++++
 README            |  2 +-
 generic/tcl.h     |  4 ++--
 library/init.tcl  |  2 +-
 unix/configure    |  2 +-
 unix/configure.in |  2 +-
 unix/tcl.spec     |  2 +-
 win/configure     |  2 +-
 win/configure.in  |  2 +-
 9 files changed, 21 insertions(+), 9 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index ddde893..13fd83b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2013-08-30  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tcl.h:	Bump version number to 8.6.1.
+	* library/init.tcl:
+	* unix/configure.in:
+	* win/configure.in:
+	* unix/tcl.spec:
+	* README:
+
+	* unix/configure:	autoconf-2.59
+	* win/configure:
+
 2013-08-03  Donal Fellows  <dkf@users.sf.net>
 
 	* library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found
diff --git a/README b/README
index 8ecd7a9..7004bc5 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
 README:  Tcl
-    This is the Tcl 8.6.0 source distribution.
+    This is the Tcl 8.6.1 source distribution.
 	http://sourceforge.net/projects/tcl/files/Tcl/
     You can get any source release of Tcl from the URL above.
 
diff --git a/generic/tcl.h b/generic/tcl.h
index a833218..1b120fb 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -56,10 +56,10 @@ extern "C" {
 #define TCL_MAJOR_VERSION   8
 #define TCL_MINOR_VERSION   6
 #define TCL_RELEASE_LEVEL   TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL  0
+#define TCL_RELEASE_SERIAL  1
 
 #define TCL_VERSION	    "8.6"
-#define TCL_PATCH_LEVEL	    "8.6.0"
+#define TCL_PATCH_LEVEL	    "8.6.1"
 
 /*
  *----------------------------------------------------------------------------
diff --git a/library/init.tcl b/library/init.tcl
index bedc06e..1ca6413 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -16,7 +16,7 @@
 if {[info commands package] == ""} {
     error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
 }
-package require -exact Tcl 8.6.0
+package require -exact Tcl 8.6.1
 
 # Compute the auto path to use in this interpreter.
 # The values on the path come from several locations:
diff --git a/unix/configure b/unix/configure
index 9b3c298..06ff7a4 100755
--- a/unix/configure
+++ b/unix/configure
@@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
 TCL_VERSION=8.6
 TCL_MAJOR_VERSION=8
 TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".0"
+TCL_PATCH_LEVEL=".1"
 VERSION=${TCL_VERSION}
 
 #------------------------------------------------------------------------
diff --git a/unix/configure.in b/unix/configure.in
index 1a9bb31..61ad30f 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [
 TCL_VERSION=8.6
 TCL_MAJOR_VERSION=8
 TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".0"
+TCL_PATCH_LEVEL=".1"
 VERSION=${TCL_VERSION}
 
 #------------------------------------------------------------------------
diff --git a/unix/tcl.spec b/unix/tcl.spec
index 27f7189..678222c 100644
--- a/unix/tcl.spec
+++ b/unix/tcl.spec
@@ -4,7 +4,7 @@
 
 Name:          tcl
 Summary:       Tcl scripting language development environment
-Version:       8.6.0
+Version:       8.6.1
 Release:       2
 License:       BSD
 Group:         Development/Languages
diff --git a/win/configure b/win/configure
index fc453f8..e7c1329 100755
--- a/win/configure
+++ b/win/configure
@@ -1311,7 +1311,7 @@ SHELL=/bin/sh
 TCL_VERSION=8.6
 TCL_MAJOR_VERSION=8
 TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".0"
+TCL_PATCH_LEVEL=".1"
 VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
 
 TCL_DDE_VERSION=1.4
diff --git a/win/configure.in b/win/configure.in
index 373cfcc..6e1af50 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -14,7 +14,7 @@ SHELL=/bin/sh
 TCL_VERSION=8.6
 TCL_MAJOR_VERSION=8
 TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".0"
+TCL_PATCH_LEVEL=".1"
 VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
 
 TCL_DDE_VERSION=1.4
-- 
cgit v0.12


From 05fa6e93c1f1952c259e23fca85fe2cae122ad47 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 3 Sep 2013 16:04:30 +0000
Subject: update changes

---
 changes | 128 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 127 insertions(+), 1 deletion(-)

diff --git a/changes b/changes
index d3bbb43..0339919 100644
--- a/changes
+++ b/changes
@@ -8164,6 +8164,132 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
 
 --- Released 8.6.0, December 20, 2012 --- See ChangeLog for details ---
 
-2013-05-08 (bug fix)[3036566] Honor language packs on Vista+ to get initial locale (oehlmann)
+2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd)
+
+2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans)
+
+2013-01-04 (bug fix) memleak in [format] compiler (fellows)
+
+2013-01-08 (bug fix)[3092089,3587096] [file normalize] on junction points
+
+2013-01-09 (bug fix)[3599395] status line processing (nijtmans)
+2013-01-23 (bug fix)[2911139] repair async connection management (fellows)
+=> http 2.8.6
+
+2013-01-26 (bug fix)[3601804] Darwin segfault platformCPUID (nijtmans)
+
+2013-01-28 (enhancement) improve ensemble bytecode (fellows)
+
+2013-01-30 (enhancement) selected script code improvements (fradin)
+=> tcltest 2.3.6
+
+2013-01-30 (bug fix)[3599098] update to handle glibc banner changes (kupries)
+=> platform 1.0.11
+
+2013-01-31 (bug fix)[3598282] make install DESTDIR support (cassoff)
+
+2013-02-05 (bug fix)[3603434] [file normalize a:/] flaw in VFS (porter,griffin)
+
+2013-02-09 (bug fix)[3603695] $obj varname resolution rules (venable,fellows)
+
+2013-02-11 (bug fix)[3603553] zlib flushing errors (vampiera,fellows)
+
+2013-02-14 (bug fix)[3604576] msgcat use of Windows registry (oehlmann,nijtmans)
+=> msgcat 1.5.1
+
+2013-02-19 (bug fix)[2438181] report errors in trace handlers (yorick)
+
+2013-02-21 (bug fix)[3605447] unbreak [namespace export -clear] (porter)
+
+2013-02-23 (bug fix)[3599194] fallback IPv6 routines (afredd,max)
+
+2013-02-27 (bug fix)[3606139] stop crash in [regexp] (lane)
+
+2013-03-03 (bug fix)[3606258] major serial port update (english)
+
+2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs
+(grathwohl,lane,porter)
+
+2013-03-12 (enhancement) better build support for Debian arch (shadura)
+
+2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans)
+
+2013-03-21 (bug fix)[2102614] [auto_mkindex] ensemble support (griffin)
+
+2013-03-27 Tcl_Zlib*() routines tolerate NULL interps (porter
+
+2013-04-04 (bug fix) Support URLs with query but no path (max)
+=> http 2.8.7
+
+2013-04-08 (bug fix)[3610026] regexp crash on color overflow (linnakangas)
+
+2013-04-29 (enhancement) [array set] compile improvement (fellows)
+
+2013-04-30 (enhancement) broaden glibc version detection (kupries)
+=> platform 1.0.12
+
+2013-05-06 (platform support) Cygwin64 (nijtmans)
+
+2013-05-15 (enhancement) Improved [list {*}...] compile (fellows)
+
+2013-05-16 (platform support) mingw-4.0 (nijtmans)
+
+2013-05-19 (platform support) FreeBSD updates (cerutti)
+
+2013-05-20 (bug fix)[3613567] access error temp file creation (keene)
+
+2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene)
+
+2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows)
+
+2013-05-28 (bug fix)[3036566] Use language packs (Vista+) locale (oehlmann)
 => msgcat 1.5.2
 
+2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter)
+
+2013-06-03 Restored lost performance appending to long strings (elby,porter)
+
+2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
+
+2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)
+
+2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)
+
+2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang)
+
+2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin)
+
+2013-07-06 tzdata updated to Olson's tzdata2013d (kenny)
+
+2013-07-10 (bug fix)[86fb5e] [info frame] in compiled ensembles (porter)
+
+2013-07-18 (bug fix)[1c17fb] revisd syntax errorinfo that shows error (porter)
+
+2013-07-26 (bug fix)[6585b2] regexp {(\w).*?\1} abb (lane)
+
+2013-07-29 [string is space \u202f] => 1 (nijtmans)
+
+2013-08-01 [a0bc85] Limited support for fork with threads (for Rivet) (nijtmans)
+
+2013-08-01 (bug fix)[1905562] RE recursion limit increased to support
+reported usage of large expressions (porter)
+
+2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)
+
+2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows)
+
+2013-08-14 (bug fix)[a16752] Missing command delete callbacks (porter)
+
+2013-08-15 (bug fix)[3610404] reresolve traced forwards (porter)
+
+2013-08-15 Errors from execution traces become errors of the command (porter)
+
+2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter)
+
+2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter)
+
+2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows)
+
+Many optmizations, improvements, and tightened stack management in bytecode.
+
+--- Released 8.6.1, Septemer 18, 2013 --- See ChangeLog for details ---
-- 
cgit v0.12


From 8bc4ab1c8756c1abaefa435e76d7a4ab6458bdb9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 3 Sep 2013 16:47:50 +0000
Subject: Favor timeline over ChangeLog

---
 changes | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/changes b/changes
index 0339919..5428c3e 100644
--- a/changes
+++ b/changes
@@ -8292,4 +8292,4 @@ reported usage of large expressions (porter)
 
 Many optmizations, improvements, and tightened stack management in bytecode.
 
---- Released 8.6.1, Septemer 18, 2013 --- See ChangeLog for details ---
+--- Released 8.6.1, Septemer 18, 2013 --- http://core.tcl.tk/tcl/ for details 
-- 
cgit v0.12


From da0f4e22533c85ac4c70e6a45cb88cd87176cb66 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 3 Sep 2013 17:07:41 +0000
Subject: typo

---
 pkgs/README | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/pkgs/README b/pkgs/README
index 01c6f43..868bd4f 100644
--- a/pkgs/README
+++ b/pkgs/README
@@ -39,7 +39,7 @@ needs to conform to the following conventions.
     distclean:	Delete all generated files. 
 
     dist:	Produce a copy of the package's source code distribution.
-		Must respect the DIST_ROOT variable determing where to
+		Must respect the DIST_ROOT variable determining where to
 		write the generated directory.
 
 Packages that are written to make use of the Tcl Extension Architecture (TEA)
-- 
cgit v0.12


From a7ced6a9fdfa214f263e10b93d9d93b4f22d739d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 3 Sep 2013 17:39:34 +0000
Subject: make dist

---
 unix/tclConfig.h.in | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index 23d6026..e55dcd0 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -115,6 +115,9 @@
 /* Define to 1 if you have the `gmtime_r' function. */
 #undef HAVE_GMTIME_R
 
+/* Compiler support for module scope symbols */
+#undef HAVE_HIDDEN
+
 /* Do we have the intptr_t type? */
 #undef HAVE_INTPTR_T
 
@@ -343,9 +346,6 @@
 /* Do we have <values.h>? */
 #undef NO_VALUES_H
 
-/* Compiler support for module scope symbols */
-#undef HAVE_HIDDEN
-
 /* Do we have wait3() */
 #undef NO_WAIT3
 
-- 
cgit v0.12


From ee5dada68d84581a9b0c3ac970c11b862f0eb186 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 3 Sep 2013 18:50:08 +0000
Subject: doc fix exposed by `make html`

---
 doc/file.n | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/file.n b/doc/file.n
index 0b0ee9d..c117ee1 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -484,7 +484,7 @@ not the effective ones.
 .TP
 \fBWindows\fR\0\0\0\0
 .
-The \fbfile owned\fR subcommand currently always reports that the current user
+The \fBfile owned\fR subcommand currently always reports that the current user
 is the owner of the file, without regard for what the operating system
 believes to be true, making an ownership test useless. This issue (#3613671)
 may be fixed in a future release of Tcl.
-- 
cgit v0.12


From 991ddbd26c7c24de6598ff9fe61a1d9f13186548 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 8 Sep 2013 10:21:37 +0000
Subject: [3611643] Stop polluting the global namespace. Refactor the index
 entry generation so it is done right, once. Handle more of [namespace
 ensemble create]'s behavior.

---
 library/auto.tcl | 69 +++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 43 insertions(+), 26 deletions(-)

diff --git a/library/auto.tcl b/library/auto.tcl
index 78c219e..02edcc4 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -513,6 +513,32 @@ proc auto_mkindex_parser::fullname {name} {
     return [string map [list \0 \$] $name]
 }
 
+# auto_mkindex_parser::indexEntry --
+#
+# Used by commands like "proc" within the auto_mkindex parser to add a
+# correctly-quoted entry to the index. This is shared code so it is done
+# *right*, in one place.
+#
+# Arguments:
+# name -		Name that is being added to index.
+
+proc auto_mkindex_parser::indexEntry {name} {
+    variable index
+    variable scriptFile
+
+    # We convert all metacharacters to their backslashed form, and pre-split
+    # the file name that we know about (which will be a proper list, and so
+    # correctly quoted).
+
+    set name [string range [list \}[fullname $name]] 2 end]
+    set filenameParts [file split $scriptFile]
+
+    append index [format \
+	    {set auto_index(%s) [list source [file join $dir %s]]%s} \
+	    $name $filenameParts \n]
+    return
+}
+
 if {[llength $::auto_mkindex_parser::initCommands]} {
     return
 }
@@ -524,15 +550,7 @@ if {[llength $::auto_mkindex_parser::initCommands]} {
 # Adds an entry to the auto index list for the given procedure name.
 
 auto_mkindex_parser::command proc {name args} {
-    variable index
-    variable scriptFile
-    # Do some fancy reformatting on the "source" call to handle platform
-    # differences with respect to pathnames.  Use format just so that the
-    # command is a little easier to read (otherwise it'd be full of
-    # backslashed dollar signs, etc.
-    append index [list set auto_index([fullname $name])] \
-	    [format { [list source [file join $dir %s]]} \
-	    [file split $scriptFile]] "\n"
+    indexEntry $name
 }
 
 # Conditionally add support for Tcl byte code files.  There are some tricky
@@ -559,14 +577,7 @@ auto_mkindex_parser::hook {
 	# procedure name.
 
 	auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
-	    variable index
-	    variable scriptFile
-	    # Do some nice reformatting of the "source" call, to get around
-	    # path differences on different platforms.  We use the format
-	    # command just so that the code is a little easier to read.
-	    append index [list set auto_index([fullname $name])] \
-		    [format { [list source [file join $dir %s]]} \
-		    [file split $scriptFile]] "\n"
+	    indexEntry $name
 	}
     }
 }
@@ -610,6 +621,13 @@ auto_mkindex_parser::command namespace {op args} {
 	    variable contextStack
 	    if {[lindex $args 0] eq "create"} {
 		set name ::[join [lreverse $contextStack] ::]
+		catch {
+		    set name [dict get [lrange $args 1 end] -command]
+		    if {![string match ::* $name]} {
+			set name ::[join [lreverse $contextStack] ::]$name
+		    }
+		    regsub -all ::+ $name :: name
+		}
 		# create artifical proc to force an entry in the tclIndex
 		$parser eval [list ::proc $name {} {}]
 	    }
@@ -619,15 +637,14 @@ auto_mkindex_parser::command namespace {op args} {
 
 # AUTO MKINDEX:  oo::class create name ?definition?
 # Adds an entry to the auto index list for the given class name.
-foreach cmd {oo::class class} {
-    auto_mkindex_parser::command $cmd {ecmd name {body ""}} {
-	if {$cmd eq "create"} {
-	    variable index
-	    variable scriptFile
-	    append index [format "set %s \[list source \[%s]]\n" \
-			      [list auto_index([fullname $name])] \
-			      [list file join $dir {*}[file split $scriptFile]]]
-	}
+auto_mkindex_parser::command oo::class {op name {body ""}} {
+    if {$op eq "create"} {
+	indexEntry $name
+    }
+}
+auto_mkindex_parser::command class {op name {body ""}} {
+    if {$op eq "create"} {
+	indexEntry $name
     }
 }
 
-- 
cgit v0.12


From 6652de82ba5502a042b2be29a5cf7e04b73fca4b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 9 Sep 2013 13:34:06 +0000
Subject: [3609693] Must strip the internal representation of procedure-like
 methods in order to ensure that any bound references to instance variables
 are removed.

---
 generic/tclOOMethod.c | 50 ++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 48 insertions(+), 2 deletions(-)

diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 81293c7..61215de 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1290,11 +1290,57 @@ CloneProcedureMethod(
     ClientData *newClientData)
 {
     ProcedureMethod *pmPtr = clientData;
-    ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod));
+    ProcedureMethod *pm2Ptr;
+    Tcl_Obj *bodyObj, *argsObj;
+    CompiledLocal *localPtr;
 
+    /*
+     * Copy the argument list.
+     */
+
+    argsObj = Tcl_NewObj();
+    for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL;
+	    localPtr=localPtr->nextPtr) {
+	if (TclIsVarArgument(localPtr)) {
+	    Tcl_Obj *argObj = Tcl_NewObj();
+
+	    Tcl_ListObjAppendElement(NULL, argObj,
+		    Tcl_NewStringObj(localPtr->name, -1));
+	    if (localPtr->defValuePtr != NULL) {
+		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+	    }
+	    Tcl_ListObjAppendElement(NULL, argsObj, argObj);
+	}
+    }
+
+    /*
+     * Must strip the internal representation in order to ensure that any
+     * bound references to instance variables are removed. [Bug 3609693]
+     */
+
+    bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
+    TclFreeIntRep(bodyObj);
+
+    /*
+     * Create the actual copy of the method record, manufacturing a new proc
+     * record.
+     */
+
+    pm2Ptr = ckalloc(sizeof(ProcedureMethod));
     memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
     pm2Ptr->refCount = 1;
-    pm2Ptr->procPtr->refCount++;
+    Tcl_IncrRefCount(argsObj);
+    Tcl_IncrRefCount(bodyObj);
+    if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
+	    &pm2Ptr->procPtr) != TCL_OK) {
+	Tcl_DecrRefCount(argsObj);
+	Tcl_DecrRefCount(bodyObj);
+	ckfree(pm2Ptr);
+	return TCL_ERROR;
+    }
+    Tcl_DecrRefCount(argsObj);
+    Tcl_DecrRefCount(bodyObj);
+
     if (pmPtr->cloneClientdataProc) {
 	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
     }
-- 
cgit v0.12


From 28bb618586416fbb3c1c9a710cf88e5f8d924025 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 11 Sep 2013 02:32:04 +0000
Subject: Stop the save and restore of currStackDepth.  Just manage it
 correctly so it doesn't need correcting.

---
 generic/tclCompExpr.c | 8 +-------
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 2a48117..c2b5a1a 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -490,8 +490,6 @@ typedef struct JumpList {
     JumpFixup jump;		/* Pass this argument to matching calls of
 				 * TclEmitForwardJump() and 
 				 * TclFixupForwardJump(). */
-    int depth;			/* Remember the currStackDepth of the
-				 * CompileEnv here. */
     int offset;			/* Data used to compute jump lengths to pass
 				 * to TclFixupForwardJump() */
     int convert;		/* Temporary storage used to compute whether
@@ -2269,7 +2267,6 @@ CompileExprTree(
 		newJump = TclStackAlloc(interp, sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
-		jumpPtr->depth = envPtr->currStackDepth;
 		convert = 1;
 		break;
 	    case AND:
@@ -2283,7 +2280,6 @@ CompileExprTree(
 		newJump = TclStackAlloc(interp, sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
-		jumpPtr->depth = envPtr->currStackDepth;
 		break;
 	    }
 	} else if (nodePtr->mark == MARK_RIGHT) {
@@ -2323,7 +2319,7 @@ CompileExprTree(
 		CLANG_ASSERT(jumpPtr);
 		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
 			&jumpPtr->next->jump);
-		envPtr->currStackDepth = jumpPtr->depth;
+		TclAdjustStackDepth(-1, envPtr);
 		jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
 		jumpPtr->convert = convert;
 		convert = 1;
@@ -2383,7 +2379,6 @@ CompileExprTree(
 		TclFixupForwardJump(envPtr, &jumpPtr->jump,
 			jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
 		convert |= jumpPtr->convert;
-		envPtr->currStackDepth = jumpPtr->depth + 1;
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
 		TclStackFree(interp, freePtr);
@@ -2411,7 +2406,6 @@ CompileExprTree(
 		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump,
 			127);
 		convert = 0;
-		envPtr->currStackDepth = jumpPtr->depth + 1;
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
 		TclStackFree(interp, freePtr);
-- 
cgit v0.12


From 7eabd2838a8210a30da24672179294fd7d8b1b0a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 11 Sep 2013 04:49:08 +0000
Subject: Make use of the existing JumpFixup fields.  Eliminate extra storage
 field 'offset' in JumpList that we don't require.

---
 generic/tclCompExpr.c | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index c2b5a1a..0021323 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -490,8 +490,6 @@ typedef struct JumpList {
     JumpFixup jump;		/* Pass this argument to matching calls of
 				 * TclEmitForwardJump() and 
 				 * TclFixupForwardJump(). */
-    int offset;			/* Data used to compute jump lengths to pass
-				 * to TclFixupForwardJump() */
     int convert;		/* Temporary storage used to compute whether
 				 * numeric conversion will be needed following
 				 * the operator we're compiling. */
@@ -2320,7 +2318,6 @@ CompileExprTree(
 		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
 			&jumpPtr->next->jump);
 		TclAdjustStackDepth(-1, envPtr);
-		jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
 		jumpPtr->convert = convert;
 		convert = 1;
 		break;
@@ -2374,10 +2371,10 @@ CompileExprTree(
 		if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump,
 			(envPtr->codeNext - envPtr->codeStart)
 			- jumpPtr->next->jump.codeOffset, 127)) {
-		    jumpPtr->offset += 3;
+		    jumpPtr->next->jump.codeOffset += 3;
 		}
 		TclFixupForwardJump(envPtr, &jumpPtr->jump,
-			jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
+			jumpPtr->next->jump.codeOffset + 2 -jumpPtr->jump.codeOffset, 127);
 		convert |= jumpPtr->convert;
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
-- 
cgit v0.12


From 23bb5a2c20bd07e4b66ad4293fb927128e9e975b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 11 Sep 2013 05:07:52 +0000
Subject: Eliminate another surplus storage field.  Make a(n ab)use of the
 existing JumpFixup fields instead.

---
 generic/tclCompExpr.c | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 0021323..4afb069 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -490,9 +490,6 @@ typedef struct JumpList {
     JumpFixup jump;		/* Pass this argument to matching calls of
 				 * TclEmitForwardJump() and 
 				 * TclFixupForwardJump(). */
-    int convert;		/* Temporary storage used to compute whether
-				 * numeric conversion will be needed following
-				 * the operator we're compiling. */
     struct JumpList *next;	/* Point to next item on the stack */
 } JumpList;
 
@@ -2318,7 +2315,9 @@ CompileExprTree(
 		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
 			&jumpPtr->next->jump);
 		TclAdjustStackDepth(-1, envPtr);
-		jumpPtr->convert = convert;
+		if (convert) {
+		    jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
+		}
 		convert = 1;
 		break;
 	    case AND:
@@ -2368,6 +2367,10 @@ CompileExprTree(
 		break;
 	    case COLON:
 		CLANG_ASSERT(jumpPtr);
+		if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) {
+		    jumpPtr->jump.jumpType = TCL_FALSE_JUMP;
+		    convert = 1;
+		}
 		if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump,
 			(envPtr->codeNext - envPtr->codeStart)
 			- jumpPtr->next->jump.codeOffset, 127)) {
@@ -2375,7 +2378,6 @@ CompileExprTree(
 		}
 		TclFixupForwardJump(envPtr, &jumpPtr->jump,
 			jumpPtr->next->jump.codeOffset + 2 -jumpPtr->jump.codeOffset, 127);
-		convert |= jumpPtr->convert;
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
 		TclStackFree(interp, freePtr);
-- 
cgit v0.12


From 3e3fe2606ae5233ae213b95fd91d7d05d2987659 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 12 Sep 2013 17:42:36 +0000
Subject: Stop allocating JumpFixups for jumps that can never need any fixing
 up.

---
 generic/tclCompExpr.c | 37 +++++++++++++++----------------------
 1 file changed, 15 insertions(+), 22 deletions(-)

diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 4afb069..7684c70 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2269,12 +2269,6 @@ CompileExprTree(
 		newJump = TclStackAlloc(interp, sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
 		break;
 	    }
 	} else if (nodePtr->mark == MARK_RIGHT) {
@@ -2328,6 +2322,8 @@ CompileExprTree(
 		break;
 	    }
 	} else {
+	    int pc1, pc2;
+
 	    switch (nodePtr->lexeme) {
 	    case START:
 	    case QUESTION:
@@ -2377,7 +2373,9 @@ CompileExprTree(
 		    jumpPtr->next->jump.codeOffset += 3;
 		}
 		TclFixupForwardJump(envPtr, &jumpPtr->jump,
-			jumpPtr->next->jump.codeOffset + 2 -jumpPtr->jump.codeOffset, 127);
+			jumpPtr->next->jump.codeOffset + 2
+			- jumpPtr->jump.codeOffset, 127);
+
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
 		TclStackFree(interp, freePtr);
@@ -2388,32 +2386,27 @@ CompileExprTree(
 	    case AND:
 	    case OR:
 		CLANG_ASSERT(jumpPtr);
-		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
-			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP,
-			&jumpPtr->next->jump);
+		pc1 = CurrentOffset(envPtr);
+		TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
+			: INST_JUMP_TRUE1, 0, envPtr);
 		TclEmitPush(TclRegisterNewLiteral(envPtr,
 			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
-		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-			&jumpPtr->next->next->jump);
+		pc2 = CurrentOffset(envPtr);
+		TclEmitInstInt1(INST_JUMP1, 0, envPtr);
 		TclAdjustStackDepth(-1, envPtr);
-		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127);
+		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
+			envPtr->codeStart + pc1 + 1);
 		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
-		    jumpPtr->next->next->jump.codeOffset += 3;
+		    pc2 += 3;
 		}
 		TclEmitPush(TclRegisterNewLiteral(envPtr,
 			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
-		TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump,
-			127);
+		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
+			envPtr->codeStart + pc2 + 1);
 		convert = 0;
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
 		TclStackFree(interp, freePtr);
-		freePtr = jumpPtr;
-		jumpPtr = jumpPtr->next;
-		TclStackFree(interp, freePtr);
-		freePtr = jumpPtr;
-		jumpPtr = jumpPtr->next;
-		TclStackFree(interp, freePtr);
 		break;
 	    default:
 		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
-- 
cgit v0.12


From c12159563db8f0ecce0a00351e1cb0caed2a7acc Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 12 Sep 2013 19:21:20 +0000
Subject: Swap the two fixups used when compiling the ternary operator. Push
 them on the stack only when needed, and pop as soon as possible.

---
 generic/tclCompExpr.c | 33 ++++++++++++++++-----------------
 1 file changed, 16 insertions(+), 17 deletions(-)

diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 7684c70..106855a 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2256,12 +2256,6 @@ CompileExprTree(
 
 	    switch (nodePtr->lexeme) {
 	    case QUESTION:
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
 		convert = 1;
 		break;
 	    case AND:
@@ -2302,12 +2296,17 @@ CompileExprTree(
 		break;
 	    }
 	    case QUESTION:
+		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
 		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
 		break;
 	    case COLON:
-		CLANG_ASSERT(jumpPtr);
+		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
 		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-			&jumpPtr->next->jump);
+			&jumpPtr->jump);
 		TclAdjustStackDepth(-1, envPtr);
 		if (convert) {
 		    jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
@@ -2322,7 +2321,7 @@ CompileExprTree(
 		break;
 	    }
 	} else {
-	    int pc1, pc2;
+	    int pc1, pc2, target;
 
 	    switch (nodePtr->lexeme) {
 	    case START:
@@ -2364,21 +2363,21 @@ CompileExprTree(
 	    case COLON:
 		CLANG_ASSERT(jumpPtr);
 		if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) {
-		    jumpPtr->jump.jumpType = TCL_FALSE_JUMP;
+		    jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP;
 		    convert = 1;
 		}
-		if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump,
+		target = jumpPtr->jump.codeOffset + 2;
+		if (TclFixupForwardJump(envPtr, &jumpPtr->jump,
 			(envPtr->codeNext - envPtr->codeStart)
-			- jumpPtr->next->jump.codeOffset, 127)) {
-		    jumpPtr->next->jump.codeOffset += 3;
+			- jumpPtr->jump.codeOffset, 127)) {
+		    target += 3;
 		}
-		TclFixupForwardJump(envPtr, &jumpPtr->jump,
-			jumpPtr->next->jump.codeOffset + 2
-			- jumpPtr->jump.codeOffset, 127);
-
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
 		TclStackFree(interp, freePtr);
+		TclFixupForwardJump(envPtr, &jumpPtr->jump,
+			target - jumpPtr->jump.codeOffset, 127);
+
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
 		TclStackFree(interp, freePtr);
-- 
cgit v0.12


From c34e729136c3608344a630fc086235da2a4092e4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 12 Sep 2013 19:27:48 +0000
Subject: Push fixup on the stack only when needed.

---
 generic/tclCompExpr.c | 18 ++++++------------
 1 file changed, 6 insertions(+), 12 deletions(-)

diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 106855a..fce870b 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2254,16 +2254,8 @@ CompileExprTree(
 	if (nodePtr->mark == MARK_LEFT) {
 	    next = nodePtr->left;
 
-	    switch (nodePtr->lexeme) {
-	    case QUESTION:
+	    if (nodePtr->lexeme == QUESTION) {
 		convert = 1;
-		break;
-	    case AND:
-	    case OR:
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		break;
 	    }
 	} else if (nodePtr->mark == MARK_RIGHT) {
 	    next = nodePtr->right;
@@ -2314,10 +2306,12 @@ CompileExprTree(
 		convert = 1;
 		break;
 	    case AND:
-		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
-		break;
 	    case OR:
-		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpPtr->jump);
+		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump->next = jumpPtr;
+		jumpPtr = newJump;
+		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
+			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump);
 		break;
 	    }
 	} else {
-- 
cgit v0.12


From 6fef99593ff6cf1e4f504ca2a9ddabbd0d17c04b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 13 Sep 2013 03:33:43 +0000
Subject: More macro use.

---
 generic/tclCompCmds.c | 8 ++------
 generic/tclCompExpr.c | 4 +---
 2 files changed, 3 insertions(+), 9 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 8edb2d9..fdc8ec1 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2228,7 +2228,7 @@ TclCompileForCmd(
 {
     Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
     JumpFixup jumpEvalCondFixup;
-    int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
+    int bodyCodeOffset, nextCodeOffset, jumpDist;
     int bodyRange, nextRange;
     DefineLineInformation;	/* TIP #280 */
 
@@ -2309,13 +2309,9 @@ TclCompileForCmd(
      * terminates the for.
      */
 
-    testCodeOffset = CurrentOffset(envPtr);
-
-    jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
-    if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
+    if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) {
 	bodyCodeOffset += 3;
 	nextCodeOffset += 3;
-	testCodeOffset += 3;
     }
 
     SetLineInformation(2);
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index fce870b..d8e4d9f 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2361,9 +2361,7 @@ CompileExprTree(
 		    convert = 1;
 		}
 		target = jumpPtr->jump.codeOffset + 2;
-		if (TclFixupForwardJump(envPtr, &jumpPtr->jump,
-			(envPtr->codeNext - envPtr->codeStart)
-			- jumpPtr->jump.codeOffset, 127)) {
+		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
 		    target += 3;
 		}
 		freePtr = jumpPtr;
-- 
cgit v0.12


From 92eea63a7df5071fddef9b89b9122a5761670908 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 14 Sep 2013 07:07:03 +0000
Subject: [2152292] Corrected implementation of uuencoding.

---
 doc/binary.n        |  17 +++----
 generic/tclBinary.c | 125 ++++++++++++++++++++++++++++++++++++++++++++++++++--
 tests/binary.test   |  43 ++++++++++++------
 3 files changed, 158 insertions(+), 27 deletions(-)

diff --git a/doc/binary.n b/doc/binary.n
index a40afe6..95be36e 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -96,25 +96,22 @@ largely superseded by the \fBbase64\fR binary encoding.
 .RS
 .PP
 During encoding, the following options are supported:
-'\" This is wrong! The uuencode format had more complexity than this!
 .TP
 \fB\-maxlen \fIlength\fR
 .
 Indicates that the output should be split into lines of no more than
-\fIlength\fR characters. By default, lines are not split.
-.TP
-\fB\-wrapchar \fIcharacter\fR
-.
-Indicates that, when lines are split because of the \fB\-maxlen\fR option,
-\fIcharacter\fR should be used to separate lines. By default, this is a
-newline character,
-.QW \en .
+\fIlength\fR characters. By default, lines are split every 61 characters, and
+this must be in the range 3 to 85 due to limitations in the encoding.
 .PP
 During decoding, the following options are supported:
 .TP
 \fB\-strict\fR
 .
-Instructs the decoder to throw an error if it encounters whitespace characters. Otherwise it ignores them.
+Instructs the decoder to throw an error if it encounters whitespace
+characters. Otherwise it ignores them.
+.PP
+Note that neither the encoder nor the decoder handle the header and footer of
+the uuencode format.
 .RE
 .VE 8.6
 .SH "BINARY FORMAT"
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 7625d39..71da309 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -87,10 +87,13 @@ static int		BinaryDecodeHex(ClientData clientData,
 static int		BinaryEncode64(ClientData clientData,
 			    Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
-static int		BinaryDecodeUu(ClientData clientData,
+static int		BinaryDecode64(ClientData clientData,
 			    Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
-static int		BinaryDecode64(ClientData clientData,
+static int		BinaryEncodeUu(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		BinaryDecodeUu(ClientData clientData,
 			    Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 
@@ -140,7 +143,7 @@ static const EnsembleImplMap binaryMap[] = {
 };
 static const EnsembleImplMap encodeMap[] = {
     { "hex",      BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, (ClientData)HexDigits, 0 },
-    { "uuencode", BinaryEncode64,  NULL, NULL, (ClientData)UueDigits, 0 },
+    { "uuencode", BinaryEncodeUu,  NULL, NULL, NULL, 0 },
     { "base64",   BinaryEncode64,  NULL, NULL, (ClientData)B64Digits, 0 },
     { NULL, NULL, NULL, NULL, NULL, 0 }
 };
@@ -2439,7 +2442,7 @@ BinaryDecodeHex(
  *	This implements a generic 6 bit binary encoding. Input is broken into
  *	6 bit chunks and a lookup table passed in via clientData is used to
  *	turn these values into output characters. This is used to implement
- *	base64 and uuencode binary encodings.
+ *	base64 binary encodings.
  *
  * Results:
  *	Interp result set to an encoded byte array object
@@ -2498,6 +2501,12 @@ BinaryEncode64(
 	    if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) {
 		return TCL_ERROR;
 	    }
+	    if (maxlen < 0) {
+		Tcl_SetResult(interp, "line length out of range", TCL_STATIC);
+		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
+			"LINE_LENGTH", NULL);
+		return TCL_ERROR;
+	    }
 	    break;
 	case OPT_WRAPCHAR:
 	    wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
@@ -2550,6 +2559,114 @@ BinaryEncode64(
 /*
  *----------------------------------------------------------------------
  *
+ * BinaryEncodeUu --
+ *
+ *	This implements the uuencode binary encoding. Input is broken into 6
+ *	bit chunks and a lookup table is used to turn these values into output
+ *	characters. This differs from the generic code above in that line
+ *	lengths are also encoded.
+ *
+ * Results:
+ *	Interp result set to an encoded byte array object
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BinaryEncodeUu(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *resultObj;
+    unsigned char *data, *start, *cursor;
+    int offset, count, rawLength, n, i, bits, index;
+    int lineLength = 61;
+    enum {OPT_MAXLEN};
+    static const char *const optStrings[] = { "-maxlen", NULL };
+
+    if (objc < 2 || objc%2 != 0) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? data");
+	return TCL_ERROR;
+    }
+    for (i = 1; i < objc-1; i += 2) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
+		TCL_EXACT, &index) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (index) {
+	case OPT_MAXLEN:
+	    if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (lineLength < 3 || lineLength > 85) {
+		Tcl_SetResult(interp, "line length out of range", TCL_STATIC);
+		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
+			"LINE_LENGTH", NULL);
+		return TCL_ERROR;
+	    }
+	    break;
+	}
+    }
+
+    /*
+     * Allocate the buffer. This is a little bit too long, but is "good
+     * enough".
+     */
+
+    resultObj = Tcl_NewObj();
+    offset = 0;
+    data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
+    rawLength = (lineLength - 1) * 3 / 4;
+    start = cursor = Tcl_SetByteArrayLength(resultObj,
+	    (lineLength + 1) * ((count + (rawLength - 1)) / rawLength));
+    n = bits = 0;
+
+    /*
+     * Encode the data. Each output line first has the length of raw data
+     * encoded by the output line described in it by one encoded byte, then
+     * the encoded data follows (encoding each 6 bits as one character).
+     * Encoded lines are always terminated by a newline.
+     */
+
+    while (offset < count) {
+	int lineLen = count - offset;
+
+	if (lineLen > rawLength) {
+	    lineLen = rawLength;
+	}
+	*cursor++ = UueDigits[lineLen];
+	for (i=0 ; i<lineLen ; i++) {
+	    n <<= 8;
+	    n |= data[offset++];
+	    for (bits += 8; bits > 6 ; bits -= 6) {
+		*cursor++ = UueDigits[(n >> (bits-6)) & 0x3f];
+	    }
+	}
+	if (bits > 0) {
+	    n <<= 8;
+	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
+	    bits = 0;
+	}
+	*cursor++ = '\n';
+    }
+
+    /*
+     * Fix the length of the output bytearray.
+     */
+
+    Tcl_SetByteArrayLength(resultObj, cursor-start);
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * BinaryDecodeUu --
  *
  *	Decode a uuencoded string.
diff --git a/tests/binary.test b/tests/binary.test
index d424837..4b71b77 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -2705,34 +2705,51 @@ test binary-74.1 {binary encode uuencode} -body {
 } -returnCodes error -match glob -result "wrong # args: *"
 test binary-74.2 {binary encode uuencode} -body {
     binary encode uuencode abc
-} -result {86)C}
+} -result {#86)C
+}
 test binary-74.3 {binary encode uuencode} -body {
     binary encode uuencode {}
 } -result {}
 test binary-74.4 {binary encode uuencode} -body {
     binary encode uuencode [string repeat abc 20]
-} -result [string repeat 86)C 20]
+} -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
 test binary-74.5 {binary encode uuencode} -body {
     binary encode uuencode \0\1\2\3\4\0\1\2\3
-} -result "``\$\"`P0``0(#"
+} -result ")``\$\"`P0``0(#\n"
 test binary-74.6 {binary encode uuencode} -body {
     binary encode uuencode \0
-} -result {````}
+} -result {!``
+}
 test binary-74.7 {binary encode uuencode} -body {
     binary encode uuencode \0\0
-} -result {````}
+} -result "\"```
+"
 test binary-74.8 {binary encode uuencode} -body {
     binary encode uuencode \0\0\0
-} -result {````}
+} -result {#````
+}
 test binary-74.9 {binary encode uuencode} -body {
     binary encode uuencode \0\0\0\0
-} -result {````````}
-test binary-74.10 {binary encode uuencode} -body {
-    binary encode uuencode -maxlen 0 -wrapchar | abcabcabc
-} -result {86)C86)C86)C}
-test binary-74.11 {binary encode uuencode} -body {
-    binary encode uuencode -maxlen 1 -wrapchar | abcabcabc
-} -result {8|6|)|C|8|6|)|C|8|6|)|C}
+} -result {$``````
+}
+test binary-74.10 {binary encode uuencode} -returnCodes error -body {
+    binary encode uuencode -maxlen 30 -wrapchar | abcabcabc
+} -result {bad option "-wrapchar": must be -maxlen}
+test binary-74.11 {binary encode uuencode} -returnCodes error -body {
+    binary encode uuencode -maxlen 1 abcabcabc
+} -result {line length out of range}
+test binary-74.12 {binary encode uuencode} -body {
+    binary encode uuencode -maxlen 3 abcabcabc
+} -result {!80
+!8@
+!8P
+!80
+!8@
+!8P
+!80
+!8@
+!8P
+}
 
 test binary-75.1 {binary decode uuencode} -body {
     binary decode uuencode
-- 
cgit v0.12


From b1264cd184de3c9ba370ae1e9cb9bb029b12872b Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sat, 14 Sep 2013 08:51:23 +0000
Subject: Add back -wrapchar option to "binary encode uuencode".

---
 doc/binary.n        |  9 ++++++++-
 generic/tclBinary.c | 25 +++++++++++++++++++------
 tests/binary.test   | 17 ++++-------------
 3 files changed, 31 insertions(+), 20 deletions(-)

diff --git a/doc/binary.n b/doc/binary.n
index 95be36e..9f22fb1 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -64,7 +64,7 @@ Indicates that the output should be split into lines of no more than
 .
 Indicates that, when lines are split because of the \fB\-maxlen\fR option,
 \fIcharacter\fR should be used to separate lines. By default, this is a
-newline character,
+newline character.
 .QW \en .
 .PP
 During decoding, the following options are supported:
@@ -102,6 +102,13 @@ During encoding, the following options are supported:
 Indicates that the output should be split into lines of no more than
 \fIlength\fR characters. By default, lines are split every 61 characters, and
 this must be in the range 3 to 85 due to limitations in the encoding.
+.TP
+\fB\-wrapchar \fIcharacter\fR
+.
+Indicates that, when lines are split because of the \fB\-maxlen\fR option,
+\fIcharacter\fR should be used to separate lines. By default, this is a
+newline character.
+.QW \en .
 .PP
 During decoding, the following options are supported:
 .TP
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 71da309..98a4d31 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2584,13 +2584,15 @@ BinaryEncodeUu(
 {
     Tcl_Obj *resultObj;
     unsigned char *data, *start, *cursor;
-    int offset, count, rawLength, n, i, bits, index;
+    int offset, count, rawLength, n, i, j, bits, index;
     int lineLength = 61;
-    enum {OPT_MAXLEN};
-    static const char *const optStrings[] = { "-maxlen", NULL };
+    const char *wrapchar = "\n";
+    int wrapcharlen = 1;
+    enum {OPT_MAXLEN, OPT_WRAPCHAR };
+    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
 
     if (objc < 2 || objc%2 != 0) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? data");
+	Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data");
 	return TCL_ERROR;
     }
     for (i = 1; i < objc-1; i += 2) {
@@ -2610,6 +2612,15 @@ BinaryEncodeUu(
 		return TCL_ERROR;
 	    }
 	    break;
+	case OPT_WRAPCHAR:
+	    wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
+	    if (wrapcharlen < 0 || wrapcharlen > 2) {
+		Tcl_SetResult(interp, "wrap char out of range", TCL_STATIC);
+		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
+			"WRAP_CHAR", NULL);
+		return TCL_ERROR;
+	    }
+	    break;
 	}
     }
 
@@ -2623,7 +2634,7 @@ BinaryEncodeUu(
     data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
     rawLength = (lineLength - 1) * 3 / 4;
     start = cursor = Tcl_SetByteArrayLength(resultObj,
-	    (lineLength + 1) * ((count + (rawLength - 1)) / rawLength));
+	    (lineLength + wrapcharlen) * ((count + (rawLength - 1)) / rawLength));
     n = bits = 0;
 
     /*
@@ -2652,7 +2663,9 @@ BinaryEncodeUu(
 	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
 	    bits = 0;
 	}
-	*cursor++ = '\n';
+	for (j=0; j<wrapcharlen; ++j) {
+	    *cursor++ = wrapchar[j];
+	}
     }
 
     /*
diff --git a/tests/binary.test b/tests/binary.test
index 4b71b77..ff1929f 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -2733,23 +2733,14 @@ test binary-74.9 {binary encode uuencode} -body {
 } -result {$``````
 }
 test binary-74.10 {binary encode uuencode} -returnCodes error -body {
-    binary encode uuencode -maxlen 30 -wrapchar | abcabcabc
-} -result {bad option "-wrapchar": must be -maxlen}
+    binary encode uuencode -foo 30 abcabcabc
+} -result {bad option "-foo": must be -maxlen or -wrapchar}
 test binary-74.11 {binary encode uuencode} -returnCodes error -body {
     binary encode uuencode -maxlen 1 abcabcabc
 } -result {line length out of range}
 test binary-74.12 {binary encode uuencode} -body {
-    binary encode uuencode -maxlen 3 abcabcabc
-} -result {!80
-!8@
-!8P
-!80
-!8@
-!8P
-!80
-!8@
-!8P
-}
+    binary encode uuencode -maxlen 3 -wrapchar | abcabcabc
+} -result {!80|!8@|!8P|!80|!8@|!8P|!80|!8@|!8P|}
 
 test binary-75.1 {binary decode uuencode} -body {
     binary decode uuencode
-- 
cgit v0.12


From dc8a74cb4dd9032147ee2106fb16a738e394bc1f Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sat, 14 Sep 2013 08:59:41 +0000
Subject: Hm, this check doesn't really add anything.

---
 generic/tclBinary.c | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 98a4d31..69f5baf 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2614,12 +2614,6 @@ BinaryEncodeUu(
 	    break;
 	case OPT_WRAPCHAR:
 	    wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
-	    if (wrapcharlen < 0 || wrapcharlen > 2) {
-		Tcl_SetResult(interp, "wrap char out of range", TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
-			"WRAP_CHAR", NULL);
-		return TCL_ERROR;
-	    }
 	    break;
 	}
     }
-- 
cgit v0.12


From 0f1f636a50239c2409172a34da5fa1b1f45bf9c4 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 14 Sep 2013 18:25:45 +0000
Subject: And the decoder too.

---
 doc/binary.n        |   2 +-
 generic/tclBinary.c | 104 +++++++++++++++++++++++++++++++++++++++++++---------
 tests/binary.test   |  41 +++++++++++----------
 3 files changed, 109 insertions(+), 38 deletions(-)

diff --git a/doc/binary.n b/doc/binary.n
index 95be36e..b301f4d 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -107,7 +107,7 @@ During decoding, the following options are supported:
 .TP
 \fB\-strict\fR
 .
-Instructs the decoder to throw an error if it encounters whitespace
+Instructs the decoder to throw an error if it encounters unexpected whitespace
 characters. Otherwise it ignores them.
 .PP
 Note that neither the encoder nor the decoder handle the header and footer of
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 71da309..c0dd926 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2690,8 +2690,8 @@ BinaryDecodeUu(
     Tcl_Obj *resultObj = NULL;
     unsigned char *data, *datastart, *dataend;
     unsigned char *begin, *cursor;
-    int i, index, size, count = 0, cut = 0, strict = 0;
-    char c;
+    int i, index, size, count = 0, strict = 0, lineLen;
+    unsigned char c;
     enum {OPT_STRICT };
     static const char *const optStrings[] = { "-strict", NULL };
 
@@ -2717,44 +2717,112 @@ BinaryDecodeUu(
     dataend = data + count;
     size = ((count + 3) & ~3) * 3 / 4;
     begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
+    lineLen = -1;
+
+    /*
+     * The decoding loop. First, we get the length of line (strictly, the
+     * number of data bytes we expect to generate from the line) we're
+     * processing this time round if it is not already known (i.e., when the
+     * lineLen variable is set to the magic value, -1).
+     */
+
     while (data < dataend) {
 	char d[4] = {0, 0, 0, 0};
 
+	if (lineLen < 0) {
+	    c = *data++;
+	    if (c < 32 || c > 96) {
+		if (strict || !isspace(c)) {
+		    goto badUu;
+		}
+		i--;
+		continue;
+	    }
+	    lineLen = (c - 32) & 0x3f;
+	}
+
+	/*
+	 * Now we read a four-character grouping.
+	 */
+
 	for (i=0 ; i<4 ; i++) {
 	    if (data < dataend) {
 		d[i] = c = *data++;
-		if (c < 33 || c > 96) {
-		    if (strict || !isspace(UCHAR(c))) {
-			goto badUu;
+		if (c < 32 || c > 96) {
+		    if (strict) {
+			if (!isspace(c)) {
+			    goto badUu;
+			} else if (c == '\n') {
+			    goto shortUu;
+			}
 		    }
 		    i--;
 		    continue;
 		}
-	    } else {
-		cut++;
 	    }
 	}
-	if (cut > 3) {
-	    cut = 3;
+
+	/*
+	 * Translate that grouping into (up to) three binary bytes output.
+	 */
+
+	if (lineLen > 0) {
+	    *cursor++ = (((d[0] - 0x20) & 0x3f) << 2)
+		    | (((d[1] - 0x20) & 0x3f) >> 4);
+	    if (--lineLen > 0) {
+		*cursor++ = (((d[1] - 0x20) & 0x3f) << 4)
+			| (((d[2] - 0x20) & 0x3f) >> 2);
+		if (--lineLen > 0) {
+		    *cursor++ = (((d[2] - 0x20) & 0x3f) << 6)
+			    | (((d[3] - 0x20) & 0x3f));
+		    lineLen--;
+		}
+	    }
+	}
+
+	/*
+	 * If we've reached the end of the line, skip until we process a
+	 * newline.
+	 */
+
+	if (lineLen == 0 && data < dataend) {
+	    lineLen = -1;
+	    do {
+		c = *data++;
+		if (c == '\n') {
+		    break;
+		} else if (c >= 32 && c <= 96) {
+		    data--;
+		    break;
+		} else if (strict || !isspace(c)) {
+		    goto badUu;
+		}
+	    } while (data < dataend);
 	}
-	*cursor++ = (((d[0] - 0x20) & 0x3f) << 2)
-		| (((d[1] - 0x20) & 0x3f) >> 4);
-	*cursor++ = (((d[1] - 0x20) & 0x3f) << 4)
-		| (((d[2] - 0x20) & 0x3f) >> 2);
-	*cursor++ = (((d[2] - 0x20) & 0x3f) << 6)
-		| (((d[3] - 0x20) & 0x3f));
     }
-    if (cut > size) {
-	cut = size;
+
+    /*
+     * Sanity check, clean up and finish.
+     */
+
+    if (lineLen > 0 && strict) {
+	goto shortUu;
     }
-    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
+    Tcl_SetByteArrayLength(resultObj, cursor - begin);
     Tcl_SetObjResult(interp, resultObj);
     return TCL_OK;
 
+  shortUu:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
+    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL);
+    TclDecrRefCount(resultObj);
+    return TCL_ERROR;
+
   badUu:
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 	    "invalid uuencode character \"%c\" at position %d",
 	    c, (int) (data - datastart - 1)));
+    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
     TclDecrRefCount(resultObj);
     return TCL_ERROR;
 }
diff --git a/tests/binary.test b/tests/binary.test
index 4b71b77..607a070 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -2755,72 +2755,75 @@ test binary-75.1 {binary decode uuencode} -body {
     binary decode uuencode
 } -returnCodes error -match glob -result "wrong # args: *"
 test binary-75.2 {binary decode uuencode} -body {
-    binary decode uuencode 86)C
+    binary decode uuencode "#86)C\n"
 } -result {abc}
 test binary-75.3 {binary decode uuencode} -body {
     binary decode uuencode {}
 } -result {}
+test binary-75.3.1 {binary decode uuencode} -body {
+    binary decode uuencode `\n
+} -result {}
 test binary-75.4 {binary decode uuencode} -body {
-    binary decode uuencode [string repeat "86)C" 20]
+    binary decode uuencode "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
 } -result [string repeat abc 20]
 test binary-75.5 {binary decode uuencode} -body {
-    binary decode uuencode "``\$\"`P0``0(#"
+    binary decode uuencode ")``\$\"`P0``0(#"
 } -result "\0\1\2\3\4\0\1\2\3"
 test binary-75.6 {binary decode uuencode} -body {
-    string length [binary decode uuencode {`}]
+    string length [binary decode uuencode "`\n"]
 } -result 0
 test binary-75.7 {binary decode uuencode} -body {
-    string length [binary decode uuencode {``}]
+    string length [binary decode uuencode "!`\n"]
 } -result 1
 test binary-75.8 {binary decode uuencode} -body {
-    string length [binary decode uuencode {```}]
+    string length [binary decode uuencode "\"``\n"]
 } -result 2
 test binary-75.9 {binary decode uuencode} -body {
-    string length [binary decode uuencode {````}]
+    string length [binary decode uuencode "#```\n"]
 } -result 3
 test binary-75.10 {binary decode uuencode} -body {
-    set s "[string repeat 86)C 10]\n[string repeat 86)C 10]"
+    set s ">[string repeat 86)C 10]\n>[string repeat 86)C 10]"
     binary decode uuencode $s
 } -result [string repeat abc 20]
 test binary-75.11 {binary decode uuencode} -body {
-    set s "[string repeat 86)C 10]\n    [string repeat 86)C 10]"
+    set s ">[string repeat 86)C 10]\n\t>\t[string repeat 86)C 10]\r"
     binary decode uuencode $s
 } -result [string repeat abc 20]
 test binary-75.12 {binary decode uuencode} -body {
     binary decode uuencode -strict "|86)C"
 } -returnCodes error -match glob -result {invalid uuencode character "|" at position 0}
 test binary-75.13 {binary decode uuencode} -body {
-    set s "[string repeat 86)C 10]|[string repeat 86)C 10]"
+    set s ">[string repeat 86)C 10]|[string repeat 86)C 10]"
     binary decode uuencode -strict $s
-} -returnCodes error -match glob -result {invalid uuencode character "|" at position 40}
+} -returnCodes error -match glob -result {invalid uuencode character "|" at position 41}
 test binary-75.14 {binary decode uuencode} -body {
-    set s "[string repeat 86)C 10]\n    [string repeat 86)C 10]"
+    set s ">[string repeat 86)C 10]\na[string repeat 86)C 10]"
     binary decode uuencode -strict $s
 } -returnCodes error -match glob -result {invalid uuencode character *}
 test binary-75.20 {binary decode uuencode} -body {
-    set r [binary decode uuencode 8]
+    set r [binary decode uuencode " 8"]
     list [string length $r] $r
 } -result {0 {}}
 test binary-75.21 {binary decode uuencode} -body {
-    set r [binary decode uuencode 86]
+    set r [binary decode uuencode "!86"]
     list [string length $r] $r
 } -result {1 a}
 test binary-75.22 {binary decode uuencode} -body {
-    set r [binary decode uuencode 86)]
+    set r [binary decode uuencode "\"86)"]
     list [string length $r] $r
 } -result {2 ab}
 test binary-75.23 {binary decode uuencode} -body {
-    set r [binary decode uuencode 86)C]
+    set r [binary decode uuencode "#86)C"]
     list [string length $r] $r
 } -result {3 abc}
 test binary-75.24 {binary decode uuencode} -body {
-    set s "04)\# "
+    set s "#04)\# "
     binary decode uuencode $s
 } -result ABC
 test binary-75.25 {binary decode uuencode} -body {
-    set s "04)\#z"
+    set s "#04)\#z"
     binary decode uuencode $s
-} -returnCodes error -match glob -result {invalid uuencode character "z" at position 4}
+} -returnCodes error -match glob -result {invalid uuencode character "z" at position 5}
 test binary-75.26 {binary decode uuencode} -body {
     string length [binary decode uuencode " "]
 } -result 0
-- 
cgit v0.12


From 826a355cc84e880287a692ccc1c3c48c915f5f4a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 16 Sep 2013 08:52:12 +0000
Subject: Be careful: separator needs to be bytes, not internal-encoded.

---
 generic/tclBinary.c | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 2053319..114984f 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2586,13 +2586,15 @@ BinaryEncodeUu(
     unsigned char *data, *start, *cursor;
     int offset, count, rawLength, n, i, j, bits, index;
     int lineLength = 61;
-    const char *wrapchar = "\n";
-    int wrapcharlen = 1;
-    enum {OPT_MAXLEN, OPT_WRAPCHAR };
+    const unsigned char SingleNewline[] = { (unsigned char) '\n' };
+    const unsigned char *wrapchar = SingleNewline;
+    int wrapcharlen = sizeof(SingleNewline);
+    enum { OPT_MAXLEN, OPT_WRAPCHAR };
     static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
 
     if (objc < 2 || objc%2 != 0) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data");
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?-maxlen len? ?-wrapchar char? data");
 	return TCL_ERROR;
     }
     for (i = 1; i < objc-1; i += 2) {
@@ -2613,7 +2615,7 @@ BinaryEncodeUu(
 	    }
 	    break;
 	case OPT_WRAPCHAR:
-	    wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
+	    wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen);
 	    break;
 	}
     }
@@ -2628,7 +2630,8 @@ BinaryEncodeUu(
     data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
     rawLength = (lineLength - 1) * 3 / 4;
     start = cursor = Tcl_SetByteArrayLength(resultObj,
-	    (lineLength + wrapcharlen) * ((count + (rawLength - 1)) / rawLength));
+	    (lineLength + wrapcharlen) *
+	    ((count + (rawLength - 1)) / rawLength));
     n = bits = 0;
 
     /*
@@ -2657,7 +2660,7 @@ BinaryEncodeUu(
 	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
 	    bits = 0;
 	}
-	for (j=0; j<wrapcharlen; ++j) {
+	for (j=0 ; j<wrapcharlen ; ++j) {
 	    *cursor++ = wrapchar[j];
 	}
     }
-- 
cgit v0.12


From 7b804b09e12bf6d2b1da605b34daa9ab8ccfb424 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 16 Sep 2013 09:03:50 +0000
Subject: Refactor to remove unused flexibility.

---
 generic/tclBinary.c | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 114984f..58583f4 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -142,9 +142,9 @@ static const EnsembleImplMap binaryMap[] = {
     { NULL, NULL, NULL, NULL, NULL, 0 }
 };
 static const EnsembleImplMap encodeMap[] = {
-    { "hex",      BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, (ClientData)HexDigits, 0 },
+    { "hex",      BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
     { "uuencode", BinaryEncodeUu,  NULL, NULL, NULL, 0 },
-    { "base64",   BinaryEncode64,  NULL, NULL, (ClientData)B64Digits, 0 },
+    { "base64",   BinaryEncode64,  NULL, NULL, NULL, 0 },
     { NULL, NULL, NULL, NULL, NULL, 0 }
 };
 static const EnsembleImplMap decodeMap[] = {
@@ -2315,7 +2315,6 @@ BinaryEncodeHex(
     Tcl_Obj *resultObj = NULL;
     unsigned char *data = NULL;
     unsigned char *cursor = NULL;
-    const char *digits = clientData;
     int offset = 0, count = 0;
 
     if (objc != 2) {
@@ -2327,8 +2326,8 @@ BinaryEncodeHex(
     data = Tcl_GetByteArrayFromObj(objv[1], &count);
     cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
     for (offset = 0; offset < count; ++offset) {
-	*cursor++ = digits[((data[offset] >> 4) & 0x0f)];
-	*cursor++ = digits[(data[offset] & 0x0f)];
+	*cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)];
+	*cursor++ = HexDigits[(data[offset] & 0x0f)];
     }
     Tcl_SetObjResult(interp, resultObj);
     return TCL_OK;
@@ -2478,7 +2477,6 @@ BinaryEncode64(
 {
     Tcl_Obj *resultObj;
     unsigned char *data, *cursor, *limit;
-    const char *digits = clientData;
     int maxlen = 0;
     const char *wrapchar = "\n";
     int wrapcharlen = 1;
@@ -2537,17 +2535,17 @@ BinaryEncode64(
 	    for (i = 0; i < 3 && offset+i < count; ++i) {
 		d[i] = data[offset + i];
 	    }
-	    OUTPUT(digits[d[0] >> 2]);
-	    OUTPUT(digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
+	    OUTPUT(B64Digits[d[0] >> 2]);
+	    OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
 	    if (offset+1 < count) {
-		OUTPUT(digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
+		OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
 	    } else {
-		OUTPUT(digits[64]);
+		OUTPUT(B64Digits[64]);
 	    }
 	    if (offset+2 < count) {
-		OUTPUT(digits[d[2] & 0x3f]);
+		OUTPUT(B64Digits[d[2] & 0x3f]);
 	    } else {
-		OUTPUT(digits[64]);
+		OUTPUT(B64Digits[64]);
 	    }
 	}
     }
-- 
cgit v0.12


From e1a2deb52347de47b6357eb9662c56ee98a4d81e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 16 Sep 2013 23:18:54 +0000
Subject: [7b32d8d13b] Insert missing field initialization.

---
 generic/tclAssembly.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 100e9ef..946c729 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -2617,6 +2617,7 @@ AllocBB(
     bb->minStackDepth = 0;
     bb->maxStackDepth = 0;
     bb->finalStackDepth = 0;
+    bb->catchDepth = 0;
     bb->enclosingCatch = NULL;
     bb->foreignExceptionBase = -1;
     bb->foreignExceptionCount = 0;
-- 
cgit v0.12


From 081808cdabb46c7e3f387d766ca6e58cc5c9af8f Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 17 Sep 2013 09:13:40 +0000
Subject: small improvements to the documentation

---
 doc/binary.n | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/doc/binary.n b/doc/binary.n
index 0cdf465..cbbebd1 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -36,6 +36,13 @@ The \fBbinary encode\fR and \fBbinary decode\fR subcommands convert
 binary data to or from string encodings such as base64 (used in MIME
 messages for example).
 .VE 8.6
+.PP
+Note that other operations on binary data, such as taking a subsequence of it,
+getting its length, or reinterpreting it as a string in some encoding, are
+done by other Tcl commands (respectively \fBstring range\fR,
+\fBstring length\fR and \fBencoding convertfrom\fR in the example cases).  A
+binary string in Tcl is merely one where all the characters it contains are in
+the range \eu0000\-\eu00FF.
 .SH "BINARY ENCODE AND DECODE"
 .VS 8.6
 .PP
@@ -64,7 +71,7 @@ Indicates that the output should be split into lines of no more than
 .
 Indicates that, when lines are split because of the \fB\-maxlen\fR option,
 \fIcharacter\fR should be used to separate lines. By default, this is a
-newline character.
+newline character,
 .QW \en .
 .PP
 During decoding, the following options are supported:
@@ -95,7 +102,8 @@ between Unix systems and on USENET, but is less common these days, having been
 largely superseded by the \fBbase64\fR binary encoding.
 .RS
 .PP
-During encoding, the following options are supported:
+During encoding, the following options are supported (though changing them may
+produce files that other implementations of decoders cannot process):
 .TP
 \fB\-maxlen \fIlength\fR
 .
@@ -107,7 +115,7 @@ this must be in the range 3 to 85 due to limitations in the encoding.
 .
 Indicates that, when lines are split because of the \fB\-maxlen\fR option,
 \fIcharacter\fR should be used to separate lines. By default, this is a
-newline character.
+newline character,
 .QW \en .
 .PP
 During decoding, the following options are supported:
@@ -859,6 +867,7 @@ architectures, use their textual representation (as produced by
 .PP
 This is a procedure to write a Tcl string to a binary-encoded channel as
 UTF-8 data preceded by a length word:
+.PP
 .CS
 proc \fIwriteString\fR {channel string} {
     set data [encoding convertto utf-8 $string]
@@ -869,6 +878,7 @@ proc \fIwriteString\fR {channel string} {
 .PP
 This procedure reads a string from a channel that was written by the
 previously presented \fIwriteString\fR procedure:
+.PP
 .CS
 proc \fIreadString\fR {channel} {
     if {![\fBbinary scan\fR [read $channel 4] I length]} {
@@ -881,6 +891,7 @@ proc \fIreadString\fR {channel} {
 .PP
 This converts the contents of a file (named in the variable \fIfilename\fR) to
 base64 and prints them:
+.PP
 .CS
 set f [open $filename rb]
 set data [read $f]
@@ -888,9 +899,10 @@ close $f
 puts [\fBbinary encode\fR base64 \-maxlen 64 $data]
 .CE
 .SH "SEE ALSO"
-format(n), scan(n), tcl_platform(n)
+encoding(n), format(n), scan(n), string(n), tcl_platform(n)
 .SH KEYWORDS
 binary, format, scan
 '\" Local Variables:
 '\" mode: nroff
+'\" fill-column: 78
 '\" End:
-- 
cgit v0.12


From 485b7e865a78e8d32056d25dc181e4b19e07be0c Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 17 Sep 2013 09:20:58 +0000
Subject: ChangeLog entry

---
 ChangeLog | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 8e1a8b9..eaa5fc8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2013-09-17  Donal Fellows  <dkf@Donals-MacBook-Pro.local>
+
+	* generic/tclBinary.c (BinaryEncodeUu, BinaryDecodeUu): [Bug 2152292]:
+	Corrected implementation of the core of uuencode handling so that the
+	line length processing is correctly applied.
+	***POTENTIAL INCOMPATIBILITY***
+	Existing code that was using the old versions and working around the
+	limitations will now need to do far less. The -maxlen option now has
+	strict limits on the range of supported lengths; this is a limitation
+	of the format itself.
+
 2013-09-09  Donal Fellows  <dkf@users.sf.net>
 
 	* generic/tclOOMethod.c (CloneProcedureMethod): [Bug 3609693]: Strip
-- 
cgit v0.12


From 868b8031fd65e9786ac1484f3fe1261c176ad5c0 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 18 Sep 2013 12:32:26 +0000
Subject: Bump TclOO version to 1.0.1

---
 ChangeLog                 | 25 +++++++++++++++----------
 generic/tclOO.h           |  2 +-
 generic/tclOOBasic.c      |  2 +-
 generic/tclOODefineCmds.c |  2 +-
 tests/oo.test             |  4 ++--
 tests/ooNext2.test        |  2 +-
 unix/tclooConfig.sh       |  2 +-
 win/tclooConfig.sh        |  2 +-
 8 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index eaa5fc8..3dc8c5e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,8 @@
-2013-09-17  Donal Fellows  <dkf@Donals-MacBook-Pro.local>
+2013-09-18  Donal Fellows  <dkf@users.sf.net>
+
+	Bump TclOO version to 1.0.1 for release.
+
+2013-09-17  Donal Fellows  <dkf@users.sf.net>
 
 	* generic/tclBinary.c (BinaryEncodeUu, BinaryDecodeUu): [Bug 2152292]:
 	Corrected implementation of the core of uuencode handling so that the
@@ -59,12 +63,13 @@
 
 2013-06-27  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs initialized
-	* generic/tclMain.c:   encodings.
+	* generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs
+	* generic/tclMain.c:   initialized encodings.
 
 2013-06-18  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread issue.
+	* generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread
+	issue.
 
 2013-06-17  Jan Nijtmans  <nijtmans@users.sf.net>
 
@@ -176,10 +181,10 @@
 
 	* generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit
 	* generic/tclDecls.h: "long" type. Binary compatibility with win64
-	requires that all stub entries use 32-bit long's, therefore the
-	need for various wrapper functions/macros. For Tcl 9 a better
-	solution is needed, but that cannot be done without introducing
-	binary incompatibility.
+	requires that all stub entries use 32-bit long's, therefore the need
+	for various wrapper functions/macros. For Tcl 9 a better solution is
+	needed, but that cannot be done without introducing binary
+	incompatibility.
 
 2013-04-30  Andreas Kupries  <andreask@activestate.com>
 
@@ -197,8 +202,8 @@
 
 	* generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj
 	and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj
-	and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same,
-	it only eliminates code duplication.
+	and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same, it
+	only eliminates code duplication.
 	* generic/tclInt.h: Eliminate use of NO_WIDE_TYPE everywhere: It's
 	exactly the same as TCL_WIDE_INT_IS_LONG
 
diff --git a/generic/tclOO.h b/generic/tclOO.h
index cf253b1..d5ab8a0 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -39,7 +39,7 @@ extern const char *TclOOInitializeStubs(
  * win/tclooConfig.sh
  */
 
-#define TCLOO_VERSION "1.0"
+#define TCLOO_VERSION "1.0.1"
 #define TCLOO_PATCHLEVEL TCLOO_VERSION
 
 /*
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index aba06a5..853e2ec 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -4,7 +4,7 @@
  *	This file contains implementations of the "simple" commands and
  *	methods from the object-system core.
  *
- * Copyright (c) 2005-2012 by Donal K. Fellows
+ * Copyright (c) 2005-2013 by Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index f0983cc..5a6c0ad 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -4,7 +4,7 @@
  *	This file contains the implementation of the ::oo::define command,
  *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
  *
- * Copyright (c) 2006-2012 by Donal K. Fellows
+ * Copyright (c) 2006-2013 by Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/tests/oo.test b/tests/oo.test
index 054bc46..37bbadb 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -2,12 +2,12 @@
 # Sourcing this file into Tcl runs the tests and generates output for errors.
 # No output means no errors were found.
 #
-# Copyright (c) 2006-2012 Donal K. Fellows
+# Copyright (c) 2006-2013 Donal K. Fellows
 #
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require TclOO 1.0
+package require TclOO 1.0.1
 package require tcltest 2
 if {"::tcltest" in [namespace children]} {
     namespace import -force ::tcltest::*
diff --git a/tests/ooNext2.test b/tests/ooNext2.test
index d77e8d1..a47aa91 100644
--- a/tests/ooNext2.test
+++ b/tests/ooNext2.test
@@ -7,7 +7,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require TclOO 1.0
+package require TclOO 1.0.1
 package require tcltest 2
 if {"::tcltest" in [namespace children]} {
     namespace import -force ::tcltest::*
diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh
index 721825b..08cc4c5 100644
--- a/unix/tclooConfig.sh
+++ b/unix/tclooConfig.sh
@@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC=""
 TCLOO_INCLUDE_SPEC=""
 TCLOO_PRIVATE_INCLUDE_SPEC=""
 TCLOO_CFLAGS=""
-TCLOO_VERSION=1.0
+TCLOO_VERSION=1.0.1
diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh
index 721825b..08cc4c5 100644
--- a/win/tclooConfig.sh
+++ b/win/tclooConfig.sh
@@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC=""
 TCLOO_INCLUDE_SPEC=""
 TCLOO_PRIVATE_INCLUDE_SPEC=""
 TCLOO_CFLAGS=""
-TCLOO_VERSION=1.0
+TCLOO_VERSION=1.0.1
-- 
cgit v0.12


From 5260904a408218366fe2ef7a780eea2dc5922c9b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 19 Sep 2013 04:11:01 +0000
Subject: [3487626] knownBug tests dict-23.2 and dist-24.21 already fixed on
 trunk.

---
 tests/dict.test | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/dict.test b/tests/dict.test
index 02c9050..e898637 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1604,7 +1604,7 @@ test dict-23.1 {dict compilation crash: Bug 3487626} {
 	}
     }} [linenumber]}}
 } 5
-test dict-23.2 {dict compilation crash: Bug 3487626} knownBug {
+test dict-23.2 {dict compilation crash: Bug 3487626} {
     # Something isn't quite right in line number and continuation line
     # tracking; at time of writing, this test produces 7, not 5, which
     # indicates that the extra newlines in the non-script argument are
@@ -1838,7 +1838,7 @@ test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} {
 	}
     }} [linenumber]}}
 } 5
-test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} knownBug {
+test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} {
     apply {{} {apply {n {
 	set e {}
 	set k {}
-- 
cgit v0.12


From 0467fcff78969cf483da62fc1c7b7cb9309cf16b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 19 Sep 2013 13:39:40 +0000
Subject: [31661d2135] Plug memory leak.

---
 generic/tclExecute.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index e402634..4d7bdd5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4327,7 +4327,7 @@ TEBCresume(
 		if (listPtr->refCount == 1) {
 		    TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr),
 			    TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)));
-		    for (index=toIdx+1 ; index<objc-1 ; index++) {
+		    for (index=toIdx+1; index<objc ; index++) {
 			TclDecrRefCount(objv[index]);
 		    }
 		    listPtr->elemCount = toIdx+1;
-- 
cgit v0.12


From b9d177cec41c6ca4abcb019b38e7da7739ded8e7 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 19 Sep 2013 14:21:21 +0000
Subject: [3606943]: Corrected description of method search order.

---
 ChangeLog  |  5 +++++
 doc/next.n | 11 +++++++----
 2 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 3dc8c5e..b144110 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2013-09-19  Donal Fellows  <dkf@users.sf.net>
+
+	* doc/next.n (METHOD SEARCH ORDER): Bug [3606943]: Corrected
+	description of method search order.
+
 2013-09-18  Donal Fellows  <dkf@users.sf.net>
 
 	Bump TclOO version to 1.0.1 for release.
diff --git a/doc/next.n b/doc/next.n
index 0ad752a..fe7bddf 100644
--- a/doc/next.n
+++ b/doc/next.n
@@ -62,14 +62,14 @@ The method chain is cached for future use.
 When constructing the method chain, method implementations are searched for in
 the following order:
 .IP [1]
-In the object.
-.IP [2]
 In the classes mixed into the object, in class traversal order. The list of
 mixins is checked in natural order.
-.IP [3]
+.IP [2]
 In the classes mixed into the classes of the object, with sources of mixing in
 being searched in class traversal order. Within each class, the list of mixins
 is processed in natural order.
+.IP [3]
+In the object itself.
 .IP [4]
 In the object's class.
 .IP [5]
@@ -77,7 +77,10 @@ In the superclasses of the class, following each superclass in a depth-first
 fashion in the natural order of the superclass list.
 .PP
 Any particular method implementation always comes as \fIlate\fR in the
-resulting list of implementations as possible.
+resulting list of implementations as possible; this means that if some class,
+A, is both mixed into a class, B, and is also a superclass of B, the instances
+of B will always treat A as a superclass from the perspective of inheritance.
+This is true even when the multiple inheritance is processed indirectly.
 .SS FILTERS
 .PP
 When an object has a list of filter names set upon it, or is an instance of a
-- 
cgit v0.12


From b290b21a4427ac5d1584ad6fcf61e4934f1bf505 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 19 Sep 2013 17:01:58 +0000
Subject: Line numbers wrong in compiled [dict exists].

---
 generic/tclCompCmds.c | 7 +++----
 tests/dict.test       | 6 ++++++
 2 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 9829b9c..64c110d 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1002,7 +1002,7 @@ TclCompileDictExistsCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *tokenPtr;
-    int numWords, i;
+    int i;
     DefineLineInformation;	/* TIP #280 */
 
     /*
@@ -1015,17 +1015,16 @@ TclCompileDictExistsCmd(
 	return TCL_ERROR;
     }
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    numWords = parsePtr->numWords-1;
 
     /*
      * Now we do the code generation.
      */
 
-    for (i=0 ; i<numWords ; i++) {
+    for (i=1 ; i<parsePtr->numWords ; i++) {
 	CompileWord(envPtr, tokenPtr, interp, i);
 	tokenPtr = TokenAfter(tokenPtr);
     }
-    TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr);
+    TclEmitInstInt4(INST_DICT_EXISTS, parsePtr->numWords-2, envPtr);
     TclAdjustStackDepth(-1, envPtr);
     return TCL_OK;
 }
diff --git a/tests/dict.test b/tests/dict.test
index 797ab46..6c254eb 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1899,6 +1899,12 @@ test dict-23.8 {CompileWord OBOE} {
 	} [return [incr n -[linenumber]]] x {}
     }} [linenumber]
 } 1
+test dict-23.9 {CompileWord OBOE} {
+    apply {n {
+	dict exists {} {*}{
+	} [return [incr n -[linenumber]]]
+    }} [linenumber]
+} 1
 
 rename linenumber {}
 test dict-24.22 {dict map results (non-compiled)} {
-- 
cgit v0.12


From 91ec52b16e7cd903ca196560e5ddb1d5ca1c60a9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 19 Sep 2013 17:21:41 +0000
Subject: Line numbers wrong in compiled [dict with].

---
 generic/tclCompCmds.c | 10 +++++-----
 tests/dict.test       | 30 ++++++++++++++++++++++++++++++
 2 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 64c110d..7e6b6da 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1875,7 +1875,7 @@ TclCompileDictWithCmd(
 
 		tokenPtr = TokenAfter(varTokenPtr);
 		for (i=2 ; i<parsePtr->numWords-1 ; i++) {
-		    CompileWord(envPtr, tokenPtr, interp, i-1);
+		    CompileWord(envPtr, tokenPtr, interp, i);
 		    tokenPtr = TokenAfter(tokenPtr);
 		}
 		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
@@ -1902,7 +1902,7 @@ TclCompileDictWithCmd(
 
 		tokenPtr = varTokenPtr;
 		for (i=1 ; i<parsePtr->numWords-1 ; i++) {
-		    CompileWord(envPtr, tokenPtr, interp, i-1);
+		    CompileWord(envPtr, tokenPtr, interp, i);
 		    tokenPtr = TokenAfter(tokenPtr);
 		}
 		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
@@ -1916,7 +1916,7 @@ TclCompileDictWithCmd(
 		 * Case: Direct dict in non-simple var with empty body.
 		 */
 
-		CompileWord(envPtr, varTokenPtr, interp, 0);
+		CompileWord(envPtr, varTokenPtr, interp, 1);
 		TclEmitOpcode(	INST_DUP,			envPtr);
 		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
 		PushStringLiteral(envPtr, "");
@@ -1951,13 +1951,13 @@ TclCompileDictWithCmd(
      */
 
     if (dictVar == -1) {
-	CompileWord(envPtr, varTokenPtr, interp, 0);
+	CompileWord(envPtr, varTokenPtr, interp, 1);
 	Emit14Inst(		INST_STORE_SCALAR, varNameTmp,	envPtr);
     }
     tokenPtr = TokenAfter(varTokenPtr);
     if (gotPath) {
 	for (i=2 ; i<parsePtr->numWords-1 ; i++) {
-	    CompileWord(envPtr, tokenPtr, interp, i-1);
+	    CompileWord(envPtr, tokenPtr, interp, i);
 	    tokenPtr = TokenAfter(tokenPtr);
 	}
 	TclEmitInstInt4(	INST_LIST, parsePtr->numWords-3,envPtr);
diff --git a/tests/dict.test b/tests/dict.test
index 6c254eb..a583de8 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1905,6 +1905,36 @@ test dict-23.9 {CompileWord OBOE} {
 	} [return [incr n -[linenumber]]]
     }} [linenumber]
 } 1
+test dict-23.10 {CompileWord OBOE} {
+    apply {n {
+	dict with foo {*}{
+	} [return [incr n -[linenumber]]] {}
+    }} [linenumber]
+} 1
+test dict-23.11 {CompileWord OBOE} {
+    apply {n {
+	dict with ::foo {*}{
+	} [return [incr n -[linenumber]]] {}
+    }} [linenumber]
+} 1
+test dict-23.12 {CompileWord OBOE} {
+    apply {n {
+	dict with {*}{
+	} [return [incr n -[linenumber]]] {}
+    }} [linenumber]
+} 1
+test dict-23.13 {CompileWord OBOE} {
+    apply {n {
+	dict with {*}{
+	} [return [incr n -[linenumber]]] {bar}
+    }} [linenumber]
+} 1
+test dict-23.14 {CompileWord OBOE} {
+    apply {n {
+	dict with foo {*}{
+	} [return [incr n -[linenumber]]] {bar}
+    }} [linenumber]
+} 1
 
 rename linenumber {}
 test dict-24.22 {dict map results (non-compiled)} {
-- 
cgit v0.12


From 7b3702821be88e66474de1c1b1aa84c381276668 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 19 Sep 2013 18:53:01 +0000
Subject: Line numbers wrong in compiled [unset].

---
 generic/tclCompCmdsGR.c |  1 +
 generic/tclCompCmdsSZ.c | 14 +++++++-------
 tests/var.test          | 13 +++++++++++++
 3 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 4e4a3af..43ea3d3 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -587,6 +587,7 @@ TclCompileInfoCommandsCmd(
      * that the result needs to be list-ified.
      */
 
+    /* TODO: Just push the known value */
     CompileWord(envPtr, tokenPtr,		interp, 1);
     TclEmitOpcode(	INST_RESOLVE_COMMAND,	envPtr);
     TclEmitOpcode(	INST_DUP,		envPtr);
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index d1eb9db..6c55e2e 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2814,26 +2814,26 @@ TclCompileUnsetCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr;
-    int isScalar, localIndex, numWords, flags, i;
+    int isScalar, localIndex, flags, i;
     Tcl_Obj *leadingWord;
     DefineLineInformation;	/* TIP #280 */
 
     /* TODO: Consider support for compiling expanded args. */
-    numWords = parsePtr->numWords-1;
     flags = 1;
+    i = 1;
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
     leadingWord = Tcl_NewObj();
-    if (numWords > 0 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+    if (parsePtr->numWords > 1 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
 	int len;
 	const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
 
 	if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
 	    flags = 0;
 	    varTokenPtr = TokenAfter(varTokenPtr);
-	    numWords--;
+	    i++;
 	} else if (len == 2 && !strncmp("--", bytes, 2)) {
 	    varTokenPtr = TokenAfter(varTokenPtr);
-	    numWords--;
+	    i++;
 	}
     } else {
 	/*
@@ -2846,7 +2846,7 @@ TclCompileUnsetCmd(
     }
     TclDecrRefCount(leadingWord);
 
-    for (i=0 ; i<numWords ; i++) {
+    for ( ; i<parsePtr->numWords ; i++) {
 	/*
 	 * Decide if we can use a frame slot for the var/array name or if we
 	 * need to emit code to compute and push the name at runtime. We use a
@@ -2856,7 +2856,7 @@ TclCompileUnsetCmd(
 	 */
 
 	PushVarNameWord(interp, varTokenPtr, envPtr, 0,
-		&localIndex, &isScalar, 1);
+		&localIndex, &isScalar, i);
 
 	/*
 	 * Emit instructions to unset the variable.
diff --git a/tests/var.test b/tests/var.test
index 5939100..6d4be26 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -862,6 +862,19 @@ test var-20.8 {array set compilation correctness: Bug 3603163} -setup {
     }}
     array size x
 } -result 0
+
+test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
+    proc linenumber {} {dict get [info frame -1] line}
+} -body {
+    apply {n {
+	set foo bar
+        unset foo {*}{
+        } [return [incr n -[linenumber]]]
+    }} [linenumber]
+} -cleanup {
+    rename linenumber {}
+} -result 1
+
 
 catch {namespace delete ns}
 catch {unset arr}
-- 
cgit v0.12


From f19c90364c590451e85ba125933b3aa1fd9acd20 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 19 Sep 2013 19:02:42 +0000
Subject: comment

---
 generic/tclCompCmdsSZ.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 6c55e2e..468c1c0 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1864,6 +1864,7 @@ TclCompileTailcallCmd(
     }
 
     /* make room for the nsObjPtr */
+    /* TODO: Doesn't this have to be a known value? */
     CompileWord(envPtr, tokenPtr, interp, 0);
     for (i=1 ; i<parsePtr->numWords ; i++) {
 	tokenPtr = TokenAfter(tokenPtr);
-- 
cgit v0.12


From cadf55303e72b696eedb9b29a469156b27fffa47 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 19 Sep 2013 19:37:05 +0000
Subject: [3970f54c4e]: Corrected regression in argument order processing in
 [unset].

---
 generic/tclCompCmdsSZ.c | 40 +++++++++++++++++++++++++---------------
 tests/var.test          |  3 +++
 2 files changed, 28 insertions(+), 15 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 468c1c0..b90bff8 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2815,19 +2815,37 @@ TclCompileUnsetCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr;
-    int isScalar, localIndex, flags, i;
-    Tcl_Obj *leadingWord;
+    int isScalar, localIndex, flags = 1, i;
     DefineLineInformation;	/* TIP #280 */
 
     /* TODO: Consider support for compiling expanded args. */
-    flags = 1;
-    i = 1;
+
+    /*
+     * Verify that all words are known at compile time so that we can handle
+     * them without needing to do a nasty push/rotate. [Bug 3970f54c4e]
+     */
+
+    for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
+	varTokenPtr = TokenAfter(varTokenPtr);
+	if (!TclWordKnownAtCompileTime(varTokenPtr, NULL)) {
+	    return TCL_ERROR;
+	}
+    }
+
+    /*
+     * Check for options; if they're present we'll know for sure because we
+     * know we're all constant arguments.
+     */
+
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    leadingWord = Tcl_NewObj();
-    if (parsePtr->numWords > 1 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+    i = 1;
+    if (parsePtr->numWords > 1) {
+	Tcl_Obj *leadingWord = Tcl_NewObj();
+	const char *bytes;
 	int len;
-	const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
 
+	(void) TclWordKnownAtCompileTime(varTokenPtr, leadingWord);
+	bytes = Tcl_GetStringFromObj(leadingWord, &len);
 	if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
 	    flags = 0;
 	    varTokenPtr = TokenAfter(varTokenPtr);
@@ -2836,16 +2854,8 @@ TclCompileUnsetCmd(
 	    varTokenPtr = TokenAfter(varTokenPtr);
 	    i++;
 	}
-    } else {
-	/*
-	 * Cannot guarantee that the first word is not '-nocomplain' at
-	 * evaluation with reasonable effort, so spill to interpreted version.
-	 */
-
 	TclDecrRefCount(leadingWord);
-	return TCL_ERROR;
     }
-    TclDecrRefCount(leadingWord);
 
     for ( ; i<parsePtr->numWords ; i++) {
 	/*
diff --git a/tests/var.test b/tests/var.test
index 6d4be26..208b361 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -748,6 +748,9 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
     namespace eval test A useSomeUnlikelyNameHere
     namespace eval test unset useSomeUnlikelyNameHere
 } {}
+test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {
+    apply {{} {unset foo [return ok]}}
+} ok
 
 test var-16.1 {CallVarTraces: save/restore interp error state} {
     trace add variable ::errorCode write " ;#"
-- 
cgit v0.12


From 2139c0e39e6fb83eb76edc0088de73b9caa7cdb3 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 19 Sep 2013 22:37:06 +0000
Subject: [3970f54c4e]: Improved fix that is more tolerant of a single variable
 varname.

---
 generic/tclCompCmdsSZ.c | 82 ++++++++++++++++++++++++++++++++++---------------
 1 file changed, 57 insertions(+), 25 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index b90bff8..44cb66e 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2815,49 +2815,81 @@ TclCompileUnsetCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr;
-    int isScalar, localIndex, flags = 1, i;
+    int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
     DefineLineInformation;	/* TIP #280 */
 
     /* TODO: Consider support for compiling expanded args. */
 
     /*
-     * Verify that all words are known at compile time so that we can handle
-     * them without needing to do a nasty push/rotate. [Bug 3970f54c4e]
+     * Verify that all words - except the first non-option one - are known at
+     * compile time so that we can handle them without needing to do a nasty
+     * push/rotate. [Bug 3970f54c4e]
      */
 
     for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
+	Tcl_Obj *leadingWord = Tcl_NewObj();
+
 	varTokenPtr = TokenAfter(varTokenPtr);
-	if (!TclWordKnownAtCompileTime(varTokenPtr, NULL)) {
+	if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+	    TclDecrRefCount(leadingWord);
+
+	    /*
+	     * We can tolerate non-trivial substitutions in the first variable
+	     * to be unset. If a '--' or '-nocomplain' was present, anything
+	     * goes in that one place! (All subsequent variable names must be
+	     * constants since we don't want to have to push them all first.)
+	     */
+
+	    if (varCount == 0) {
+		if (haveFlags) {
+		    continue;
+		}
+
+		/*
+		 * In fact, we're OK as long as we're the first argument *and*
+		 * we provably don't start with a '-'. If that is true, then
+		 * even if everything else is varying, we still can't be a
+		 * flag. Otherwise we'll spill to runtime to place a limit on
+		 * the trickiness.
+		 */
+
+		if (varTokenPtr->type == TCL_TOKEN_WORD
+			&& varTokenPtr[1].type == TCL_TOKEN_TEXT
+			&& varTokenPtr[1].size > 0
+			&& varTokenPtr[1].start[0] != '-') {
+		    continue;
+		}
+	    }
 	    return TCL_ERROR;
 	}
+	if (i == 1) {
+	    const char *bytes;
+	    int len;
+
+	    bytes = Tcl_GetStringFromObj(leadingWord, &len);
+	    if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
+		flags = 0;
+		haveFlags = 1;
+	    } else if (len == 2 && !strncmp("--", bytes, 2)) {
+		haveFlags = 1;
+	    } else {
+		varCount++;
+	    }
+	} else {
+	    varCount++;
+	}
+	TclDecrRefCount(leadingWord);
     }
 
     /*
-     * Check for options; if they're present we'll know for sure because we
-     * know we're all constant arguments.
+     * Issue instructions to unset each of the named variables.
      */
 
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    i = 1;
-    if (parsePtr->numWords > 1) {
-	Tcl_Obj *leadingWord = Tcl_NewObj();
-	const char *bytes;
-	int len;
-
-	(void) TclWordKnownAtCompileTime(varTokenPtr, leadingWord);
-	bytes = Tcl_GetStringFromObj(leadingWord, &len);
-	if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
-	    flags = 0;
-	    varTokenPtr = TokenAfter(varTokenPtr);
-	    i++;
-	} else if (len == 2 && !strncmp("--", bytes, 2)) {
-	    varTokenPtr = TokenAfter(varTokenPtr);
-	    i++;
-	}
-	TclDecrRefCount(leadingWord);
+    if (haveFlags) {
+	varTokenPtr = TokenAfter(varTokenPtr);
     }
-
-    for ( ; i<parsePtr->numWords ; i++) {
+    for (i=1+haveFlags ; i<parsePtr->numWords ; i++) {
 	/*
 	 * Decide if we can use a frame slot for the var/array name or if we
 	 * need to emit code to compute and push the name at runtime. We use a
-- 
cgit v0.12


From c4175e0434a242a24610b0c3a70214885b897006 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 20 Sep 2013 09:11:51 +0000
Subject: Make sure that panic's during finalization are handled by the custom
 panicproc not by the default panicproc, because stderr might not be
 available. When the default panicproc is in use, this doesn't make any
 difference.

---
 generic/tclEvent.c | 2 --
 1 file changed, 2 deletions(-)

diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 686b80d..941d566 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1171,8 +1171,6 @@ Tcl_Finalize(void)
 
     TclFinalizeEncodingSubsystem();
 
-    Tcl_SetPanicProc(NULL);
-
     /*
      * Repeat finalization of the thread local storage once more. Although
      * this step is already done by the Tcl_FinalizeThread call above, series
-- 
cgit v0.12


From b54c2a5958b12875dc5a32cc1f09da20e23b087d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 23 Sep 2013 12:18:45 +0000
Subject: revert mistaken commit of experiment

---
 generic/tclIOUtil.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 6332453..6259216 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1944,7 +1944,7 @@ TclNREvalFile(
     iPtr->evalFlags |= TCL_EVAL_FILE;
     TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr,
 	    NULL);
-    return TclNREvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, INT_MIN);
+    return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN);
 }
 
 static int
-- 
cgit v0.12


From 38f8605a8d202951bbf792a4813b9b48a20910fb Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 26 Sep 2013 14:27:37 +0000
Subject: Tcl_SetResult -> Tcl_SetObjResult

---
 generic/tclBinary.c | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 58583f4..4e977f2 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2500,7 +2500,8 @@ BinaryEncode64(
 		return TCL_ERROR;
 	    }
 	    if (maxlen < 0) {
-		Tcl_SetResult(interp, "line length out of range", TCL_STATIC);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"line length out of range", -1));
 		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
 			"LINE_LENGTH", NULL);
 		return TCL_ERROR;
@@ -2606,7 +2607,8 @@ BinaryEncodeUu(
 		return TCL_ERROR;
 	    }
 	    if (lineLength < 3 || lineLength > 85) {
-		Tcl_SetResult(interp, "line length out of range", TCL_STATIC);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"line length out of range", -1));
 		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
 			"LINE_LENGTH", NULL);
 		return TCL_ERROR;
-- 
cgit v0.12


From 790f8f7114d0cc7b44cbaddc66e36c877c9c55b6 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 27 Sep 2013 09:18:36 +0000
Subject: Workaround for [http://sourceforge.net/p/mingw/bugs/2065/|MinGW bug
 #2065]. Both MinGW and MinGW-w64 (32-bit) are affected. Even though Win64 is
 not affected, adding -static-libgcc doesn't harm there, and we don't want to
 distrubute additional dll's with MinGW-compiled Tcl anyway.

---
 win/configure | 3 +--
 win/tcl.m4    | 3 +--
 2 files changed, 2 insertions(+), 4 deletions(-)

diff --git a/win/configure b/win/configure
index be9c98a..d09b588 100755
--- a/win/configure
+++ b/win/configure
@@ -3450,7 +3450,7 @@ echo "${ECHO_T}yes" >&6
 
     if test "${GCC}" = "yes" ; then
 	extra_cflags="-pipe"
-	extra_ldflags="-pipe"
+	extra_ldflags="-pipe -static-libgcc"
 	echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5
 echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6
 if test "${ac_cv_win32+set}" = set; then
@@ -3579,7 +3579,6 @@ echo "${ECHO_T}$ac_cv_municode" >&6
 	    extra_ldflags="$extra_ldflags -municode"
 	else
 	    extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
-	    extra_ldflags="$extra_ldflags -static-libgcc"
 	fi
     fi
 
diff --git a/win/tcl.m4 b/win/tcl.m4
index 335494b..7ea7fad 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -634,7 +634,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 
     if test "${GCC}" = "yes" ; then
 	extra_cflags="-pipe"
-	extra_ldflags="-pipe"
+	extra_ldflags="-pipe -static-libgcc"
 	AC_CACHE_CHECK(for mingw32 version of gcc,
 	    ac_cv_win32,
 	    AC_TRY_COMPILE([
@@ -665,7 +665,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	    extra_ldflags="$extra_ldflags -municode"
 	else
 	    extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
-	    extra_ldflags="$extra_ldflags -static-libgcc"
 	fi
     fi
 
-- 
cgit v0.12


From a5a2f896bb91053061b5a83f09cb0778c3b53e3b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 27 Sep 2013 10:29:43 +0000
Subject: =?UTF-8?q?[219226]:=20Rewrote=20how=20::env=20is=20synchronized?=
 =?UTF-8?q?=20to=20the=20environment=20so=20it=20no=20longer=20smashes=20t?=
 =?UTF-8?q?he=20array=20or=20its=20elements=20flat,=20This=20affects=20tra?=
 =?UTF-8?q?ces=20on=20env,=20links=20to=20env,=20and=20iterations=20over?=
 =?UTF-8?q?=20env:=20it=20makes=20them=20work=20as=20na=C3=AFvely=20expect?=
 =?UTF-8?q?ed.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 generic/tclEnv.c | 81 +++++++++++++++++++++++++++++++++++++++++++++-----------
 generic/tclInt.h |  2 ++
 generic/tclVar.c | 47 ++++++++++++++++++++++++++++++++
 tests/env.test   | 23 ++++++++++++++++
 4 files changed, 137 insertions(+), 16 deletions(-)

diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index b5ae6ea..6a21947 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -76,36 +76,56 @@ TclSetupEnv(
     Tcl_Interp *interp)		/* Interpreter whose "env" array is to be
 				 * managed. */
 {
+    Var *varPtr, *arrayPtr;
+    Tcl_Obj *varNamePtr;
     Tcl_DString envString;
-    char *p1, *p2;
-    int i;
+    Tcl_HashTable namesHash;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
 
     /*
      * Synchronize the values in the environ array with the contents of the
      * Tcl "env" variable. To do this:
-     *    1) Remove the trace that fires when the "env" var is unset.
-     *    2) Unset the "env" variable.
-     *    3) If there are no environ variables, create an empty "env" array.
-     *	     Otherwise populate the array with current values.
-     *    4) Add a trace that synchronizes the "env" array.
+     *    1) Remove the trace that fires when the "env" var is updated.
+     *    2) Find the existing contents of the "env", storing in a hash table.
+     *    3) Create/update elements for each environ variable, removing
+     *	     elements from the hash table as we go.
+     *    4) Remove the elements for each remaining entry in the hash table,
+     *	     which must have existed before yet have no analog in the environ
+     *	     variable.
+     *    5) Add a trace that synchronizes the "env" array.
      */
 
     Tcl_UntraceVar2(interp, "env", NULL,
 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
 	    TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
 
-    Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
+    /*
+     * Find out what elements are currently in the global env array.
+     */
 
-    if (environ[0] == NULL) {
-	Tcl_Obj *varNamePtr;
+    TclNewLiteralStringObj(varNamePtr, "env");
+    Tcl_IncrRefCount(varNamePtr);
+    Tcl_InitObjHashTable(&namesHash);
+    varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY,
+	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    TclFindArrayPtrElements(varPtr, &namesHash);
+
+    /*
+     * Go through the environment array and transfer its values into Tcl. At
+     * the same time, remove those elements we add/update from the hash table
+     * of existing elements, so that after this part processes, that table
+     * will hold just the parts to remove.
+     */
+
+    if (environ[0] != NULL) {
+	int i;
 
-	TclNewLiteralStringObj(varNamePtr, "env");
-	Tcl_IncrRefCount(varNamePtr);
-	TclArraySet(interp, varNamePtr, NULL);
-	Tcl_DecrRefCount(varNamePtr);
-    } else {
 	Tcl_MutexLock(&envMutex);
 	for (i = 0; environ[i] != NULL; i++) {
+	    Tcl_Obj *obj1, *obj2;
+	    char *p1, *p2;
+
 	    p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
 	    p2 = strchr(p1, '=');
 	    if (p2 == NULL) {
@@ -119,12 +139,41 @@ TclSetupEnv(
 	    }
 	    p2++;
 	    p2[-1] = '\0';
-	    Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
+	    obj1 = Tcl_NewStringObj(p1, -1);
+	    obj2 = Tcl_NewStringObj(p2, -1);
 	    Tcl_DStringFree(&envString);
+
+	    Tcl_IncrRefCount(obj1);
+	    Tcl_IncrRefCount(obj2);
+	    Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY);
+	    hPtr = Tcl_FindHashEntry(&namesHash, obj1);
+	    if (hPtr != NULL) {
+		Tcl_DeleteHashEntry(hPtr);
+	    }
+	    Tcl_DecrRefCount(obj1);
+	    Tcl_DecrRefCount(obj2);
 	}
 	Tcl_MutexUnlock(&envMutex);
     }
 
+    /*
+     * Delete those elements that existed in the array but which had no
+     * counterparts in the environment array.
+     */
+
+    for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
+	    hPtr=Tcl_NextHashEntry(&search)) {
+	Tcl_Obj *elemName = Tcl_GetHashValue(hPtr);
+
+	TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
+    }
+    Tcl_DeleteHashTable(&namesHash);
+    Tcl_DecrRefCount(varNamePtr);
+
+    /*
+     * Re-establish the trace.
+     */
+
     Tcl_TraceVar2(interp, "env", NULL,
 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
 	    TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 380284f..feea6dd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3857,6 +3857,8 @@ MODULE_SCOPE int	TclPtrUnsetVar(Tcl_Interp *interp, Var *varPtr,
 			    Tcl_Obj *part2Ptr, const int flags,
 			    int index);
 MODULE_SCOPE void	TclInvalidateNsPath(Namespace *nsPtr);
+MODULE_SCOPE void	TclFindArrayPtrElements(Var *arrayPtr,
+			    Tcl_HashTable *tablePtr);
 
 /*
  * The new extended interface to the variable traces.
diff --git a/generic/tclVar.c b/generic/tclVar.c
index af1a563..4694cd8 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -3850,6 +3850,53 @@ ArrayNamesCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclFindArrayPtrElements --
+ *
+ *	Fill out a hash table (which *must* use Tcl_Obj* keys) with an entry
+ *	for each existing element of the given array. The provided hash table
+ *	is assumed to be initially empty.
+ *
+ * Result:
+ *	none
+ *
+ * Side effects:
+ *	The keys of the array gain an extra reference. The supplied hash table
+ *	has elements added to it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFindArrayPtrElements(
+    Var *arrayPtr,
+    Tcl_HashTable *tablePtr)
+{
+    Var *varPtr;
+    Tcl_HashSearch search;
+
+    if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr)
+	    || TclIsVarUndefined(arrayPtr)) {
+	return;
+    }
+
+    for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search);
+	    varPtr!=NULL ; varPtr=VarHashNextVar(&search)) {
+	Tcl_HashEntry *hPtr;
+	Tcl_Obj *nameObj;
+	int dummy;
+
+	if (TclIsVarUndefined(varPtr)) {
+	    continue;
+	}
+	nameObj = VarHashGetKey(varPtr);
+	hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy);
+	Tcl_SetHashValue(hPtr, nameObj);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * ArraySetCmd --
  *
  *	This object-based function is invoked to process the "array set" Tcl
diff --git a/tests/env.test b/tests/env.test
index fa76433..8115652 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -291,6 +291,29 @@ test env-6.1 {corner cases - add lots of env variables} {} {
     expr {[array size env] - $size}
 } 100
 
+test env-7.1 {[219226]: whole env array should not be unset by read} {
+    set n [array size env]
+    set s [array startsearch env]
+    while {[array anymore env $s]} {
+	array nextelement env $s
+	incr n -1
+    }
+    array donesearch env $s
+    return $n
+} 0
+test env-7.2 {[219226]: links to env elements should not be removed by read} {
+    apply {{} {
+	set ::env(test7_2) ok
+	upvar env(test7_2) elem
+	set ::env(PATH)
+	try {
+	    return $elem
+	} finally {
+	    unset ::env(test7_2)
+	}
+    }}
+} ok
+
 # Restore the environment variables at the end of the test.
 
 foreach name [array names env] {
-- 
cgit v0.12


From ad4355066f0d4cdafaa288933a1517e6c79817ad Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 27 Sep 2013 17:33:17 +0000
Subject: Fix test source-4.1

---
 generic/tclCompile.c | 6 +++++-
 tests/source.test    | 2 +-
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index f5c8d41..d15ef3a 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -2229,7 +2229,7 @@ TclCompileTokens(
     Tcl_DString textBuffer;	/* Holds concatenated chars from adjacent
 				 * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
     char buffer[TCL_UTF_MAX];
-    int i, numObjsToConcat, length;
+    int i, numObjsToConcat, length, adjust;
     unsigned char *entryCodeNext = envPtr->codeNext;
 #define NUM_STATIC_POS 20
     int isLiteral, maxNumCL, numCL;
@@ -2266,6 +2266,7 @@ TclCompileTokens(
 	clPosition = ckalloc(maxNumCL * sizeof(int));
     }
 
+    adjust = 0;
     Tcl_DStringInit(&textBuffer);
     numObjsToConcat = 0;
     for ( ;  count > 0;  count--, tokenPtr++) {
@@ -2309,6 +2310,7 @@ TclCompileTokens(
 		    clPosition[numCL] = clPos;
 		    numCL ++;
 		}
+		adjust++;
 	    }
 	    break;
 
@@ -2331,8 +2333,10 @@ TclCompileTokens(
 		numCL = 0;
 	    }
 
+	    envPtr->line += adjust;
 	    TclCompileScript(interp, tokenPtr->start+1,
 		    tokenPtr->size-2, envPtr);
+	    envPtr->line -= adjust;
 	    numObjsToConcat++;
 	    break;
 
diff --git a/tests/source.test b/tests/source.test
index 6ee2198..0235bd1 100644
--- a/tests/source.test
+++ b/tests/source.test
@@ -187,7 +187,7 @@ test source-3.5 {return with special code etc.} -setup {
     invoked from within
 "source $sourcefile"} {a b c}}
 
-test source-4.1 {continuation line parsing} -constraints knownBug -setup {
+test source-4.1 {continuation line parsing} -setup {
     set sourcefile [makeFile [string map {CL \\\n} {
 	format %s "[dict get [info frame 0] type]:CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]"
     }] source.file]
-- 
cgit v0.12


From 789e4ada24cc5f08a6d5300e354a752cdb066eec Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 28 Sep 2013 21:10:22 +0000
Subject: [dfc08326e3]: Corrected symbol export for TclOO to match Tcl so
 things work as expected in a static build.

---
 generic/tclOO.decls     | 21 +++++++++++++++---
 generic/tclOODecls.h    | 58 ++++++++++++++++++++++++-------------------------
 generic/tclOOIntDecls.h | 32 +++++++++++++--------------
 3 files changed, 63 insertions(+), 48 deletions(-)

diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 31d1113..19d3f03 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -1,12 +1,25 @@
+# tclOO.decls --
+#
+#	This file contains the declarations for all supported public functions
+#	that are exported by the TclOO package that is embedded within the Tcl
+#	library via the stubs table.  This file is used to generate the
+#	tclOODecls.h, tclOOIntDecls.h, tclOOStubInit.c, and tclOOStubLib.c
+#	files.
+#
+# Copyright (c) 2008-2013 by Donal K. Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
 library tclOO
+scspec EXTERN
 
 ######################################################################
-# public API
+# Public API, exposed for general users of TclOO.
 #
 
 interface tclOO
 hooks tclOOInt
-scspec TCLOOAPI
 
 declare 0 {
     Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
@@ -116,7 +129,9 @@ declare 28 {
 }
 
 ######################################################################
-# private API, exposed to support advanced OO systems that plug in on top
+# Private API, exposed to support advanced OO systems that plug in on top of
+# TclOO; not intended for general use and does not have any commitment to
+# long-term support.
 #
 
 interface tclOOInt
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index 58871c6..9cb704e 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -12,92 +12,92 @@
  */
 
 /* 0 */
-TCLOOAPI Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
+EXTERN Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
 				Tcl_Object sourceObject,
 				const char *targetName,
 				const char *targetNamespaceName);
 /* 1 */
-TCLOOAPI Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
+EXTERN Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
 /* 2 */
-TCLOOAPI Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
+EXTERN Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
 /* 3 */
-TCLOOAPI Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
+EXTERN Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
 /* 4 */
-TCLOOAPI Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
+EXTERN Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
 /* 5 */
-TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
+EXTERN Tcl_Namespace *	Tcl_GetObjectNamespace(Tcl_Object object);
 /* 6 */
-TCLOOAPI Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
+EXTERN Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
 /* 7 */
-TCLOOAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
+EXTERN Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
 /* 8 */
-TCLOOAPI int		Tcl_MethodIsPublic(Tcl_Method method);
+EXTERN int		Tcl_MethodIsPublic(Tcl_Method method);
 /* 9 */
-TCLOOAPI int		Tcl_MethodIsType(Tcl_Method method,
+EXTERN int		Tcl_MethodIsType(Tcl_Method method,
 				const Tcl_MethodType *typePtr,
 				ClientData *clientDataPtr);
 /* 10 */
-TCLOOAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
+EXTERN Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
 /* 11 */
-TCLOOAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
+EXTERN Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Obj *nameObj,
 				int isPublic, const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 12 */
-TCLOOAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+EXTERN Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
 				Tcl_Obj *nameObj, int isPublic,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 13 */
-TCLOOAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
+EXTERN Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
 				Tcl_Class cls, const char *nameStr,
 				const char *nsNameStr, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 14 */
-TCLOOAPI int		Tcl_ObjectDeleted(Tcl_Object object);
+EXTERN int		Tcl_ObjectDeleted(Tcl_Object object);
 /* 15 */
-TCLOOAPI int		Tcl_ObjectContextIsFiltering(
+EXTERN int		Tcl_ObjectContextIsFiltering(
 				Tcl_ObjectContext context);
 /* 16 */
-TCLOOAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+EXTERN Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
 /* 17 */
-TCLOOAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
+EXTERN Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
 /* 18 */
-TCLOOAPI int		Tcl_ObjectContextSkippedArgs(
+EXTERN int		Tcl_ObjectContextSkippedArgs(
 				Tcl_ObjectContext context);
 /* 19 */
-TCLOOAPI ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
+EXTERN ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 20 */
-TCLOOAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
+EXTERN void		Tcl_ClassSetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 21 */
-TCLOOAPI ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
+EXTERN ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 22 */
-TCLOOAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
+EXTERN void		Tcl_ObjectSetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 23 */
-TCLOOAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+EXTERN int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
 				Tcl_ObjectContext context, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 24 */
-TCLOOAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
 				Tcl_Object object);
 /* 25 */
-TCLOOAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+EXTERN void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
 				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
 /* 26 */
-TCLOOAPI void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
+EXTERN void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 27 */
-TCLOOAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
+EXTERN void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 28 */
-TCLOOAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
+EXTERN Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
 				Tcl_Object object);
 
 typedef struct {
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
index acafb18..834d8cb 100644
--- a/generic/tclOOIntDecls.h
+++ b/generic/tclOOIntDecls.h
@@ -12,46 +12,46 @@
  */
 
 /* 0 */
-TCLOOAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
+EXTERN Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
 /* 1 */
-TCLOOAPI Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
+EXTERN Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 2 */
-TCLOOAPI Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
+EXTERN Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
 				Class *clsPtr, int flags, Tcl_Obj *nameObj,
 				const char *namePtr, Tcl_Obj *argsObj,
 				Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 3 */
-TCLOOAPI Method *	TclOONewProcInstanceMethod(Tcl_Interp *interp,
+EXTERN Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 4 */
-TCLOOAPI Method *	TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+EXTERN Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
 				int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 5 */
-TCLOOAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
+EXTERN int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
 				int objc, Tcl_Obj *const *objv,
 				int publicOnly, Class *startCls);
 /* 6 */
-TCLOOAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
+EXTERN int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
 /* 7 */
-TCLOOAPI Method *	TclOONewForwardMethod(Tcl_Interp *interp,
+EXTERN Method *		TclOONewForwardMethod(Tcl_Interp *interp,
 				Class *clsPtr, int isPublic,
 				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
 /* 8 */
-TCLOOAPI Method *	TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+EXTERN Method *		TclOONewForwardInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
 				Tcl_Obj *prefixObj);
 /* 9 */
-TCLOOAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+EXTERN Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Object oPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -60,7 +60,7 @@ TCLOOAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 10 */
-TCLOOAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
+EXTERN Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Class clsPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -69,22 +69,22 @@ TCLOOAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 11 */
-TCLOOAPI int		TclOOInvokeObject(Tcl_Interp *interp,
+EXTERN int		TclOOInvokeObject(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Class startCls,
 				int publicPrivate, int objc,
 				Tcl_Obj *const *objv);
 /* 12 */
-TCLOOAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
+EXTERN void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 13 */
-TCLOOAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
+EXTERN void		TclOOClassSetFilters(Tcl_Interp *interp,
 				Class *classPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 14 */
-TCLOOAPI void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
+EXTERN void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
 				Class *const *mixins);
 /* 15 */
-TCLOOAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
+EXTERN void		TclOOClassSetMixins(Tcl_Interp *interp,
 				Class *classPtr, int numMixins,
 				Class *const *mixins);
 
-- 
cgit v0.12


From 6a1cc41ccac84140abbe6011995eefbf2e8a4435 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 28 Sep 2013 22:52:11 +0000
Subject: typo; spotted by stu

---
 doc/Class.3 | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/Class.3 b/doc/Class.3
index 28cea9b..febe703 100644
--- a/doc/Class.3
+++ b/doc/Class.3
@@ -111,7 +111,7 @@ function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR
 is a shared reference.
 .PP
 Instances of classes are created using \fBTcl_NewObjectInstance\fR, which
-takes creates an object from any class (and which is internally called by both
+creates an object from any class (and which is internally called by both
 the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes
 parameters that optionally give the name of the object and namespace to
 create, and which describe the arguments to pass to the class's constructor
-- 
cgit v0.12


From 11fdcc3fedcd680e93a93d28bf862d388ada3f9d Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 30 Sep 2013 03:00:06 +0000
Subject: First attempt at [string trim] compilation.

---
 generic/tclAssembly.c   |   5 +-
 generic/tclCmdMZ.c      |   8 +--
 generic/tclCompCmdsSZ.c | 135 ++++++++++++++++++++++++++++++++++++++++++++++++
 generic/tclCompile.c    |  11 ++++
 generic/tclCompile.h    |   6 ++-
 generic/tclExecute.c    |  33 ++++++++++++
 generic/tclInt.h        |   9 ++++
 7 files changed, 202 insertions(+), 5 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 946c729..659f483 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -462,6 +462,8 @@ static const TalInstDesc TalInstructionTable[] = {
     {"strneq",		ASSEM_1BYTE,	INST_STR_NEQ,		2,	1},
     {"strrange",	ASSEM_1BYTE,	INST_STR_RANGE,		3,	1},
     {"strrfind",	ASSEM_1BYTE,	INST_STR_FIND_LAST,	2,	1},
+    {"strtrimLeft",	ASSEM_1BYTE,	INST_STRTRIM_LEFT,	2,	1},
+    {"strtrimRight",	ASSEM_1BYTE,	INST_STRTRIM_RIGHT,	2,	1},
     {"sub",		ASSEM_1BYTE,	INST_SUB,		2,	1},
     {"tclooClass",	ASSEM_1BYTE,	INST_TCLOO_CLASS,	1,	1},
     {"tclooIsObject",	ASSEM_1BYTE,	INST_TCLOO_IS_OBJECT,	1,	1},
@@ -502,7 +504,8 @@ static const unsigned char NonThrowingByteCodes[] = {
     INST_COROUTINE_NAME,					/* 149 */
     INST_NS_CURRENT,						/* 151 */
     INST_INFO_LEVEL_NUM,					/* 152 */
-    INST_RESOLVE_COMMAND					/* 154 */
+    INST_RESOLVE_COMMAND,					/* 154 */
+    INST_STRTRIM_LEFT, INST_STRTRIM_RIGHT			/* 166,167 */
 };
 
 /*
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 5087fbb..2b5e995 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -35,6 +35,8 @@ static int		UniCharIsHexDigit(int character);
 /*
  * Default set of characters to trim in [string trim] and friends. This is a
  * UTF-8 literal string containing all Unicode space characters [TIP #413]
+ *
+ * Synch with tclCompCmdsSZ.c
  */
 
 #define DEFAULT_TRIM_SET \
@@ -3342,9 +3344,9 @@ TclInitStringCmd(
 	{"tolower",	StringLowerCmd,	TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
 	{"toupper",	StringUpperCmd,	TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
 	{"totitle",	StringTitleCmd,	TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
-	{"trim",	StringTrimCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
-	{"trimleft",	StringTrimLCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
-	{"trimright",	StringTrimRCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"trim",	StringTrimCmd,	TclCompileStringTrimCmd, NULL, NULL, 0},
+	{"trimleft",	StringTrimLCmd,	TclCompileStringTrimLCmd, NULL, NULL, 0},
+	{"trimright",	StringTrimRCmd,	TclCompileStringTrimRCmd, NULL, NULL, 0},
 	{"wordend",	StringEndCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{"wordstart",	StringStartCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{NULL, NULL, NULL, NULL, NULL, 0}
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 44cb66e..0177b2d 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -640,6 +640,141 @@ TclCompileStringRangeCmd(
     OP(			STR_RANGE);
     return TCL_OK;
 }
+
+/*
+ * Synch with tclCmdMZ.c
+ */
+
+#define DEFAULT_TRIM_SET \
+	"\x09\x0a\x0b\x0c\x0d " /* ASCII */\
+	"\xc0\x80" /*     nul (U+0000) */\
+	"\xc2\x85" /*     next line (U+0085) */\
+	"\xc2\xa0" /*     non-breaking space (U+00a0) */\
+	"\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
+	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
+	"\xe2\x80\x80" /* en quad (U+2000) */\
+	"\xe2\x80\x81" /* em quad (U+2001) */\
+	"\xe2\x80\x82" /* en space (U+2002) */\
+	"\xe2\x80\x83" /* em space (U+2003) */\
+	"\xe2\x80\x84" /* three-per-em space (U+2004) */\
+	"\xe2\x80\x85" /* four-per-em space (U+2005) */\
+	"\xe2\x80\x86" /* six-per-em space (U+2006) */\
+	"\xe2\x80\x87" /* figure space (U+2007) */\
+	"\xe2\x80\x88" /* punctuation space (U+2008) */\
+	"\xe2\x80\x89" /* thin space (U+2009) */\
+	"\xe2\x80\x8a" /* hair space (U+200a) */\
+	"\xe2\x80\x8b" /* zero width space (U+200b) */\
+	"\xe2\x80\xa8" /* line separator (U+2028) */\
+	"\xe2\x80\xa9" /* paragraph separator (U+2029) */\
+	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
+	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
+	"\xe2\x81\xa0" /* word joiner (U+2060) */\
+	"\xe3\x80\x80" /* ideographic space (U+3000) */\
+	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
+
+int
+TclCompileStringTrimLCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    if (parsePtr->numWords == 3) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr,			interp, 2);
+    } else {
+	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+    }
+    OP(			STRTRIM_LEFT);
+    return TCL_OK;
+}
+
+int
+TclCompileStringTrimRCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    if (parsePtr->numWords == 3) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr,			interp, 2);
+    } else {
+	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+    }
+    OP(			STRTRIM_RIGHT);
+    return TCL_OK;
+}
+
+int
+TclCompileStringTrimCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+    Tcl_Obj *objPtr;
+
+    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
+	return TCL_ERROR;
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    if (parsePtr->numWords == 3) {
+	tokenPtr = TokenAfter(tokenPtr);
+	TclNewObj(objPtr);
+	if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+	    int len;
+	    const char *p = Tcl_GetStringFromObj(objPtr, &len);
+
+	    PushLiteral(envPtr, p, len);
+	    OP(			STRTRIM_LEFT);
+	    PushLiteral(envPtr, p, len);
+	    OP(			STRTRIM_RIGHT);
+	} else {
+	    CompileWord(envPtr, tokenPtr,		interp, 2);
+	    OP4(		REVERSE, 2);
+	    OP4(		OVER, 1);
+	    OP(			STRTRIM_LEFT);
+	    OP4(		REVERSE, 2);
+	    OP(			STRTRIM_RIGHT);
+	}
+	TclDecrRefCount(objPtr);
+    } else {
+	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+	OP(			STRTRIM_LEFT);
+	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+	OP(			STRTRIM_RIGHT);
+    }
+    return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d15ef3a..cdedbda 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -545,6 +545,17 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Drops an element from the auxiliary stack, popping stack elements
 	 * until the matching stack depth is reached. */
 
+    {"strtrimLeft",	 1,	-1,	  0,	{OPERAND_NONE}},
+	/* [string trimleft] core: removes the characters (designated by the
+	 * value at the top of the stack) from the left of the string and
+	 * pushes the resulting string.
+	 * Stack: ... string charset => ... trimmedString */
+    {"strtrimRight",	 1,	-1,	  0,	{OPERAND_NONE}},
+	/* [string trimright] core: removes the characters (designated by the
+	 * value at the top of the stack) from the right of the string and
+	 * pushes the resulting string.
+	 * Stack: ... string charset => ... trimmedString */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5660055..08eb393 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -768,8 +768,12 @@ typedef struct ByteCode {
 
 #define INST_EXPAND_DROP		165
 
+/* For compilation of [string trim] and related */
+#define INST_STRTRIM_LEFT		166
+#define INST_STRTRIM_RIGHT		167
+
 /* The last opcode */
-#define LAST_INST_OPCODE		165
+#define LAST_INST_OPCODE		167
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0ca393b..b4785bf 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5252,6 +5252,39 @@ TEBCresume(
 	objResultPtr = TCONST(match);
 	NEXT_INST_F(0, 2, 1);
 
+    {
+	const char *string1, *string2;
+
+    case INST_STRTRIM_LEFT:
+	valuePtr = OBJ_UNDER_TOS;	/* String */
+	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
+	string2 = TclGetStringFromObj(value2Ptr, &length2);
+	string1 = TclGetStringFromObj(valuePtr, &length);
+	match = TclTrimLeft(string1, length, string2, length2);
+	if (match == 0) {
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
+		    valuePtr);
+	    NEXT_INST_F(1, 1, 0);
+	} else {
+	    objResultPtr = Tcl_NewStringObj(string1+match, length-match);
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
+		    objResultPtr);
+	    NEXT_INST_F(1, 2, 1);
+	}
+    case INST_STRTRIM_RIGHT:
+	valuePtr = OBJ_UNDER_TOS;	/* String */
+	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
+	string2 = TclGetStringFromObj(value2Ptr, &length2);
+	string1 = TclGetStringFromObj(valuePtr, &length);
+	match = TclTrimRight(string1, length, string2, length2);
+	if (match == 0) {
+	    NEXT_INST_F(1, 1, 0);
+	} else {
+	    objResultPtr = Tcl_NewStringObj(string1, length-match);
+	    NEXT_INST_F(1, 2, 1);
+	}
+    }
+
     case INST_REGEXP:
 	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
 	valuePtr = OBJ_AT_TOS;		/* String */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index feea6dd..2312734 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3614,6 +3614,15 @@ MODULE_SCOPE int	TclCompileStringMatchCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileStringRangeCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringTrimCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringTrimLCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringTrimRCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileSubstCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12


From 5d83a3919d8912254cb477b87abab826cf78bc53 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 30 Sep 2013 09:03:20 +0000
Subject: Fix [f51efe99a7] by reverting [371bcd0714]

---
 generic/tclOO.decls     | 21 +++---------------
 generic/tclOODecls.h    | 58 ++++++++++++++++++++++++-------------------------
 generic/tclOOIntDecls.h | 32 +++++++++++++--------------
 3 files changed, 48 insertions(+), 63 deletions(-)

diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 19d3f03..31d1113 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -1,25 +1,12 @@
-# tclOO.decls --
-#
-#	This file contains the declarations for all supported public functions
-#	that are exported by the TclOO package that is embedded within the Tcl
-#	library via the stubs table.  This file is used to generate the
-#	tclOODecls.h, tclOOIntDecls.h, tclOOStubInit.c, and tclOOStubLib.c
-#	files.
-#
-# Copyright (c) 2008-2013 by Donal K. Fellows.
-#
-# See the file "license.terms" for information on usage and redistribution of
-# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
 library tclOO
-scspec EXTERN
 
 ######################################################################
-# Public API, exposed for general users of TclOO.
+# public API
 #
 
 interface tclOO
 hooks tclOOInt
+scspec TCLOOAPI
 
 declare 0 {
     Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
@@ -129,9 +116,7 @@ declare 28 {
 }
 
 ######################################################################
-# Private API, exposed to support advanced OO systems that plug in on top of
-# TclOO; not intended for general use and does not have any commitment to
-# long-term support.
+# private API, exposed to support advanced OO systems that plug in on top
 #
 
 interface tclOOInt
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index 9cb704e..58871c6 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -12,92 +12,92 @@
  */
 
 /* 0 */
-EXTERN Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
+TCLOOAPI Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
 				Tcl_Object sourceObject,
 				const char *targetName,
 				const char *targetNamespaceName);
 /* 1 */
-EXTERN Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
+TCLOOAPI Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
 /* 2 */
-EXTERN Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
+TCLOOAPI Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
 /* 3 */
-EXTERN Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
+TCLOOAPI Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
 /* 4 */
-EXTERN Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
+TCLOOAPI Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
 /* 5 */
-EXTERN Tcl_Namespace *	Tcl_GetObjectNamespace(Tcl_Object object);
+TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
 /* 6 */
-EXTERN Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
+TCLOOAPI Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
 /* 7 */
-EXTERN Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
+TCLOOAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
 /* 8 */
-EXTERN int		Tcl_MethodIsPublic(Tcl_Method method);
+TCLOOAPI int		Tcl_MethodIsPublic(Tcl_Method method);
 /* 9 */
-EXTERN int		Tcl_MethodIsType(Tcl_Method method,
+TCLOOAPI int		Tcl_MethodIsType(Tcl_Method method,
 				const Tcl_MethodType *typePtr,
 				ClientData *clientDataPtr);
 /* 10 */
-EXTERN Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
+TCLOOAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
 /* 11 */
-EXTERN Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Obj *nameObj,
 				int isPublic, const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 12 */
-EXTERN Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+TCLOOAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
 				Tcl_Obj *nameObj, int isPublic,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 13 */
-EXTERN Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
+TCLOOAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
 				Tcl_Class cls, const char *nameStr,
 				const char *nsNameStr, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 14 */
-EXTERN int		Tcl_ObjectDeleted(Tcl_Object object);
+TCLOOAPI int		Tcl_ObjectDeleted(Tcl_Object object);
 /* 15 */
-EXTERN int		Tcl_ObjectContextIsFiltering(
+TCLOOAPI int		Tcl_ObjectContextIsFiltering(
 				Tcl_ObjectContext context);
 /* 16 */
-EXTERN Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+TCLOOAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
 /* 17 */
-EXTERN Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
+TCLOOAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
 /* 18 */
-EXTERN int		Tcl_ObjectContextSkippedArgs(
+TCLOOAPI int		Tcl_ObjectContextSkippedArgs(
 				Tcl_ObjectContext context);
 /* 19 */
-EXTERN ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
+TCLOOAPI ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 20 */
-EXTERN void		Tcl_ClassSetMetadata(Tcl_Class clazz,
+TCLOOAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 21 */
-EXTERN ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
+TCLOOAPI ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 22 */
-EXTERN void		Tcl_ObjectSetMetadata(Tcl_Object object,
+TCLOOAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 23 */
-EXTERN int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+TCLOOAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
 				Tcl_ObjectContext context, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 24 */
-EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+TCLOOAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
 				Tcl_Object object);
 /* 25 */
-EXTERN void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+TCLOOAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
 				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
 /* 26 */
-EXTERN void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
+TCLOOAPI void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 27 */
-EXTERN void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
+TCLOOAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 28 */
-EXTERN Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
+TCLOOAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
 				Tcl_Object object);
 
 typedef struct {
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
index 834d8cb..acafb18 100644
--- a/generic/tclOOIntDecls.h
+++ b/generic/tclOOIntDecls.h
@@ -12,46 +12,46 @@
  */
 
 /* 0 */
-EXTERN Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
+TCLOOAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
 /* 1 */
-EXTERN Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 2 */
-EXTERN Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
 				Class *clsPtr, int flags, Tcl_Obj *nameObj,
 				const char *namePtr, Tcl_Obj *argsObj,
 				Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 3 */
-EXTERN Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
+TCLOOAPI Method *	TclOONewProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 4 */
-EXTERN Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+TCLOOAPI Method *	TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
 				int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 5 */
-EXTERN int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
+TCLOOAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
 				int objc, Tcl_Obj *const *objv,
 				int publicOnly, Class *startCls);
 /* 6 */
-EXTERN int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
+TCLOOAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
 /* 7 */
-EXTERN Method *		TclOONewForwardMethod(Tcl_Interp *interp,
+TCLOOAPI Method *	TclOONewForwardMethod(Tcl_Interp *interp,
 				Class *clsPtr, int isPublic,
 				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
 /* 8 */
-EXTERN Method *		TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+TCLOOAPI Method *	TclOONewForwardInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
 				Tcl_Obj *prefixObj);
 /* 9 */
-EXTERN Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Object oPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -60,7 +60,7 @@ EXTERN Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 10 */
-EXTERN Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
+TCLOOAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Class clsPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -69,22 +69,22 @@ EXTERN Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 11 */
-EXTERN int		TclOOInvokeObject(Tcl_Interp *interp,
+TCLOOAPI int		TclOOInvokeObject(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Class startCls,
 				int publicPrivate, int objc,
 				Tcl_Obj *const *objv);
 /* 12 */
-EXTERN void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
+TCLOOAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 13 */
-EXTERN void		TclOOClassSetFilters(Tcl_Interp *interp,
+TCLOOAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
 				Class *classPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 14 */
-EXTERN void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
+TCLOOAPI void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
 				Class *const *mixins);
 /* 15 */
-EXTERN void		TclOOClassSetMixins(Tcl_Interp *interp,
+TCLOOAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
 				Class *classPtr, int numMixins,
 				Class *const *mixins);
 
-- 
cgit v0.12


From 09b2762b8a6317ae6ef595df2c9dd239fd4749b3 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 30 Sep 2013 09:38:49 +0000
Subject: Restore copyright assignments and some improved comments in
 tclOO.decls: previous commit was a blind revert of [371bcd0714], but those
 changes should not have been reverted.

---
 generic/tclOO.decls | 21 ++++++++++++++++++---
 1 file changed, 18 insertions(+), 3 deletions(-)

diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 31d1113..f22390e 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -1,12 +1,25 @@
+# tclOO.decls --
+#
+#	This file contains the declarations for all supported public functions
+#	that are exported by the TclOO package that is embedded within the Tcl
+#	library via the stubs table.  This file is used to generate the
+#	tclOODecls.h, tclOOIntDecls.h, tclOOStubInit.c, and tclOOStubLib.c
+#	files.
+#
+# Copyright (c) 2008-2013 by Donal K. Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
 library tclOO
+scspec TCLOOAPI
 
 ######################################################################
-# public API
+# Public API, exposed for general users of TclOO.
 #
 
 interface tclOO
 hooks tclOOInt
-scspec TCLOOAPI
 
 declare 0 {
     Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
@@ -116,7 +129,9 @@ declare 28 {
 }
 
 ######################################################################
-# private API, exposed to support advanced OO systems that plug in on top
+# Private API, exposed to support advanced OO systems that plug in on top of
+# TclOO; not intended for general use and does not have any commitment to
+# long-term support.
 #
 
 interface tclOOInt
-- 
cgit v0.12


From b43170300d1edfb68bdc87f81aa4399d909177ee Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 2 Oct 2013 08:46:29 +0000
Subject: Expand subset of lreplace functionality that is compiled.

---
 generic/tclCompCmdsGR.c | 159 ++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 142 insertions(+), 17 deletions(-)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 43ea3d3..e695068 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1430,9 +1430,9 @@ TclCompileLreplaceCmd(
     Tcl_Token *tokenPtr, *listTokenPtr;
     DefineLineInformation;	/* TIP #280 */
     Tcl_Obj *tmpObj;
-    int idx1, idx2, result, guaranteedDropAll = 0;
+    int idx1, idx2, result, i, offset;
 
-    if (parsePtr->numWords != 4) {
+    if (parsePtr->numWords < 4) {
 	return TCL_ERROR;
     }
     listTokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -1492,38 +1492,163 @@ TclCompileLreplaceCmd(
     }
 
     /*
-     * Sanity check: can only issue when we're removing a range at one or
-     * other end of the list. If we're at one end or the other, convert the
-     * indices into the equivalent for an [lrange].
+     * Work out what this [lreplace] is actually doing.
      */
 
+    tmpObj = NULL;
+    CompileWord(envPtr, listTokenPtr, interp, 1);
+    if (parsePtr->numWords == 4) {
+	if (idx1 == 0) {
+	    if (idx2 == -2) {
+		goto dropAll;
+	    }
+	    idx1 = idx2 + 1;
+	    idx2 = -2;
+	    goto dropEnd;
+	} else if (idx2 == -2) {
+	    idx2 = idx1 - 1;
+	    idx1 = 0;
+	    goto dropEnd;
+	} else {
+	    if (idx1 > 0) {
+		tmpObj = Tcl_NewIntObj(idx1);
+		Tcl_IncrRefCount(tmpObj);
+	    }
+	    goto dropRange;
+	}
+    }
+
+    tokenPtr = TokenAfter(tokenPtr);
+    for (i=4 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt4(		INST_LIST, i - 4,		envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
     if (idx1 == 0) {
 	if (idx2 == -2) {
-	    guaranteedDropAll = 1;
+	    goto replaceAll;
 	}
 	idx1 = idx2 + 1;
 	idx2 = -2;
+	goto replaceHead;
     } else if (idx2 == -2) {
 	idx2 = idx1 - 1;
 	idx1 = 0;
+	goto replaceTail;
     } else {
-	return TCL_ERROR;
+	if (idx1 > 0 && idx2 > 0 && idx2 < idx1) {
+	    idx2 = idx1 - 1;
+	} else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) {
+	    idx2 = idx1 - 1;
+	}
+	if (idx1 > 0) {
+	    tmpObj = Tcl_NewIntObj(idx1);
+	    Tcl_IncrRefCount(tmpObj);
+	}
+	goto replaceRange;
     }
 
     /*
-     * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
-     * we've not proved that the 'list' argument is really a list. Not that it
-     * is worth trying to do that given current knowledge.
+     * Issue instructions to perform the operations relating to configurations
+     * that just drop. The only argument pushed on the stack is the list to
+     * operate on.
      */
 
-    CompileWord(envPtr, listTokenPtr, interp, 1);
-    if (guaranteedDropAll) {
+  dropAll:
+    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+    PushStringLiteral(envPtr,	"");
+    goto done;
+
+  dropEnd:
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
+    TclEmitInt4(			idx2,			envPtr);
+    goto done;
+
+  dropRange:
+    if (tmpObj != NULL) {
+	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
-	PushStringLiteral(envPtr, "");
-    } else {
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx1,	envPtr);
-	TclEmitInt4(		idx2,				envPtr);
+	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
+	TclEmitOpcode(		INST_GT,			envPtr);
+	offset = 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);
+    }
+    TclEmitOpcode(		INST_DUP,			envPtr);
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, 0,		envPtr);
+    TclEmitInt4(			idx1 - 1,		envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx2 + 1,	envPtr);
+    TclEmitInt4(			-2,			envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    goto done;
+
+    /*
+     * Issue instructions to perform the operations relating to configurations
+     * that do real replacement. All arguments are pushed and assembled into a
+     * pair: the list of values to replace with, and the list to do the
+     * surgery on.
+     */
+
+  replaceAll:
+    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+    TclEmitOpcode(		INST_POP,			envPtr);
+    goto done;
+
+  replaceHead:
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
+    TclEmitInt4(			idx2,			envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    goto done;
+
+  replaceTail:
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
+    TclEmitInt4(			idx2,			envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    goto done;
+
+  replaceRange:
+    if (tmpObj != NULL) {
+	TclEmitOpcode(		INST_DUP,			envPtr);
+	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+	TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL),	envPtr);
+	TclEmitOpcode(		INST_GT,			envPtr);
+	offset = 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);
+    }
+    TclEmitOpcode(		INST_DUP,			envPtr);
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, 0,		envPtr);
+    TclEmitInt4(			idx1 - 1,		envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx2 + 1,	envPtr);
+    TclEmitInt4(			-2,			envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 3,		envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
+    TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    goto done;
+
+    /*
+     * Clean up the allocated memory.
+     */
+
+  done:
+    if (tmpObj != NULL) {
+	Tcl_DecrRefCount(tmpObj);
     }
     return TCL_OK;
 }
-- 
cgit v0.12


From 6671b7930273fc4c18dedbe929e2f3d67e1dedf0 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 2 Oct 2013 09:41:01 +0000
Subject: Fix TclOO API export rules.

---
 generic/tclOO.decls     |  1 -
 generic/tclOO.h         | 33 ++++++++++++-----------
 generic/tclOODecls.h    | 72 +++++++++++++++++++++++++++++--------------------
 generic/tclOOIntDecls.h | 46 ++++++++++++++++++++-----------
 4 files changed, 91 insertions(+), 61 deletions(-)

diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index f22390e..4f1987c 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -12,7 +12,6 @@
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 library tclOO
-scspec TCLOOAPI
 
 ######################################################################
 # Public API, exposed for general users of TclOO.
diff --git a/generic/tclOO.h b/generic/tclOO.h
index d5ab8a0..4a6cda7 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -12,21 +12,6 @@
 
 #ifndef TCLOO_H_INCLUDED
 #define TCLOO_H_INCLUDED
-#include "tcl.h"
-
-#ifndef TCLOOAPI
-#   if defined(BUILD_tcl) || defined(BUILD_TclOO)
-#	define TCLOOAPI MODULE_SCOPE
-#   else
-#	define TCLOOAPI extern
-#	undef USE_TCLOO_STUBS
-#	define USE_TCLOO_STUBS 1
-#   endif
-#endif
-
-extern const char *TclOOInitializeStubs(
-	Tcl_Interp *, const char *version);
-#define Tcl_OOInitStubs(interp) TclOOInitializeStubs((interp), TCLOO_VERSION)
 
 /*
  * Be careful when it comes to versioning; need to make sure that the
@@ -42,6 +27,21 @@ extern const char *TclOOInitializeStubs(
 #define TCLOO_VERSION "1.0.1"
 #define TCLOO_PATCHLEVEL TCLOO_VERSION
 
+#include "tcl.h"
+
+/*
+ * For C++ compilers, use extern "C"
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern const char *TclOOInitializeStubs(
+	Tcl_Interp *, const char *version);
+#define Tcl_OOInitStubs(interp) \
+    TclOOInitializeStubs((interp), TCLOO_VERSION)
+
 /*
  * These are opaque types.
  */
@@ -130,6 +130,9 @@ typedef struct {
 
 #include "tclOODecls.h"
 
+#ifdef __cplusplus
+}
+#endif
 #endif
 
 /*
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index 58871c6..c2a5615 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -5,6 +5,17 @@
 #ifndef _TCLOODECLS
 #define _TCLOODECLS
 
+#undef TCL_STORAGE_CLASS
+#ifdef BUILD_tcl
+#   define TCL_STORAGE_CLASS DLLEXPORT
+#else
+#   ifdef USE_TCL_STUBS
+#      define TCL_STORAGE_CLASS
+#   else
+#      define TCL_STORAGE_CLASS DLLIMPORT
+#   endif
+#endif
+
 /* !BEGIN!: Do not edit below this line. */
 
 /*
@@ -12,92 +23,92 @@
  */
 
 /* 0 */
-TCLOOAPI Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
+EXTERN Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
 				Tcl_Object sourceObject,
 				const char *targetName,
 				const char *targetNamespaceName);
 /* 1 */
-TCLOOAPI Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
+EXTERN Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
 /* 2 */
-TCLOOAPI Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
+EXTERN Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
 /* 3 */
-TCLOOAPI Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
+EXTERN Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
 /* 4 */
-TCLOOAPI Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
+EXTERN Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
 /* 5 */
-TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
+EXTERN Tcl_Namespace *	Tcl_GetObjectNamespace(Tcl_Object object);
 /* 6 */
-TCLOOAPI Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
+EXTERN Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
 /* 7 */
-TCLOOAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
+EXTERN Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
 /* 8 */
-TCLOOAPI int		Tcl_MethodIsPublic(Tcl_Method method);
+EXTERN int		Tcl_MethodIsPublic(Tcl_Method method);
 /* 9 */
-TCLOOAPI int		Tcl_MethodIsType(Tcl_Method method,
+EXTERN int		Tcl_MethodIsType(Tcl_Method method,
 				const Tcl_MethodType *typePtr,
 				ClientData *clientDataPtr);
 /* 10 */
-TCLOOAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
+EXTERN Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
 /* 11 */
-TCLOOAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
+EXTERN Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Obj *nameObj,
 				int isPublic, const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 12 */
-TCLOOAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+EXTERN Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
 				Tcl_Obj *nameObj, int isPublic,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 13 */
-TCLOOAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
+EXTERN Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
 				Tcl_Class cls, const char *nameStr,
 				const char *nsNameStr, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 14 */
-TCLOOAPI int		Tcl_ObjectDeleted(Tcl_Object object);
+EXTERN int		Tcl_ObjectDeleted(Tcl_Object object);
 /* 15 */
-TCLOOAPI int		Tcl_ObjectContextIsFiltering(
+EXTERN int		Tcl_ObjectContextIsFiltering(
 				Tcl_ObjectContext context);
 /* 16 */
-TCLOOAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+EXTERN Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
 /* 17 */
-TCLOOAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
+EXTERN Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
 /* 18 */
-TCLOOAPI int		Tcl_ObjectContextSkippedArgs(
+EXTERN int		Tcl_ObjectContextSkippedArgs(
 				Tcl_ObjectContext context);
 /* 19 */
-TCLOOAPI ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
+EXTERN ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 20 */
-TCLOOAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
+EXTERN void		Tcl_ClassSetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 21 */
-TCLOOAPI ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
+EXTERN ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 22 */
-TCLOOAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
+EXTERN void		Tcl_ObjectSetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 23 */
-TCLOOAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+EXTERN int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
 				Tcl_ObjectContext context, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 24 */
-TCLOOAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
 				Tcl_Object object);
 /* 25 */
-TCLOOAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+EXTERN void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
 				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
 /* 26 */
-TCLOOAPI void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
+EXTERN void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 27 */
-TCLOOAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
+EXTERN void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 28 */
-TCLOOAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
+EXTERN Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
 				Tcl_Object object);
 
 typedef struct {
@@ -215,4 +226,7 @@ extern const TclOOStubs *tclOOStubsPtr;
 #endif /* defined(USE_TCLOO_STUBS) */
 
 /* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
 #endif /* _TCLOODECLS */
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
index acafb18..f0e3ee5 100644
--- a/generic/tclOOIntDecls.h
+++ b/generic/tclOOIntDecls.h
@@ -5,6 +5,17 @@
 #ifndef _TCLOOINTDECLS
 #define _TCLOOINTDECLS
 
+#undef TCL_STORAGE_CLASS
+#ifdef BUILD_tcl
+#   define TCL_STORAGE_CLASS DLLEXPORT
+#else
+#   ifdef USE_TCL_STUBS
+#      define TCL_STORAGE_CLASS
+#   else
+#      define TCL_STORAGE_CLASS DLLIMPORT
+#   endif
+#endif
+
 /* !BEGIN!: Do not edit below this line. */
 
 /*
@@ -12,46 +23,46 @@
  */
 
 /* 0 */
-TCLOOAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
+EXTERN Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
 /* 1 */
-TCLOOAPI Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
+EXTERN Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 2 */
-TCLOOAPI Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
+EXTERN Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
 				Class *clsPtr, int flags, Tcl_Obj *nameObj,
 				const char *namePtr, Tcl_Obj *argsObj,
 				Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 3 */
-TCLOOAPI Method *	TclOONewProcInstanceMethod(Tcl_Interp *interp,
+EXTERN Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 4 */
-TCLOOAPI Method *	TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+EXTERN Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
 				int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 5 */
-TCLOOAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
+EXTERN int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
 				int objc, Tcl_Obj *const *objv,
 				int publicOnly, Class *startCls);
 /* 6 */
-TCLOOAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
+EXTERN int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
 /* 7 */
-TCLOOAPI Method *	TclOONewForwardMethod(Tcl_Interp *interp,
+EXTERN Method *		TclOONewForwardMethod(Tcl_Interp *interp,
 				Class *clsPtr, int isPublic,
 				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
 /* 8 */
-TCLOOAPI Method *	TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+EXTERN Method *		TclOONewForwardInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
 				Tcl_Obj *prefixObj);
 /* 9 */
-TCLOOAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+EXTERN Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Object oPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -60,7 +71,7 @@ TCLOOAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 10 */
-TCLOOAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
+EXTERN Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Class clsPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -69,22 +80,22 @@ TCLOOAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 11 */
-TCLOOAPI int		TclOOInvokeObject(Tcl_Interp *interp,
+EXTERN int		TclOOInvokeObject(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Class startCls,
 				int publicPrivate, int objc,
 				Tcl_Obj *const *objv);
 /* 12 */
-TCLOOAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
+EXTERN void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 13 */
-TCLOOAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
+EXTERN void		TclOOClassSetFilters(Tcl_Interp *interp,
 				Class *classPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 14 */
-TCLOOAPI void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
+EXTERN void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
 				Class *const *mixins);
 /* 15 */
-TCLOOAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
+EXTERN void		TclOOClassSetMixins(Tcl_Interp *interp,
 				Class *classPtr, int numMixins,
 				Class *const *mixins);
 
@@ -160,4 +171,7 @@ extern const TclOOIntStubs *tclOOIntStubsPtr;
 #endif /* defined(USE_TCLOO_STUBS) */
 
 /* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
 #endif /* _TCLOOINTDECLS */
-- 
cgit v0.12


From 0bb601dd7253b545f4f9723a05bdd71c23421c77 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 2 Oct 2013 10:01:50 +0000
Subject: Turn Tcl_OOInitStubs into a no-op in non-stub-enabled usage.

---
 generic/tclOO.h | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/generic/tclOO.h b/generic/tclOO.h
index 4a6cda7..e5ed10d 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -37,10 +37,14 @@
 extern "C" {
 #endif
 
+#ifdef USE_TCLOO_STUBS
 extern const char *TclOOInitializeStubs(
 	Tcl_Interp *, const char *version);
 #define Tcl_OOInitStubs(interp) \
     TclOOInitializeStubs((interp), TCLOO_VERSION)
+#else
+#define Tcl_OOInitStubs(interp) (TCL_OK)
+#endif
 
 /*
  * These are opaque types.
-- 
cgit v0.12


From 497f593fcdae942fd1be5b1f8c9b6bfa22b77b97 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 2 Oct 2013 10:30:19 +0000
Subject: Fix compilation of Itcl and Tdbc

---
 generic/tclOO.h | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/generic/tclOO.h b/generic/tclOO.h
index e5ed10d..b77faf4 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -37,6 +37,10 @@
 extern "C" {
 #endif
 
+#ifdef USE_TCL_STUBS
+#   define USE_TCLOO_STUBS
+#endif
+
 #ifdef USE_TCLOO_STUBS
 extern const char *TclOOInitializeStubs(
 	Tcl_Interp *, const char *version);
-- 
cgit v0.12


From 1153158b42de547b96903291c168db993b64d960 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 2 Oct 2013 13:14:29 +0000
Subject: silence warnings with clang

---
 generic/tclExecute.c | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0ca393b..fd91bdb 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -293,12 +293,14 @@ VarHashCreateVar(
 	    switch (nCleanup) {					\
 	    case 1: goto cleanup1_pushObjResultPtr;		\
 	    case 2: goto cleanup2_pushObjResultPtr;		\
+	    case 0: break;					\
 	    }							\
 	} else {						\
 	    pc += (pcAdjustment);				\
 	    switch (nCleanup) {					\
 	    case 1: goto cleanup1;				\
 	    case 2: goto cleanup2;				\
+	    case 0: break;					\
 	    }							\
 	}							\
     } while (0)
@@ -360,6 +362,8 @@ VarHashCreateVar(
 
 #define CURR_DEPTH	((ptrdiff_t) (tosPtr - initTosPtr))
 
+#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)
+
 /*
  * Macros used to trace instruction execution. The macros TRACE,
  * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
@@ -451,7 +455,7 @@ VarHashCreateVar(
 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
     ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) ||	\
     (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)))		\
-	? TCL_ERROR :							\
+	? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR :							\
     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
 #else /* !TCL_WIDE_INT_IS_LONG */
 #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
@@ -471,7 +475,7 @@ VarHashCreateVar(
 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
     ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) ||	\
     (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)))		\
-	? TCL_ERROR :							\
+	? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR :							\
     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
 #endif /* TCL_WIDE_INT_IS_LONG */
 
@@ -885,7 +889,7 @@ TclCreateExecEnv(
     esPtr->nextPtr = NULL;
     esPtr->markerPtr = NULL;
     esPtr->endPtr = &esPtr->stackWords[size-1];
-    esPtr->tosPtr = &esPtr->stackWords[-1];
+    esPtr->tosPtr = STACK_BASE(esPtr);
 
     Tcl_MutexLock(&execMutex);
     if (!execInitialized) {
@@ -1106,8 +1110,8 @@ GrowEvaluationStack(
     if (esPtr->nextPtr) {
 	oldPtr = esPtr;
 	esPtr = oldPtr->nextPtr;
-	currElems = esPtr->endPtr - &esPtr->stackWords[-1];
-	if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) {
+	currElems = esPtr->endPtr - STACK_BASE(esPtr);
+	if (esPtr->markerPtr || (esPtr->tosPtr != STACK_BASE(esPtr))) {
 	    Tcl_Panic("STACK: Stack after current is in use");
 	}
 	if (esPtr->nextPtr) {
@@ -1119,7 +1123,7 @@ GrowEvaluationStack(
 	DeleteExecStack(esPtr);
 	esPtr = oldPtr;
     } else {
-	currElems = esPtr->endPtr - &esPtr->stackWords[-1];
+	currElems = esPtr->endPtr - STACK_BASE(esPtr);
     }
 
     /*
@@ -1273,10 +1277,10 @@ TclStackFree(
     while (esPtr->nextPtr) {
 	esPtr = esPtr->nextPtr;
     }
-    esPtr->tosPtr = &esPtr->stackWords[-1];
+    esPtr->tosPtr = STACK_BASE(esPtr);
     while (esPtr->prevPtr) {
 	ExecStack *tmpPtr = esPtr->prevPtr;
-	if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) {
+	if (tmpPtr->tosPtr == STACK_BASE(tmpPtr)) {
 	    DeleteExecStack(tmpPtr);
 	} else {
 	    break;
-- 
cgit v0.12


From 08c51736454ed20f4975179188a837a41f8f9d15 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 2 Oct 2013 13:16:10 +0000
Subject: neater

---
 generic/tclOO.h | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/generic/tclOO.h b/generic/tclOO.h
index b77faf4..e19510d 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -37,11 +37,7 @@
 extern "C" {
 #endif
 
-#ifdef USE_TCL_STUBS
-#   define USE_TCLOO_STUBS
-#endif
-
-#ifdef USE_TCLOO_STUBS
+#if (defined(USE_TCLOO_STUBS) || defined(USE_TCL_STUBS))
 extern const char *TclOOInitializeStubs(
 	Tcl_Interp *, const char *version);
 #define Tcl_OOInitStubs(interp) \
-- 
cgit v0.12


From 5871b801b3da2d89d15ea3d66bcb3b216f7584fe Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 2 Oct 2013 14:35:30 +0000
Subject: minor: whitespace correction (my bad!)

---
 generic/tclExecute.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fd91bdb..d3c1227 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -455,7 +455,7 @@ VarHashCreateVar(
 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
     ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) ||	\
     (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)))		\
-	? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR :							\
+	? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR :			\
     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
 #else /* !TCL_WIDE_INT_IS_LONG */
 #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
@@ -475,7 +475,7 @@ VarHashCreateVar(
 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
     ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) ||	\
     (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)))		\
-	? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR :							\
+	? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR :			\
     TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
 #endif /* TCL_WIDE_INT_IS_LONG */
 
-- 
cgit v0.12


From f9427cdbfd828dbabe79facdc3d757146c090563 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 3 Oct 2013 13:32:06 +0000
Subject: cleaner and faster 'string trim'

---
 generic/tclAssembly.c   |  3 ++-
 generic/tclCompCmdsSZ.c | 24 ++----------------------
 generic/tclCompile.c    |  5 +++++
 generic/tclCompile.h    |  7 ++++---
 generic/tclExecute.c    | 34 ++++++++++++++++++++++++++++------
 5 files changed, 41 insertions(+), 32 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 659f483..44cddba 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -462,6 +462,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"strneq",		ASSEM_1BYTE,	INST_STR_NEQ,		2,	1},
     {"strrange",	ASSEM_1BYTE,	INST_STR_RANGE,		3,	1},
     {"strrfind",	ASSEM_1BYTE,	INST_STR_FIND_LAST,	2,	1},
+    {"strtrim",		ASSEM_1BYTE,	INST_STRTRIM,		2,	1},
     {"strtrimLeft",	ASSEM_1BYTE,	INST_STRTRIM_LEFT,	2,	1},
     {"strtrimRight",	ASSEM_1BYTE,	INST_STRTRIM_RIGHT,	2,	1},
     {"sub",		ASSEM_1BYTE,	INST_SUB,		2,	1},
@@ -505,7 +506,7 @@ static const unsigned char NonThrowingByteCodes[] = {
     INST_NS_CURRENT,						/* 151 */
     INST_INFO_LEVEL_NUM,					/* 152 */
     INST_RESOLVE_COMMAND,					/* 154 */
-    INST_STRTRIM_LEFT, INST_STRTRIM_RIGHT			/* 166,167 */
+    INST_STRTRIM, INST_STRTRIM_LEFT, INST_STRTRIM_RIGHT		/* 166-168 */
 };
 
 /*
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 0177b2d..12f6167 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -739,7 +739,6 @@ TclCompileStringTrimCmd(
 {
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr;
-    Tcl_Obj *objPtr;
 
     if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
 	return TCL_ERROR;
@@ -749,30 +748,11 @@ TclCompileStringTrimCmd(
     CompileWord(envPtr, tokenPtr,			interp, 1);
     if (parsePtr->numWords == 3) {
 	tokenPtr = TokenAfter(tokenPtr);
-	TclNewObj(objPtr);
-	if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
-	    int len;
-	    const char *p = Tcl_GetStringFromObj(objPtr, &len);
-
-	    PushLiteral(envPtr, p, len);
-	    OP(			STRTRIM_LEFT);
-	    PushLiteral(envPtr, p, len);
-	    OP(			STRTRIM_RIGHT);
-	} else {
-	    CompileWord(envPtr, tokenPtr,		interp, 2);
-	    OP4(		REVERSE, 2);
-	    OP4(		OVER, 1);
-	    OP(			STRTRIM_LEFT);
-	    OP4(		REVERSE, 2);
-	    OP(			STRTRIM_RIGHT);
-	}
-	TclDecrRefCount(objPtr);
+	CompileWord(envPtr, tokenPtr,			interp, 2);
     } else {
 	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
-	OP(			STRTRIM_LEFT);
-	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
-	OP(			STRTRIM_RIGHT);
     }
+    OP(			STRTRIM);
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index cdedbda..7e72d84 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -545,6 +545,11 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Drops an element from the auxiliary stack, popping stack elements
 	 * until the matching stack depth is reached. */
 
+    {"strtrim",		 1,	-1,	  0,	{OPERAND_NONE}},
+	/* [string trim] core: removes the characters (designated by the value
+	 * at the top of the stack) from both ends of the string and pushes
+	 * the resulting string.
+	 * Stack: ... string charset => ... trimmedString */
     {"strtrimLeft",	 1,	-1,	  0,	{OPERAND_NONE}},
 	/* [string trimleft] core: removes the characters (designated by the
 	 * value at the top of the stack) from the left of the string and
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 08eb393..fa8d773 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -769,11 +769,12 @@ typedef struct ByteCode {
 #define INST_EXPAND_DROP		165
 
 /* For compilation of [string trim] and related */
-#define INST_STRTRIM_LEFT		166
-#define INST_STRTRIM_RIGHT		167
+#define INST_STRTRIM			166
+#define INST_STRTRIM_LEFT		167
+#define INST_STRTRIM_RIGHT		168
 
 /* The last opcode */
-#define LAST_INST_OPCODE		167
+#define LAST_INST_OPCODE		168
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 83f68fd..8470389 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5258,19 +5258,41 @@ TEBCresume(
 
     {
 	const char *string1, *string2;
+	int trim1, trim2;
 
+    case INST_STRTRIM:
+	valuePtr = OBJ_UNDER_TOS;	/* String */
+	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
+	string2 = TclGetStringFromObj(value2Ptr, &length2);
+	string1 = TclGetStringFromObj(valuePtr, &length);
+	trim1 = TclTrimLeft(string1, length, string2, length2);
+	if (trim1 < length) {
+	    trim2 = TclTrimRight(string1, length, string2, length2);
+	} else {
+	    trim2 = 0;
+	}
+	if (trim1 == 0 && trim2 == 0) {
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
+		    valuePtr);
+	    NEXT_INST_F(1, 1, 0);
+	} else {
+	    objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
+		    objResultPtr);
+	    NEXT_INST_F(1, 2, 1);
+	}
     case INST_STRTRIM_LEFT:
 	valuePtr = OBJ_UNDER_TOS;	/* String */
 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
 	string2 = TclGetStringFromObj(value2Ptr, &length2);
 	string1 = TclGetStringFromObj(valuePtr, &length);
-	match = TclTrimLeft(string1, length, string2, length2);
-	if (match == 0) {
+	trim1 = TclTrimLeft(string1, length, string2, length2);
+	if (trim1 == 0) {
 	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
 		    valuePtr);
 	    NEXT_INST_F(1, 1, 0);
 	} else {
-	    objResultPtr = Tcl_NewStringObj(string1+match, length-match);
+	    objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1);
 	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
 		    objResultPtr);
 	    NEXT_INST_F(1, 2, 1);
@@ -5280,11 +5302,11 @@ TEBCresume(
 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
 	string2 = TclGetStringFromObj(value2Ptr, &length2);
 	string1 = TclGetStringFromObj(valuePtr, &length);
-	match = TclTrimRight(string1, length, string2, length2);
-	if (match == 0) {
+	trim2 = TclTrimRight(string1, length, string2, length2);
+	if (trim2 == 0) {
 	    NEXT_INST_F(1, 1, 0);
 	} else {
-	    objResultPtr = Tcl_NewStringObj(string1, length-match);
+	    objResultPtr = Tcl_NewStringObj(string1, length-trim2);
 	    NEXT_INST_F(1, 2, 1);
 	}
     }
-- 
cgit v0.12


From 84ae9beda9265b2eea4f1c06d39e10cabc760103 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 4 Oct 2013 13:12:22 +0000
Subject: Added missing documentation. Corrected result of Tcl_OOInitStubs in
 non-stub case.

---
 doc/OOInitStubs.3 | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 generic/tclOO.h   |  2 +-
 2 files changed, 55 insertions(+), 1 deletion(-)
 create mode 100644 doc/OOInitStubs.3

diff --git a/doc/OOInitStubs.3 b/doc/OOInitStubs.3
new file mode 100644
index 0000000..be531c8
--- /dev/null
+++ b/doc/OOInitStubs.3
@@ -0,0 +1,54 @@
+'\"
+'\" Copyright (c) 2012 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.so man.macros
+.TH Tcl_OOInitStubs 3 1.0 TclOO "TclOO Library Functions"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_OOInitStubs \- initialize library access to TclOO functionality
+.SH SYNOPSIS
+.nf
+\fB#include <tclOO.h>\fR
+.sp
+const char *
+\fBTcl_OOInitStubs\fR(\fIinterp\fR)
+.fi
+.SH ARGUMENTS
+.AS Tcl_Interp *interp in
+.AP Tcl_Interp *interp in
+The Tcl interpreter that the TclOO API is integrated with and whose C
+interface is going to be used.
+.BE
+.SH DESCRIPTION
+.PP
+When an extension library is going to use the C interface exposed by TclOO, it
+should use \fBTcl_OOInitStubs\fR to initialize its access to that interface
+from within its \fI*\fB_Init\fR (or \fI*\fB_SafeInit\fR) function, passing in
+the \fIinterp\fR that was passed into that routine as context. If the result
+of calling \fBTcl_OOInitStubs\fR is NULL, the initialization failed and an
+error message will have been left in the interpreter's result. Otherwise, the
+initialization succeeded and the TclOO API may thereafter be used; the
+version of the TclOO API is returned.
+.PP
+When using this function, either the C #define symbol \fBUSE_TCLOO_STUBS\fR
+should be defined and your library code linked against the Tcl stub library,
+or that #define symbol should \fInot\fR be defined and your library code
+linked against the Tcl main library directly.
+.SH "BACKWARD COMPATIBILITY NOTE"
+.PP
+If you are linking against the Tcl 8.5 forward compatibility package for
+TclOO, \fIonly\fR the stub-enabled configuration is supported and you should
+also link against the TclOO independent stub library; that library is an
+integrated part of the main Tcl stub library in Tcl 8.6.
+.SH KEYWORDS
+stubs
+.SH "SEE ALSO"
+Tcl_InitStubs(3)
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/generic/tclOO.h b/generic/tclOO.h
index e19510d..41be168 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -43,7 +43,7 @@ extern const char *TclOOInitializeStubs(
 #define Tcl_OOInitStubs(interp) \
     TclOOInitializeStubs((interp), TCLOO_VERSION)
 #else
-#define Tcl_OOInitStubs(interp) (TCL_OK)
+#define Tcl_OOInitStubs(interp) (TCLOO_PATCHLEVEL)
 #endif
 
 /*
-- 
cgit v0.12


From bf332fb49405c13e2d003ac1b447bae2ac4291b4 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 5 Oct 2013 13:53:30 +0000
Subject: Added 'linsert' compiler. Factored out constant list index parser.

---
 generic/tclBasic.c      |   2 +-
 generic/tclCompCmdsGR.c | 278 +++++++++++++++++++++++++++---------------------
 generic/tclInt.h        |   3 +
 3 files changed, 160 insertions(+), 123 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a41351e..9f40932 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -227,7 +227,7 @@ static const CmdInfo builtInCmds[] = {
     {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
     {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
     {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
-    {"linsert",		Tcl_LinsertObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
     {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
     {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
     {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index e695068..c5a0126 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -27,7 +27,57 @@ static void		CompileReturnInternal(CompileEnv *envPtr,
 			    Tcl_Obj *returnOpts);
 static int		IndexTailVarIfKnown(Tcl_Interp *interp,
 			    Tcl_Token *varTokenPtr, CompileEnv *envPtr);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLinsertCmd --
+ *
+ *	Parse a token and get the encoded version of the index (as understood
+ *	by TEBC), assuming it is at all knowable at compile time. Only handles
+ *	indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ *	Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+    Tcl_Token *tokenPtr,
+    int *index)
+{
+    Tcl_Obj *tmpObj = Tcl_NewObj();
+    int result, idx;
+
+    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+	Tcl_DecrRefCount(tmpObj);
+	return TCL_ERROR;
+    }
 
+    result = TclGetIntFromObj(NULL, tmpObj, &idx);
+    if (result == TCL_OK) {
+	if (idx < 0) {
+	    result = TCL_ERROR;
+	}
+    } else {
+	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx);
+	if (result == TCL_OK && idx > -2) {
+	    result = TCL_ERROR;
+	}
+    }
+    Tcl_DecrRefCount(tmpObj);
+
+    if (result == TCL_OK) {
+	*index = idx;
+    }
+
+    return result;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -1060,7 +1110,7 @@ TclCompileLindexCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *idxTokenPtr, *valTokenPtr;
-    int i, numWords = parsePtr->numWords;
+    int i, idx, numWords = parsePtr->numWords;
     DefineLineInformation;	/* TIP #280 */
 
     /*
@@ -1078,46 +1128,28 @@ TclCompileLindexCmd(
     }
 
     idxTokenPtr = TokenAfter(valTokenPtr);
-    if (idxTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	Tcl_Obj *tmpObj;
-	int idx, result;
-
-	tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size);
-	result = TclGetIntFromObj(NULL, tmpObj, &idx);
-	if (result == TCL_OK) {
-	    if (idx < 0) {
-		result = TCL_ERROR;
-	    }
-	} else {
-	    result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx);
-	    if (result == TCL_OK && idx > -2) {
-		result = TCL_ERROR;
-	    }
-	}
-	TclDecrRefCount(tmpObj);
-
-	if (result == TCL_OK) {
-	    /*
-	     * All checks have been completed, and we have exactly one of
-	     * these constructs:
-	     *	 lindex <arbitraryValue> <posInt>
-	     *	 lindex <arbitraryValue> end-<posInt>
-	     * This is best compiled as a push of the arbitrary value followed
-	     * by an "immediate lindex" which is the most efficient variety.
-	     */
-
-	    CompileWord(envPtr, valTokenPtr, interp, 1);
-	    TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
-	    return TCL_OK;
-	}
-
+    if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) {
 	/*
-	 * If the conversion failed or the value was negative, we just keep on
-	 * going with the more complex compilation.
+	 * All checks have been completed, and we have exactly one of these
+	 * constructs:
+	 *	 lindex <arbitraryValue> <posInt>
+	 *	 lindex <arbitraryValue> end-<posInt>
+	 * This is best compiled as a push of the arbitrary value followed by
+	 * an "immediate lindex" which is the most efficient variety.
 	 */
+
+	CompileWord(envPtr, valTokenPtr, interp, 1);
+	TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
+	return TCL_OK;
     }
 
     /*
+     * If the value was not known at compile time, the conversion failed or
+     * the value was negative, we just keep on going with the more complex
+     * compilation.
+     */
+
+    /*
      * Push the operands onto the stack.
      */
 
@@ -1330,8 +1362,7 @@ TclCompileLrangeCmd(
 {
     Tcl_Token *tokenPtr, *listTokenPtr;
     DefineLineInformation;	/* TIP #280 */
-    Tcl_Obj *tmpObj;
-    int idx1, idx2, result;
+    int idx1, idx2;
 
     if (parsePtr->numWords != 4) {
 	return TCL_ERROR;
@@ -1339,56 +1370,18 @@ TclCompileLrangeCmd(
     listTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     /*
-     * Parse the first index. Will only compile if it is constant and not an
+     * Parse the indices. Will only compile if both are constants and not an
      * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
+     * end-relative indexing) or an end-based index greater than 'end' itself.
      */
 
     tokenPtr = TokenAfter(listTokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+    if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
 	return TCL_ERROR;
     }
-    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
-    result = TclGetIntFromObj(NULL, tmpObj, &idx1);
-    if (result == TCL_OK) {
-	if (idx1 < 0) {
-	    result = TCL_ERROR;
-	}
-    } else {
-	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
-	if (result == TCL_OK && idx1 > -2) {
-	    result = TCL_ERROR;
-	}
-    }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Parse the second index. Will only compile if it is constant and not an
-     * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
-     */
 
     tokenPtr = TokenAfter(tokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
-    }
-    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
-    result = TclGetIntFromObj(NULL, tmpObj, &idx2);
-    if (result == TCL_OK) {
-	if (idx2 < 0) {
-	    result = TCL_ERROR;
-	}
-    } else {
-	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
-	if (result == TCL_OK && idx2 > -2) {
-	    result = TCL_ERROR;
-	}
-    }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
+    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -1407,19 +1400,16 @@ TclCompileLrangeCmd(
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileLreplaceCmd --
+ * TclCompileLinsertCmd --
  *
- *	How to compile the "lreplace" command. We only bother with the case
- *	where there are no elements to insert and where both the 'first' and
- *	'last' arguments are constant and one can be deterined to be at the
- *	end of the list. (This is the case that could also be written with
- *	"lrange".)
+ *	How to compile the "linsert" command. We only bother with the case
+ *	where the index is constant.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileLreplaceCmd(
+TclCompileLinsertCmd(
     Tcl_Interp *interp,		/* Tcl interpreter for context. */
     Tcl_Parse *parsePtr,	/* Points to a parse structure for the
 				 * command. */
@@ -1429,65 +1419,109 @@ TclCompileLreplaceCmd(
 {
     Tcl_Token *tokenPtr, *listTokenPtr;
     DefineLineInformation;	/* TIP #280 */
-    Tcl_Obj *tmpObj;
-    int idx1, idx2, result, i, offset;
+    int idx, i;
 
-    if (parsePtr->numWords < 4) {
+    if (parsePtr->numWords < 3) {
 	return TCL_ERROR;
     }
     listTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     /*
-     * Parse the first index. Will only compile if it is constant and not an
+     * Parse the index. Will only compile if it is constant and not an
      * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
+     * end-relative indexing) or an end-based index greater than 'end' itself.
      */
 
     tokenPtr = TokenAfter(listTokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+    if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) {
 	return TCL_ERROR;
     }
-    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
-    result = TclGetIntFromObj(NULL, tmpObj, &idx1);
-    if (result == TCL_OK) {
-	if (idx1 < 0) {
-	    result = TCL_ERROR;
-	}
+
+    /*
+     * There are four main cases. If there are no values to insert, this is
+     * just a confirm-listiness check. If the index is '0', this is a prepend.
+     * If the index is 'end' (== -2), this is an append. Otherwise, this is a
+     * splice (== split, insert values as list, concat-3).
+     */
+
+    CompileWord(envPtr, listTokenPtr, interp, 1);
+    if (parsePtr->numWords == 3) {
+	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
+	TclEmitInt4(			-2,			envPtr);
+	return TCL_OK;
+    }
+
+    for (i=3 ; i<parsePtr->numWords ; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i);
+    }
+    TclEmitInstInt4(		INST_LIST, i-3,			envPtr);
+
+    if (idx == 0 /*start*/) {
+	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
+	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    } else if (idx == -2 /*end*/) {
+	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
     } else {
-	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
-	if (result == TCL_OK && idx1 > -2) {
-	    result = TCL_ERROR;
+	if (idx < 0) {
+	    idx++;
 	}
+	TclEmitInstInt4(	INST_OVER, 1,			envPtr);
+	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
+	TclEmitInt4(			idx-1,			envPtr);
+	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
+	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx,	envPtr);
+	TclEmitInt4(			-2,			envPtr);
+	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
     }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileLreplaceCmd --
+ *
+ *	How to compile the "lreplace" command. We only bother with the case
+ *	where the indices are constant.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileLreplaceCmd(
+    Tcl_Interp *interp,		/* Tcl interpreter for context. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
+				 * command. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds the resulting instructions. */
+{
+    Tcl_Token *tokenPtr, *listTokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Obj *tmpObj;
+    int idx1, idx2, i, offset;
+
+    if (parsePtr->numWords < 4) {
 	return TCL_ERROR;
     }
+    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     /*
-     * Parse the second index. Will only compile if it is constant and not an
+     * Parse the indices. Will only compile if both are constants and not an
      * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
+     * end-relative indexing) or an end-based index greater than 'end' itself.
      */
 
-    tokenPtr = TokenAfter(tokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+    tokenPtr = TokenAfter(listTokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
 	return TCL_ERROR;
     }
-    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
-    result = TclGetIntFromObj(NULL, tmpObj, &idx2);
-    if (result == TCL_OK) {
-	if (idx2 < 0) {
-	    result = TCL_ERROR;
-	}
-    } else {
-	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
-	if (result == TCL_OK && idx2 > -2) {
-	    result = TCL_ERROR;
-	}
-    }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
+
+    tokenPtr = TokenAfter(tokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
 	return TCL_ERROR;
     }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 2312734..6fe07f8 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3533,6 +3533,9 @@ MODULE_SCOPE int	TclCompileLassignCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileLindexCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLinsertCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileListCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12


From 40fefcafadb6a8be490c3ec0be0c6ed724cd1845 Mon Sep 17 00:00:00 2001
From: Kevin B Kenny <kennykb@acm.org>
Date: Sat, 5 Oct 2013 16:28:52 +0000
Subject: Advance to tzdata2013g

---
 library/tzdata/Africa/Casablanca          | 284 ++++++++++++------------------
 library/tzdata/Africa/Juba                |  40 +----
 library/tzdata/America/Anguilla           |   7 +-
 library/tzdata/America/Araguaina          | 174 +-----------------
 library/tzdata/America/Argentina/San_Luis |   2 +-
 library/tzdata/America/Aruba              |   8 +-
 library/tzdata/America/Cayman             |   4 +-
 library/tzdata/America/Dominica           |   7 +-
 library/tzdata/America/Grand_Turk         |   4 +-
 library/tzdata/America/Grenada            |   7 +-
 library/tzdata/America/Guadeloupe         |   7 +-
 library/tzdata/America/Jamaica            |   6 +-
 library/tzdata/America/Marigot            |   6 +-
 library/tzdata/America/Montserrat         |   7 +-
 library/tzdata/America/St_Barthelemy      |   6 +-
 library/tzdata/America/St_Kitts           |   7 +-
 library/tzdata/America/St_Lucia           |   8 +-
 library/tzdata/America/St_Thomas          |   7 +-
 library/tzdata/America/St_Vincent         |   8 +-
 library/tzdata/America/Tortola            |   7 +-
 library/tzdata/America/Virgin             |   6 +-
 library/tzdata/Antarctica/McMurdo         | 258 +--------------------------
 library/tzdata/Antarctica/South_Pole      |   6 +-
 library/tzdata/Asia/Amman                 | 175 +-----------------
 library/tzdata/Asia/Dili                  |   2 +-
 library/tzdata/Asia/Gaza                  | 174 +++++++++---------
 library/tzdata/Asia/Hebron                | 174 +++++++++---------
 library/tzdata/Asia/Jakarta               |  12 +-
 library/tzdata/Asia/Jayapura              |   4 +-
 library/tzdata/Asia/Makassar              |   4 +-
 library/tzdata/Asia/Pontianak             |  12 +-
 library/tzdata/Europe/Vaduz               | 246 +-------------------------
 library/tzdata/Europe/Zurich              |   4 +-
 library/tzdata/Pacific/Fiji               |  78 ++++----
 library/tzdata/Pacific/Johnston           |   6 +-
 35 files changed, 413 insertions(+), 1354 deletions(-)

diff --git a/library/tzdata/Africa/Casablanca b/library/tzdata/Africa/Casablanca
index 757007c..dec2778 100644
--- a/library/tzdata/Africa/Casablanca
+++ b/library/tzdata/Africa/Casablanca
@@ -36,189 +36,133 @@ set TZData(:Africa/Casablanca) {
     {1367114400 3600 1 WEST}
     {1373162400 0 0 WET}
     {1376100000 3600 1 WEST}
-    {1380420000 0 0 WET}
-    {1398564000 3600 1 WEST}
+    {1382839200 0 0 WET}
+    {1396144800 3600 1 WEST}
     {1404007200 0 0 WET}
     {1406599200 3600 1 WEST}
-    {1411869600 0 0 WET}
-    {1430013600 3600 1 WEST}
+    {1414288800 0 0 WET}
+    {1427594400 3600 1 WEST}
     {1434592800 0 0 WET}
     {1437184800 3600 1 WEST}
-    {1443319200 0 0 WET}
-    {1461463200 3600 1 WEST}
+    {1445738400 0 0 WET}
+    {1459044000 3600 1 WEST}
     {1465264800 0 0 WET}
     {1467856800 3600 1 WEST}
-    {1474768800 0 0 WET}
-    {1493517600 3600 1 WEST}
+    {1477792800 0 0 WET}
+    {1490493600 3600 1 WEST}
     {1495850400 0 0 WET}
     {1498442400 3600 1 WEST}
-    {1506218400 0 0 WET}
-    {1524967200 3600 1 WEST}
+    {1509242400 0 0 WET}
+    {1521943200 3600 1 WEST}
     {1526436000 0 0 WET}
     {1529028000 3600 1 WEST}
-    {1538272800 0 0 WET}
-    {1556416800 3600 1 WEST}
+    {1540692000 0 0 WET}
+    {1553997600 3600 1 WEST}
     {1557108000 0 0 WET}
     {1559700000 3600 1 WEST}
-    {1569722400 0 0 WET}
+    {1572141600 0 0 WET}
+    {1585447200 3600 1 WEST}
+    {1587693600 0 0 WET}
     {1590285600 3600 1 WEST}
-    {1601172000 0 0 WET}
+    {1603591200 0 0 WET}
+    {1616896800 3600 1 WEST}
+    {1618279200 0 0 WET}
     {1620871200 3600 1 WEST}
-    {1632621600 0 0 WET}
+    {1635645600 0 0 WET}
+    {1648346400 3600 1 WEST}
+    {1648951200 0 0 WET}
     {1651543200 3600 1 WEST}
-    {1664071200 0 0 WET}
-    {1682820000 3600 1 WEST}
-    {1695520800 0 0 WET}
-    {1714269600 3600 1 WEST}
-    {1727575200 0 0 WET}
-    {1745719200 3600 1 WEST}
-    {1759024800 0 0 WET}
-    {1777168800 3600 1 WEST}
-    {1790474400 0 0 WET}
-    {1808618400 3600 1 WEST}
-    {1821924000 0 0 WET}
-    {1840672800 3600 1 WEST}
-    {1853373600 0 0 WET}
-    {1872122400 3600 1 WEST}
-    {1885428000 0 0 WET}
-    {1903572000 3600 1 WEST}
-    {1916877600 0 0 WET}
-    {1935021600 3600 1 WEST}
-    {1948327200 0 0 WET}
-    {1966471200 3600 1 WEST}
-    {1979776800 0 0 WET}
-    {1997920800 3600 1 WEST}
-    {2011226400 0 0 WET}
-    {2029975200 3600 1 WEST}
-    {2042676000 0 0 WET}
-    {2061424800 3600 1 WEST}
-    {2074730400 0 0 WET}
-    {2092874400 3600 1 WEST}
-    {2106180000 0 0 WET}
-    {2124324000 3600 1 WEST}
-    {2137629600 0 0 WET}
-    {2155773600 3600 1 WEST}
-    {2169079200 0 0 WET}
-    {2187223200 3600 1 WEST}
-    {2200528800 0 0 WET}
-    {2219277600 3600 1 WEST}
-    {2232583200 0 0 WET}
-    {2250727200 3600 1 WEST}
-    {2264032800 0 0 WET}
-    {2282176800 3600 1 WEST}
-    {2295482400 0 0 WET}
-    {2313626400 3600 1 WEST}
-    {2326932000 0 0 WET}
-    {2345076000 3600 1 WEST}
-    {2358381600 0 0 WET}
-    {2377130400 3600 1 WEST}
-    {2389831200 0 0 WET}
-    {2408580000 3600 1 WEST}
-    {2421885600 0 0 WET}
-    {2440029600 3600 1 WEST}
-    {2453335200 0 0 WET}
-    {2471479200 3600 1 WEST}
-    {2484784800 0 0 WET}
-    {2502928800 3600 1 WEST}
-    {2516234400 0 0 WET}
-    {2534378400 3600 1 WEST}
-    {2547684000 0 0 WET}
-    {2566432800 3600 1 WEST}
-    {2579133600 0 0 WET}
-    {2597882400 3600 1 WEST}
-    {2611188000 0 0 WET}
-    {2629332000 3600 1 WEST}
-    {2642637600 0 0 WET}
-    {2660781600 3600 1 WEST}
-    {2674087200 0 0 WET}
-    {2692231200 3600 1 WEST}
-    {2705536800 0 0 WET}
-    {2724285600 3600 1 WEST}
-    {2736986400 0 0 WET}
-    {2755735200 3600 1 WEST}
-    {2769040800 0 0 WET}
-    {2787184800 3600 1 WEST}
-    {2800490400 0 0 WET}
-    {2818634400 3600 1 WEST}
-    {2831940000 0 0 WET}
-    {2850084000 3600 1 WEST}
-    {2863389600 0 0 WET}
-    {2881533600 3600 1 WEST}
-    {2894839200 0 0 WET}
-    {2913588000 3600 1 WEST}
-    {2926288800 0 0 WET}
-    {2945037600 3600 1 WEST}
-    {2958343200 0 0 WET}
-    {2976487200 3600 1 WEST}
-    {2989792800 0 0 WET}
-    {3007936800 3600 1 WEST}
-    {3021242400 0 0 WET}
-    {3039386400 3600 1 WEST}
-    {3052692000 0 0 WET}
-    {3070836000 3600 1 WEST}
-    {3084141600 0 0 WET}
-    {3102890400 3600 1 WEST}
-    {3116196000 0 0 WET}
-    {3134340000 3600 1 WEST}
-    {3147645600 0 0 WET}
-    {3165789600 3600 1 WEST}
-    {3179095200 0 0 WET}
-    {3197239200 3600 1 WEST}
-    {3210544800 0 0 WET}
-    {3228688800 3600 1 WEST}
-    {3241994400 0 0 WET}
-    {3260743200 3600 1 WEST}
-    {3273444000 0 0 WET}
-    {3292192800 3600 1 WEST}
-    {3305498400 0 0 WET}
-    {3323642400 3600 1 WEST}
-    {3336948000 0 0 WET}
-    {3355092000 3600 1 WEST}
-    {3368397600 0 0 WET}
-    {3386541600 3600 1 WEST}
-    {3399847200 0 0 WET}
-    {3417991200 3600 1 WEST}
-    {3431296800 0 0 WET}
-    {3450045600 3600 1 WEST}
-    {3462746400 0 0 WET}
-    {3481495200 3600 1 WEST}
-    {3494800800 0 0 WET}
-    {3512944800 3600 1 WEST}
-    {3526250400 0 0 WET}
-    {3544394400 3600 1 WEST}
-    {3557700000 0 0 WET}
-    {3575844000 3600 1 WEST}
-    {3589149600 0 0 WET}
-    {3607898400 3600 1 WEST}
-    {3620599200 0 0 WET}
-    {3639348000 3600 1 WEST}
-    {3652653600 0 0 WET}
-    {3670797600 3600 1 WEST}
-    {3684103200 0 0 WET}
-    {3702247200 3600 1 WEST}
-    {3715552800 0 0 WET}
-    {3733696800 3600 1 WEST}
-    {3747002400 0 0 WET}
-    {3765146400 3600 1 WEST}
-    {3778452000 0 0 WET}
-    {3797200800 3600 1 WEST}
-    {3809901600 0 0 WET}
-    {3828650400 3600 1 WEST}
-    {3841956000 0 0 WET}
-    {3860100000 3600 1 WEST}
-    {3873405600 0 0 WET}
-    {3891549600 3600 1 WEST}
-    {3904855200 0 0 WET}
-    {3922999200 3600 1 WEST}
-    {3936304800 0 0 WET}
-    {3954448800 3600 1 WEST}
-    {3967754400 0 0 WET}
-    {3986503200 3600 1 WEST}
-    {3999808800 0 0 WET}
-    {4017952800 3600 1 WEST}
-    {4031258400 0 0 WET}
-    {4049402400 3600 1 WEST}
-    {4062708000 0 0 WET}
-    {4080852000 3600 1 WEST}
-    {4094157600 0 0 WET}
+    {1667095200 0 0 WET}
+    {1682128800 3600 1 WEST}
+    {1698544800 0 0 WET}
+    {1712714400 3600 1 WEST}
+    {1729994400 0 0 WET}
+    {1743386400 3600 1 WEST}
+    {1761444000 0 0 WET}
+    {1774749600 3600 1 WEST}
+    {1792893600 0 0 WET}
+    {1806199200 3600 1 WEST}
+    {1824948000 0 0 WET}
+    {1837648800 3600 1 WEST}
+    {1856397600 0 0 WET}
+    {1869098400 3600 1 WEST}
+    {1887847200 0 0 WET}
+    {1901152800 3600 1 WEST}
+    {1919296800 0 0 WET}
+    {1932602400 3600 1 WEST}
+    {1950746400 0 0 WET}
+    {1964052000 3600 1 WEST}
+    {1982800800 0 0 WET}
+    {1995501600 3600 1 WEST}
+    {2014250400 0 0 WET}
+    {2026951200 3600 1 WEST}
+    {2045700000 0 0 WET}
+    {2058400800 3600 1 WEST}
+    {2077149600 0 0 WET}
+    {2090455200 3600 1 WEST}
+    {2108167200 0 0 WET}
+    {2121904800 3600 1 WEST}
+    {2138839200 0 0 WET}
+    {2153354400 3600 1 WEST}
+    {2184800400 3600 1 WEST}
+    {2216250000 3600 1 WEST}
+    {2248304400 3600 1 WEST}
+    {2279754000 3600 1 WEST}
+    {2311203600 3600 1 WEST}
+    {2342653200 3600 1 WEST}
+    {2374102800 3600 1 WEST}
+    {2405552400 3600 1 WEST}
+    {2437606800 3600 1 WEST}
+    {2469056400 3600 1 WEST}
+    {2500506000 3600 1 WEST}
+    {2531955600 3600 1 WEST}
+    {2563405200 3600 1 WEST}
+    {2595459600 3600 1 WEST}
+    {2626909200 3600 1 WEST}
+    {2658358800 3600 1 WEST}
+    {2689808400 3600 1 WEST}
+    {2721258000 3600 1 WEST}
+    {2752707600 3600 1 WEST}
+    {2784762000 3600 1 WEST}
+    {2816211600 3600 1 WEST}
+    {2847661200 3600 1 WEST}
+    {2879110800 3600 1 WEST}
+    {2910560400 3600 1 WEST}
+    {2942010000 3600 1 WEST}
+    {2974064400 3600 1 WEST}
+    {3005514000 3600 1 WEST}
+    {3036963600 3600 1 WEST}
+    {3068413200 3600 1 WEST}
+    {3099862800 3600 1 WEST}
+    {3131917200 3600 1 WEST}
+    {3163366800 3600 1 WEST}
+    {3194816400 3600 1 WEST}
+    {3226266000 3600 1 WEST}
+    {3257715600 3600 1 WEST}
+    {3289165200 3600 1 WEST}
+    {3321219600 3600 1 WEST}
+    {3352669200 3600 1 WEST}
+    {3384118800 3600 1 WEST}
+    {3415568400 3600 1 WEST}
+    {3447018000 3600 1 WEST}
+    {3479072400 3600 1 WEST}
+    {3510522000 3600 1 WEST}
+    {3541971600 3600 1 WEST}
+    {3573421200 3600 1 WEST}
+    {3604870800 3600 1 WEST}
+    {3636320400 3600 1 WEST}
+    {3668374800 3600 1 WEST}
+    {3699824400 3600 1 WEST}
+    {3731274000 3600 1 WEST}
+    {3762723600 3600 1 WEST}
+    {3794173200 3600 1 WEST}
+    {3825622800 3600 1 WEST}
+    {3857677200 3600 1 WEST}
+    {3889126800 3600 1 WEST}
+    {3920576400 3600 1 WEST}
+    {3952026000 3600 1 WEST}
+    {3983475600 3600 1 WEST}
+    {4015530000 3600 1 WEST}
+    {4046979600 3600 1 WEST}
+    {4078429200 3600 1 WEST}
 }
diff --git a/library/tzdata/Africa/Juba b/library/tzdata/Africa/Juba
index 7495981..40551f2 100644
--- a/library/tzdata/Africa/Juba
+++ b/library/tzdata/Africa/Juba
@@ -1,39 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:Africa/Juba) {
-    {-9223372036854775808 7584 0 LMT}
-    {-1230775584 7200 0 CAT}
-    {10360800 10800 1 CAST}
-    {24786000 7200 0 CAT}
-    {41810400 10800 1 CAST}
-    {56322000 7200 0 CAT}
-    {73432800 10800 1 CAST}
-    {87944400 7200 0 CAT}
-    {104882400 10800 1 CAST}
-    {119480400 7200 0 CAT}
-    {136332000 10800 1 CAST}
-    {151016400 7200 0 CAT}
-    {167781600 10800 1 CAST}
-    {182552400 7200 0 CAT}
-    {199231200 10800 1 CAST}
-    {214174800 7200 0 CAT}
-    {230680800 10800 1 CAST}
-    {245710800 7200 0 CAT}
-    {262735200 10800 1 CAST}
-    {277246800 7200 0 CAT}
-    {294184800 10800 1 CAST}
-    {308782800 7200 0 CAT}
-    {325634400 10800 1 CAST}
-    {340405200 7200 0 CAT}
-    {357084000 10800 1 CAST}
-    {371941200 7200 0 CAT}
-    {388533600 10800 1 CAST}
-    {403477200 7200 0 CAT}
-    {419983200 10800 1 CAST}
-    {435013200 7200 0 CAT}
-    {452037600 10800 1 CAST}
-    {466635600 7200 0 CAT}
-    {483487200 10800 1 CAST}
-    {498171600 7200 0 CAT}
-    {947930400 10800 0 EAT}
+if {![info exists TZData(Africa/Khartoum)]} {
+    LoadTimeZoneFile Africa/Khartoum
 }
+set TZData(:Africa/Juba) $TZData(:Africa/Khartoum)
diff --git a/library/tzdata/America/Anguilla b/library/tzdata/America/Anguilla
index cfe7483..39a0d18 100644
--- a/library/tzdata/America/Anguilla
+++ b/library/tzdata/America/Anguilla
@@ -1,6 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Anguilla) {
-    {-9223372036854775808 -15136 0 LMT}
-    {-1825098464 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/Anguilla) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Araguaina b/library/tzdata/America/Araguaina
index dc1b543..e4a0d52 100644
--- a/library/tzdata/America/Araguaina
+++ b/library/tzdata/America/Araguaina
@@ -56,177 +56,5 @@ set TZData(:America/Araguaina) {
     {1064368800 -10800 0 BRT}
     {1350788400 -7200 0 BRST}
     {1361066400 -10800 0 BRT}
-    {1382238000 -7200 1 BRST}
-    {1392516000 -10800 0 BRT}
-    {1413687600 -7200 1 BRST}
-    {1424570400 -10800 0 BRT}
-    {1445137200 -7200 1 BRST}
-    {1456020000 -10800 0 BRT}
-    {1476586800 -7200 1 BRST}
-    {1487469600 -10800 0 BRT}
-    {1508036400 -7200 1 BRST}
-    {1518919200 -10800 0 BRT}
-    {1540090800 -7200 1 BRST}
-    {1550368800 -10800 0 BRT}
-    {1571540400 -7200 1 BRST}
-    {1581818400 -10800 0 BRT}
-    {1602990000 -7200 1 BRST}
-    {1613872800 -10800 0 BRT}
-    {1634439600 -7200 1 BRST}
-    {1645322400 -10800 0 BRT}
-    {1665889200 -7200 1 BRST}
-    {1677376800 -10800 0 BRT}
-    {1697338800 -7200 1 BRST}
-    {1708221600 -10800 0 BRT}
-    {1729393200 -7200 1 BRST}
-    {1739671200 -10800 0 BRT}
-    {1760842800 -7200 1 BRST}
-    {1771725600 -10800 0 BRT}
-    {1792292400 -7200 1 BRST}
-    {1803175200 -10800 0 BRT}
-    {1823742000 -7200 1 BRST}
-    {1834624800 -10800 0 BRT}
-    {1855191600 -7200 1 BRST}
-    {1866074400 -10800 0 BRT}
-    {1887246000 -7200 1 BRST}
-    {1897524000 -10800 0 BRT}
-    {1918695600 -7200 1 BRST}
-    {1928973600 -10800 0 BRT}
-    {1950145200 -7200 1 BRST}
-    {1960423200 -10800 0 BRT}
-    {1981594800 -7200 1 BRST}
-    {1992477600 -10800 0 BRT}
-    {2013044400 -7200 1 BRST}
-    {2024532000 -10800 0 BRT}
-    {2044494000 -7200 1 BRST}
-    {2055376800 -10800 0 BRT}
-    {2076548400 -7200 1 BRST}
-    {2086826400 -10800 0 BRT}
-    {2107998000 -7200 1 BRST}
-    {2118880800 -10800 0 BRT}
-    {2139447600 -7200 1 BRST}
-    {2150330400 -10800 0 BRT}
-    {2170897200 -7200 1 BRST}
-    {2181780000 -10800 0 BRT}
-    {2202346800 -7200 1 BRST}
-    {2213229600 -10800 0 BRT}
-    {2234401200 -7200 1 BRST}
-    {2244679200 -10800 0 BRT}
-    {2265850800 -7200 1 BRST}
-    {2276128800 -10800 0 BRT}
-    {2297300400 -7200 1 BRST}
-    {2307578400 -10800 0 BRT}
-    {2328750000 -7200 1 BRST}
-    {2339632800 -10800 0 BRT}
-    {2360199600 -7200 1 BRST}
-    {2371082400 -10800 0 BRT}
-    {2391649200 -7200 1 BRST}
-    {2402532000 -10800 0 BRT}
-    {2423703600 -7200 1 BRST}
-    {2433981600 -10800 0 BRT}
-    {2455153200 -7200 1 BRST}
-    {2465431200 -10800 0 BRT}
-    {2486602800 -7200 1 BRST}
-    {2497485600 -10800 0 BRT}
-    {2518052400 -7200 1 BRST}
-    {2528935200 -10800 0 BRT}
-    {2549502000 -7200 1 BRST}
-    {2560384800 -10800 0 BRT}
-    {2580951600 -7200 1 BRST}
-    {2591834400 -10800 0 BRT}
-    {2613006000 -7200 1 BRST}
-    {2623284000 -10800 0 BRT}
-    {2644455600 -7200 1 BRST}
-    {2654733600 -10800 0 BRT}
-    {2675905200 -7200 1 BRST}
-    {2686788000 -10800 0 BRT}
-    {2707354800 -7200 1 BRST}
-    {2718237600 -10800 0 BRT}
-    {2738804400 -7200 1 BRST}
-    {2749687200 -10800 0 BRT}
-    {2770858800 -7200 1 BRST}
-    {2781136800 -10800 0 BRT}
-    {2802308400 -7200 1 BRST}
-    {2812586400 -10800 0 BRT}
-    {2833758000 -7200 1 BRST}
-    {2844036000 -10800 0 BRT}
-    {2865207600 -7200 1 BRST}
-    {2876090400 -10800 0 BRT}
-    {2896657200 -7200 1 BRST}
-    {2907540000 -10800 0 BRT}
-    {2928106800 -7200 1 BRST}
-    {2938989600 -10800 0 BRT}
-    {2960161200 -7200 1 BRST}
-    {2970439200 -10800 0 BRT}
-    {2991610800 -7200 1 BRST}
-    {3001888800 -10800 0 BRT}
-    {3023060400 -7200 1 BRST}
-    {3033943200 -10800 0 BRT}
-    {3054510000 -7200 1 BRST}
-    {3065392800 -10800 0 BRT}
-    {3085959600 -7200 1 BRST}
-    {3096842400 -10800 0 BRT}
-    {3118014000 -7200 1 BRST}
-    {3128292000 -10800 0 BRT}
-    {3149463600 -7200 1 BRST}
-    {3159741600 -10800 0 BRT}
-    {3180913200 -7200 1 BRST}
-    {3191191200 -10800 0 BRT}
-    {3212362800 -7200 1 BRST}
-    {3223245600 -10800 0 BRT}
-    {3243812400 -7200 1 BRST}
-    {3254695200 -10800 0 BRT}
-    {3275262000 -7200 1 BRST}
-    {3286144800 -10800 0 BRT}
-    {3307316400 -7200 1 BRST}
-    {3317594400 -10800 0 BRT}
-    {3338766000 -7200 1 BRST}
-    {3349044000 -10800 0 BRT}
-    {3370215600 -7200 1 BRST}
-    {3381098400 -10800 0 BRT}
-    {3401665200 -7200 1 BRST}
-    {3412548000 -10800 0 BRT}
-    {3433114800 -7200 1 BRST}
-    {3443997600 -10800 0 BRT}
-    {3464564400 -7200 1 BRST}
-    {3475447200 -10800 0 BRT}
-    {3496618800 -7200 1 BRST}
-    {3506896800 -10800 0 BRT}
-    {3528068400 -7200 1 BRST}
-    {3538346400 -10800 0 BRT}
-    {3559518000 -7200 1 BRST}
-    {3570400800 -10800 0 BRT}
-    {3590967600 -7200 1 BRST}
-    {3601850400 -10800 0 BRT}
-    {3622417200 -7200 1 BRST}
-    {3633300000 -10800 0 BRT}
-    {3654471600 -7200 1 BRST}
-    {3664749600 -10800 0 BRT}
-    {3685921200 -7200 1 BRST}
-    {3696199200 -10800 0 BRT}
-    {3717370800 -7200 1 BRST}
-    {3727648800 -10800 0 BRT}
-    {3748820400 -7200 1 BRST}
-    {3759703200 -10800 0 BRT}
-    {3780270000 -7200 1 BRST}
-    {3791152800 -10800 0 BRT}
-    {3811719600 -7200 1 BRST}
-    {3822602400 -10800 0 BRT}
-    {3843774000 -7200 1 BRST}
-    {3854052000 -10800 0 BRT}
-    {3875223600 -7200 1 BRST}
-    {3885501600 -10800 0 BRT}
-    {3906673200 -7200 1 BRST}
-    {3917556000 -10800 0 BRT}
-    {3938122800 -7200 1 BRST}
-    {3949005600 -10800 0 BRT}
-    {3969572400 -7200 1 BRST}
-    {3980455200 -10800 0 BRT}
-    {4001626800 -7200 1 BRST}
-    {4011904800 -10800 0 BRT}
-    {4033076400 -7200 1 BRST}
-    {4043354400 -10800 0 BRT}
-    {4064526000 -7200 1 BRST}
-    {4074804000 -10800 0 BRT}
-    {4095975600 -7200 1 BRST}
+    {1378000800 -10800 0 BRT}
 }
diff --git a/library/tzdata/America/Argentina/San_Luis b/library/tzdata/America/Argentina/San_Luis
index bec1554..8ca55d7 100644
--- a/library/tzdata/America/Argentina/San_Luis
+++ b/library/tzdata/America/Argentina/San_Luis
@@ -64,5 +64,5 @@ set TZData(:America/Argentina/San_Luis) {
     {1205031600 -14400 0 WART}
     {1223784000 -10800 1 WARST}
     {1236481200 -14400 0 WART}
-    {1255233600 -10800 1 WARST}
+    {1255233600 -10800 0 ART}
 }
diff --git a/library/tzdata/America/Aruba b/library/tzdata/America/Aruba
index 92f182d..e02d5fc 100644
--- a/library/tzdata/America/Aruba
+++ b/library/tzdata/America/Aruba
@@ -1,7 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Aruba) {
-    {-9223372036854775808 -16824 0 LMT}
-    {-1826738376 -16200 0 ANT}
-    {-157750200 -14400 0 AST}
+if {![info exists TZData(America/Curacao)]} {
+    LoadTimeZoneFile America/Curacao
 }
+set TZData(:America/Aruba) $TZData(:America/Curacao)
diff --git a/library/tzdata/America/Cayman b/library/tzdata/America/Cayman
index ab5d12b..3e2e3cc 100644
--- a/library/tzdata/America/Cayman
+++ b/library/tzdata/America/Cayman
@@ -2,6 +2,6 @@
 
 set TZData(:America/Cayman) {
     {-9223372036854775808 -19532 0 LMT}
-    {-2524502068 -18432 0 KMT}
-    {-1827687168 -18000 0 EST}
+    {-2524502068 -18431 0 KMT}
+    {-1827687169 -18000 0 EST}
 }
diff --git a/library/tzdata/America/Dominica b/library/tzdata/America/Dominica
index 3503a65..b97cb0e 100644
--- a/library/tzdata/America/Dominica
+++ b/library/tzdata/America/Dominica
@@ -1,6 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Dominica) {
-    {-9223372036854775808 -14736 0 LMT}
-    {-1846266804 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/Dominica) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Grand_Turk b/library/tzdata/America/Grand_Turk
index a455dd5..6c8ea4a 100644
--- a/library/tzdata/America/Grand_Turk
+++ b/library/tzdata/America/Grand_Turk
@@ -2,8 +2,8 @@
 
 set TZData(:America/Grand_Turk) {
     {-9223372036854775808 -17072 0 LMT}
-    {-2524504528 -18432 0 KMT}
-    {-1827687168 -18000 0 EST}
+    {-2524504528 -18431 0 KMT}
+    {-1827687169 -18000 0 EST}
     {294217200 -14400 1 EDT}
     {309938400 -18000 0 EST}
     {325666800 -14400 1 EDT}
diff --git a/library/tzdata/America/Grenada b/library/tzdata/America/Grenada
index 3c2919b..92300c3 100644
--- a/library/tzdata/America/Grenada
+++ b/library/tzdata/America/Grenada
@@ -1,6 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Grenada) {
-    {-9223372036854775808 -14820 0 LMT}
-    {-1846266780 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/Grenada) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Guadeloupe b/library/tzdata/America/Guadeloupe
index b1987ce..aba6bd7 100644
--- a/library/tzdata/America/Guadeloupe
+++ b/library/tzdata/America/Guadeloupe
@@ -1,6 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Guadeloupe) {
-    {-9223372036854775808 -14768 0 LMT}
-    {-1848254032 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/Guadeloupe) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Jamaica b/library/tzdata/America/Jamaica
index 393d90a8..682e47c 100644
--- a/library/tzdata/America/Jamaica
+++ b/library/tzdata/America/Jamaica
@@ -1,9 +1,9 @@
 # created by tools/tclZIC.tcl - do not edit
 
 set TZData(:America/Jamaica) {
-    {-9223372036854775808 -18432 0 LMT}
-    {-2524503168 -18432 0 KMT}
-    {-1827687168 -18000 0 EST}
+    {-9223372036854775808 -18431 0 LMT}
+    {-2524503169 -18431 0 KMT}
+    {-1827687169 -18000 0 EST}
     {136364400 -14400 0 EDT}
     {152085600 -18000 0 EST}
     {162370800 -14400 1 EDT}
diff --git a/library/tzdata/America/Marigot b/library/tzdata/America/Marigot
index 9f3f8f6..c2b3873 100644
--- a/library/tzdata/America/Marigot
+++ b/library/tzdata/America/Marigot
@@ -1,5 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Guadeloupe)]} {
-    LoadTimeZoneFile America/Guadeloupe
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
-set TZData(:America/Marigot) $TZData(:America/Guadeloupe)
+set TZData(:America/Marigot) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Montserrat b/library/tzdata/America/Montserrat
index 4d82766..0a656d3 100644
--- a/library/tzdata/America/Montserrat
+++ b/library/tzdata/America/Montserrat
@@ -1,6 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Montserrat) {
-    {-9223372036854775808 -14932 0 LMT}
-    {-1846266608 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/Montserrat) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/St_Barthelemy b/library/tzdata/America/St_Barthelemy
index 25c114a..46bc287 100644
--- a/library/tzdata/America/St_Barthelemy
+++ b/library/tzdata/America/St_Barthelemy
@@ -1,5 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/Guadeloupe)]} {
-    LoadTimeZoneFile America/Guadeloupe
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
-set TZData(:America/St_Barthelemy) $TZData(:America/Guadeloupe)
+set TZData(:America/St_Barthelemy) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/St_Kitts b/library/tzdata/America/St_Kitts
index bfd803b..6ad7f04 100644
--- a/library/tzdata/America/St_Kitts
+++ b/library/tzdata/America/St_Kitts
@@ -1,6 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/St_Kitts) {
-    {-9223372036854775808 -15052 0 LMT}
-    {-1825098548 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/St_Kitts) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/St_Lucia b/library/tzdata/America/St_Lucia
index c2767dd..e479b31 100644
--- a/library/tzdata/America/St_Lucia
+++ b/library/tzdata/America/St_Lucia
@@ -1,7 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/St_Lucia) {
-    {-9223372036854775808 -14640 0 LMT}
-    {-2524506960 -14640 0 CMT}
-    {-1830369360 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/St_Lucia) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/St_Thomas b/library/tzdata/America/St_Thomas
index bf93595..24698b8 100644
--- a/library/tzdata/America/St_Thomas
+++ b/library/tzdata/America/St_Thomas
@@ -1,6 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/St_Thomas) {
-    {-9223372036854775808 -15584 0 LMT}
-    {-1846266016 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/St_Thomas) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/St_Vincent b/library/tzdata/America/St_Vincent
index 3a884c7..e3b32fb 100644
--- a/library/tzdata/America/St_Vincent
+++ b/library/tzdata/America/St_Vincent
@@ -1,7 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/St_Vincent) {
-    {-9223372036854775808 -14696 0 LMT}
-    {-2524506904 -14696 0 KMT}
-    {-1830369304 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/St_Vincent) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Tortola b/library/tzdata/America/Tortola
index bf7f1fc..aa6f655 100644
--- a/library/tzdata/America/Tortola
+++ b/library/tzdata/America/Tortola
@@ -1,6 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:America/Tortola) {
-    {-9223372036854775808 -15508 0 LMT}
-    {-1846266092 -14400 0 AST}
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
+set TZData(:America/Tortola) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/America/Virgin b/library/tzdata/America/Virgin
index 390d7c2..c267e5b 100644
--- a/library/tzdata/America/Virgin
+++ b/library/tzdata/America/Virgin
@@ -1,5 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-if {![info exists TZData(America/St_Thomas)]} {
-    LoadTimeZoneFile America/St_Thomas
+if {![info exists TZData(America/Port_of_Spain)]} {
+    LoadTimeZoneFile America/Port_of_Spain
 }
-set TZData(:America/Virgin) $TZData(:America/St_Thomas)
+set TZData(:America/Virgin) $TZData(:America/Port_of_Spain)
diff --git a/library/tzdata/Antarctica/McMurdo b/library/tzdata/Antarctica/McMurdo
index 670f7eb..3b29ba1 100644
--- a/library/tzdata/Antarctica/McMurdo
+++ b/library/tzdata/Antarctica/McMurdo
@@ -1,257 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:Antarctica/McMurdo) {
-    {-9223372036854775808 0 0 zzz}
-    {-441849600 43200 0 NZST}
-    {152632800 46800 1 NZDT}
-    {162309600 43200 0 NZST}
-    {183477600 46800 1 NZDT}
-    {194968800 43200 0 NZST}
-    {215532000 46800 1 NZDT}
-    {226418400 43200 0 NZST}
-    {246981600 46800 1 NZDT}
-    {257868000 43200 0 NZST}
-    {278431200 46800 1 NZDT}
-    {289317600 43200 0 NZST}
-    {309880800 46800 1 NZDT}
-    {320767200 43200 0 NZST}
-    {341330400 46800 1 NZDT}
-    {352216800 43200 0 NZST}
-    {372780000 46800 1 NZDT}
-    {384271200 43200 0 NZST}
-    {404834400 46800 1 NZDT}
-    {415720800 43200 0 NZST}
-    {436284000 46800 1 NZDT}
-    {447170400 43200 0 NZST}
-    {467733600 46800 1 NZDT}
-    {478620000 43200 0 NZST}
-    {499183200 46800 1 NZDT}
-    {510069600 43200 0 NZST}
-    {530632800 46800 1 NZDT}
-    {541519200 43200 0 NZST}
-    {562082400 46800 1 NZDT}
-    {573573600 43200 0 NZST}
-    {594136800 46800 1 NZDT}
-    {605023200 43200 0 NZST}
-    {623772000 46800 1 NZDT}
-    {637682400 43200 0 NZST}
-    {655221600 46800 1 NZDT}
-    {669132000 43200 0 NZST}
-    {686671200 46800 1 NZDT}
-    {700581600 43200 0 NZST}
-    {718120800 46800 1 NZDT}
-    {732636000 43200 0 NZST}
-    {749570400 46800 1 NZDT}
-    {764085600 43200 0 NZST}
-    {781020000 46800 1 NZDT}
-    {795535200 43200 0 NZST}
-    {812469600 46800 1 NZDT}
-    {826984800 43200 0 NZST}
-    {844524000 46800 1 NZDT}
-    {858434400 43200 0 NZST}
-    {875973600 46800 1 NZDT}
-    {889884000 43200 0 NZST}
-    {907423200 46800 1 NZDT}
-    {921938400 43200 0 NZST}
-    {938872800 46800 1 NZDT}
-    {953388000 43200 0 NZST}
-    {970322400 46800 1 NZDT}
-    {984837600 43200 0 NZST}
-    {1002376800 46800 1 NZDT}
-    {1016287200 43200 0 NZST}
-    {1033826400 46800 1 NZDT}
-    {1047736800 43200 0 NZST}
-    {1065276000 46800 1 NZDT}
-    {1079791200 43200 0 NZST}
-    {1096725600 46800 1 NZDT}
-    {1111240800 43200 0 NZST}
-    {1128175200 46800 1 NZDT}
-    {1142690400 43200 0 NZST}
-    {1159624800 46800 1 NZDT}
-    {1174140000 43200 0 NZST}
-    {1191074400 46800 1 NZDT}
-    {1207404000 43200 0 NZST}
-    {1222524000 46800 1 NZDT}
-    {1238853600 43200 0 NZST}
-    {1253973600 46800 1 NZDT}
-    {1270303200 43200 0 NZST}
-    {1285423200 46800 1 NZDT}
-    {1301752800 43200 0 NZST}
-    {1316872800 46800 1 NZDT}
-    {1333202400 43200 0 NZST}
-    {1348927200 46800 1 NZDT}
-    {1365256800 43200 0 NZST}
-    {1380376800 46800 1 NZDT}
-    {1396706400 43200 0 NZST}
-    {1411826400 46800 1 NZDT}
-    {1428156000 43200 0 NZST}
-    {1443276000 46800 1 NZDT}
-    {1459605600 43200 0 NZST}
-    {1474725600 46800 1 NZDT}
-    {1491055200 43200 0 NZST}
-    {1506175200 46800 1 NZDT}
-    {1522504800 43200 0 NZST}
-    {1538229600 46800 1 NZDT}
-    {1554559200 43200 0 NZST}
-    {1569679200 46800 1 NZDT}
-    {1586008800 43200 0 NZST}
-    {1601128800 46800 1 NZDT}
-    {1617458400 43200 0 NZST}
-    {1632578400 46800 1 NZDT}
-    {1648908000 43200 0 NZST}
-    {1664028000 46800 1 NZDT}
-    {1680357600 43200 0 NZST}
-    {1695477600 46800 1 NZDT}
-    {1712412000 43200 0 NZST}
-    {1727532000 46800 1 NZDT}
-    {1743861600 43200 0 NZST}
-    {1758981600 46800 1 NZDT}
-    {1775311200 43200 0 NZST}
-    {1790431200 46800 1 NZDT}
-    {1806760800 43200 0 NZST}
-    {1821880800 46800 1 NZDT}
-    {1838210400 43200 0 NZST}
-    {1853330400 46800 1 NZDT}
-    {1869660000 43200 0 NZST}
-    {1885384800 46800 1 NZDT}
-    {1901714400 43200 0 NZST}
-    {1916834400 46800 1 NZDT}
-    {1933164000 43200 0 NZST}
-    {1948284000 46800 1 NZDT}
-    {1964613600 43200 0 NZST}
-    {1979733600 46800 1 NZDT}
-    {1996063200 43200 0 NZST}
-    {2011183200 46800 1 NZDT}
-    {2027512800 43200 0 NZST}
-    {2042632800 46800 1 NZDT}
-    {2058962400 43200 0 NZST}
-    {2074687200 46800 1 NZDT}
-    {2091016800 43200 0 NZST}
-    {2106136800 46800 1 NZDT}
-    {2122466400 43200 0 NZST}
-    {2137586400 46800 1 NZDT}
-    {2153916000 43200 0 NZST}
-    {2169036000 46800 1 NZDT}
-    {2185365600 43200 0 NZST}
-    {2200485600 46800 1 NZDT}
-    {2216815200 43200 0 NZST}
-    {2232540000 46800 1 NZDT}
-    {2248869600 43200 0 NZST}
-    {2263989600 46800 1 NZDT}
-    {2280319200 43200 0 NZST}
-    {2295439200 46800 1 NZDT}
-    {2311768800 43200 0 NZST}
-    {2326888800 46800 1 NZDT}
-    {2343218400 43200 0 NZST}
-    {2358338400 46800 1 NZDT}
-    {2374668000 43200 0 NZST}
-    {2389788000 46800 1 NZDT}
-    {2406117600 43200 0 NZST}
-    {2421842400 46800 1 NZDT}
-    {2438172000 43200 0 NZST}
-    {2453292000 46800 1 NZDT}
-    {2469621600 43200 0 NZST}
-    {2484741600 46800 1 NZDT}
-    {2501071200 43200 0 NZST}
-    {2516191200 46800 1 NZDT}
-    {2532520800 43200 0 NZST}
-    {2547640800 46800 1 NZDT}
-    {2563970400 43200 0 NZST}
-    {2579090400 46800 1 NZDT}
-    {2596024800 43200 0 NZST}
-    {2611144800 46800 1 NZDT}
-    {2627474400 43200 0 NZST}
-    {2642594400 46800 1 NZDT}
-    {2658924000 43200 0 NZST}
-    {2674044000 46800 1 NZDT}
-    {2690373600 43200 0 NZST}
-    {2705493600 46800 1 NZDT}
-    {2721823200 43200 0 NZST}
-    {2736943200 46800 1 NZDT}
-    {2753272800 43200 0 NZST}
-    {2768997600 46800 1 NZDT}
-    {2785327200 43200 0 NZST}
-    {2800447200 46800 1 NZDT}
-    {2816776800 43200 0 NZST}
-    {2831896800 46800 1 NZDT}
-    {2848226400 43200 0 NZST}
-    {2863346400 46800 1 NZDT}
-    {2879676000 43200 0 NZST}
-    {2894796000 46800 1 NZDT}
-    {2911125600 43200 0 NZST}
-    {2926245600 46800 1 NZDT}
-    {2942575200 43200 0 NZST}
-    {2958300000 46800 1 NZDT}
-    {2974629600 43200 0 NZST}
-    {2989749600 46800 1 NZDT}
-    {3006079200 43200 0 NZST}
-    {3021199200 46800 1 NZDT}
-    {3037528800 43200 0 NZST}
-    {3052648800 46800 1 NZDT}
-    {3068978400 43200 0 NZST}
-    {3084098400 46800 1 NZDT}
-    {3100428000 43200 0 NZST}
-    {3116152800 46800 1 NZDT}
-    {3132482400 43200 0 NZST}
-    {3147602400 46800 1 NZDT}
-    {3163932000 43200 0 NZST}
-    {3179052000 46800 1 NZDT}
-    {3195381600 43200 0 NZST}
-    {3210501600 46800 1 NZDT}
-    {3226831200 43200 0 NZST}
-    {3241951200 46800 1 NZDT}
-    {3258280800 43200 0 NZST}
-    {3273400800 46800 1 NZDT}
-    {3289730400 43200 0 NZST}
-    {3305455200 46800 1 NZDT}
-    {3321784800 43200 0 NZST}
-    {3336904800 46800 1 NZDT}
-    {3353234400 43200 0 NZST}
-    {3368354400 46800 1 NZDT}
-    {3384684000 43200 0 NZST}
-    {3399804000 46800 1 NZDT}
-    {3416133600 43200 0 NZST}
-    {3431253600 46800 1 NZDT}
-    {3447583200 43200 0 NZST}
-    {3462703200 46800 1 NZDT}
-    {3479637600 43200 0 NZST}
-    {3494757600 46800 1 NZDT}
-    {3511087200 43200 0 NZST}
-    {3526207200 46800 1 NZDT}
-    {3542536800 43200 0 NZST}
-    {3557656800 46800 1 NZDT}
-    {3573986400 43200 0 NZST}
-    {3589106400 46800 1 NZDT}
-    {3605436000 43200 0 NZST}
-    {3620556000 46800 1 NZDT}
-    {3636885600 43200 0 NZST}
-    {3652610400 46800 1 NZDT}
-    {3668940000 43200 0 NZST}
-    {3684060000 46800 1 NZDT}
-    {3700389600 43200 0 NZST}
-    {3715509600 46800 1 NZDT}
-    {3731839200 43200 0 NZST}
-    {3746959200 46800 1 NZDT}
-    {3763288800 43200 0 NZST}
-    {3778408800 46800 1 NZDT}
-    {3794738400 43200 0 NZST}
-    {3809858400 46800 1 NZDT}
-    {3826188000 43200 0 NZST}
-    {3841912800 46800 1 NZDT}
-    {3858242400 43200 0 NZST}
-    {3873362400 46800 1 NZDT}
-    {3889692000 43200 0 NZST}
-    {3904812000 46800 1 NZDT}
-    {3921141600 43200 0 NZST}
-    {3936261600 46800 1 NZDT}
-    {3952591200 43200 0 NZST}
-    {3967711200 46800 1 NZDT}
-    {3984040800 43200 0 NZST}
-    {3999765600 46800 1 NZDT}
-    {4016095200 43200 0 NZST}
-    {4031215200 46800 1 NZDT}
-    {4047544800 43200 0 NZST}
-    {4062664800 46800 1 NZDT}
-    {4078994400 43200 0 NZST}
-    {4094114400 46800 1 NZDT}
+if {![info exists TZData(Pacific/Auckland)]} {
+    LoadTimeZoneFile Pacific/Auckland
 }
+set TZData(:Antarctica/McMurdo) $TZData(:Pacific/Auckland)
diff --git a/library/tzdata/Antarctica/South_Pole b/library/tzdata/Antarctica/South_Pole
index 34d0db1..544bde4 100644
--- a/library/tzdata/Antarctica/South_Pole
+++ b/library/tzdata/Antarctica/South_Pole
@@ -1,5 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-if {![info exists TZData(Antarctica/McMurdo)]} {
-    LoadTimeZoneFile Antarctica/McMurdo
+if {![info exists TZData(Pacific/Auckland)]} {
+    LoadTimeZoneFile Pacific/Auckland
 }
-set TZData(:Antarctica/South_Pole) $TZData(:Antarctica/McMurdo)
+set TZData(:Antarctica/South_Pole) $TZData(:Pacific/Auckland)
diff --git a/library/tzdata/Asia/Amman b/library/tzdata/Asia/Amman
index 33f0ba7..d5e8616 100644
--- a/library/tzdata/Asia/Amman
+++ b/library/tzdata/Asia/Amman
@@ -70,178 +70,5 @@ set TZData(:Asia/Amman) {
     {1301608800 10800 1 EEST}
     {1319752800 7200 0 EET}
     {1333058400 10800 1 EEST}
-    {1364504400 10800 1 EEST}
-    {1382652000 7200 0 EET}
-    {1395957600 10800 1 EEST}
-    {1414706400 7200 0 EET}
-    {1427407200 10800 1 EEST}
-    {1446156000 7200 0 EET}
-    {1459461600 10800 1 EEST}
-    {1477605600 7200 0 EET}
-    {1490911200 10800 1 EEST}
-    {1509055200 7200 0 EET}
-    {1522360800 10800 1 EEST}
-    {1540504800 7200 0 EET}
-    {1553810400 10800 1 EEST}
-    {1571954400 7200 0 EET}
-    {1585260000 10800 1 EEST}
-    {1604008800 7200 0 EET}
-    {1616709600 10800 1 EEST}
-    {1635458400 7200 0 EET}
-    {1648764000 10800 1 EEST}
-    {1666908000 7200 0 EET}
-    {1680213600 10800 1 EEST}
-    {1698357600 7200 0 EET}
-    {1711663200 10800 1 EEST}
-    {1729807200 7200 0 EET}
-    {1743112800 10800 1 EEST}
-    {1761861600 7200 0 EET}
-    {1774562400 10800 1 EEST}
-    {1793311200 7200 0 EET}
-    {1806012000 10800 1 EEST}
-    {1824760800 7200 0 EET}
-    {1838066400 10800 1 EEST}
-    {1856210400 7200 0 EET}
-    {1869516000 10800 1 EEST}
-    {1887660000 7200 0 EET}
-    {1900965600 10800 1 EEST}
-    {1919109600 7200 0 EET}
-    {1932415200 10800 1 EEST}
-    {1951164000 7200 0 EET}
-    {1963864800 10800 1 EEST}
-    {1982613600 7200 0 EET}
-    {1995919200 10800 1 EEST}
-    {2014063200 7200 0 EET}
-    {2027368800 10800 1 EEST}
-    {2045512800 7200 0 EET}
-    {2058818400 10800 1 EEST}
-    {2076962400 7200 0 EET}
-    {2090268000 10800 1 EEST}
-    {2109016800 7200 0 EET}
-    {2121717600 10800 1 EEST}
-    {2140466400 7200 0 EET}
-    {2153167200 10800 1 EEST}
-    {2171916000 7200 0 EET}
-    {2185221600 10800 1 EEST}
-    {2203365600 7200 0 EET}
-    {2216671200 10800 1 EEST}
-    {2234815200 7200 0 EET}
-    {2248120800 10800 1 EEST}
-    {2266264800 7200 0 EET}
-    {2279570400 10800 1 EEST}
-    {2298319200 7200 0 EET}
-    {2311020000 10800 1 EEST}
-    {2329768800 7200 0 EET}
-    {2343074400 10800 1 EEST}
-    {2361218400 7200 0 EET}
-    {2374524000 10800 1 EEST}
-    {2392668000 7200 0 EET}
-    {2405973600 10800 1 EEST}
-    {2424117600 7200 0 EET}
-    {2437423200 10800 1 EEST}
-    {2455567200 7200 0 EET}
-    {2468872800 10800 1 EEST}
-    {2487621600 7200 0 EET}
-    {2500322400 10800 1 EEST}
-    {2519071200 7200 0 EET}
-    {2532376800 10800 1 EEST}
-    {2550520800 7200 0 EET}
-    {2563826400 10800 1 EEST}
-    {2581970400 7200 0 EET}
-    {2595276000 10800 1 EEST}
-    {2613420000 7200 0 EET}
-    {2626725600 10800 1 EEST}
-    {2645474400 7200 0 EET}
-    {2658175200 10800 1 EEST}
-    {2676924000 7200 0 EET}
-    {2689624800 10800 1 EEST}
-    {2708373600 7200 0 EET}
-    {2721679200 10800 1 EEST}
-    {2739823200 7200 0 EET}
-    {2753128800 10800 1 EEST}
-    {2771272800 7200 0 EET}
-    {2784578400 10800 1 EEST}
-    {2802722400 7200 0 EET}
-    {2816028000 10800 1 EEST}
-    {2834776800 7200 0 EET}
-    {2847477600 10800 1 EEST}
-    {2866226400 7200 0 EET}
-    {2879532000 10800 1 EEST}
-    {2897676000 7200 0 EET}
-    {2910981600 10800 1 EEST}
-    {2929125600 7200 0 EET}
-    {2942431200 10800 1 EEST}
-    {2960575200 7200 0 EET}
-    {2973880800 10800 1 EEST}
-    {2992629600 7200 0 EET}
-    {3005330400 10800 1 EEST}
-    {3024079200 7200 0 EET}
-    {3036780000 10800 1 EEST}
-    {3055528800 7200 0 EET}
-    {3068834400 10800 1 EEST}
-    {3086978400 7200 0 EET}
-    {3100284000 10800 1 EEST}
-    {3118428000 7200 0 EET}
-    {3131733600 10800 1 EEST}
-    {3149877600 7200 0 EET}
-    {3163183200 10800 1 EEST}
-    {3181932000 7200 0 EET}
-    {3194632800 10800 1 EEST}
-    {3213381600 7200 0 EET}
-    {3226687200 10800 1 EEST}
-    {3244831200 7200 0 EET}
-    {3258136800 10800 1 EEST}
-    {3276280800 7200 0 EET}
-    {3289586400 10800 1 EEST}
-    {3307730400 7200 0 EET}
-    {3321036000 10800 1 EEST}
-    {3339180000 7200 0 EET}
-    {3352485600 10800 1 EEST}
-    {3371234400 7200 0 EET}
-    {3383935200 10800 1 EEST}
-    {3402684000 7200 0 EET}
-    {3415989600 10800 1 EEST}
-    {3434133600 7200 0 EET}
-    {3447439200 10800 1 EEST}
-    {3465583200 7200 0 EET}
-    {3478888800 10800 1 EEST}
-    {3497032800 7200 0 EET}
-    {3510338400 10800 1 EEST}
-    {3529087200 7200 0 EET}
-    {3541788000 10800 1 EEST}
-    {3560536800 7200 0 EET}
-    {3573237600 10800 1 EEST}
-    {3591986400 7200 0 EET}
-    {3605292000 10800 1 EEST}
-    {3623436000 7200 0 EET}
-    {3636741600 10800 1 EEST}
-    {3654885600 7200 0 EET}
-    {3668191200 10800 1 EEST}
-    {3686335200 7200 0 EET}
-    {3699640800 10800 1 EEST}
-    {3718389600 7200 0 EET}
-    {3731090400 10800 1 EEST}
-    {3749839200 7200 0 EET}
-    {3763144800 10800 1 EEST}
-    {3781288800 7200 0 EET}
-    {3794594400 10800 1 EEST}
-    {3812738400 7200 0 EET}
-    {3826044000 10800 1 EEST}
-    {3844188000 7200 0 EET}
-    {3857493600 10800 1 EEST}
-    {3876242400 7200 0 EET}
-    {3888943200 10800 1 EEST}
-    {3907692000 7200 0 EET}
-    {3920392800 10800 1 EEST}
-    {3939141600 7200 0 EET}
-    {3952447200 10800 1 EEST}
-    {3970591200 7200 0 EET}
-    {3983896800 10800 1 EEST}
-    {4002040800 7200 0 EET}
-    {4015346400 10800 1 EEST}
-    {4033490400 7200 0 EET}
-    {4046796000 10800 1 EEST}
-    {4065544800 7200 0 EET}
-    {4078245600 10800 1 EEST}
-    {4096994400 7200 0 EET}
+    {1351202400 10800 0 AST}
 }
diff --git a/library/tzdata/Asia/Dili b/library/tzdata/Asia/Dili
index 36910fd..f783557 100644
--- a/library/tzdata/Asia/Dili
+++ b/library/tzdata/Asia/Dili
@@ -5,6 +5,6 @@ set TZData(:Asia/Dili) {
     {-1830414140 28800 0 TLT}
     {-879152400 32400 0 JST}
     {-766054800 32400 0 TLT}
-    {199897200 28800 0 CIT}
+    {199897200 28800 0 WITA}
     {969120000 32400 0 TLT}
 }
diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza
index a0636e2..7d62a96 100644
--- a/library/tzdata/Asia/Gaza
+++ b/library/tzdata/Asia/Gaza
@@ -102,177 +102,177 @@ set TZData(:Asia/Gaza) {
     {1333058400 10800 1 EEST}
     {1348178400 7200 0 EET}
     {1364508000 10800 1 EEST}
-    {1380232800 7200 0 EET}
+    {1380229200 7200 0 EET}
     {1395957600 10800 1 EEST}
-    {1411682400 7200 0 EET}
+    {1411678800 7200 0 EET}
     {1427407200 10800 1 EEST}
-    {1443132000 7200 0 EET}
+    {1443128400 7200 0 EET}
     {1459461600 10800 1 EEST}
-    {1474581600 7200 0 EET}
+    {1474578000 7200 0 EET}
     {1490911200 10800 1 EEST}
-    {1506031200 7200 0 EET}
+    {1506027600 7200 0 EET}
     {1522360800 10800 1 EEST}
-    {1537480800 7200 0 EET}
+    {1537477200 7200 0 EET}
     {1553810400 10800 1 EEST}
-    {1569535200 7200 0 EET}
+    {1569531600 7200 0 EET}
     {1585260000 10800 1 EEST}
-    {1600984800 7200 0 EET}
+    {1600981200 7200 0 EET}
     {1616709600 10800 1 EEST}
-    {1632434400 7200 0 EET}
+    {1632430800 7200 0 EET}
     {1648764000 10800 1 EEST}
-    {1663884000 7200 0 EET}
+    {1663880400 7200 0 EET}
     {1680213600 10800 1 EEST}
-    {1695333600 7200 0 EET}
+    {1695330000 7200 0 EET}
     {1711663200 10800 1 EEST}
-    {1727388000 7200 0 EET}
+    {1727384400 7200 0 EET}
     {1743112800 10800 1 EEST}
-    {1758837600 7200 0 EET}
+    {1758834000 7200 0 EET}
     {1774562400 10800 1 EEST}
-    {1790287200 7200 0 EET}
+    {1790283600 7200 0 EET}
     {1806012000 10800 1 EEST}
-    {1821736800 7200 0 EET}
+    {1821733200 7200 0 EET}
     {1838066400 10800 1 EEST}
-    {1853186400 7200 0 EET}
+    {1853182800 7200 0 EET}
     {1869516000 10800 1 EEST}
-    {1884636000 7200 0 EET}
+    {1884632400 7200 0 EET}
     {1900965600 10800 1 EEST}
-    {1916690400 7200 0 EET}
+    {1916686800 7200 0 EET}
     {1932415200 10800 1 EEST}
-    {1948140000 7200 0 EET}
+    {1948136400 7200 0 EET}
     {1963864800 10800 1 EEST}
-    {1979589600 7200 0 EET}
+    {1979586000 7200 0 EET}
     {1995919200 10800 1 EEST}
-    {2011039200 7200 0 EET}
+    {2011035600 7200 0 EET}
     {2027368800 10800 1 EEST}
-    {2042488800 7200 0 EET}
+    {2042485200 7200 0 EET}
     {2058818400 10800 1 EEST}
-    {2073938400 7200 0 EET}
+    {2073934800 7200 0 EET}
     {2090268000 10800 1 EEST}
-    {2105992800 7200 0 EET}
+    {2105989200 7200 0 EET}
     {2121717600 10800 1 EEST}
-    {2137442400 7200 0 EET}
+    {2137438800 7200 0 EET}
     {2153167200 10800 1 EEST}
-    {2168892000 7200 0 EET}
+    {2168888400 7200 0 EET}
     {2185221600 10800 1 EEST}
-    {2200341600 7200 0 EET}
+    {2200338000 7200 0 EET}
     {2216671200 10800 1 EEST}
-    {2231791200 7200 0 EET}
+    {2231787600 7200 0 EET}
     {2248120800 10800 1 EEST}
-    {2263845600 7200 0 EET}
+    {2263842000 7200 0 EET}
     {2279570400 10800 1 EEST}
-    {2295295200 7200 0 EET}
+    {2295291600 7200 0 EET}
     {2311020000 10800 1 EEST}
-    {2326744800 7200 0 EET}
+    {2326741200 7200 0 EET}
     {2343074400 10800 1 EEST}
-    {2358194400 7200 0 EET}
+    {2358190800 7200 0 EET}
     {2374524000 10800 1 EEST}
-    {2389644000 7200 0 EET}
+    {2389640400 7200 0 EET}
     {2405973600 10800 1 EEST}
-    {2421093600 7200 0 EET}
+    {2421090000 7200 0 EET}
     {2437423200 10800 1 EEST}
-    {2453148000 7200 0 EET}
+    {2453144400 7200 0 EET}
     {2468872800 10800 1 EEST}
-    {2484597600 7200 0 EET}
+    {2484594000 7200 0 EET}
     {2500322400 10800 1 EEST}
-    {2516047200 7200 0 EET}
+    {2516043600 7200 0 EET}
     {2532376800 10800 1 EEST}
-    {2547496800 7200 0 EET}
+    {2547493200 7200 0 EET}
     {2563826400 10800 1 EEST}
-    {2578946400 7200 0 EET}
+    {2578942800 7200 0 EET}
     {2595276000 10800 1 EEST}
-    {2611000800 7200 0 EET}
+    {2610997200 7200 0 EET}
     {2626725600 10800 1 EEST}
-    {2642450400 7200 0 EET}
+    {2642446800 7200 0 EET}
     {2658175200 10800 1 EEST}
-    {2673900000 7200 0 EET}
+    {2673896400 7200 0 EET}
     {2689624800 10800 1 EEST}
-    {2705349600 7200 0 EET}
+    {2705346000 7200 0 EET}
     {2721679200 10800 1 EEST}
-    {2736799200 7200 0 EET}
+    {2736795600 7200 0 EET}
     {2753128800 10800 1 EEST}
-    {2768248800 7200 0 EET}
+    {2768245200 7200 0 EET}
     {2784578400 10800 1 EEST}
-    {2800303200 7200 0 EET}
+    {2800299600 7200 0 EET}
     {2816028000 10800 1 EEST}
-    {2831752800 7200 0 EET}
+    {2831749200 7200 0 EET}
     {2847477600 10800 1 EEST}
-    {2863202400 7200 0 EET}
+    {2863198800 7200 0 EET}
     {2879532000 10800 1 EEST}
-    {2894652000 7200 0 EET}
+    {2894648400 7200 0 EET}
     {2910981600 10800 1 EEST}
-    {2926101600 7200 0 EET}
+    {2926098000 7200 0 EET}
     {2942431200 10800 1 EEST}
-    {2957551200 7200 0 EET}
+    {2957547600 7200 0 EET}
     {2973880800 10800 1 EEST}
-    {2989605600 7200 0 EET}
+    {2989602000 7200 0 EET}
     {3005330400 10800 1 EEST}
-    {3021055200 7200 0 EET}
+    {3021051600 7200 0 EET}
     {3036780000 10800 1 EEST}
-    {3052504800 7200 0 EET}
+    {3052501200 7200 0 EET}
     {3068834400 10800 1 EEST}
-    {3083954400 7200 0 EET}
+    {3083950800 7200 0 EET}
     {3100284000 10800 1 EEST}
-    {3115404000 7200 0 EET}
+    {3115400400 7200 0 EET}
     {3131733600 10800 1 EEST}
-    {3147458400 7200 0 EET}
+    {3147454800 7200 0 EET}
     {3163183200 10800 1 EEST}
-    {3178908000 7200 0 EET}
+    {3178904400 7200 0 EET}
     {3194632800 10800 1 EEST}
-    {3210357600 7200 0 EET}
+    {3210354000 7200 0 EET}
     {3226687200 10800 1 EEST}
-    {3241807200 7200 0 EET}
+    {3241803600 7200 0 EET}
     {3258136800 10800 1 EEST}
-    {3273256800 7200 0 EET}
+    {3273253200 7200 0 EET}
     {3289586400 10800 1 EEST}
-    {3304706400 7200 0 EET}
+    {3304702800 7200 0 EET}
     {3321036000 10800 1 EEST}
-    {3336760800 7200 0 EET}
+    {3336757200 7200 0 EET}
     {3352485600 10800 1 EEST}
-    {3368210400 7200 0 EET}
+    {3368206800 7200 0 EET}
     {3383935200 10800 1 EEST}
-    {3399660000 7200 0 EET}
+    {3399656400 7200 0 EET}
     {3415989600 10800 1 EEST}
-    {3431109600 7200 0 EET}
+    {3431106000 7200 0 EET}
     {3447439200 10800 1 EEST}
-    {3462559200 7200 0 EET}
+    {3462555600 7200 0 EET}
     {3478888800 10800 1 EEST}
-    {3494613600 7200 0 EET}
+    {3494610000 7200 0 EET}
     {3510338400 10800 1 EEST}
-    {3526063200 7200 0 EET}
+    {3526059600 7200 0 EET}
     {3541788000 10800 1 EEST}
-    {3557512800 7200 0 EET}
+    {3557509200 7200 0 EET}
     {3573237600 10800 1 EEST}
-    {3588962400 7200 0 EET}
+    {3588958800 7200 0 EET}
     {3605292000 10800 1 EEST}
-    {3620412000 7200 0 EET}
+    {3620408400 7200 0 EET}
     {3636741600 10800 1 EEST}
-    {3651861600 7200 0 EET}
+    {3651858000 7200 0 EET}
     {3668191200 10800 1 EEST}
-    {3683916000 7200 0 EET}
+    {3683912400 7200 0 EET}
     {3699640800 10800 1 EEST}
-    {3715365600 7200 0 EET}
+    {3715362000 7200 0 EET}
     {3731090400 10800 1 EEST}
-    {3746815200 7200 0 EET}
+    {3746811600 7200 0 EET}
     {3763144800 10800 1 EEST}
-    {3778264800 7200 0 EET}
+    {3778261200 7200 0 EET}
     {3794594400 10800 1 EEST}
-    {3809714400 7200 0 EET}
+    {3809710800 7200 0 EET}
     {3826044000 10800 1 EEST}
-    {3841164000 7200 0 EET}
+    {3841160400 7200 0 EET}
     {3857493600 10800 1 EEST}
-    {3873218400 7200 0 EET}
+    {3873214800 7200 0 EET}
     {3888943200 10800 1 EEST}
-    {3904668000 7200 0 EET}
+    {3904664400 7200 0 EET}
     {3920392800 10800 1 EEST}
-    {3936117600 7200 0 EET}
+    {3936114000 7200 0 EET}
     {3952447200 10800 1 EEST}
-    {3967567200 7200 0 EET}
+    {3967563600 7200 0 EET}
     {3983896800 10800 1 EEST}
-    {3999016800 7200 0 EET}
+    {3999013200 7200 0 EET}
     {4015346400 10800 1 EEST}
-    {4031071200 7200 0 EET}
+    {4031067600 7200 0 EET}
     {4046796000 10800 1 EEST}
-    {4062520800 7200 0 EET}
+    {4062517200 7200 0 EET}
     {4078245600 10800 1 EEST}
-    {4093970400 7200 0 EET}
+    {4093966800 7200 0 EET}
 }
diff --git a/library/tzdata/Asia/Hebron b/library/tzdata/Asia/Hebron
index a8a9019..1333d5a 100644
--- a/library/tzdata/Asia/Hebron
+++ b/library/tzdata/Asia/Hebron
@@ -101,177 +101,177 @@ set TZData(:Asia/Hebron) {
     {1333058400 10800 1 EEST}
     {1348178400 7200 0 EET}
     {1364508000 10800 1 EEST}
-    {1380232800 7200 0 EET}
+    {1380229200 7200 0 EET}
     {1395957600 10800 1 EEST}
-    {1411682400 7200 0 EET}
+    {1411678800 7200 0 EET}
     {1427407200 10800 1 EEST}
-    {1443132000 7200 0 EET}
+    {1443128400 7200 0 EET}
     {1459461600 10800 1 EEST}
-    {1474581600 7200 0 EET}
+    {1474578000 7200 0 EET}
     {1490911200 10800 1 EEST}
-    {1506031200 7200 0 EET}
+    {1506027600 7200 0 EET}
     {1522360800 10800 1 EEST}
-    {1537480800 7200 0 EET}
+    {1537477200 7200 0 EET}
     {1553810400 10800 1 EEST}
-    {1569535200 7200 0 EET}
+    {1569531600 7200 0 EET}
     {1585260000 10800 1 EEST}
-    {1600984800 7200 0 EET}
+    {1600981200 7200 0 EET}
     {1616709600 10800 1 EEST}
-    {1632434400 7200 0 EET}
+    {1632430800 7200 0 EET}
     {1648764000 10800 1 EEST}
-    {1663884000 7200 0 EET}
+    {1663880400 7200 0 EET}
     {1680213600 10800 1 EEST}
-    {1695333600 7200 0 EET}
+    {1695330000 7200 0 EET}
     {1711663200 10800 1 EEST}
-    {1727388000 7200 0 EET}
+    {1727384400 7200 0 EET}
     {1743112800 10800 1 EEST}
-    {1758837600 7200 0 EET}
+    {1758834000 7200 0 EET}
     {1774562400 10800 1 EEST}
-    {1790287200 7200 0 EET}
+    {1790283600 7200 0 EET}
     {1806012000 10800 1 EEST}
-    {1821736800 7200 0 EET}
+    {1821733200 7200 0 EET}
     {1838066400 10800 1 EEST}
-    {1853186400 7200 0 EET}
+    {1853182800 7200 0 EET}
     {1869516000 10800 1 EEST}
-    {1884636000 7200 0 EET}
+    {1884632400 7200 0 EET}
     {1900965600 10800 1 EEST}
-    {1916690400 7200 0 EET}
+    {1916686800 7200 0 EET}
     {1932415200 10800 1 EEST}
-    {1948140000 7200 0 EET}
+    {1948136400 7200 0 EET}
     {1963864800 10800 1 EEST}
-    {1979589600 7200 0 EET}
+    {1979586000 7200 0 EET}
     {1995919200 10800 1 EEST}
-    {2011039200 7200 0 EET}
+    {2011035600 7200 0 EET}
     {2027368800 10800 1 EEST}
-    {2042488800 7200 0 EET}
+    {2042485200 7200 0 EET}
     {2058818400 10800 1 EEST}
-    {2073938400 7200 0 EET}
+    {2073934800 7200 0 EET}
     {2090268000 10800 1 EEST}
-    {2105992800 7200 0 EET}
+    {2105989200 7200 0 EET}
     {2121717600 10800 1 EEST}
-    {2137442400 7200 0 EET}
+    {2137438800 7200 0 EET}
     {2153167200 10800 1 EEST}
-    {2168892000 7200 0 EET}
+    {2168888400 7200 0 EET}
     {2185221600 10800 1 EEST}
-    {2200341600 7200 0 EET}
+    {2200338000 7200 0 EET}
     {2216671200 10800 1 EEST}
-    {2231791200 7200 0 EET}
+    {2231787600 7200 0 EET}
     {2248120800 10800 1 EEST}
-    {2263845600 7200 0 EET}
+    {2263842000 7200 0 EET}
     {2279570400 10800 1 EEST}
-    {2295295200 7200 0 EET}
+    {2295291600 7200 0 EET}
     {2311020000 10800 1 EEST}
-    {2326744800 7200 0 EET}
+    {2326741200 7200 0 EET}
     {2343074400 10800 1 EEST}
-    {2358194400 7200 0 EET}
+    {2358190800 7200 0 EET}
     {2374524000 10800 1 EEST}
-    {2389644000 7200 0 EET}
+    {2389640400 7200 0 EET}
     {2405973600 10800 1 EEST}
-    {2421093600 7200 0 EET}
+    {2421090000 7200 0 EET}
     {2437423200 10800 1 EEST}
-    {2453148000 7200 0 EET}
+    {2453144400 7200 0 EET}
     {2468872800 10800 1 EEST}
-    {2484597600 7200 0 EET}
+    {2484594000 7200 0 EET}
     {2500322400 10800 1 EEST}
-    {2516047200 7200 0 EET}
+    {2516043600 7200 0 EET}
     {2532376800 10800 1 EEST}
-    {2547496800 7200 0 EET}
+    {2547493200 7200 0 EET}
     {2563826400 10800 1 EEST}
-    {2578946400 7200 0 EET}
+    {2578942800 7200 0 EET}
     {2595276000 10800 1 EEST}
-    {2611000800 7200 0 EET}
+    {2610997200 7200 0 EET}
     {2626725600 10800 1 EEST}
-    {2642450400 7200 0 EET}
+    {2642446800 7200 0 EET}
     {2658175200 10800 1 EEST}
-    {2673900000 7200 0 EET}
+    {2673896400 7200 0 EET}
     {2689624800 10800 1 EEST}
-    {2705349600 7200 0 EET}
+    {2705346000 7200 0 EET}
     {2721679200 10800 1 EEST}
-    {2736799200 7200 0 EET}
+    {2736795600 7200 0 EET}
     {2753128800 10800 1 EEST}
-    {2768248800 7200 0 EET}
+    {2768245200 7200 0 EET}
     {2784578400 10800 1 EEST}
-    {2800303200 7200 0 EET}
+    {2800299600 7200 0 EET}
     {2816028000 10800 1 EEST}
-    {2831752800 7200 0 EET}
+    {2831749200 7200 0 EET}
     {2847477600 10800 1 EEST}
-    {2863202400 7200 0 EET}
+    {2863198800 7200 0 EET}
     {2879532000 10800 1 EEST}
-    {2894652000 7200 0 EET}
+    {2894648400 7200 0 EET}
     {2910981600 10800 1 EEST}
-    {2926101600 7200 0 EET}
+    {2926098000 7200 0 EET}
     {2942431200 10800 1 EEST}
-    {2957551200 7200 0 EET}
+    {2957547600 7200 0 EET}
     {2973880800 10800 1 EEST}
-    {2989605600 7200 0 EET}
+    {2989602000 7200 0 EET}
     {3005330400 10800 1 EEST}
-    {3021055200 7200 0 EET}
+    {3021051600 7200 0 EET}
     {3036780000 10800 1 EEST}
-    {3052504800 7200 0 EET}
+    {3052501200 7200 0 EET}
     {3068834400 10800 1 EEST}
-    {3083954400 7200 0 EET}
+    {3083950800 7200 0 EET}
     {3100284000 10800 1 EEST}
-    {3115404000 7200 0 EET}
+    {3115400400 7200 0 EET}
     {3131733600 10800 1 EEST}
-    {3147458400 7200 0 EET}
+    {3147454800 7200 0 EET}
     {3163183200 10800 1 EEST}
-    {3178908000 7200 0 EET}
+    {3178904400 7200 0 EET}
     {3194632800 10800 1 EEST}
-    {3210357600 7200 0 EET}
+    {3210354000 7200 0 EET}
     {3226687200 10800 1 EEST}
-    {3241807200 7200 0 EET}
+    {3241803600 7200 0 EET}
     {3258136800 10800 1 EEST}
-    {3273256800 7200 0 EET}
+    {3273253200 7200 0 EET}
     {3289586400 10800 1 EEST}
-    {3304706400 7200 0 EET}
+    {3304702800 7200 0 EET}
     {3321036000 10800 1 EEST}
-    {3336760800 7200 0 EET}
+    {3336757200 7200 0 EET}
     {3352485600 10800 1 EEST}
-    {3368210400 7200 0 EET}
+    {3368206800 7200 0 EET}
     {3383935200 10800 1 EEST}
-    {3399660000 7200 0 EET}
+    {3399656400 7200 0 EET}
     {3415989600 10800 1 EEST}
-    {3431109600 7200 0 EET}
+    {3431106000 7200 0 EET}
     {3447439200 10800 1 EEST}
-    {3462559200 7200 0 EET}
+    {3462555600 7200 0 EET}
     {3478888800 10800 1 EEST}
-    {3494613600 7200 0 EET}
+    {3494610000 7200 0 EET}
     {3510338400 10800 1 EEST}
-    {3526063200 7200 0 EET}
+    {3526059600 7200 0 EET}
     {3541788000 10800 1 EEST}
-    {3557512800 7200 0 EET}
+    {3557509200 7200 0 EET}
     {3573237600 10800 1 EEST}
-    {3588962400 7200 0 EET}
+    {3588958800 7200 0 EET}
     {3605292000 10800 1 EEST}
-    {3620412000 7200 0 EET}
+    {3620408400 7200 0 EET}
     {3636741600 10800 1 EEST}
-    {3651861600 7200 0 EET}
+    {3651858000 7200 0 EET}
     {3668191200 10800 1 EEST}
-    {3683916000 7200 0 EET}
+    {3683912400 7200 0 EET}
     {3699640800 10800 1 EEST}
-    {3715365600 7200 0 EET}
+    {3715362000 7200 0 EET}
     {3731090400 10800 1 EEST}
-    {3746815200 7200 0 EET}
+    {3746811600 7200 0 EET}
     {3763144800 10800 1 EEST}
-    {3778264800 7200 0 EET}
+    {3778261200 7200 0 EET}
     {3794594400 10800 1 EEST}
-    {3809714400 7200 0 EET}
+    {3809710800 7200 0 EET}
     {3826044000 10800 1 EEST}
-    {3841164000 7200 0 EET}
+    {3841160400 7200 0 EET}
     {3857493600 10800 1 EEST}
-    {3873218400 7200 0 EET}
+    {3873214800 7200 0 EET}
     {3888943200 10800 1 EEST}
-    {3904668000 7200 0 EET}
+    {3904664400 7200 0 EET}
     {3920392800 10800 1 EEST}
-    {3936117600 7200 0 EET}
+    {3936114000 7200 0 EET}
     {3952447200 10800 1 EEST}
-    {3967567200 7200 0 EET}
+    {3967563600 7200 0 EET}
     {3983896800 10800 1 EEST}
-    {3999016800 7200 0 EET}
+    {3999013200 7200 0 EET}
     {4015346400 10800 1 EEST}
-    {4031071200 7200 0 EET}
+    {4031067600 7200 0 EET}
     {4046796000 10800 1 EEST}
-    {4062520800 7200 0 EET}
+    {4062517200 7200 0 EET}
     {4078245600 10800 1 EEST}
-    {4093970400 7200 0 EET}
+    {4093966800 7200 0 EET}
 }
diff --git a/library/tzdata/Asia/Jakarta b/library/tzdata/Asia/Jakarta
index 27033e8..75cd659 100644
--- a/library/tzdata/Asia/Jakarta
+++ b/library/tzdata/Asia/Jakarta
@@ -2,12 +2,12 @@
 
 set TZData(:Asia/Jakarta) {
     {-9223372036854775808 25632 0 LMT}
-    {-3231299232 25632 0 JMT}
+    {-3231299232 25632 0 BMT}
     {-1451719200 26400 0 JAVT}
-    {-1172906400 27000 0 WIT}
+    {-1172906400 27000 0 WIB}
     {-876641400 32400 0 JST}
-    {-766054800 27000 0 WIT}
-    {-683883000 28800 0 WIT}
-    {-620812800 27000 0 WIT}
-    {-189415800 25200 0 WIT}
+    {-766054800 27000 0 WIB}
+    {-683883000 28800 0 WIB}
+    {-620812800 27000 0 WIB}
+    {-189415800 25200 0 WIB}
 }
diff --git a/library/tzdata/Asia/Jayapura b/library/tzdata/Asia/Jayapura
index 893da8b..a71228f 100644
--- a/library/tzdata/Asia/Jayapura
+++ b/library/tzdata/Asia/Jayapura
@@ -2,7 +2,7 @@
 
 set TZData(:Asia/Jayapura) {
     {-9223372036854775808 33768 0 LMT}
-    {-1172913768 32400 0 EIT}
+    {-1172913768 32400 0 WIT}
     {-799491600 34200 0 CST}
-    {-189423000 32400 0 EIT}
+    {-189423000 32400 0 WIT}
 }
diff --git a/library/tzdata/Asia/Makassar b/library/tzdata/Asia/Makassar
index aa604b4..be947f3 100644
--- a/library/tzdata/Asia/Makassar
+++ b/library/tzdata/Asia/Makassar
@@ -3,7 +3,7 @@
 set TZData(:Asia/Makassar) {
     {-9223372036854775808 28656 0 LMT}
     {-1577951856 28656 0 MMT}
-    {-1172908656 28800 0 CIT}
+    {-1172908656 28800 0 WITA}
     {-880272000 32400 0 JST}
-    {-766054800 28800 0 CIT}
+    {-766054800 28800 0 WITA}
 }
diff --git a/library/tzdata/Asia/Pontianak b/library/tzdata/Asia/Pontianak
index f3567dd..728b552 100644
--- a/library/tzdata/Asia/Pontianak
+++ b/library/tzdata/Asia/Pontianak
@@ -3,11 +3,11 @@
 set TZData(:Asia/Pontianak) {
     {-9223372036854775808 26240 0 LMT}
     {-1946186240 26240 0 PMT}
-    {-1172906240 27000 0 WIT}
+    {-1172906240 27000 0 WIB}
     {-881220600 32400 0 JST}
-    {-766054800 27000 0 WIT}
-    {-683883000 28800 0 WIT}
-    {-620812800 27000 0 WIT}
-    {-189415800 28800 0 CIT}
-    {567964800 25200 0 WIT}
+    {-766054800 27000 0 WIB}
+    {-683883000 28800 0 WIB}
+    {-620812800 27000 0 WIB}
+    {-189415800 28800 0 WITA}
+    {567964800 25200 0 WIB}
 }
diff --git a/library/tzdata/Europe/Vaduz b/library/tzdata/Europe/Vaduz
index 3118331..095e018 100644
--- a/library/tzdata/Europe/Vaduz
+++ b/library/tzdata/Europe/Vaduz
@@ -1,245 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:Europe/Vaduz) {
-    {-9223372036854775808 2284 0 LMT}
-    {-2385247084 3600 0 CET}
-    {347151600 3600 0 CET}
-    {354675600 7200 1 CEST}
-    {370400400 3600 0 CET}
-    {386125200 7200 1 CEST}
-    {401850000 3600 0 CET}
-    {417574800 7200 1 CEST}
-    {433299600 3600 0 CET}
-    {449024400 7200 1 CEST}
-    {465354000 3600 0 CET}
-    {481078800 7200 1 CEST}
-    {496803600 3600 0 CET}
-    {512528400 7200 1 CEST}
-    {528253200 3600 0 CET}
-    {543978000 7200 1 CEST}
-    {559702800 3600 0 CET}
-    {575427600 7200 1 CEST}
-    {591152400 3600 0 CET}
-    {606877200 7200 1 CEST}
-    {622602000 3600 0 CET}
-    {638326800 7200 1 CEST}
-    {654656400 3600 0 CET}
-    {670381200 7200 1 CEST}
-    {686106000 3600 0 CET}
-    {701830800 7200 1 CEST}
-    {717555600 3600 0 CET}
-    {733280400 7200 1 CEST}
-    {749005200 3600 0 CET}
-    {764730000 7200 1 CEST}
-    {780454800 3600 0 CET}
-    {796179600 7200 1 CEST}
-    {811904400 3600 0 CET}
-    {828234000 7200 1 CEST}
-    {846378000 3600 0 CET}
-    {859683600 7200 1 CEST}
-    {877827600 3600 0 CET}
-    {891133200 7200 1 CEST}
-    {909277200 3600 0 CET}
-    {922582800 7200 1 CEST}
-    {941331600 3600 0 CET}
-    {954032400 7200 1 CEST}
-    {972781200 3600 0 CET}
-    {985482000 7200 1 CEST}
-    {1004230800 3600 0 CET}
-    {1017536400 7200 1 CEST}
-    {1035680400 3600 0 CET}
-    {1048986000 7200 1 CEST}
-    {1067130000 3600 0 CET}
-    {1080435600 7200 1 CEST}
-    {1099184400 3600 0 CET}
-    {1111885200 7200 1 CEST}
-    {1130634000 3600 0 CET}
-    {1143334800 7200 1 CEST}
-    {1162083600 3600 0 CET}
-    {1174784400 7200 1 CEST}
-    {1193533200 3600 0 CET}
-    {1206838800 7200 1 CEST}
-    {1224982800 3600 0 CET}
-    {1238288400 7200 1 CEST}
-    {1256432400 3600 0 CET}
-    {1269738000 7200 1 CEST}
-    {1288486800 3600 0 CET}
-    {1301187600 7200 1 CEST}
-    {1319936400 3600 0 CET}
-    {1332637200 7200 1 CEST}
-    {1351386000 3600 0 CET}
-    {1364691600 7200 1 CEST}
-    {1382835600 3600 0 CET}
-    {1396141200 7200 1 CEST}
-    {1414285200 3600 0 CET}
-    {1427590800 7200 1 CEST}
-    {1445734800 3600 0 CET}
-    {1459040400 7200 1 CEST}
-    {1477789200 3600 0 CET}
-    {1490490000 7200 1 CEST}
-    {1509238800 3600 0 CET}
-    {1521939600 7200 1 CEST}
-    {1540688400 3600 0 CET}
-    {1553994000 7200 1 CEST}
-    {1572138000 3600 0 CET}
-    {1585443600 7200 1 CEST}
-    {1603587600 3600 0 CET}
-    {1616893200 7200 1 CEST}
-    {1635642000 3600 0 CET}
-    {1648342800 7200 1 CEST}
-    {1667091600 3600 0 CET}
-    {1679792400 7200 1 CEST}
-    {1698541200 3600 0 CET}
-    {1711846800 7200 1 CEST}
-    {1729990800 3600 0 CET}
-    {1743296400 7200 1 CEST}
-    {1761440400 3600 0 CET}
-    {1774746000 7200 1 CEST}
-    {1792890000 3600 0 CET}
-    {1806195600 7200 1 CEST}
-    {1824944400 3600 0 CET}
-    {1837645200 7200 1 CEST}
-    {1856394000 3600 0 CET}
-    {1869094800 7200 1 CEST}
-    {1887843600 3600 0 CET}
-    {1901149200 7200 1 CEST}
-    {1919293200 3600 0 CET}
-    {1932598800 7200 1 CEST}
-    {1950742800 3600 0 CET}
-    {1964048400 7200 1 CEST}
-    {1982797200 3600 0 CET}
-    {1995498000 7200 1 CEST}
-    {2014246800 3600 0 CET}
-    {2026947600 7200 1 CEST}
-    {2045696400 3600 0 CET}
-    {2058397200 7200 1 CEST}
-    {2077146000 3600 0 CET}
-    {2090451600 7200 1 CEST}
-    {2108595600 3600 0 CET}
-    {2121901200 7200 1 CEST}
-    {2140045200 3600 0 CET}
-    {2153350800 7200 1 CEST}
-    {2172099600 3600 0 CET}
-    {2184800400 7200 1 CEST}
-    {2203549200 3600 0 CET}
-    {2216250000 7200 1 CEST}
-    {2234998800 3600 0 CET}
-    {2248304400 7200 1 CEST}
-    {2266448400 3600 0 CET}
-    {2279754000 7200 1 CEST}
-    {2297898000 3600 0 CET}
-    {2311203600 7200 1 CEST}
-    {2329347600 3600 0 CET}
-    {2342653200 7200 1 CEST}
-    {2361402000 3600 0 CET}
-    {2374102800 7200 1 CEST}
-    {2392851600 3600 0 CET}
-    {2405552400 7200 1 CEST}
-    {2424301200 3600 0 CET}
-    {2437606800 7200 1 CEST}
-    {2455750800 3600 0 CET}
-    {2469056400 7200 1 CEST}
-    {2487200400 3600 0 CET}
-    {2500506000 7200 1 CEST}
-    {2519254800 3600 0 CET}
-    {2531955600 7200 1 CEST}
-    {2550704400 3600 0 CET}
-    {2563405200 7200 1 CEST}
-    {2582154000 3600 0 CET}
-    {2595459600 7200 1 CEST}
-    {2613603600 3600 0 CET}
-    {2626909200 7200 1 CEST}
-    {2645053200 3600 0 CET}
-    {2658358800 7200 1 CEST}
-    {2676502800 3600 0 CET}
-    {2689808400 7200 1 CEST}
-    {2708557200 3600 0 CET}
-    {2721258000 7200 1 CEST}
-    {2740006800 3600 0 CET}
-    {2752707600 7200 1 CEST}
-    {2771456400 3600 0 CET}
-    {2784762000 7200 1 CEST}
-    {2802906000 3600 0 CET}
-    {2816211600 7200 1 CEST}
-    {2834355600 3600 0 CET}
-    {2847661200 7200 1 CEST}
-    {2866410000 3600 0 CET}
-    {2879110800 7200 1 CEST}
-    {2897859600 3600 0 CET}
-    {2910560400 7200 1 CEST}
-    {2929309200 3600 0 CET}
-    {2942010000 7200 1 CEST}
-    {2960758800 3600 0 CET}
-    {2974064400 7200 1 CEST}
-    {2992208400 3600 0 CET}
-    {3005514000 7200 1 CEST}
-    {3023658000 3600 0 CET}
-    {3036963600 7200 1 CEST}
-    {3055712400 3600 0 CET}
-    {3068413200 7200 1 CEST}
-    {3087162000 3600 0 CET}
-    {3099862800 7200 1 CEST}
-    {3118611600 3600 0 CET}
-    {3131917200 7200 1 CEST}
-    {3150061200 3600 0 CET}
-    {3163366800 7200 1 CEST}
-    {3181510800 3600 0 CET}
-    {3194816400 7200 1 CEST}
-    {3212960400 3600 0 CET}
-    {3226266000 7200 1 CEST}
-    {3245014800 3600 0 CET}
-    {3257715600 7200 1 CEST}
-    {3276464400 3600 0 CET}
-    {3289165200 7200 1 CEST}
-    {3307914000 3600 0 CET}
-    {3321219600 7200 1 CEST}
-    {3339363600 3600 0 CET}
-    {3352669200 7200 1 CEST}
-    {3370813200 3600 0 CET}
-    {3384118800 7200 1 CEST}
-    {3402867600 3600 0 CET}
-    {3415568400 7200 1 CEST}
-    {3434317200 3600 0 CET}
-    {3447018000 7200 1 CEST}
-    {3465766800 3600 0 CET}
-    {3479072400 7200 1 CEST}
-    {3497216400 3600 0 CET}
-    {3510522000 7200 1 CEST}
-    {3528666000 3600 0 CET}
-    {3541971600 7200 1 CEST}
-    {3560115600 3600 0 CET}
-    {3573421200 7200 1 CEST}
-    {3592170000 3600 0 CET}
-    {3604870800 7200 1 CEST}
-    {3623619600 3600 0 CET}
-    {3636320400 7200 1 CEST}
-    {3655069200 3600 0 CET}
-    {3668374800 7200 1 CEST}
-    {3686518800 3600 0 CET}
-    {3699824400 7200 1 CEST}
-    {3717968400 3600 0 CET}
-    {3731274000 7200 1 CEST}
-    {3750022800 3600 0 CET}
-    {3762723600 7200 1 CEST}
-    {3781472400 3600 0 CET}
-    {3794173200 7200 1 CEST}
-    {3812922000 3600 0 CET}
-    {3825622800 7200 1 CEST}
-    {3844371600 3600 0 CET}
-    {3857677200 7200 1 CEST}
-    {3875821200 3600 0 CET}
-    {3889126800 7200 1 CEST}
-    {3907270800 3600 0 CET}
-    {3920576400 7200 1 CEST}
-    {3939325200 3600 0 CET}
-    {3952026000 7200 1 CEST}
-    {3970774800 3600 0 CET}
-    {3983475600 7200 1 CEST}
-    {4002224400 3600 0 CET}
-    {4015530000 7200 1 CEST}
-    {4033674000 3600 0 CET}
-    {4046979600 7200 1 CEST}
-    {4065123600 3600 0 CET}
-    {4078429200 7200 1 CEST}
-    {4096573200 3600 0 CET}
+if {![info exists TZData(Europe/Zurich)]} {
+    LoadTimeZoneFile Europe/Zurich
 }
+set TZData(:Europe/Vaduz) $TZData(:Europe/Zurich)
diff --git a/library/tzdata/Europe/Zurich b/library/tzdata/Europe/Zurich
index 33831c3..87a20db 100644
--- a/library/tzdata/Europe/Zurich
+++ b/library/tzdata/Europe/Zurich
@@ -2,8 +2,8 @@
 
 set TZData(:Europe/Zurich) {
     {-9223372036854775808 2048 0 LMT}
-    {-3827954048 1784 0 BMT}
-    {-2385246584 3600 0 CET}
+    {-3675198848 1786 0 BMT}
+    {-2385246586 3600 0 CET}
     {-904435200 7200 1 CEST}
     {-891129600 3600 0 CET}
     {-872985600 7200 1 CEST}
diff --git a/library/tzdata/Pacific/Fiji b/library/tzdata/Pacific/Fiji
index bfcaa03..454ee87 100644
--- a/library/tzdata/Pacific/Fiji
+++ b/library/tzdata/Pacific/Fiji
@@ -15,11 +15,11 @@ set TZData(:Pacific/Fiji) {
     {1327154400 43200 0 FJT}
     {1350741600 46800 1 FJST}
     {1358604000 43200 0 FJT}
-    {1382191200 46800 1 FJST}
+    {1382796000 46800 1 FJST}
     {1390053600 43200 0 FJT}
-    {1413640800 46800 1 FJST}
+    {1414245600 46800 1 FJST}
     {1421503200 43200 0 FJT}
-    {1445090400 46800 1 FJST}
+    {1445695200 46800 1 FJST}
     {1453557600 43200 0 FJT}
     {1477144800 46800 1 FJST}
     {1485007200 43200 0 FJT}
@@ -27,9 +27,9 @@ set TZData(:Pacific/Fiji) {
     {1516456800 43200 0 FJT}
     {1540044000 46800 1 FJST}
     {1547906400 43200 0 FJT}
-    {1571493600 46800 1 FJST}
+    {1572098400 46800 1 FJST}
     {1579356000 43200 0 FJT}
-    {1602943200 46800 1 FJST}
+    {1603548000 46800 1 FJST}
     {1611410400 43200 0 FJT}
     {1634997600 46800 1 FJST}
     {1642860000 43200 0 FJT}
@@ -37,11 +37,11 @@ set TZData(:Pacific/Fiji) {
     {1674309600 43200 0 FJT}
     {1697896800 46800 1 FJST}
     {1705759200 43200 0 FJT}
-    {1729346400 46800 1 FJST}
+    {1729951200 46800 1 FJST}
     {1737208800 43200 0 FJT}
-    {1760796000 46800 1 FJST}
+    {1761400800 46800 1 FJST}
     {1768658400 43200 0 FJT}
-    {1792245600 46800 1 FJST}
+    {1792850400 46800 1 FJST}
     {1800712800 43200 0 FJT}
     {1824300000 46800 1 FJST}
     {1832162400 43200 0 FJT}
@@ -49,9 +49,9 @@ set TZData(:Pacific/Fiji) {
     {1863612000 43200 0 FJT}
     {1887199200 46800 1 FJST}
     {1895061600 43200 0 FJT}
-    {1918648800 46800 1 FJST}
+    {1919253600 46800 1 FJST}
     {1926511200 43200 0 FJT}
-    {1950098400 46800 1 FJST}
+    {1950703200 46800 1 FJST}
     {1957960800 43200 0 FJT}
     {1982152800 46800 1 FJST}
     {1990015200 43200 0 FJT}
@@ -61,9 +61,9 @@ set TZData(:Pacific/Fiji) {
     {2052914400 43200 0 FJT}
     {2076501600 46800 1 FJST}
     {2084364000 43200 0 FJT}
-    {2107951200 46800 1 FJST}
+    {2108556000 46800 1 FJST}
     {2115813600 43200 0 FJT}
-    {2139400800 46800 1 FJST}
+    {2140005600 46800 1 FJST}
     {2147868000 43200 0 FJT}
     {2171455200 46800 1 FJST}
     {2179317600 43200 0 FJT}
@@ -71,11 +71,11 @@ set TZData(:Pacific/Fiji) {
     {2210767200 43200 0 FJT}
     {2234354400 46800 1 FJST}
     {2242216800 43200 0 FJT}
-    {2265804000 46800 1 FJST}
+    {2266408800 46800 1 FJST}
     {2273666400 43200 0 FJT}
-    {2297253600 46800 1 FJST}
+    {2297858400 46800 1 FJST}
     {2305116000 43200 0 FJT}
-    {2328703200 46800 1 FJST}
+    {2329308000 46800 1 FJST}
     {2337170400 43200 0 FJT}
     {2360757600 46800 1 FJST}
     {2368620000 43200 0 FJT}
@@ -83,9 +83,9 @@ set TZData(:Pacific/Fiji) {
     {2400069600 43200 0 FJT}
     {2423656800 46800 1 FJST}
     {2431519200 43200 0 FJT}
-    {2455106400 46800 1 FJST}
+    {2455711200 46800 1 FJST}
     {2462968800 43200 0 FJT}
-    {2486556000 46800 1 FJST}
+    {2487160800 46800 1 FJST}
     {2495023200 43200 0 FJT}
     {2518610400 46800 1 FJST}
     {2526472800 43200 0 FJT}
@@ -93,11 +93,11 @@ set TZData(:Pacific/Fiji) {
     {2557922400 43200 0 FJT}
     {2581509600 46800 1 FJST}
     {2589372000 43200 0 FJT}
-    {2612959200 46800 1 FJST}
+    {2613564000 46800 1 FJST}
     {2620821600 43200 0 FJT}
-    {2644408800 46800 1 FJST}
+    {2645013600 46800 1 FJST}
     {2652271200 43200 0 FJT}
-    {2675858400 46800 1 FJST}
+    {2676463200 46800 1 FJST}
     {2684325600 43200 0 FJT}
     {2707912800 46800 1 FJST}
     {2715775200 43200 0 FJT}
@@ -105,9 +105,9 @@ set TZData(:Pacific/Fiji) {
     {2747224800 43200 0 FJT}
     {2770812000 46800 1 FJST}
     {2778674400 43200 0 FJT}
-    {2802261600 46800 1 FJST}
+    {2802866400 46800 1 FJST}
     {2810124000 43200 0 FJT}
-    {2833711200 46800 1 FJST}
+    {2834316000 46800 1 FJST}
     {2841573600 43200 0 FJT}
     {2865765600 46800 1 FJST}
     {2873628000 43200 0 FJT}
@@ -117,9 +117,9 @@ set TZData(:Pacific/Fiji) {
     {2936527200 43200 0 FJT}
     {2960114400 46800 1 FJST}
     {2967976800 43200 0 FJT}
-    {2991564000 46800 1 FJST}
+    {2992168800 46800 1 FJST}
     {2999426400 43200 0 FJT}
-    {3023013600 46800 1 FJST}
+    {3023618400 46800 1 FJST}
     {3031480800 43200 0 FJT}
     {3055068000 46800 1 FJST}
     {3062930400 43200 0 FJT}
@@ -127,11 +127,11 @@ set TZData(:Pacific/Fiji) {
     {3094380000 43200 0 FJT}
     {3117967200 46800 1 FJST}
     {3125829600 43200 0 FJT}
-    {3149416800 46800 1 FJST}
+    {3150021600 46800 1 FJST}
     {3157279200 43200 0 FJT}
-    {3180866400 46800 1 FJST}
+    {3181471200 46800 1 FJST}
     {3188728800 43200 0 FJT}
-    {3212316000 46800 1 FJST}
+    {3212920800 46800 1 FJST}
     {3220783200 43200 0 FJT}
     {3244370400 46800 1 FJST}
     {3252232800 43200 0 FJT}
@@ -139,9 +139,9 @@ set TZData(:Pacific/Fiji) {
     {3283682400 43200 0 FJT}
     {3307269600 46800 1 FJST}
     {3315132000 43200 0 FJT}
-    {3338719200 46800 1 FJST}
+    {3339324000 46800 1 FJST}
     {3346581600 43200 0 FJT}
-    {3370168800 46800 1 FJST}
+    {3370773600 46800 1 FJST}
     {3378636000 43200 0 FJT}
     {3402223200 46800 1 FJST}
     {3410085600 43200 0 FJT}
@@ -149,11 +149,11 @@ set TZData(:Pacific/Fiji) {
     {3441535200 43200 0 FJT}
     {3465122400 46800 1 FJST}
     {3472984800 43200 0 FJT}
-    {3496572000 46800 1 FJST}
+    {3497176800 46800 1 FJST}
     {3504434400 43200 0 FJT}
-    {3528021600 46800 1 FJST}
+    {3528626400 46800 1 FJST}
     {3535884000 43200 0 FJT}
-    {3559471200 46800 1 FJST}
+    {3560076000 46800 1 FJST}
     {3567938400 43200 0 FJT}
     {3591525600 46800 1 FJST}
     {3599388000 43200 0 FJT}
@@ -161,9 +161,9 @@ set TZData(:Pacific/Fiji) {
     {3630837600 43200 0 FJT}
     {3654424800 46800 1 FJST}
     {3662287200 43200 0 FJT}
-    {3685874400 46800 1 FJST}
+    {3686479200 46800 1 FJST}
     {3693736800 43200 0 FJT}
-    {3717324000 46800 1 FJST}
+    {3717928800 46800 1 FJST}
     {3725186400 43200 0 FJT}
     {3749378400 46800 1 FJST}
     {3757240800 43200 0 FJT}
@@ -173,9 +173,9 @@ set TZData(:Pacific/Fiji) {
     {3820140000 43200 0 FJT}
     {3843727200 46800 1 FJST}
     {3851589600 43200 0 FJT}
-    {3875176800 46800 1 FJST}
+    {3875781600 46800 1 FJST}
     {3883039200 43200 0 FJT}
-    {3906626400 46800 1 FJST}
+    {3907231200 46800 1 FJST}
     {3915093600 43200 0 FJT}
     {3938680800 46800 1 FJST}
     {3946543200 43200 0 FJT}
@@ -183,9 +183,9 @@ set TZData(:Pacific/Fiji) {
     {3977992800 43200 0 FJT}
     {4001580000 46800 1 FJST}
     {4009442400 43200 0 FJT}
-    {4033029600 46800 1 FJST}
+    {4033634400 46800 1 FJST}
     {4040892000 43200 0 FJT}
-    {4064479200 46800 1 FJST}
+    {4065084000 46800 1 FJST}
     {4072341600 43200 0 FJT}
-    {4095928800 46800 1 FJST}
+    {4096533600 46800 1 FJST}
 }
diff --git a/library/tzdata/Pacific/Johnston b/library/tzdata/Pacific/Johnston
index 7f9fee4..21ab39a 100644
--- a/library/tzdata/Pacific/Johnston
+++ b/library/tzdata/Pacific/Johnston
@@ -1,5 +1,5 @@
 # created by tools/tclZIC.tcl - do not edit
-
-set TZData(:Pacific/Johnston) {
-    {-9223372036854775808 -36000 0 HST}
+if {![info exists TZData(Pacific/Honolulu)]} {
+    LoadTimeZoneFile Pacific/Honolulu
 }
+set TZData(:Pacific/Johnston) $TZData(:Pacific/Honolulu)
-- 
cgit v0.12


From ed5a6c598b93838fa631c454cc0bb1af031d3c88 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 6 Oct 2013 13:21:10 +0000
Subject: Factor out some knowledge of immediate index encoding.

---
 generic/tclCompCmdsGR.c | 36 +++++++++++++++++++-----------------
 1 file changed, 19 insertions(+), 17 deletions(-)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index c5a0126..c5dddcb 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -27,6 +27,8 @@ static void		CompileReturnInternal(CompileEnv *envPtr,
 			    Tcl_Obj *returnOpts);
 static int		IndexTailVarIfKnown(Tcl_Interp *interp,
 			    Tcl_Token *varTokenPtr, CompileEnv *envPtr);
+
+#define INDEX_END	(-2)
 
 /*
  *----------------------------------------------------------------------
@@ -65,8 +67,8 @@ GetIndexFromToken(
 	    result = TCL_ERROR;
 	}
     } else {
-	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx);
-	if (result == TCL_OK && idx > -2) {
+	result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+	if (result == TCL_OK && idx > INDEX_END) {
 	    result = TCL_ERROR;
 	}
     }
@@ -1077,7 +1079,7 @@ TclCompileLassignCmd(
      */
 
     TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
-    TclEmitInt4(		-2 /* == "end" */,		envPtr);
+    TclEmitInt4(			INDEX_END,		envPtr);
 
     return TCL_OK;
 }
@@ -1295,7 +1297,7 @@ TclCompileListCmd(
 
     if (concat && numWords == 2) {
 	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
-	TclEmitInt4(			-2,		envPtr);
+	TclEmitInt4(			INDEX_END,	envPtr);
     }
     return TCL_OK;
 }
@@ -1440,14 +1442,14 @@ TclCompileLinsertCmd(
     /*
      * There are four main cases. If there are no values to insert, this is
      * just a confirm-listiness check. If the index is '0', this is a prepend.
-     * If the index is 'end' (== -2), this is an append. Otherwise, this is a
-     * splice (== split, insert values as list, concat-3).
+     * If the index is 'end' (== INDEX_END), this is an append. Otherwise,
+     * this is a splice (== split, insert values as list, concat-3).
      */
 
     CompileWord(envPtr, listTokenPtr, interp, 1);
     if (parsePtr->numWords == 3) {
 	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
-	TclEmitInt4(			-2,			envPtr);
+	TclEmitInt4(			INDEX_END,		envPtr);
 	return TCL_OK;
     }
 
@@ -1460,7 +1462,7 @@ TclCompileLinsertCmd(
     if (idx == 0 /*start*/) {
 	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
 	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
-    } else if (idx == -2 /*end*/) {
+    } else if (idx == INDEX_END /*end*/) {
 	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
     } else {
 	if (idx < 0) {
@@ -1471,7 +1473,7 @@ TclCompileLinsertCmd(
 	TclEmitInt4(			idx-1,			envPtr);
 	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
 	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx,	envPtr);
-	TclEmitInt4(			-2,			envPtr);
+	TclEmitInt4(			INDEX_END,		envPtr);
 	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
 	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
     }
@@ -1533,13 +1535,13 @@ TclCompileLreplaceCmd(
     CompileWord(envPtr, listTokenPtr, interp, 1);
     if (parsePtr->numWords == 4) {
 	if (idx1 == 0) {
-	    if (idx2 == -2) {
+	    if (idx2 == INDEX_END) {
 		goto dropAll;
 	    }
 	    idx1 = idx2 + 1;
-	    idx2 = -2;
+	    idx2 = INDEX_END;
 	    goto dropEnd;
-	} else if (idx2 == -2) {
+	} else if (idx2 == INDEX_END) {
 	    idx2 = idx1 - 1;
 	    idx1 = 0;
 	    goto dropEnd;
@@ -1560,13 +1562,13 @@ TclCompileLreplaceCmd(
     TclEmitInstInt4(		INST_LIST, i - 4,		envPtr);
     TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
     if (idx1 == 0) {
-	if (idx2 == -2) {
+	if (idx2 == INDEX_END) {
 	    goto replaceAll;
 	}
 	idx1 = idx2 + 1;
-	idx2 = -2;
+	idx2 = INDEX_END;
 	goto replaceHead;
-    } else if (idx2 == -2) {
+    } else if (idx2 == INDEX_END) {
 	idx2 = idx1 - 1;
 	idx1 = 0;
 	goto replaceTail;
@@ -1620,7 +1622,7 @@ TclCompileLreplaceCmd(
     TclEmitInt4(			idx1 - 1,		envPtr);
     TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
     TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx2 + 1,	envPtr);
-    TclEmitInt4(			-2,			envPtr);
+    TclEmitInt4(			INDEX_END,		envPtr);
     TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
     goto done;
 
@@ -1669,7 +1671,7 @@ TclCompileLreplaceCmd(
     TclEmitInt4(			idx1 - 1,		envPtr);
     TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
     TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx2 + 1,	envPtr);
-    TclEmitInt4(			-2,			envPtr);
+    TclEmitInt4(			INDEX_END,		envPtr);
     TclEmitInstInt4(		INST_REVERSE, 3,		envPtr);
     TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
     TclEmitInstInt4(		INST_REVERSE, 2,		envPtr);
-- 
cgit v0.12


From b64a70d3402ce6bbee1a32e8bb48e16144f3744d Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 6 Oct 2013 19:17:20 +0000
Subject: [3381085] Improved way of detecting what version of the documentation
 to build. Set the HTML_VERSION environment variable to override the
 (sensible) default.

---
 unix/Makefile.in | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/unix/Makefile.in b/unix/Makefile.in
index 505f7e0..74dd150 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -2076,6 +2076,9 @@ alldist: dist
 # build of this HTML documentation that has already been placed online. As
 # such, this rule is not guaranteed to work well on all systems; it only needs
 # to function on those of the Tcl/Tk maintainers.
+#
+# Also note that the 8.6 tool build requires an installed 8.6 native Tcl
+# interpreter in order to be able to run.
 #--------------------------------------------------------------------------
 
 html: ${NATIVE_TCLSH}
@@ -2088,9 +2091,12 @@ html-tk: ${NATIVE_TCLSH}
 	$(BUILD_HTML) --tk
 	@EXTRA_BUILD_HTML@
 
+# You'd better have these programs or you will have problems creating Makefile
+# from Makefile.in in the first place...
+HTML_VERSION = `basename $(TOP_DIR) | sed s/tcl//`
 BUILD_HTML = \
 	@${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \
-		--htmldir="$(HTML_INSTALL_DIR)" \
+		--useversion=$(HTML_VERSION) --htmldir="$(HTML_INSTALL_DIR)" \
 		--srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS)
 
 #--------------------------------------------------------------------------
-- 
cgit v0.12


From 784987f7c11d9990ed7e2db04d85d42f177bdefd Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 8 Oct 2013 09:02:50 +0000
Subject: Working towards better handling of stack balance with break and
 continue exceptions.

---
 generic/tclAssembly.c   |   1 +
 generic/tclCompCmds.c   |   4 +-
 generic/tclCompCmdsSZ.c |   4 +-
 generic/tclCompExpr.c   |   4 +-
 generic/tclCompile.c    | 150 +++++++++++++++++++++++++++++++++++++++++++++++-
 generic/tclCompile.h    |   1 +
 generic/tclEnsemble.c   |   4 +-
 7 files changed, 156 insertions(+), 12 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 946c729..08da075 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1450,6 +1450,7 @@ AssembleOneLine(
 	    goto cleanup;
 	}
 
+	// FIXME - use TclEmitInvoke
 	BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
 	break;
 
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 7e6b6da..942d74c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -269,7 +269,7 @@ TclCompileArraySetCmd(
     if (isDataValid && !isDataEven) {
 	PushStringLiteral(envPtr, "list must have an even number of elements");
 	PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
-	TclEmitInstInt4(INST_RETURN_IMM, 1,			envPtr);
+	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
 	TclEmitInt4(		0,				envPtr);
 	goto done;
     }
@@ -354,7 +354,7 @@ TclCompileArraySetCmd(
 	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
 	PushStringLiteral(envPtr, "list must have an even number of elements");
 	PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
-	TclEmitInstInt4(INST_RETURN_IMM, 1,			envPtr);
+	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
 	TclEmitInt4(		0,				envPtr);
 	TclAdjustStackDepth(-1, envPtr);
 	fwd = CurrentOffset(envPtr) - offsetFwd;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 44cb66e..a5ec731 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1965,7 +1965,7 @@ TclCompileThrowCmd(
 	OP(			LIST_LENGTH);
 	OP1(			JUMP_FALSE1, 16);
 	OP4(			LIST, 2);
-	OP44(			RETURN_IMM, 1, 0);
+	OP44(			RETURN_IMM, TCL_ERROR, 0);
 	TclAdjustStackDepth(2, envPtr);
 	OP(			POP);
 	OP(			POP);
@@ -1974,7 +1974,7 @@ TclCompileThrowCmd(
 	PUSH(			"type must be non-empty list");
 	PUSH(			"-errorcode {TCL OPERATION THROW BADEXCEPTION}");
     }
-    OP44(			RETURN_IMM, 1, 0);
+    OP44(			RETURN_IMM, TCL_ERROR, 0);
     return TCL_OK;
 }
 
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index d8e4d9f..94c1bd6 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2335,9 +2335,9 @@ CompileExprTree(
 		 */
 		
 		if (numWords < 255) {
-		    TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
+		    TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
 		} else {
-		    TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
+		    TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords);
 		}
 
 		/*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index d15ef3a..a5b0bd8 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1738,9 +1738,9 @@ TclCompileInvocation(
     }
 
     if (wordIdx <= 255) {
-	TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
+	TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx);
     } else {
-	TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
+	TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx);
     }
 }
 
@@ -1802,7 +1802,7 @@ CompileExpanded(
      * stack-neutral in general.
      */
 
-    TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+    TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED);
     envPtr->expandCount--;
     TclAdjustStackDepth(1 - wordIdx, envPtr);
 }
@@ -3901,6 +3901,150 @@ TclFixupForwardJump(
     return 1;			/* the jump was grown */
 }
 
+void
+TclEmitInvoke(
+    CompileEnv *envPtr,
+    int opcode,
+    ...)
+{
+    va_list argList;
+    ExceptionRange *rangePtr;
+    ExceptionAux *auxBreakPtr, *auxContinuePtr;
+    int arg1, arg2, wordCount = 0, loopRange, predictedDepth;
+
+    /*
+     * Parse the arguments.
+     */
+
+    va_start(argList, opcode);
+    switch (opcode) {
+    case INST_INVOKE_STK1:
+	wordCount = arg1 = va_arg(argList, int);
+	arg2 = 0;
+	break;
+    case INST_INVOKE_STK4:
+	wordCount = arg1 = va_arg(argList, int);
+	arg2 = 0;
+	break;
+    case INST_INVOKE_REPLACE:
+	arg1 = va_arg(argList, int);
+	arg2 = va_arg(argList, int);
+	wordCount = arg1 + arg2 - 1;
+	break;
+    default:
+	Tcl_Panic("unexpected opcode");
+    case INST_INVOKE_EXPANDED:
+	wordCount = arg1 = arg2 = 0;
+	break;
+    }
+    va_end(argList);
+
+    /*
+     * Determine if we need to handle break and continue exceptions with a
+     * special handling exception range (so that we can correctly unwind the
+     * stack).
+     */
+
+    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr);
+    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
+	auxBreakPtr = NULL;
+    } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
+	    && auxBreakPtr->expandTarget == envPtr->expandCount) {
+	auxBreakPtr = NULL;
+    }
+    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE,
+	    &auxContinuePtr);
+    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
+	auxContinuePtr = NULL;
+    } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
+	    && auxContinuePtr->expandTarget == envPtr->expandCount) {
+	auxContinuePtr = NULL;
+    }
+    if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+	fprintf(stderr,"loop call(%s,d=%d/%d(%d/%d),t=%d/%d(%d))\n",
+		tclInstructionTable[opcode].name,
+		(auxBreakPtr?auxBreakPtr->stackDepth:-1),
+		(auxContinuePtr?auxContinuePtr->stackDepth:-1),
+		envPtr->currStackDepth,
+		wordCount,
+		(auxBreakPtr?auxBreakPtr->expandTarget:-1),
+		(auxContinuePtr?auxContinuePtr->expandTarget:-1),
+		envPtr->expandCount);
+	loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+	ExceptionRangeStarts(envPtr, loopRange);
+    }
+    predictedDepth = envPtr->currStackDepth - wordCount;
+
+    /*
+     * Issue the invoke itself.
+     */
+
+    switch (opcode) {
+    case INST_INVOKE_STK1:
+	TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr);
+	break;
+    case INST_INVOKE_STK4:
+	TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr);
+	break;
+    case INST_INVOKE_EXPANDED:
+	TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+	break;
+    case INST_INVOKE_REPLACE:
+	TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr);
+	TclEmitInt1(arg2, envPtr);
+	TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
+	break;
+    }
+
+    /*
+     * If we're generating a special wrapper exception range, we need to
+     * finish that up now.
+     */
+
+    if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
+	int savedStackDepth = envPtr->currStackDepth;
+	int savedExpandCount = envPtr->expandCount;
+	JumpFixup nonTrapFixup;
+	int off;
+
+	ExceptionRangeEnds(envPtr, loopRange);
+	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup);
+	fprintf(stderr,"loop call(d=%d,t=%d|%p,%p)\n",savedStackDepth-1,savedExpandCount,auxBreakPtr,auxContinuePtr);
+
+	/*
+	 * Careful! When generating these stack unwinding sequences, the depth
+	 * of stack in the cases where they are taken is not the same as if
+	 * the exception is not taken.
+	 */
+
+	if (auxBreakPtr != NULL) {
+	    TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
+	    assert(envPtr->currStackDepth == predictedDepth);
+	    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
+	    off = CurrentOffset(envPtr);
+	    TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
+	    fprintf(stderr,"popped(break):%ld\n",CurrentOffset(envPtr) - off);
+	    TclAddLoopBreakFixup(envPtr, auxBreakPtr);
+	    envPtr->currStackDepth = savedStackDepth;
+	    envPtr->expandCount = savedExpandCount;
+	}
+
+	if (auxContinuePtr != NULL) {
+	    TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
+	    assert(envPtr->currStackDepth == predictedDepth);
+	    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
+	    off = CurrentOffset(envPtr);
+	    TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
+	    fprintf(stderr,"popped(continue):%ld\n",CurrentOffset(envPtr) - off);
+	    TclAddLoopContinueFixup(envPtr, auxContinuePtr);
+	    envPtr->currStackDepth = savedStackDepth;
+	    envPtr->expandCount = savedExpandCount;
+	}
+
+	TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127);
+    }
+}
+
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5660055..a39e0f1 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1021,6 +1021,7 @@ MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
 			    LiteralTable *tablePtr);
 MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
 			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
+MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
 MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
 			    int catchOnly, ByteCode *codePtr);
 MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index ad11785..9bb7a0c 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3179,9 +3179,7 @@ CompileToInvokedCommand(
      * Do the replacing dispatch.
      */
 
-    TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr);
-    TclEmitInt1(numWords+1, envPtr);
-    TclAdjustStackDepth(-1, envPtr);	/* Correction to stack depth calcs. */
+    TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1);
 }
 
 /*
-- 
cgit v0.12


From 43a91548b31101b95bc2b2e29ada872bb3d9590e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 10 Oct 2013 14:13:51 +0000
Subject: Fix for bug [f51efe99a7]: MinGW build fails on current checkin. And a
 new test-case which makes the problem visible on UNIX as well.

---
 generic/tclOO.h         |   5 +-
 generic/tclOODecls.h    |   2 +
 generic/tclOOStubLib.c  |   2 +
 tests/load.test         |   6 +++
 unix/dltest/Makefile.in |  13 ++++-
 unix/dltest/pkgooa.c    | 138 ++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 161 insertions(+), 5 deletions(-)
 create mode 100644 unix/dltest/pkgooa.c

diff --git a/generic/tclOO.h b/generic/tclOO.h
index 41be168..a6e8a22 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -37,13 +37,12 @@
 extern "C" {
 #endif
 
-#if (defined(USE_TCLOO_STUBS) || defined(USE_TCL_STUBS))
 extern const char *TclOOInitializeStubs(
 	Tcl_Interp *, const char *version);
 #define Tcl_OOInitStubs(interp) \
     TclOOInitializeStubs((interp), TCLOO_VERSION)
-#else
-#define Tcl_OOInitStubs(interp) (TCLOO_PATCHLEVEL)
+#ifndef USE_TCL_STUBS
+#   define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL)
 #endif
 
 /*
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index c2a5615..e483df6 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -10,6 +10,8 @@
 #   define TCL_STORAGE_CLASS DLLEXPORT
 #else
 #   ifdef USE_TCL_STUBS
+#      undef USE_TCLOO_STUBS
+#      define USE_TCLOO_STUBS
 #      define TCL_STORAGE_CLASS
 #   else
 #      define TCL_STORAGE_CLASS DLLIMPORT
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
index 921aced..a9fa212 100644
--- a/generic/tclOOStubLib.c
+++ b/generic/tclOOStubLib.c
@@ -27,6 +27,8 @@ const TclOOIntStubs *tclOOIntStubsPtr = NULL;
  *----------------------------------------------------------------------
  */
 
+#undef TclOOInitializeStubs
+
 MODULE_SCOPE const char *
 TclOOInitializeStubs(
     Tcl_Interp *interp,
diff --git a/tests/load.test b/tests/load.test
index cded85d..9536271 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -215,6 +215,12 @@ test load-10.1 {load from vfs} \
     -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \
     -result {0 {}} \
     -cleanup {testsimplefilesystem 0; cd $dir; unset dir}
+
+test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \
+	[list $dll $loaded] {
+    load [file join $testDir pkgooa$ext]
+    list [pkgooa_stubsok] [lsort [info commands pkgooa_*]]
+} {1 pkgooa_stubsok}
 
 # cleanup
 unset ext
diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in
index 01589d9..f64b6d5 100644
--- a/unix/dltest/Makefile.in
+++ b/unix/dltest/Makefile.in
@@ -25,11 +25,11 @@ LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@
 CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -I${BUILD_DIR}/.. -DTCL_MEM_DEBUG \
 	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}
 
-all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX}
+all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX}
 	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
 	@touch ../dltest.marker
 
-dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX}
+dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX}
 	@touch ../dltest.marker
 
 pkga.o: $(SRC_DIR)/pkga.c
@@ -50,6 +50,9 @@ pkge.o: $(SRC_DIR)/pkge.c
 pkgua.o: $(SRC_DIR)/pkgua.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c
 
+pkgooa.o: $(SRC_DIR)/pkgooa.c
+	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c
+
 pkga${SHLIB_SUFFIX}: pkga.o
 	${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS}
 
@@ -68,6 +71,9 @@ pkge${SHLIB_SUFFIX}: pkge.o
 pkgua${SHLIB_SUFFIX}: pkgua.o
 	${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}
 
+pkgooa${SHLIB_SUFFIX}: pkgooa.o
+	${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS}
+
 pkga${DLTEST_SUFFIX}: pkga.o
 	${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS}
 
@@ -86,6 +92,9 @@ pkge${DLTEST_SUFFIX}: pkge.o
 pkgua${DLTEST_SUFFIX}: pkgua.o
 	${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}
 
+pkgooa${DLTEST_SUFFIX}: pkgooa.o
+	${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS}
+
 clean:
 	rm -f *.o lib.exp ../dltest.marker
 	@if test "$(SHLIB_SUFFIX)" != ""; then \
diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c
new file mode 100644
index 0000000..bdac9db
--- /dev/null
+++ b/unix/dltest/pkgooa.c
@@ -0,0 +1,138 @@
+/*
+ * pkgooa.c --
+ *
+ *	This file contains a simple Tcl package "pkgooa" that is intended for
+ *	testing the Tcl dynamic loading facilities.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#undef STATIC_BUILD
+#include "tclOO.h"
+#include <string.h>
+
+/*
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Pkgooa_Init declaration is in the source file itself, which is only
+ * accessed when we are building a library.
+ */
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static int    Pkgooa_StubsOKObjCmd(ClientData clientData,
+		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgooa_StubsOKObjCmd --
+ *
+ *	This procedure is invoked to process the "pkgooa_stubsok" Tcl command.
+ *	It gives 1 if stubs are used correctly, 0 if stubs are not OK.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Pkgooa_StubsOKObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, "");
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(
+	    Tcl_CopyObjectInstance == tclOOStubsPtr->tcl_CopyObjectInstance));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Pkgooa_Init --
+ *
+ *	This is a package initialization procedure, which is called by Tcl
+ *	when this package is to be added to an interpreter.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Object copyObjectInstance(Tcl_Interp *interp,
+		Tcl_Object source, const char *name, const char *nameSpace)
+{
+	Tcl_Object result;
+	result = Tcl_CopyObjectInstance(interp, source, name, nameSpace);
+	if (result == NULL) {
+        Tcl_AppendResult(interp, "ERROR: copy failed.");
+	}
+	return result;
+}
+
+static TclOOStubs stubsCopy = {
+    TCL_STUB_MAGIC,
+    NULL,
+    copyObjectInstance
+    /* more entries here, but those are not
+     * needed for this test-case. */
+};
+
+EXTERN int
+Pkgooa_Init(
+    Tcl_Interp *interp)		/* Interpreter in which the package is to be
+				 * made available. */
+{
+    int code;
+
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+	return TCL_ERROR;
+    }
+    if (Tcl_OOInitStubs(interp) == NULL) {
+	return TCL_ERROR;
+    }
+
+    /* Test case for Bug [f51efe99a7].
+     *
+     * Let tclOOStubsPtr point to an alternate stub table
+     * (with only a single function, that's enough for
+     * this test). This way, the function "pkgooa_stubsok"
+     * can check whether the TclOO function calls really
+     * use the stub table, or only pretend to.
+     *
+     * On platforms without backlinking (Windows, Cygwin,
+     * AIX), this code doesn't even compile without using
+     * stubs, but on UNIX ELF systems, the problem is
+     * less visible.
+     */
+
+    tclOOStubsPtr = &stubsCopy;
+
+    code = Tcl_PkgProvide(interp, "Pkgooa", "1.0");
+    if (code != TCL_OK) {
+	return code;
+    }
+    Tcl_CreateObjCommand(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL);
+    return TCL_OK;
+}
-- 
cgit v0.12


From 7d1b223f7df36d45707d0c6325c3c5665b324724 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 10 Oct 2013 21:24:15 +0000
Subject: [98c8b3ec12] Use constraint to work around failing test; it's just a
 bug in the underlying library, and one that appears fixed in later versions.
 Not our fault if some OSes don't update. (It's also in a very esoteric spot.)

---
 tests/zlib.test | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/tests/zlib.test b/tests/zlib.test
index 0712929..4e51ebb 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -16,6 +16,13 @@ if {"::tcltest" ni [namespace children]} {
 }
 
 testConstraint zlib [llength [info commands zlib]]
+testConstraint recentZlib 0
+catch {
+    # Work around a bug in some versions of zlib; known to manifest on at
+    # least Mac OS X Mountain Lion...
+    testConstraint recentZlib \
+	    [package vsatisfies [zlib::pkgconfig get zlibVersion] 1.2.6]
+}
 
 test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body {
     zlib
@@ -269,7 +276,7 @@ test zlib-8.9 {transformation and fconfigure} -setup {
 } -result {3064818174 358 358}
 test zlib-8.10 {transformation and fconfigure} -setup {
     lassign [chan pipe] inSide outSide
-} -constraints zlib -body {
+} -constraints {zlib recentZlib} -body {
     zlib push deflate $outSide -dictionary $spdyDict
     fconfigure $outSide -blocking 0 -translation binary -buffering none
     fconfigure $inSide -blocking 0 -translation binary
-- 
cgit v0.12


From 1fa1578500c58be8eed071fcbdce604c32b418cd Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 11 Oct 2013 10:26:35 +0000
Subject: Even though TCLOO_PATCHLEVEL is equal to TCLOO_VERSION, using
 "patchlevel" is more appropriate in those two places.

---
 generic/tclOO.c | 2 +-
 tests/oo.test   | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index cb22de6..529640f 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -271,7 +271,7 @@ TclOOInit(
 	return TCL_ERROR;
     }
 
-    return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_VERSION,
+    return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
 	    (ClientData) &tclOOStubs);
 }
 
diff --git a/tests/oo.test b/tests/oo.test
index 37bbadb..d63e931 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -101,7 +101,7 @@ test oo-0.8 {leak in variable management} -setup {
 test oo-0.9 {various types of presence of the TclOO package} {
     list [lsearch -nocase -all -inline [package names] tcloo] \
 	[package present TclOO] [package versions TclOO]
-} [list TclOO $::oo::version $::oo::version]
+} [list TclOO $::oo::patchlevel $::oo::patchlevel]
 
 test oo-1.1 {basic test of OO functionality: no classes} {
     set result {}
-- 
cgit v0.12


From 2dc26cc732ba64065c0bf64d8c63a2c82c539999 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 13 Oct 2013 10:45:08 +0000
Subject: Allow loading of pkgooa.so in Tcl 8.5 for (regression) test purposes.
 Better error messages in stead of crashes in some (hypothetical) error
 situations.

---
 unix/dltest/pkgooa.c | 19 ++++++++++++++++++-
 1 file changed, 18 insertions(+), 1 deletion(-)

diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c
index bdac9db..c0c1605 100644
--- a/unix/dltest/pkgooa.c
+++ b/unix/dltest/pkgooa.c
@@ -106,12 +106,29 @@ Pkgooa_Init(
 {
     int code;
 
-    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+    /* Any TclOO extension which uses stubs, calls
+     * both Tcl_InitStubs and Tcl_OOInitStubs() and
+     * does not use any Tcl 8.6 features should be
+     * loadable in Tcl 8.5 as well, provided the
+     * TclOO extension (for Tcl 8.5) is installed.
+     * This worked in Tcl 8.6.0, and is expected
+     * to keep working in all future Tcl 8.x releases.
+     */
+    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
+	return TCL_ERROR;
+    }
+    if (tclStubsPtr == NULL) {
+	Tcl_AppendResult(interp, "Tcl stubs are not inialized, "
+		"did you compile using -DUSE_TCL_STUBS? ");
 	return TCL_ERROR;
     }
     if (Tcl_OOInitStubs(interp) == NULL) {
 	return TCL_ERROR;
     }
+    if (tclOOStubsPtr == NULL) {
+	Tcl_AppendResult(interp, "TclOO stubs are not inialized");
+	return TCL_ERROR;
+    }
 
     /* Test case for Bug [f51efe99a7].
      *
-- 
cgit v0.12


From 18620aebd7623aaa3031162500c392cf2fa6ade7 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 13 Oct 2013 12:09:22 +0000
Subject: Stop crashing in interactive testing. (The unknown and history
 mechanisms tend to exercise some parts of the bytecode compiler very well.)

---
 generic/tclCompile.c | 49 ++++++++++++++++++++++++++++++-------------------
 1 file changed, 30 insertions(+), 19 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index a5b0bd8..74a9c8c 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -3911,6 +3911,7 @@ TclEmitInvoke(
     ExceptionRange *rangePtr;
     ExceptionAux *auxBreakPtr, *auxContinuePtr;
     int arg1, arg2, wordCount = 0, loopRange, predictedDepth;
+    int breakRange = -1, continueRange = -1;
 
     /*
      * Parse the arguments.
@@ -3943,6 +3944,9 @@ TclEmitInvoke(
      * Determine if we need to handle break and continue exceptions with a
      * special handling exception range (so that we can correctly unwind the
      * stack).
+     *
+     * These must be done separately; they can be different (especially for
+     * calls from inside a [for] increment clause).
      */
 
     rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr);
@@ -3951,7 +3955,10 @@ TclEmitInvoke(
     } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
 	    && auxBreakPtr->expandTarget == envPtr->expandCount) {
 	auxBreakPtr = NULL;
+    } else {
+	breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
     }
+
     rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE,
 	    &auxContinuePtr);
     if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
@@ -3959,17 +3966,11 @@ TclEmitInvoke(
     } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
 	    && auxContinuePtr->expandTarget == envPtr->expandCount) {
 	auxContinuePtr = NULL;
+    } else {
+	continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
     }
+
     if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
-	fprintf(stderr,"loop call(%s,d=%d/%d(%d/%d),t=%d/%d(%d))\n",
-		tclInstructionTable[opcode].name,
-		(auxBreakPtr?auxBreakPtr->stackDepth:-1),
-		(auxContinuePtr?auxContinuePtr->stackDepth:-1),
-		envPtr->currStackDepth,
-		wordCount,
-		(auxBreakPtr?auxBreakPtr->expandTarget:-1),
-		(auxContinuePtr?auxContinuePtr->expandTarget:-1),
-		envPtr->expandCount);
 	loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
 	ExceptionRangeStarts(envPtr, loopRange);
     }
@@ -4005,11 +4006,17 @@ TclEmitInvoke(
 	int savedStackDepth = envPtr->currStackDepth;
 	int savedExpandCount = envPtr->expandCount;
 	JumpFixup nonTrapFixup;
-	int off;
+	ExceptionAux *exceptAux = envPtr->exceptAuxArrayPtr + loopRange;
+
+	if (auxBreakPtr != NULL) {
+	    auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
+	}
+	if (auxContinuePtr != NULL) {
+	    auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange;
+	}
 
 	ExceptionRangeEnds(envPtr, loopRange);
 	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup);
-	fprintf(stderr,"loop call(d=%d,t=%d|%p,%p)\n",savedStackDepth-1,savedExpandCount,auxBreakPtr,auxContinuePtr);
 
 	/*
 	 * Careful! When generating these stack unwinding sequences, the depth
@@ -4018,25 +4025,29 @@ TclEmitInvoke(
 	 */
 
 	if (auxBreakPtr != NULL) {
-	    TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
+	    TclAdjustStackDepth(-1, envPtr);
 	    assert(envPtr->currStackDepth == predictedDepth);
+	    exceptAux->stackDepth = auxBreakPtr->stackDepth;
+	    exceptAux->expandTarget = auxBreakPtr->expandTarget;
+
 	    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
-	    off = CurrentOffset(envPtr);
-	    TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
-	    fprintf(stderr,"popped(break):%ld\n",CurrentOffset(envPtr) - off);
+	    TclCleanupStackForBreakContinue(envPtr, exceptAux);
 	    TclAddLoopBreakFixup(envPtr, auxBreakPtr);
+
 	    envPtr->currStackDepth = savedStackDepth;
 	    envPtr->expandCount = savedExpandCount;
 	}
 
 	if (auxContinuePtr != NULL) {
-	    TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
+	    TclAdjustStackDepth(-1, envPtr);
 	    assert(envPtr->currStackDepth == predictedDepth);
+	    exceptAux->stackDepth = auxContinuePtr->stackDepth;
+	    exceptAux->expandTarget = auxContinuePtr->expandTarget;
+
 	    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
-	    off = CurrentOffset(envPtr);
-	    TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
-	    fprintf(stderr,"popped(continue):%ld\n",CurrentOffset(envPtr) - off);
+	    TclCleanupStackForBreakContinue(envPtr, exceptAux);
 	    TclAddLoopContinueFixup(envPtr, auxContinuePtr);
+
 	    envPtr->currStackDepth = savedStackDepth;
 	    envPtr->expandCount = savedExpandCount;
 	}
-- 
cgit v0.12


From 62cb43456456d34b7a1b738feb2d2114915aff3c Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 13 Oct 2013 13:34:01 +0000
Subject: update comments

---
 generic/tclCompCmdsGR.c |  1 +
 generic/tclCompile.c    | 21 +++++++++++++++++++++
 2 files changed, 22 insertions(+)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 43ea3d3..3efcba7 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2480,6 +2480,7 @@ TclCompileReturnCmd(
      * emit the INST_RETURN_IMM instruction with code and level as operands.
      */
 
+    // TODO: when (code==TCL_BREAK || code==TCL_CONTINUE)&&(level==0&&size==0), check for stack balance and jump opportunities
     CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts);
     return TCL_OK;
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 74a9c8c..68b7649 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -3901,6 +3901,27 @@ TclFixupForwardJump(
     return 1;			/* the jump was grown */
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEmitInvoke --
+ *
+ *	Emit one of the invoke-related instructions, wrapping it if necessary
+ *	in code that ensures that any break or continue operation passing
+ *	through it gets the stack unwinding correct, converting it into an
+ *	internal jump if in an appropriate context.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	Issues the jump with all correct stack management. May create another
+ *	loop exception range; pointers to ExceptionRange and ExceptionAux
+ *	structures should not be held across this call.
+ *
+ *----------------------------------------------------------------------
+ */
+
 void
 TclEmitInvoke(
     CompileEnv *envPtr,
-- 
cgit v0.12


From 9adfa74f671acd5bcc33247b07176d117eda3357 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 13 Oct 2013 13:57:27 +0000
Subject: Added the tests I want to pass...

---
 tests/for.test | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 126 insertions(+)

diff --git a/tests/for.test b/tests/for.test
index 8936682..6a18abe 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -942,6 +942,132 @@ test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount}
 	expr {$end - $tmp}
     }}
 } 0
+test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [apply {{} {return -code break}}] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [apply {{} {return -code continue}}] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[apply {{} {
+		    return -code continue
+		}}] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+		    return -code break
+		}}] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+		    return -code continue
+		}}] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+		    return -code break
+		}}] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+		    return -code continue
+		}}] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
 
 # cleanup
 ::tcltest::cleanupTests
-- 
cgit v0.12


From d02f468b979104d4c98a39347be7960486530e1c Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 14 Oct 2013 08:11:59 +0000
Subject: Fix comment in tclOO.decls: tclOOStubLib.c is not generated by "make
 genstubs". In pkgooa.c, check whether the internal TclOO stub table is
 initialized correctly as well, some internal simplifications and improved
 comments.

---
 generic/tclOO.decls  |  3 +--
 unix/dltest/pkgooa.c | 48 ++++++++++++++++--------------------------------
 2 files changed, 17 insertions(+), 34 deletions(-)

diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 4f1987c..5d6f2c2 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -3,8 +3,7 @@
 #	This file contains the declarations for all supported public functions
 #	that are exported by the TclOO package that is embedded within the Tcl
 #	library via the stubs table.  This file is used to generate the
-#	tclOODecls.h, tclOOIntDecls.h, tclOOStubInit.c, and tclOOStubLib.c
-#	files.
+#	tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files.
 #
 # Copyright (c) 2008-2013 by Donal K. Fellows.
 #
diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c
index c0c1605..7b14ca0 100644
--- a/unix/dltest/pkgooa.c
+++ b/unix/dltest/pkgooa.c
@@ -11,24 +11,8 @@
  */
 
 #undef STATIC_BUILD
-#include "tclOO.h"
+#include "tclOOInt.h"
 #include <string.h>
-
-/*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Pkgooa_Init declaration is in the source file itself, which is only
- * accessed when we are building a library.
- */
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
-/*
- * Prototypes for procedures defined later in this file:
- */
-
-static int    Pkgooa_StubsOKObjCmd(ClientData clientData,
-		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
-
 
 /*
  *----------------------------------------------------------------------
@@ -80,26 +64,22 @@ Pkgooa_StubsOKObjCmd(
  *----------------------------------------------------------------------
  */
 
-static Tcl_Object copyObjectInstance(Tcl_Interp *interp,
-		Tcl_Object source, const char *name, const char *nameSpace)
-{
-	Tcl_Object result;
-	result = Tcl_CopyObjectInstance(interp, source, name, nameSpace);
-	if (result == NULL) {
-        Tcl_AppendResult(interp, "ERROR: copy failed.");
-	}
-	return result;
-}
-
 static TclOOStubs stubsCopy = {
     TCL_STUB_MAGIC,
     NULL,
-    copyObjectInstance
-    /* more entries here, but those are not
-     * needed for this test-case. */
+    /* It doesn't really matter what implementation of
+     * Tcl_CopyObjectInstance is put in the "pseudo"
+     * stub table, since the test-case never actually
+     * calls this function. All that matters is that it's
+     * a function with a different memory address than
+     * the real Tcl_CopyObjectInstance function in Tcl. */
+    (Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *,
+	    const char *t)) Pkgooa_StubsOKObjCmd
+    /* More entries could be here, but those are not used
+     * for this test-case. So, being NULL is OK. */
 };
 
-EXTERN int
+extern DLLEXPORT int
 Pkgooa_Init(
     Tcl_Interp *interp)		/* Interpreter in which the package is to be
 				 * made available. */
@@ -129,6 +109,10 @@ Pkgooa_Init(
 	Tcl_AppendResult(interp, "TclOO stubs are not inialized");
 	return TCL_ERROR;
     }
+    if (tclOOIntStubsPtr == NULL) {
+	Tcl_AppendResult(interp, "TclOO internal stubs are not inialized");
+	return TCL_ERROR;
+    }
 
     /* Test case for Bug [f51efe99a7].
      *
-- 
cgit v0.12


From 71bcf95b719518cd64e068921561bcd2a503598e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 14 Oct 2013 08:34:48 +0000
Subject: Tcl_SetResult -> Tcl_SetObjResult in two places (for Cygwin64 only).

---
 generic/tclStubInit.c | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 782bbdf..3f1c27b 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -234,9 +234,8 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
 		    && (longValue <= (long)(UINT_MAX))) {
 	    *ptr = (int)longValue;
 	} else {
-	    Tcl_SetResult(interp,
-		    "integer value too large to represent as non-long integer",
-		    TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "integer value too large to represent as non-long integer", -1));
 	    result = TCL_ERROR;
 	}
     }
@@ -251,9 +250,8 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
 		    && (longValue <= (long)(UINT_MAX))) {
 	    *ptr = (int)longValue;
 	} else {
-	    Tcl_SetResult(interp,
-		    "integer value too large to represent as non-long integer",
-		    TCL_STATIC);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "integer value too large to represent as non-long integer", -1));
 	    result = TCL_ERROR;
 	}
     }
-- 
cgit v0.12


From 21e6601f4971f249f7681508432b98605729fb9d Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 15 Oct 2013 00:27:56 +0000
Subject: Do jump generation at places where INST_RETURN_IMM might occur.

---
 generic/tclCompCmdsGR.c | 18 +++++++++++++-
 generic/tclCompile.c    |  6 +----
 generic/tclOptimize.c   | 18 +++++++++++++-
 tests/compile.test      | 64 +++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 99 insertions(+), 7 deletions(-)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 3efcba7..5513b01 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2480,7 +2480,6 @@ TclCompileReturnCmd(
      * emit the INST_RETURN_IMM instruction with code and level as operands.
      */
 
-    // TODO: when (code==TCL_BREAK || code==TCL_CONTINUE)&&(level==0&&size==0), check for stack balance and jump opportunities
     CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts);
     return TCL_OK;
 
@@ -2522,6 +2521,23 @@ CompileReturnInternal(
     int level,
     Tcl_Obj *returnOpts)
 {
+    if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) {
+	ExceptionRange *rangePtr;
+	ExceptionAux *exceptAux;
+
+	rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux);
+	if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
+	    TclCleanupStackForBreakContinue(envPtr, exceptAux);
+	    if (code == TCL_BREAK) {
+		TclAddLoopBreakFixup(envPtr, exceptAux);
+	    } else {
+		TclAddLoopContinueFixup(envPtr, exceptAux);
+	    }
+	    Tcl_DecrRefCount(returnOpts);
+	    return;
+	}
+    }
+
     TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
     TclEmitInstInt4(op, code, envPtr);
     TclEmitInt4(level, envPtr);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 68b7649..427ccab 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -3931,8 +3931,7 @@ TclEmitInvoke(
     va_list argList;
     ExceptionRange *rangePtr;
     ExceptionAux *auxBreakPtr, *auxContinuePtr;
-    int arg1, arg2, wordCount = 0, loopRange, predictedDepth;
-    int breakRange = -1, continueRange = -1;
+    int arg1, arg2, wordCount = 0, loopRange, breakRange, continueRange;
 
     /*
      * Parse the arguments.
@@ -3995,7 +3994,6 @@ TclEmitInvoke(
 	loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
 	ExceptionRangeStarts(envPtr, loopRange);
     }
-    predictedDepth = envPtr->currStackDepth - wordCount;
 
     /*
      * Issue the invoke itself.
@@ -4047,7 +4045,6 @@ TclEmitInvoke(
 
 	if (auxBreakPtr != NULL) {
 	    TclAdjustStackDepth(-1, envPtr);
-	    assert(envPtr->currStackDepth == predictedDepth);
 	    exceptAux->stackDepth = auxBreakPtr->stackDepth;
 	    exceptAux->expandTarget = auxBreakPtr->expandTarget;
 
@@ -4061,7 +4058,6 @@ TclEmitInvoke(
 
 	if (auxContinuePtr != NULL) {
 	    TclAdjustStackDepth(-1, envPtr);
-	    assert(envPtr->currStackDepth == predictedDepth);
 	    exceptAux->stackDepth = auxContinuePtr->stackDepth;
 	    exceptAux->expandTarget = auxContinuePtr->expandTarget;
 
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index b7f4173..3b16e6e 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -344,21 +344,28 @@ AdvanceJumps(
     CompileEnv *envPtr)
 {
     unsigned char *currentInstPtr;
+    Tcl_HashTable jumps;
 
     for (currentInstPtr = envPtr->codeStart ;
 	    currentInstPtr < envPtr->codeNext-1 ;
 	    currentInstPtr += AddrLength(currentInstPtr)) {
-	int offset, delta;
+	int offset, delta, isNew;
 
 	switch (*currentInstPtr) {
 	case INST_JUMP1:
 	case INST_JUMP_TRUE1:
 	case INST_JUMP_FALSE1:
 	    offset = TclGetInt1AtPtr(currentInstPtr + 1);
+	    Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
 	    for (delta=0 ; offset+delta != 0 ;) {
 		if (offset + delta < -128 || offset + delta > 127) {
 		    break;
 		}
+		Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
+		if (!isNew) {
+		    offset = TclGetInt1AtPtr(currentInstPtr + 1);
+		    break;
+		}
 		offset += delta;
 		switch (*(currentInstPtr + offset)) {
 		case INST_NOP:
@@ -373,13 +380,21 @@ AdvanceJumps(
 		}
 		break;
 	    }
+	    Tcl_DeleteHashTable(&jumps);
 	    TclStoreInt1AtPtr(offset, currentInstPtr + 1);
 	    continue;
 
 	case INST_JUMP4:
 	case INST_JUMP_TRUE4:
 	case INST_JUMP_FALSE4:
+	    Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
+	    Tcl_CreateHashEntry(&jumps, INT2PTR(0), &isNew);
 	    for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) {
+		Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
+		if (!isNew) {
+		    offset = TclGetInt4AtPtr(currentInstPtr + 1);
+		    break;
+		}
 		switch (*(currentInstPtr + offset)) {
 		case INST_NOP:
 		    offset += InstLength(INST_NOP);
@@ -393,6 +408,7 @@ AdvanceJumps(
 		}
 		break;
 	    }
+	    Tcl_DeleteHashTable(&jumps);
 	    TclStoreInt4AtPtr(offset, currentInstPtr + 1);
 	    continue;
 	}
diff --git a/tests/compile.test b/tests/compile.test
index 51db0a2..36e24de 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -713,6 +713,70 @@ test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
     apply {{} {list [if 1]}}
 } -returnCodes error -match glob -result *
 
+test compile-20.1 {ensure there are no infinite loops in optimizing} {
+    tcl::unsupported::disassemble script {
+	while 1 {
+	    return -code continue -level 0
+	}
+    }
+    return
+} {}
+test compile-20.2 {ensure there are no infinite loops in optimizing} {
+    tcl::unsupported::disassemble script {
+	while 1 {
+	    while 1 {
+		return -code break -level 0
+	    }
+	}
+    }
+    return
+} {}
+
+test compile-21.1 {stack balance management} {
+    apply {{} {
+	set result {}
+	while 1 {
+	    lappend result a
+	    lappend result [list b [break]]
+	    lappend result c
+	}
+	return $result
+    }}
+} a
+test compile-21.2 {stack balance management} {
+    apply {{} {
+	set result {}
+	while {[incr i] <= 10} {
+	    lappend result $i
+	    lappend result [list b [continue] c]
+	    lappend result c
+	}
+	return $result
+    }}
+} {1 2 3 4 5 6 7 8 9 10}
+test compile-21.3 {stack balance management} {
+    apply {args {
+	set result {}
+	while 1 {
+	    lappend result a
+	    lappend result [concat {*}$args [break]]
+	    lappend result c
+	}
+	return $result
+    }} P Q R S T
+} a
+test compile-21.4 {stack balance management} {
+    apply {args {
+	set result {}
+	while {[incr i] <= 10} {
+	    lappend result $i
+	    lappend result [concat {*}$args [continue] c]
+	    lappend result c
+	}
+	return $result
+    }} P Q R S T
+} {1 2 3 4 5 6 7 8 9 10}
+
 # TODO sometime - check that bytecode from tbcload is *not* disassembled.
 
 # cleanup
-- 
cgit v0.12


From d0041f33437e9af324059ed08c7f158fbb1fef19 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 15 Oct 2013 21:09:19 +0000
Subject: -I${BUILD_DIR}/.. doesn't work when BUILD_DIR != "unix". Reported by
 Matthias Kraft

---
 unix/dltest/Makefile.in | 2 +-
 unix/dltest/pkgooa.c    | 4 +++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in
index f64b6d5..25b9376 100644
--- a/unix/dltest/Makefile.in
+++ b/unix/dltest/Makefile.in
@@ -22,7 +22,7 @@ LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
 LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
 LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@
 
-CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -I${BUILD_DIR}/.. -DTCL_MEM_DEBUG \
+CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
 	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}
 
 all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX}
diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c
index 7b14ca0..78af376 100644
--- a/unix/dltest/pkgooa.c
+++ b/unix/dltest/pkgooa.c
@@ -11,7 +11,7 @@
  */
 
 #undef STATIC_BUILD
-#include "tclOOInt.h"
+#include "tclOO.h"
 #include <string.h>
 
 /*
@@ -64,6 +64,8 @@ Pkgooa_StubsOKObjCmd(
  *----------------------------------------------------------------------
  */
 
+extern void *tclOOIntStubsPtr;
+
 static TclOOStubs stubsCopy = {
     TCL_STUB_MAGIC,
     NULL,
-- 
cgit v0.12


From c00bdffb6aa0fca3575ef0ab1a07813f696f1839 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 18 Oct 2013 07:08:46 +0000
Subject: Tackle evalStk by reusing existing machinery.

---
 generic/tclCompCmds.c | 2 +-
 generic/tclCompile.c  | 6 +++++-
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 942d74c..25201eb 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -620,7 +620,7 @@ TclCompileCatchCmd(
 	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
 	ExceptionRangeStarts(envPtr, range);
 	TclEmitOpcode(		INST_DUP,			envPtr);
-	TclEmitOpcode(		INST_EVAL_STK,			envPtr);
+	TclEmitInvoke(envPtr,	INST_EVAL_STK);
     }
     /* Stack at this point:
      *    nonsimple:  script <mark> result
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 427ccab..f91c2fd 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -2458,7 +2458,7 @@ TclCompileCmdWord(
 	 */
 
 	TclCompileTokens(interp, tokenPtr, count, envPtr);
-	TclEmitOpcode(INST_EVAL_STK, envPtr);
+	TclEmitInvoke(envPtr, INST_EVAL_STK);
     }
 }
 
@@ -3954,6 +3954,7 @@ TclEmitInvoke(
 	break;
     default:
 	Tcl_Panic("unexpected opcode");
+    case INST_EVAL_STK:
     case INST_INVOKE_EXPANDED:
 	wordCount = arg1 = arg2 = 0;
 	break;
@@ -4009,6 +4010,9 @@ TclEmitInvoke(
     case INST_INVOKE_EXPANDED:
 	TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
 	break;
+    case INST_EVAL_STK:
+	TclEmitOpcode(INST_EVAL_STK, envPtr);
+	break;
     case INST_INVOKE_REPLACE:
 	TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr);
 	TclEmitInt1(arg2, envPtr);
-- 
cgit v0.12


From 3e798bfe4700fd510a0daf3944429c75596786da Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 19 Oct 2013 11:20:46 +0000
Subject: Improve coverage of [error] compilation.

---
 generic/tclCompCmds.c | 43 ++++++++++++++++++++++++++++++++++++-------
 1 file changed, 36 insertions(+), 7 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 25201eb..c55635a 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2135,19 +2135,48 @@ TclCompileErrorCmd(
 {
     /*
      * General syntax: [error message ?errorInfo? ?errorCode?]
-     * However, we only deal with the case where there is just a message.
      */
-    Tcl_Token *messageTokenPtr;
+
+    Tcl_Token *tokenPtr;
     DefineLineInformation;	/* TIP #280 */
 
-    if (parsePtr->numWords != 2) {
+    if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
 	return TCL_ERROR;
     }
-    messageTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
-    PushStringLiteral(envPtr, "-code error -level 0");
-    CompileWord(envPtr, messageTokenPtr, interp, 1);
-    TclEmitOpcode(INST_RETURN_STK, envPtr);
+    /*
+     * Handle the message.
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+
+    /*
+     * Construct the options. Note that -code and -level are not here.
+     */
+
+    if (parsePtr->numWords == 2) {
+	PushStringLiteral(envPtr, "");
+    } else {
+	PushStringLiteral(envPtr, "-errorinfo");
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 2);
+	if (parsePtr->numWords == 3) {
+	    TclEmitInstInt4(	INST_LIST, 2,			envPtr);
+	} else {
+	    PushStringLiteral(envPtr, "-errorcode");
+	    tokenPtr = TokenAfter(tokenPtr);
+	    CompileWord(envPtr, tokenPtr, interp, 3);
+	    TclEmitInstInt4(	INST_LIST, 4,			envPtr);
+	}
+    }
+
+    /*
+     * Issue the error via 'returnImm error 0'.
+     */
+
+    TclEmitInstInt4(		INST_RETURN_IMM, TCL_ERROR,	envPtr);
+    TclEmitInt4(			0,			envPtr);
     return TCL_OK;
 }
 
-- 
cgit v0.12


From 674d5acbcfa7bfb12b407c88bd4bf67ae1b1d0ac Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 19 Oct 2013 12:29:06 +0000
Subject: Added missing exception range finalize.

---
 generic/tclCompile.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index f91c2fd..89b9011 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -4073,6 +4073,7 @@ TclEmitInvoke(
 	    envPtr->expandCount = savedExpandCount;
 	}
 
+	TclFinalizeLoopExceptionRange(envPtr, loopRange);
 	TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127);
     }
 }
-- 
cgit v0.12


From acfb2a50369dae9afcf444519e5d3875812d5a3b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 19 Oct 2013 14:11:28 +0000
Subject: Fix handling of 'invokeExpanded' and start to do 'returnStk'.

---
 generic/tclCompCmdsGR.c |   4 +-
 generic/tclCompile.c    |  27 ++++++++---
 tests/for.test          | 116 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 138 insertions(+), 9 deletions(-)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 5513b01..fbd370b 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2367,7 +2367,7 @@ TclCompileReturnCmd(
 
 	CompileWord(envPtr, optsTokenPtr, interp, 2);
 	CompileWord(envPtr, msgTokenPtr,  interp, 3);
-	TclEmitOpcode(INST_RETURN_STK, envPtr);
+	TclEmitInvoke(envPtr, INST_RETURN_STK);
 	return TCL_OK;
     }
 
@@ -2509,7 +2509,7 @@ TclCompileReturnCmd(
      * Issue the RETURN itself.
      */
 
-    TclEmitOpcode(INST_RETURN_STK, envPtr);
+    TclEmitInvoke(envPtr, INST_RETURN_STK);
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 89b9011..ae6e56c 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1802,9 +1802,7 @@ CompileExpanded(
      * stack-neutral in general.
      */
 
-    TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED);
-    envPtr->expandCount--;
-    TclAdjustStackDepth(1 - wordIdx, envPtr);
+    TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
 }
 
 static int 
@@ -3931,7 +3929,8 @@ TclEmitInvoke(
     va_list argList;
     ExceptionRange *rangePtr;
     ExceptionAux *auxBreakPtr, *auxContinuePtr;
-    int arg1, arg2, wordCount = 0, loopRange, breakRange, continueRange;
+    int arg1, arg2, wordCount = 0, expandCount = 0;
+    int loopRange, breakRange, continueRange;
 
     /*
      * Parse the arguments.
@@ -3955,8 +3954,17 @@ TclEmitInvoke(
     default:
 	Tcl_Panic("unexpected opcode");
     case INST_EVAL_STK:
+	wordCount = 1;
+	arg1 = arg2 = 0;
+	break;
+    case INST_RETURN_STK:
+	wordCount = 2;
+	arg1 = arg2 = 0;
+	break;
     case INST_INVOKE_EXPANDED:
-	wordCount = arg1 = arg2 = 0;
+	wordCount = arg1 = va_arg(argList, int);
+	arg2 = 0;
+	expandCount = 1;
 	break;
     }
     va_end(argList);
@@ -3974,7 +3982,7 @@ TclEmitInvoke(
     if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
 	auxBreakPtr = NULL;
     } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
-	    && auxBreakPtr->expandTarget == envPtr->expandCount) {
+	    && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) {
 	auxBreakPtr = NULL;
     } else {
 	breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
@@ -3985,7 +3993,7 @@ TclEmitInvoke(
     if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
 	auxContinuePtr = NULL;
     } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
-	    && auxContinuePtr->expandTarget == envPtr->expandCount) {
+	    && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) {
 	auxContinuePtr = NULL;
     } else {
 	continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
@@ -4009,10 +4017,15 @@ TclEmitInvoke(
 	break;
     case INST_INVOKE_EXPANDED:
 	TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
+	envPtr->expandCount--;
+	TclAdjustStackDepth(1 - arg1, envPtr);
 	break;
     case INST_EVAL_STK:
 	TclEmitOpcode(INST_EVAL_STK, envPtr);
 	break;
+    case INST_RETURN_STK:
+	TclEmitOpcode(INST_RETURN_STK, envPtr);
+	break;
     case INST_INVOKE_REPLACE:
 	TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr);
 	TclEmitInt1(arg2, envPtr);
diff --git a/tests/for.test b/tests/for.test
index 6a18abe..8abd270 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -1068,6 +1068,122 @@ test for-7.16 {Bug 3614226: ensure that continue from invoked command only clean
 	expr {$end - $tmp}
     }}
 } 0
+test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory {
+    apply {op {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [{*}$op] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code break}
+} 0
+test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory {
+    apply {op {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [{*}$op] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code continue}
+} 0
+test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory {
+    apply {op {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[{*}$op] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code break}
+} 0
+test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory {
+    apply {op {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[{*}$op] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code continue}
+} 0
+test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory {
+    apply {op {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code break}
+} 0
+test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory {
+    apply {op {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code continue}
+} 0
+test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory {
+    apply {op {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code break}
+} 0
+test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory {
+    apply {op {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code continue}
+} 0
 
 # cleanup
 ::tcltest::cleanupTests
-- 
cgit v0.12


From 39e314ad912cdbd29ba3e01673b1097b40118f8b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 20 Oct 2013 18:11:35 +0000
Subject: And the last bits that need fixing; the code is still less efficient
 than desired but should now not crash.

---
 generic/tclAssembly.c   | 35 +++++++++++++++++++++++++++++++----
 generic/tclCompCmds.c   |  4 ++--
 generic/tclCompCmdsGR.c |  6 +++++-
 generic/tclCompCmdsSZ.c | 12 +++++++-----
 4 files changed, 45 insertions(+), 12 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 08da075..fc51457 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -246,6 +246,8 @@ static void		BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
 			    int opnd, int count);
 static void		BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
 			    int param, int count);
+static void		BBEmitInvoke1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
+			    int param, int count);
 static void		BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
 			    int count);
 static int		BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
@@ -679,10 +681,13 @@ BBEmitInstInt4(
 /*
  *-----------------------------------------------------------------------------
  *
- * BBEmitInst1or4 --
+ * BBEmitInst1or4, BBEmitInvoke1or4 --
  *
  *	Emits a 1- or 4-byte operation according to the magnitude of the
- *	operand
+ *	operand. The Invoke variant generates wrapping stack-balance
+ *	management if necessary (which is not normally required in assembled
+ *	code, as loop exception ranges, expansions, breaks and continues can't
+ *	be issued currently).
  *
  *-----------------------------------------------------------------------------
  */
@@ -714,6 +719,29 @@ BBEmitInst1or4(
     TclUpdateAtCmdStart(op, envPtr);
     BBUpdateStackReqs(bbPtr, tblIdx, count);
 }
+
+static void
+BBEmitInvoke1or4(
+    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
+    int tblIdx,			/* Index in TalInstructionTable of op */
+    int param,			/* Variable-length parameter */
+    int count)			/* Arity if variadic */
+{
+    CompileEnv* envPtr = assemEnvPtr->envPtr;
+				/* Compilation environment */
+    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
+				/* Current basic block */
+    int op = TalInstructionTable[tblIdx].tclInstCode;
+
+    if (param <= 0xff) {
+	op >>= 8;
+    } else {
+	op &= 0xff;
+    }
+    TclEmitInvoke(envPtr, op, param);
+    TclUpdateAtCmdStart(op, envPtr);
+    BBUpdateStackReqs(bbPtr, tblIdx, count);
+}
 
 /*
  *-----------------------------------------------------------------------------
@@ -1450,8 +1478,7 @@ AssembleOneLine(
 	    goto cleanup;
 	}
 
-	// FIXME - use TclEmitInvoke
-	BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
+	BBEmitInvoke1or4(assemEnvPtr, tblIdx, opnd, opnd);
 	break;
 
     case ASSEM_JUMP:
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index c55635a..9c43bfe 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1675,7 +1675,7 @@ TclCompileDictUpdateCmd(
 
     TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
     TclEmitInt4(		infoIndex,			envPtr);
-    TclEmitOpcode(	INST_RETURN_STK,			envPtr);
+    TclEmitInvoke(envPtr,INST_RETURN_STK);
 
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
@@ -2033,7 +2033,7 @@ TclCompileDictWithCmd(
     } else {
 	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
     }
-    TclEmitOpcode(		INST_RETURN_STK,		envPtr);
+    TclEmitInvoke(envPtr,	INST_RETURN_STK);
 
     /*
      * Prepare for the start of the next command.
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index fbd370b..d00327d 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2381,6 +2381,10 @@ TclCompileReturnCmd(
      * Scan through the return options. If any are unknown at compile time,
      * there is no value in bytecompiling. Save the option values known in an
      * objv array for merging into a return options dictionary.
+     *
+     * TODO: There is potential for improvement if all option keys are known
+     * at compile time and all option values relating to '-code' and '-level'
+     * are known at compile time.
      */
 
     for (objc = 0; objc < numOptionWords; objc++) {
@@ -2388,7 +2392,7 @@ TclCompileReturnCmd(
 	Tcl_IncrRefCount(objv[objc]);
 	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
 	    /*
-	     * Non-literal, so punt to run-time.
+	     * Non-literal, so punt to run-time assembly of the dictionary.
 	     */
 
 	    for (; objc>=0 ; objc--) {
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index a5ec731..754238f 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -99,6 +99,8 @@ const AuxDataType tclJumptableInfoType = {
     if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
 #define STORE(idx) \
     if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
+#define INVOKE(name) \
+    TclEmitInvoke(envPtr,INST_##name)
 
 /*
  *----------------------------------------------------------------------
@@ -873,7 +875,7 @@ TclSubstCompile(
 	OP(	END_CATCH);
 	OP(	RETURN_CODE_BRANCH);
 
-	/* ERROR -> reraise it */
+	/* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
 	OP(	RETURN_STK);
 	OP(	NOP);
 
@@ -2396,7 +2398,7 @@ IssueTryClausesInstructions(
 	    TclAdjustStackDepth(-1, envPtr);
 	    FIXJUMP1(		dontChangeOptions);
 	    OP4(			REVERSE, 2);
-	    OP(				RETURN_STK);
+	    INVOKE(			RETURN_STK);
 	}
 
 	JUMP4(				JUMP, addrsToFix[i]);
@@ -2415,7 +2417,7 @@ IssueTryClausesInstructions(
     OP(					POP);
     LOAD(				optionsVar);
     LOAD(				resultVar);
-    OP(					RETURN_STK);
+    INVOKE(				RETURN_STK);
 
     /*
      * Fix all the jumps from taken clauses to here (which is the end of the
@@ -2724,7 +2726,7 @@ IssueTryClausesFinallyInstructions(
     FIXJUMP1(			finalOK);
     LOAD(				optionsVar);
     LOAD(				resultVar);
-    OP(					RETURN_STK);
+    INVOKE(				RETURN_STK);
 
     return TCL_OK;
 }
@@ -2783,7 +2785,7 @@ IssueTryFinallyInstructions(
     OP1(				JUMP1, 7);
     FIXJUMP1(		jumpOK);
     OP4(				REVERSE, 2);
-    OP(					RETURN_STK);
+    INVOKE(				RETURN_STK);
     return TCL_OK;
 }
 
-- 
cgit v0.12


From 30cd4b442c047d01653b1c217b0364eb6b5c8101 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 21 Oct 2013 14:35:02 +0000
Subject: silence compiler warnings

---
 generic/tclCompile.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index ae6e56c..a150fc2 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -3930,7 +3930,7 @@ TclEmitInvoke(
     ExceptionRange *rangePtr;
     ExceptionAux *auxBreakPtr, *auxContinuePtr;
     int arg1, arg2, wordCount = 0, expandCount = 0;
-    int loopRange, breakRange, continueRange;
+    int loopRange = 0, breakRange = 0, continueRange = 0;
 
     /*
      * Parse the arguments.
-- 
cgit v0.12


From fff622bfb179b6e2fb8d95991ae911a0f056774d Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 22 Oct 2013 09:18:19 +0000
Subject: corrected trace printing

---
 generic/tclExecute.c | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8470389..6357008 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5272,13 +5272,13 @@ TEBCresume(
 	    trim2 = 0;
 	}
 	if (trim1 == 0 && trim2 == 0) {
-	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
-		    valuePtr);
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+		    O2S(valuePtr), O2S(value2Ptr)), valuePtr);
 	    NEXT_INST_F(1, 1, 0);
 	} else {
 	    objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
-	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
-		    objResultPtr);
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
 	    NEXT_INST_F(1, 2, 1);
 	}
     case INST_STRTRIM_LEFT:
@@ -5288,13 +5288,13 @@ TEBCresume(
 	string1 = TclGetStringFromObj(valuePtr, &length);
 	trim1 = TclTrimLeft(string1, length, string2, length2);
 	if (trim1 == 0) {
-	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
-		    valuePtr);
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+		    O2S(valuePtr), O2S(value2Ptr)), valuePtr);
 	    NEXT_INST_F(1, 1, 0);
 	} else {
 	    objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1);
-	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", valuePtr, value2Ptr),
-		    objResultPtr);
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
 	    NEXT_INST_F(1, 2, 1);
 	}
     case INST_STRTRIM_RIGHT:
@@ -5304,9 +5304,13 @@ TEBCresume(
 	string1 = TclGetStringFromObj(valuePtr, &length);
 	trim2 = TclTrimRight(string1, length, string2, length2);
 	if (trim2 == 0) {
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+		    O2S(valuePtr), O2S(value2Ptr)), valuePtr);
 	    NEXT_INST_F(1, 1, 0);
 	} else {
 	    objResultPtr = Tcl_NewStringObj(string1, length-trim2);
+	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
+		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
 	    NEXT_INST_F(1, 2, 1);
 	}
     }
-- 
cgit v0.12


From 545698c7c06b1e3d1956d77508ecaf251163fb22 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 22 Oct 2013 14:29:03 +0000
Subject: Fix problems in for.test

---
 generic/tclCompile.c | 136 +++++++++++++++++++++++----------------------------
 1 file changed, 62 insertions(+), 74 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index a150fc2..dcd74f1 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1755,7 +1755,6 @@ CompileExpanded(
     int wordIdx = 0;
     DefineLineInformation;
 
-
     StartExpanding(envPtr);
     if (cmdObj) {
 	CompileCmdLiteral(interp, cmdObj, envPtr);
@@ -1787,19 +1786,17 @@ CompileExpanded(
     }
 
     /*
-     * The stack depth during argument expansion can only be
-     * managed at runtime, as the number of elements in the
-     * expanded lists is not known at compile time. We adjust here
-     * the stack depth estimate so that it is correct after the
-     * command with expanded arguments returns.
+     * The stack depth during argument expansion can only be managed at
+     * runtime, as the number of elements in the expanded lists is not known
+     * at compile time. We adjust here the stack depth estimate so that it is
+     * correct after the command with expanded arguments returns.
      *
-     * The end effect of this command's invocation is that all the
-     * words of the command are popped from the stack, and the
-     * result is pushed: the stack top changes by (1-wordIdx).
+     * The end effect of this command's invocation is that all the words of
+     * the command are popped from the stack, and the result is pushed: the
+     * stack top changes by (1-wordIdx).
      *
-     * Note that the estimates are not correct while the command
-     * is being prepared and run, INST_EXPAND_STKTOP is not
-     * stack-neutral in general.
+     * Note that the estimates are not correct while the command is being
+     * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general.
      */
 
     TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
@@ -1816,8 +1813,8 @@ CompileCmdCompileProc(
     DefineLineInformation;
 
     /*
-     * Emit of the INST_START_CMD instruction is controlled by
-     * the value of envPtr->atCmdStart:
+     * Emit of the INST_START_CMD instruction is controlled by the value of
+     * envPtr->atCmdStart:
      *
      * atCmdStart == 2	: We are not using the INST_START_CMD instruction.
      * atCmdStart == 1	: INST_START_CMD was the last instruction emitted.
@@ -1848,9 +1845,10 @@ CompileCmdCompileProc(
     if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
 	if (incrOffset >= 0) {
 	    /*
-	     * We successfully compiled a command.  Increment the number
-	     * of commands that start at the currently active INST_START_CMD.
+	     * We successfully compiled a command.  Increment the number of
+	     * commands that start at the currently active INST_START_CMD.
 	     */
+
 	    unsigned char *incrPtr = envPtr->codeStart + incrOffset;
 	    unsigned char *startPtr = incrPtr - 5;
 
@@ -1866,9 +1864,9 @@ CompileCmdCompileProc(
     envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */
 
     /*
-     * Throw out any line information generated by the failed
-     * compile attempt.
+     * Throw out any line information generated by the failed compile attempt.
      */
+
     while (mapPtr->nuloc - 1 > eclIndex) {
 	mapPtr->nuloc--;
 	ckfree(mapPtr->loc[mapPtr->nuloc].line);
@@ -1876,11 +1874,11 @@ CompileCmdCompileProc(
     }
 
     /*
-     * Reset the index of next command.
-     * Toss out any from failed nested partial compiles.
+     * Reset the index of next command.  Toss out any from failed nested
+     * partial compiles.
      */
-    envPtr->numCommands = mapPtr->nuloc;
 
+    envPtr->numCommands = mapPtr->nuloc;
     return TCL_ERROR;
 }
 
@@ -1912,11 +1910,10 @@ CompileCommandTokens(
 	    parsePtr->commandStart - envPtr->source, startCodeOffset);
 
     /*
-     * TIP #280. Scan the words and compute the extended location
-     * information. The map first contain full per-word line
-     * information for use by the compiler. This is later replaced by
-     * a reduced form which signals non-literal words, stored in
-     * 'wlines'.
+     * TIP #280. Scan the words and compute the extended location information.
+     * The map first contain full per-word line information for use by the
+     * compiler. This is later replaced by a reduced form which signals
+     * non-literal words, stored in 'wlines'.
      */
 
     EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
@@ -1938,8 +1935,8 @@ CompileCommandTokens(
 	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
 	if (cmdPtr) {
 	    /*
-	     * Found a command.  Test the ways we can be told
-	     * not to attempt to compile it.
+	     * Found a command.  Test the ways we can be told not to attempt
+	     * to compile it.
 	     */
 	    if ((cmdPtr->compileProc == NULL)
 		    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
@@ -1983,8 +1980,8 @@ CompileCommandTokens(
 	    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
 
     /*
-     * TIP #280: Free full form of per-word line data and insert the
-     * reduced form now
+     * TIP #280: Free full form of per-word line data and insert the reduced
+     * form now
      */
 
     envPtr->line = cmdLine;
@@ -2069,20 +2066,20 @@ TclCompileScript(
 
 	if (parse.numWords == 0) {
 	    /*
-	     * The "command" parsed has no words.  In this case
-	     * we can skip the rest of the loop body.  With no words,
-	     * clearly CompileCommandTokens() has nothing to do.  Since
-	     * the parser aggressively sucks up leading comment and white
-	     * space, including newlines, parse.commandStart must be 
-	     * pointing at either the end of script, or a command-terminating
-	     * semi-colon.  In either case, the TclAdvance*() calls have
-	     * nothing to do.  Finally, when no words are parsed, no
-	     * tokens have been allocated at parse.tokenPtr so there's
-	     * also nothing for Tcl_FreeParse() to do.
+	     * The "command" parsed has no words.  In this case we can skip
+	     * the rest of the loop body.  With no words, clearly
+	     * CompileCommandTokens() has nothing to do.  Since the parser
+	     * aggressively sucks up leading comment and white space,
+	     * including newlines, parse.commandStart must be pointing at
+	     * either the end of script, or a command-terminating semi-colon.
+	     * In either case, the TclAdvance*() calls have nothing to do.
+	     * Finally, when no words are parsed, no tokens have been
+	     * allocated at parse.tokenPtr so there's also nothing for
+	     * Tcl_FreeParse() to do.
 	     *
 	     * The advantage of this shortcut is that CompileCommandTokens()
-	     * can be written with an assumption that parse.numWords > 0,
-	     * with the implication the CCT() always generates bytecode.
+	     * can be written with an assumption that parse.numWords > 0, with
+	     * the implication the CCT() always generates bytecode.
 	     */
 	    continue;
 	}
@@ -2101,23 +2098,25 @@ TclCompileScript(
 
     if (lastCmdIdx == -1) {
 	/*
-	 * Compiling the script yielded no bytecode.  The script must be
-	 * all whitespace, comments, and empty commands.  Such scripts
-	 * are defined to successfully produce the empty string result,
-	 * so we emit the simple bytecode that makes that happen.
+	 * Compiling the script yielded no bytecode.  The script must be all
+	 * whitespace, comments, and empty commands.  Such scripts are defined
+	 * to successfully produce the empty string result, so we emit the
+	 * simple bytecode that makes that happen.
 	 */
+
 	PushStringLiteral(envPtr, "");
     } else {
 	/*
 	 * We compiled at least one command to bytecode.  The routine
 	 * CompileCommandTokens() follows the bytecode of each compiled
-	 * command with an INST_POP, so that stack balance is maintained
-	 * when several commands are in sequence.  (The result of each
-	 * command is thrown away before moving on to the next command).
-	 * For the last command compiled, we need to undo that INST_POP
-	 * so that the result of the last command becomes the result of
-	 * the script.  The code here removes that trailing INST_POP.
+	 * command with an INST_POP, so that stack balance is maintained when
+	 * several commands are in sequence.  (The result of each command is
+	 * thrown away before moving on to the next command).  For the last
+	 * command compiled, we need to undo that INST_POP so that the result
+	 * of the last command becomes the result of the script.  The code
+	 * here removes that trailing INST_POP.
 	 */
+
 	envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
 	envPtr->codeNext--;
 	envPtr->currStackDepth++;
@@ -3353,9 +3352,9 @@ TclAddLoopContinueFixup(
  *
  * TclCleanupStackForBreakContinue --
  *
- *	Ditch the extra elements from the auxiliary stack and the main
- *	stack. How to do this exactly depends on whether there are any
- *	elements on the auxiliary stack to pop.
+ *	Ditch the extra elements from the auxiliary stack and the main stack.
+ *	How to do this exactly depends on whether there are any elements on
+ *	the auxiliary stack to pop.
  *
  * ---------------------------------------------------------------------
  */
@@ -3369,23 +3368,16 @@ TclCleanupStackForBreakContinue(
     int toPop = envPtr->expandCount - auxPtr->expandTarget;
 
     if (toPop > 0) {
-	while (toPop > 0) {
+	while (toPop --> 0) {
 	    TclEmitOpcode(INST_EXPAND_DROP, envPtr);
-	    toPop--;
 	}
 	TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth,
 		envPtr);
-	toPop = auxPtr->expandTargetDepth - auxPtr->stackDepth;
-	while (toPop > 0) {
-	    TclEmitOpcode(INST_POP, envPtr);
-	    toPop--;
-	}
-    } else {
-	toPop = envPtr->currStackDepth - auxPtr->stackDepth;
-	while (toPop > 0) {
-	    TclEmitOpcode(INST_POP, envPtr);
-	    toPop--;
-	}
+	envPtr->currStackDepth = auxPtr->expandTargetDepth;
+    }
+    toPop = envPtr->currStackDepth - auxPtr->stackDepth;
+    while (toPop --> 0) {
+	TclEmitOpcode(INST_POP, envPtr);
     }
     envPtr->currStackDepth = savedStackDepth;
 }
@@ -4062,11 +4054,9 @@ TclEmitInvoke(
 
 	if (auxBreakPtr != NULL) {
 	    TclAdjustStackDepth(-1, envPtr);
-	    exceptAux->stackDepth = auxBreakPtr->stackDepth;
-	    exceptAux->expandTarget = auxBreakPtr->expandTarget;
 
 	    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
-	    TclCleanupStackForBreakContinue(envPtr, exceptAux);
+	    TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
 	    TclAddLoopBreakFixup(envPtr, auxBreakPtr);
 
 	    envPtr->currStackDepth = savedStackDepth;
@@ -4075,11 +4065,9 @@ TclEmitInvoke(
 
 	if (auxContinuePtr != NULL) {
 	    TclAdjustStackDepth(-1, envPtr);
-	    exceptAux->stackDepth = auxContinuePtr->stackDepth;
-	    exceptAux->expandTarget = auxContinuePtr->expandTarget;
 
 	    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
-	    TclCleanupStackForBreakContinue(envPtr, exceptAux);
+	    TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
 	    TclAddLoopContinueFixup(envPtr, auxContinuePtr);
 
 	    envPtr->currStackDepth = savedStackDepth;
-- 
cgit v0.12


From 1356c7f642888ace1fe24f64ea003567fc6a8fdd Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 22 Oct 2013 17:34:55 +0000
Subject: Fix for assemble.test; problem was a total assumption failure caused
 by way that the assembler works.

---
 generic/tclAssembly.c | 34 +++-------------------------------
 1 file changed, 3 insertions(+), 31 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index fc51457..03177b9 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -246,8 +246,6 @@ static void		BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
 			    int opnd, int count);
 static void		BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
 			    int param, int count);
-static void		BBEmitInvoke1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
-			    int param, int count);
 static void		BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
 			    int count);
 static int		BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
@@ -681,13 +679,10 @@ BBEmitInstInt4(
 /*
  *-----------------------------------------------------------------------------
  *
- * BBEmitInst1or4, BBEmitInvoke1or4 --
+ * BBEmitInst1or4 --
  *
  *	Emits a 1- or 4-byte operation according to the magnitude of the
- *	operand. The Invoke variant generates wrapping stack-balance
- *	management if necessary (which is not normally required in assembled
- *	code, as loop exception ranges, expansions, breaks and continues can't
- *	be issued currently).
+ *	operand.
  *
  *-----------------------------------------------------------------------------
  */
@@ -719,29 +714,6 @@ BBEmitInst1or4(
     TclUpdateAtCmdStart(op, envPtr);
     BBUpdateStackReqs(bbPtr, tblIdx, count);
 }
-
-static void
-BBEmitInvoke1or4(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    int tblIdx,			/* Index in TalInstructionTable of op */
-    int param,			/* Variable-length parameter */
-    int count)			/* Arity if variadic */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
-				/* Current basic block */
-    int op = TalInstructionTable[tblIdx].tclInstCode;
-
-    if (param <= 0xff) {
-	op >>= 8;
-    } else {
-	op &= 0xff;
-    }
-    TclEmitInvoke(envPtr, op, param);
-    TclUpdateAtCmdStart(op, envPtr);
-    BBUpdateStackReqs(bbPtr, tblIdx, count);
-}
 
 /*
  *-----------------------------------------------------------------------------
@@ -1478,7 +1450,7 @@ AssembleOneLine(
 	    goto cleanup;
 	}
 
-	BBEmitInvoke1or4(assemEnvPtr, tblIdx, opnd, opnd);
+	BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
 	break;
 
     case ASSEM_JUMP:
-- 
cgit v0.12


From 2c5855aae434efce2ba3a202651709aaa5bb1ce3 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 23 Oct 2013 08:33:40 +0000
Subject: Stack depth calculation correction.

---
 generic/tclCompCmdsGR.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 2aaca31..a02f0a8 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1616,6 +1616,7 @@ TclCompileLreplaceCmd(
 		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
 	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
 		envPtr->codeStart + offset + 1);
+	TclAdjustStackDepth(-1, envPtr);
     }
     TclEmitOpcode(		INST_DUP,			envPtr);
     TclEmitInstInt4(		INST_LIST_RANGE_IMM, 0,		envPtr);
@@ -1665,6 +1666,7 @@ TclCompileLreplaceCmd(
 		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
 	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
 		envPtr->codeStart + offset + 1);
+	TclAdjustStackDepth(-1, envPtr);
     }
     TclEmitOpcode(		INST_DUP,			envPtr);
     TclEmitInstInt4(		INST_LIST_RANGE_IMM, 0,		envPtr);
-- 
cgit v0.12


From cb8dc8b181dfb98f074698fc7eade5f9dfdbefff Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 23 Oct 2013 15:32:58 +0000
Subject: silence compiler warning

---
 generic/tclCompile.c | 1 -
 1 file changed, 1 deletion(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index dcd74f1..3c8e4ef 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -4034,7 +4034,6 @@ TclEmitInvoke(
 	int savedStackDepth = envPtr->currStackDepth;
 	int savedExpandCount = envPtr->expandCount;
 	JumpFixup nonTrapFixup;
-	ExceptionAux *exceptAux = envPtr->exceptAuxArrayPtr + loopRange;
 
 	if (auxBreakPtr != NULL) {
 	    auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
-- 
cgit v0.12


From bb5a05a1e626246d6baeabd22e419a4eee18ff66 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 24 Oct 2013 07:21:14 +0000
Subject: First step in compiling [concat]: the trivial cases.

---
 generic/tclBasic.c    |  2 +-
 generic/tclCompCmds.c | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++
 generic/tclInt.h      |  3 ++
 3 files changed, 90 insertions(+), 1 deletion(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9f40932..8d77cc5 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -211,7 +211,7 @@ static const CmdInfo builtInCmds[] = {
     {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
 #endif
     {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
-    {"concat",		Tcl_ConcatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
+    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
     {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
     {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
     {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 9c43bfe..9508d00 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -55,6 +55,13 @@ const AuxDataType tclDictUpdateInfoType = {
     FreeDictUpdateInfo,		/* freeProc */
     PrintDictUpdateInfo		/* printProc */
 };
+
+/*
+ * The definition of what whitespace is stripped when [concat]enating. Must be
+ * kept in synch with tclUtil.c
+ */
+
+#define CONCAT_WS	" \f\v\r\t\n"
 
 /*
  *----------------------------------------------------------------------
@@ -748,6 +755,85 @@ TclCompileCatchCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileConcatCmd --
+ *
+ *	Procedure called to compile the "concat" command.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "concat" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileConcatCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Obj *objPtr, *listObj;
+    Tcl_Token *tokenPtr;
+    int i;
+
+    if (parsePtr->numWords == 1) {
+	/*
+	 * [concat] without arguments just pushes an empty object.
+	 */
+
+	PushStringLiteral(envPtr, "");
+	return TCL_OK;
+    }
+
+    /*
+     * Test if all arguments are compile-time known. If they are, we can
+     * implement with a simple push.
+     */
+
+    listObj = Tcl_NewObj();
+    for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	objPtr = Tcl_NewObj();
+	if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+	    Tcl_DecrRefCount(objPtr);
+	    Tcl_DecrRefCount(listObj);
+	    listObj = NULL;
+	    break;
+	}
+	(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
+    }
+    if (listObj != NULL) {
+	Tcl_Obj **objs;
+	const char *bytes;
+	int len;
+
+	Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
+	objPtr = Tcl_ConcatObj(len, objs);
+	Tcl_DecrRefCount(listObj);
+	bytes = Tcl_GetStringFromObj(objPtr, &len);
+	PushLiteral(envPtr, bytes, len);
+	Tcl_DecrRefCount(objPtr);
+	return TCL_OK;
+    }
+
+    /*
+     * General case: runtime concat.
+     */
+
+    // TODO
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileContinueCmd --
  *
  *	Procedure called to compile the "continue" command.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6fe07f8..cc8469b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3434,6 +3434,9 @@ MODULE_SCOPE int	TclCompileBreakCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileCatchCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileConcatCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileContinueCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12


From fdfd431637d67d40a0af98bfe92a2771a2852e94 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 26 Oct 2013 07:50:08 +0000
Subject: Change name of instruction to make way for future changes.

---
 generic/tclAssembly.c   |  3 ++-
 generic/tclCompCmds.c   |  4 ++--
 generic/tclCompCmdsSZ.c | 12 ++++++------
 generic/tclCompile.c    | 10 +++++-----
 generic/tclCompile.h    |  2 +-
 generic/tclExecute.c    |  2 +-
 generic/tclOptimize.c   |  6 +++---
 7 files changed, 20 insertions(+), 19 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 4c0777d..f709acb 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -349,7 +349,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"bitnot",		ASSEM_1BYTE,	INST_BITNOT,		1,	1},
     {"bitor",		ASSEM_1BYTE,	INST_BITOR,		2,	1},
     {"bitxor",		ASSEM_1BYTE,	INST_BITXOR,		2,	1},
-    {"concat",		ASSEM_CONCAT1,	INST_CONCAT1,		INT_MIN,1},
+    {"concat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
     {"coroName",	ASSEM_1BYTE,	INST_COROUTINE_NAME,	0,	1},
     {"currentNamespace",ASSEM_1BYTE,	INST_NS_CURRENT,	0,	1},
     {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
@@ -453,6 +453,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"storeArrayStk",	ASSEM_1BYTE,	INST_STORE_ARRAY_STK,	3,	1},
     {"storeStk",	ASSEM_1BYTE,	INST_STORE_STK,		2,	1},
     {"strcmp",		ASSEM_1BYTE,	INST_STR_CMP,		2,	1},
+    {"strcat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
     {"streq",		ASSEM_1BYTE,	INST_STR_EQ,		2,	1},
     {"strfind",		ASSEM_1BYTE,	INST_STR_FIND,		2,	1},
     {"strindex",	ASSEM_1BYTE,	INST_STR_INDEX,		2,	1},
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 9508d00..a1ccd39 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1825,7 +1825,7 @@ TclCompileDictAppendCmd(
 	tokenPtr = TokenAfter(tokenPtr);
     }
     if (parsePtr->numWords > 4) {
-	TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
     }
 
     /*
@@ -3212,7 +3212,7 @@ TclCompileFormatCmd(
 	 * Do the concatenation, which produces the result.
 	 */
 
-	TclEmitInstInt1(INST_CONCAT1, i, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);
     } else {
 	/*
 	 * EVIL HACK! Force there to be a string representation in the case
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 5f7fad3..646adf3 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -867,7 +867,7 @@ TclSubstCompile(
     /*
      * Tricky point! If the first token does not result in a *guaranteed* push
      * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it
-     * is possible to get to an INST_CONCAT1 or INST_DONE without enough
+     * is possible to get to an INST_STR_CONCAT1 or INST_DONE without enough
      * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for
      * identifying a script that could trigger this case.
      */
@@ -932,11 +932,11 @@ TclSubstCompile(
 	}
 
 	while (count > 255) {
-	    OP1(		CONCAT1, 255);
+	    OP1(		STR_CONCAT1, 255);
 	    count -= 254;
 	}
 	if (count > 1) {
-	    OP1(		CONCAT1, count);
+	    OP1(		STR_CONCAT1, count);
 	    count = 1;
 	}
 
@@ -1056,7 +1056,7 @@ TclSubstCompile(
 		    (int) (CurrentOffset(envPtr) - okFixup.codeOffset));
 	}
 	if (count > 1) {
-	    OP1(CONCAT1, count);
+	    OP1(STR_CONCAT1, count);
 	    count = 1;
 	}
 
@@ -1069,11 +1069,11 @@ TclSubstCompile(
     }
 
     while (count > 255) {
-	OP1(	CONCAT1, 255);
+	OP1(	STR_CONCAT1, 255);
 	count -= 254;
     }
     if (count > 1) {
-	OP1(	CONCAT1, count);
+	OP1(	STR_CONCAT1, count);
     }
 
     Tcl_FreeParse(&parse);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index cfc6b2e..48a5456 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -63,7 +63,7 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Pop the topmost stack object */
     {"dup",		  1,   +1,         0,	{OPERAND_NONE}},
 	/* Duplicate the topmost stack object and push the result */
-    {"concat1",		  2,   INT_MIN,    1,	{OPERAND_UINT1}},
+    {"strcat",		  2,   INT_MIN,    1,	{OPERAND_UINT1}},
 	/* Concatenate the top op1 items and push result */
     {"invokeStk1",	  2,   INT_MIN,    1,	{OPERAND_UINT1}},
 	/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
@@ -2400,11 +2400,11 @@ TclCompileTokens(
      */
 
     while (numObjsToConcat > 255) {
-	TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
 	numObjsToConcat -= 254;	/* concat pushes 1 obj, the result */
     }
     if (numObjsToConcat > 1) {
-	TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, numObjsToConcat, envPtr);
     }
 
     /*
@@ -2535,11 +2535,11 @@ TclCompileExprWords(
     }
     concatItems = 2*numWords - 1;
     while (concatItems > 255) {
-	TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
 	concatItems -= 254;
     }
     if (concatItems > 1) {
-	TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
+	TclEmitInstInt1(INST_STR_CONCAT1, concatItems, envPtr);
     }
     TclEmitOpcode(INST_EXPR_STK, envPtr);
 }
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index db77eb1..62c41ea 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -512,7 +512,7 @@ typedef struct ByteCode {
 #define INST_PUSH4			2
 #define INST_POP			3
 #define INST_DUP			4
-#define INST_CONCAT1			5
+#define INST_STR_CONCAT1		5
 #define INST_INVOKE_STK1		6
 #define INST_INVOKE_STK4		7
 #define INST_EVAL_STK			8
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6357008..ab7a3f5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2563,7 +2563,7 @@ TEBCresume(
 	NEXT_INST_F(5, 0, 0);
     }
 
-    case INST_CONCAT1: {
+    case INST_STR_CONCAT1: {
 	int appendLen = 0;
 	char *bytes, *p;
 	Tcl_Obj **currPtr;
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index 3b16e6e..3196b83 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -191,7 +191,7 @@ TrimUnreachable(
  * ConvertZeroEffectToNOP --
  *
  *	Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also
- *	replace PUSH empty/CONCAT and TRY_CVT_NUMERIC (when followed by an
+ *	replace PUSH empty/STR_CONCAT and TRY_CVT_NUMERIC (when followed by an
  *	operation that guarantees the check for arithmeticity) and eliminate
  *	LNOT when we can invert the following JUMP condition.
  *
@@ -227,7 +227,7 @@ ConvertZeroEffectToNOP(
 	case INST_PUSH1:
 	    if (nextInst == INST_POP) {
 		blank = size + InstLength(nextInst);
-	    } else if (nextInst == INST_CONCAT1
+	    } else if (nextInst == INST_STR_CONCAT1
 		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
 		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
 			TclGetUInt1AtPtr(currentInstPtr + 1));
@@ -242,7 +242,7 @@ ConvertZeroEffectToNOP(
 	case INST_PUSH4:
 	    if (nextInst == INST_POP) {
 		blank = size + 1;
-	    } else if (nextInst == INST_CONCAT1
+	    } else if (nextInst == INST_STR_CONCAT1
 		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
 		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
 			TclGetUInt4AtPtr(currentInstPtr + 1));
-- 
cgit v0.12


From ab8249dfc3c847de69ae379bb7849bdb7346db40 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 26 Oct 2013 08:25:02 +0000
Subject: General [concat] compilation.

---
 generic/tclAssembly.c |  5 ++++-
 generic/tclCompCmds.c | 12 ++++++++++--
 generic/tclCompile.c  |  6 +++++-
 generic/tclCompile.h  |  4 +++-
 generic/tclExecute.c  | 11 +++++++++++
 5 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index f709acb..b805c63 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -350,6 +350,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"bitor",		ASSEM_1BYTE,	INST_BITOR,		2,	1},
     {"bitxor",		ASSEM_1BYTE,	INST_BITXOR,		2,	1},
     {"concat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
+    {"concatStk",	ASSEM_LIST,	INST_CONCAT_STK,	INT_MIN,1},
     {"coroName",	ASSEM_1BYTE,	INST_COROUTINE_NAME,	0,	1},
     {"currentNamespace",ASSEM_1BYTE,	INST_NS_CURRENT,	0,	1},
     {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
@@ -497,6 +498,7 @@ static const unsigned char NonThrowingByteCodes[] = {
     INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP,			/* 1-4 */
     INST_JUMP1, INST_JUMP4,					/* 34-35 */
     INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE,	/* 70-72 */
+    INST_LIST,							/* 79 */
     INST_OVER,							/* 95 */
     INST_PUSH_RETURN_OPTIONS,					/* 108 */
     INST_REVERSE,						/* 126 */
@@ -507,7 +509,8 @@ static const unsigned char NonThrowingByteCodes[] = {
     INST_NS_CURRENT,						/* 151 */
     INST_INFO_LEVEL_NUM,					/* 152 */
     INST_RESOLVE_COMMAND,					/* 154 */
-    INST_STRTRIM, INST_STRTRIM_LEFT, INST_STRTRIM_RIGHT		/* 166-168 */
+    INST_STRTRIM, INST_STRTRIM_LEFT, INST_STRTRIM_RIGHT,	/* 166-168 */
+    INST_CONCAT_STK						/* 169 */
 };
 
 /*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index a1ccd39..2f6cb96 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -779,10 +779,12 @@ TclCompileConcatCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+    DefineLineInformation;	/* TIP #280 */
     Tcl_Obj *objPtr, *listObj;
     Tcl_Token *tokenPtr;
     int i;
 
+    /* TODO: Consider compiling expansion case. */
     if (parsePtr->numWords == 1) {
 	/*
 	 * [concat] without arguments just pushes an empty object.
@@ -827,8 +829,14 @@ TclCompileConcatCmd(
      * General case: runtime concat.
      */
 
-    // TODO
-    return TCL_ERROR;
+    for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, i);
+    }
+
+    TclEmitInstInt4(	INST_CONCAT_STK, i-1,		envPtr);
+
+    return TCL_OK;
 }
 
 /*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 48a5456..280bf64 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -561,6 +561,11 @@ InstructionDesc const tclInstructionTable[] = {
 	 * pushes the resulting string.
 	 * Stack: ... string charset => ... trimmedString */
 
+    {"concatStk",	 5,	INT_MIN,  1,	{OPERAND_UINT4}},
+	/* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd
+	 * is number of values to concatenate.
+	 * Operation:	push concat(stk1 stk2 ... stktop) */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
@@ -4050,7 +4055,6 @@ TclEmitInvoke(
 	int savedStackDepth = envPtr->currStackDepth;
 	int savedExpandCount = envPtr->expandCount;
 	JumpFixup nonTrapFixup;
-	ExceptionAux *exceptAux = envPtr->exceptAuxArrayPtr + loopRange;
 
 	if (auxBreakPtr != NULL) {
 	    auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 62c41ea..4ae754c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -773,8 +773,10 @@ typedef struct ByteCode {
 #define INST_STRTRIM_LEFT		167
 #define INST_STRTRIM_RIGHT		168
 
+#define INST_CONCAT_STK			169
+
 /* The last opcode */
-#define LAST_INST_OPCODE		168
+#define LAST_INST_OPCODE		169
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ab7a3f5..cb6afaf 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2712,6 +2712,17 @@ TEBCresume(
 	NEXT_INST_V(2, opnd, 1);
     }
 
+    case INST_CONCAT_STK:
+	/*
+	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
+	 * and then decrement their ref counts.
+	 */
+
+	opnd = TclGetUInt4AtPtr(pc+1);
+	objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+	NEXT_INST_V(5, opnd, 1);
+
     case INST_EXPAND_START:
 	/*
 	 * Push an element to the auxObjList. This records the current
-- 
cgit v0.12


From 2fb0507a00743b52c4e5d679639bfb6cbc8b69b6 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 27 Oct 2013 08:28:43 +0000
Subject: [53a917d6c9]: Correction to macro for determining how to deprecate
 things. Thanks to Raphael Kubo da Costa <rakuco@FreeBSD.org> for the patch.

---
 generic/tcl.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tcl.h b/generic/tcl.h
index 1b120fb..ab54078 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -168,7 +168,7 @@ extern "C" {
  */
 
 #if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 1)))
-#   if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC__MINOR__ >= 5))
+#   if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ >= 5))
 #	define TCL_DEPRECATED_API(msg)	__attribute__ ((__deprecated__ (msg)))
 #   else
 #	define TCL_DEPRECATED_API(msg)	__attribute__ ((__deprecated__))
-- 
cgit v0.12


From c6fdd0f07eb9197e59da6170e89c7beafd0a43e0 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 28 Oct 2013 09:23:30 +0000
Subject: [01b77111e5]: Small fixes relating to this bug. In particular, the
 package name mapping was not being distributed, and there were some small
 problems with what the mappings were and how they were applied. Also
 prevented external URLs from ending with a '.'; that's vanishingly rare...

---
 pkgs/package.list.txt          | 11 +++++++-
 tools/tcltk-man2html-utils.tcl |  2 +-
 tools/tcltk-man2html.tcl       |  9 +++++--
 unix/Makefile.in               | 57 +++++++++++++++++++++---------------------
 4 files changed, 47 insertions(+), 32 deletions(-)

diff --git a/pkgs/package.list.txt b/pkgs/package.list.txt
index a13b0fb..0d5dcf8 100644
--- a/pkgs/package.list.txt
+++ b/pkgs/package.list.txt
@@ -9,7 +9,10 @@ itcl {[incr Tcl]}
 Itcl {[incr Tcl]}
 
 # SQLite
-sqlite SQLite
+Sqlite SQLite3
+sqlite SQLite3
+Sqlite3 SQLite3
+sqlite3 SQLite3
 
 # Thread
 Thread Thread
@@ -20,7 +23,13 @@ tdbc TDBC
 Tdbc TDBC
 TDBC TDBC
 # Drivers for TDBC
+Tdbcmysql	tdbc::mysql
 tdbcmysql	tdbc::mysql
+Tdbcodbc	tdbc::odbc
 tdbcodbc	tdbc::odbc
+Tdbcpostgres	tdbc::postgres
 tdbcpostgres	tdbc::postgres
+Tdbcsqlite3	tdbc::sqlite3
 tdbcsqlite3	tdbc::sqlite3
+Tdbcsqlite	tdbc::sqlite3
+tdbcsqlite	tdbc::sqlite3
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index d02bcb6..bdd0079 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -900,7 +900,7 @@ proc insert-cross-references {text} {
 		append result [string range $text 0 [expr {$off-1}]]
 		regexp -indices -start $off {http://[\w/.]+} $text range
 		set url [string range $text {*}$range]
-		append result "<A HREF=\"$url\">" $url "</A>"
+		append result "<A HREF=\"[string trimright $url .]\">$url</A>"
 		set text [string range $text[set text ""] \
 			      [expr {[lindex $range 1]+1}] end]
 		continue
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index f392bce..89e8e5c 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -470,6 +470,7 @@ proc plus-pkgs {type args} {
 		continue
 	    }
 	}
+	set dir [string trimright $dir "0123456789-."]
 	switch $type {
 	    n {
 		set title "$name Package Commands"
@@ -647,10 +648,12 @@ try {
 	append appdir "$tkdir"
     }
 
+    apply {{} {
+    global packageBuildList tcltkdir tcldir build_tcl
 
     # When building docs for Tcl, try to build docs for bundled packages too
     set packageBuildList {}
-    if  {$build_tcl} {
+    if {$build_tcl} {
 	set pkgsDir [file join $tcltkdir $tcldir pkgs]
 	set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *]
 
@@ -693,7 +696,8 @@ try {
 		foreach line [split [read $f] \n] {
 		    if {[string trim $line] eq ""} continue
 		    if {[string match #* $line]} continue
-		    lappend packageDirNameMap {*}$line
+		    lassign $line dir name
+		    lappend packageDirNameMap $dir $name
 		}
 	    } finally {
 		close $f
@@ -714,6 +718,7 @@ try {
 	    lset packageBuildList $idx+1 [dict get $packageDirNameMap $n]
 	}
     }
+    }}
 
     #
     # Invoke the scraper/converter engine.
diff --git a/unix/Makefile.in b/unix/Makefile.in
index bc396e2..093fb40 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1950,6 +1950,7 @@ $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
 $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
 	cd $(MAC_OSX_DIR); autoheader; touch $@
 
+EOLFIX=$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl
 dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(MAC_OSX_DIR)/configure genstubs dist-packages ${NATIVE_TCLSH}
 	rm -rf $(DISTDIR)
 	mkdir -p $(DISTDIR)/unix
@@ -1965,7 +1966,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
 		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
 	chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
 	chmod 775 $(DISTDIR)/unix/ldAix
-	mkdir $(DISTDIR)/generic
+	@mkdir $(DISTDIR)/generic
 	cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
 	cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
 	cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
@@ -1973,7 +1974,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
 	cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \
 		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
 		$(DISTDIR)
-	mkdir $(DISTDIR)/library
+	@mkdir $(DISTDIR)/library
 	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
 		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
 	for i in http1.0 http opt msgcat reg dde tcltest platform; \
@@ -1981,31 +1982,32 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
 		mkdir $(DISTDIR)/library/$$i ;\
 		cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
 	    done;
-	mkdir $(DISTDIR)/library/encoding
+	@mkdir $(DISTDIR)/library/encoding
 	cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
-	mkdir $(DISTDIR)/library/msgs
+	@mkdir $(DISTDIR)/library/msgs
 	cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs
-	( cd $(TOP_DIR); \
+	@echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata
+	@( cd $(TOP_DIR); \
 	  find library/tzdata -name CVS -prune -o -type f -print ) \
 	    | ( cd $(TOP_DIR) ; xargs tar cf - ) \
 	    | ( cd $(DISTDIR) ; tar xfp - )
-	mkdir $(DISTDIR)/doc
+	@mkdir $(DISTDIR)/doc
 	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
 		$(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
-	mkdir $(DISTDIR)/compat
+	@mkdir $(DISTDIR)/compat
 	cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \
 		$(COMPAT_DIR)/README $(DISTDIR)/compat
-	mkdir $(DISTDIR)/compat/zlib
+	@mkdir $(DISTDIR)/compat/zlib
 	( cd $(COMPAT_DIR)/zlib; \
 	  find . -name CVS -prune -o -type f -print ) \
 	    | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \
 	    | ( cd $(DISTDIR)/compat/zlib ; tar xfp - )
-	mkdir $(DISTDIR)/tests
+	@mkdir $(DISTDIR)/tests
 	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests
 	cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
 		$(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \
 		$(DISTDIR)/tests
-	mkdir $(DISTDIR)/win
+	@mkdir $(DISTDIR)/win
 	cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win
 	cp $(TOP_DIR)/win/configure.in $(TOP_DIR)/win/configure \
 		$(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \
@@ -2014,49 +2016,48 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
 	cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \
 		$(DISTDIR)/win
 	cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
-	$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/*.bat
+	@$(EOLFIX) -crlf $(DISTDIR)/win/*.bat
 	cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
-	$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/makefile.*
+	@$(EOLFIX) -crlf $(DISTDIR)/win/makefile.*
 	cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win
-	$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rules.vc
+	@$(EOLFIX) -crlf $(DISTDIR)/win/rules.vc
 	cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win
-	$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/coffbase.txt
+	@$(EOLFIX) -crlf $(DISTDIR)/win/coffbase.txt
 	cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win
-	$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.hpj.in
+	@$(EOLFIX) -crlf $(DISTDIR)/win/tcl.hpj.in
 	cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win
-	$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.ds*
+	@$(EOLFIX) -crlf $(DISTDIR)/win/tcl.ds*
 	cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
 	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
-	mkdir $(DISTDIR)/macosx
+	@mkdir $(DISTDIR)/macosx
 	cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \
 		$(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \
 		$(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \
 		$(MAC_OSX_DIR)/configure $(DISTDIR)/macosx
 	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx
-	mkdir $(DISTDIR)/macosx/Tcl.xcode
+	@mkdir $(DISTDIR)/macosx/Tcl.xcode
 	cp -p $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \
 		$(MAC_OSX_DIR)/Tcl.xcode/default.pbxuser \
 		$(DISTDIR)/macosx/Tcl.xcode
-	mkdir $(DISTDIR)/macosx/Tcl.xcodeproj
+	@mkdir $(DISTDIR)/macosx/Tcl.xcodeproj
 	cp -p $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \
 		$(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \
 		$(DISTDIR)/macosx/Tcl.xcodeproj
-	mkdir $(DISTDIR)/unix/dltest
+	@mkdir $(DISTDIR)/unix/dltest
 	cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \
-		$(UNIX_DIR)/dltest/README \
-		$(DISTDIR)/unix/dltest
-	mkdir $(DISTDIR)/tools
+		$(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest
+	@mkdir $(DISTDIR)/tools
 	cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \
 		$(TOOL_DIR)/configure $(TOOL_DIR)/configure.in \
 		$(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \
 		$(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \
 		$(DISTDIR)/tools
-	$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in
-	mkdir $(DISTDIR)/libtommath
-	cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \
-		$(DISTDIR)/libtommath
-	mkdir $(DISTDIR)/pkgs
+	@$(EOLFIX) -crlf $(DISTDIR)/tools/tcl.hpj.in
+	@mkdir $(DISTDIR)/libtommath
+	cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath
+	@mkdir $(DISTDIR)/pkgs
 	cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs
+	cp $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs
 	for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \
 	    tar -C $(DISTDIR)/pkgs -xzf "$$i"; \
 	done
-- 
cgit v0.12


From 3b3f0179aee2dce77bfef12308c53429523675bc Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 29 Oct 2013 20:07:56 +0000
Subject: Now do [string toupper], [string tolower] and [string totitle]. Only
 handles the no-indices case; that's the only case anyone actually commonly
 uses.

---
 generic/tclAssembly.c   |  14 ++--
 generic/tclCmdMZ.c      |   6 +-
 generic/tclCompCmdsGR.c |   2 +-
 generic/tclCompCmdsSZ.c | 171 +++++++++++++++++++++++++++++++++++-------------
 generic/tclCompile.c    |  13 ++++
 generic/tclCompile.h    |  12 ++--
 generic/tclExecute.c    |  55 +++++++++++++++-
 generic/tclInt.h        |   9 +++
 8 files changed, 221 insertions(+), 61 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index b805c63..cd0a42d 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -453,6 +453,9 @@ static const TalInstDesc TalInstructionTable[] = {
 					 | INST_STORE_ARRAY4),	2,	1},
     {"storeArrayStk",	ASSEM_1BYTE,	INST_STORE_ARRAY_STK,	3,	1},
     {"storeStk",	ASSEM_1BYTE,	INST_STORE_STK,		2,	1},
+    {"strLower",	ASSEM_1BYTE,	INST_STR_LOWER,		1,	1},
+    {"strTitle",	ASSEM_1BYTE,	INST_STR_TITLE,		1,	1},
+    {"strUpper",	ASSEM_1BYTE,	INST_STR_UPPER,		1,	1},
     {"strcmp",		ASSEM_1BYTE,	INST_STR_CMP,		2,	1},
     {"strcat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
     {"streq",		ASSEM_1BYTE,	INST_STR_EQ,		2,	1},
@@ -464,9 +467,9 @@ static const TalInstDesc TalInstructionTable[] = {
     {"strneq",		ASSEM_1BYTE,	INST_STR_NEQ,		2,	1},
     {"strrange",	ASSEM_1BYTE,	INST_STR_RANGE,		3,	1},
     {"strrfind",	ASSEM_1BYTE,	INST_STR_FIND_LAST,	2,	1},
-    {"strtrim",		ASSEM_1BYTE,	INST_STRTRIM,		2,	1},
-    {"strtrimLeft",	ASSEM_1BYTE,	INST_STRTRIM_LEFT,	2,	1},
-    {"strtrimRight",	ASSEM_1BYTE,	INST_STRTRIM_RIGHT,	2,	1},
+    {"strtrim",		ASSEM_1BYTE,	INST_STR_TRIM,		2,	1},
+    {"strtrimLeft",	ASSEM_1BYTE,	INST_STR_TRIM_LEFT,	2,	1},
+    {"strtrimRight",	ASSEM_1BYTE,	INST_STR_TRIM_RIGHT,	2,	1},
     {"sub",		ASSEM_1BYTE,	INST_SUB,		2,	1},
     {"tclooClass",	ASSEM_1BYTE,	INST_TCLOO_CLASS,	1,	1},
     {"tclooIsObject",	ASSEM_1BYTE,	INST_TCLOO_IS_OBJECT,	1,	1},
@@ -509,8 +512,9 @@ static const unsigned char NonThrowingByteCodes[] = {
     INST_NS_CURRENT,						/* 151 */
     INST_INFO_LEVEL_NUM,					/* 152 */
     INST_RESOLVE_COMMAND,					/* 154 */
-    INST_STRTRIM, INST_STRTRIM_LEFT, INST_STRTRIM_RIGHT,	/* 166-168 */
-    INST_CONCAT_STK						/* 169 */
+    INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT,	/* 166-168 */
+    INST_CONCAT_STK,						/* 169 */
+    INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE		/* 170-172 */
 };
 
 /*
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 2b5e995..da8ffe3 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3341,9 +3341,9 @@ TclInitStringCmd(
 	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{"replace",	StringRplcCmd,	NULL, NULL, NULL, 0},
 	{"reverse",	StringRevCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"tolower",	StringLowerCmd,	TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
-	{"toupper",	StringUpperCmd,	TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
-	{"totitle",	StringTitleCmd,	TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+	{"tolower",	StringLowerCmd,	TclCompileStringToLowerCmd, NULL, NULL, 0},
+	{"toupper",	StringUpperCmd,	TclCompileStringToUpperCmd, NULL, NULL, 0},
+	{"totitle",	StringTitleCmd,	TclCompileStringToTitleCmd, NULL, NULL, 0},
 	{"trim",	StringTrimCmd,	TclCompileStringTrimCmd, NULL, NULL, 0},
 	{"trimleft",	StringTrimLCmd,	TclCompileStringTrimLCmd, NULL, NULL, 0},
 	{"trimright",	StringTrimRCmd,	TclCompileStringTrimRCmd, NULL, NULL, 0},
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index a02f0a8..50fb8e9 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -33,7 +33,7 @@ static int		IndexTailVarIfKnown(Tcl_Interp *interp,
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileLinsertCmd --
+ * GetIndexFromToken --
  *
  *	Parse a token and get the encoded version of the index (as understood
  *	by TEBC), assuming it is at all knowable at compile time. Only handles
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 646adf3..ca4b316 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -101,6 +101,59 @@ const AuxDataType tclJumptableInfoType = {
     if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
 #define INVOKE(name) \
     TclEmitInvoke(envPtr,INST_##name)
+
+#define INDEX_END	(-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ *	Parse a token and get the encoded version of the index (as understood
+ *	by TEBC), assuming it is at all knowable at compile time. Only handles
+ *	indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ *	Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+    Tcl_Token *tokenPtr,
+    int *index)
+{
+    Tcl_Obj *tmpObj = Tcl_NewObj();
+    int result, idx;
+
+    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+	Tcl_DecrRefCount(tmpObj);
+	return TCL_ERROR;
+    }
+
+    result = TclGetIntFromObj(NULL, tmpObj, &idx);
+    if (result == TCL_OK) {
+	if (idx < 0) {
+	    result = TCL_ERROR;
+	}
+    } else {
+	result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+	if (result == TCL_OK && idx > INDEX_END) {
+	    result = TCL_ERROR;
+	}
+    }
+    Tcl_DecrRefCount(tmpObj);
+
+    if (result == TCL_OK) {
+	*index = idx;
+    }
+
+    return result;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -565,8 +618,7 @@ TclCompileStringRangeCmd(
 {
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr;
-    Tcl_Obj *tmpObj;
-    int idx1, idx2, result;
+    int idx1, idx2;
 
     if (parsePtr->numWords != 4) {
 	return TCL_ERROR;
@@ -576,50 +628,13 @@ TclCompileStringRangeCmd(
     toTokenPtr = TokenAfter(fromTokenPtr);
 
     /*
-     * Parse the first index. Will only compile if it is constant and not an
-     * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
+     * Parse the two indices.
      */
 
-    tmpObj = Tcl_NewObj();
-    result = TCL_ERROR;
-    if (TclWordKnownAtCompileTime(fromTokenPtr, tmpObj)) {
-	if (TclGetIntFromObj(NULL, tmpObj, &idx1) == TCL_OK) {
-	    if (idx1 >= 0) {
-		result = TCL_OK;
-	    }
-	} else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx1) == TCL_OK) {
-	    if (idx1 <= -2) {
-		result = TCL_OK;
-	    }
-	}
-    }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
+    if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) {
 	goto nonConstantIndices;
     }
-
-    /*
-     * Parse the second index. Will only compile if it is constant and not an
-     * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
-     */
-
-    tmpObj = Tcl_NewObj();
-    result = TCL_ERROR;
-    if (TclWordKnownAtCompileTime(toTokenPtr, tmpObj)) {
-	if (TclGetIntFromObj(NULL, tmpObj, &idx2) == TCL_OK) {
-	    if (idx2 >= 0) {
-		result = TCL_OK;
-	    }
-	} else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx2) == TCL_OK) {
-	    if (idx2 <= -2) {
-		result = TCL_OK;
-	    }
-	}
-    }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
+    if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) {
 	goto nonConstantIndices;
     }
 
@@ -698,7 +713,7 @@ TclCompileStringTrimLCmd(
     } else {
 	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
     }
-    OP(			STRTRIM_LEFT);
+    OP(			STR_TRIM_LEFT);
     return TCL_OK;
 }
 
@@ -726,7 +741,7 @@ TclCompileStringTrimRCmd(
     } else {
 	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
     }
-    OP(			STRTRIM_RIGHT);
+    OP(			STR_TRIM_RIGHT);
     return TCL_OK;
 }
 
@@ -754,7 +769,73 @@ TclCompileStringTrimCmd(
     } else {
 	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
     }
-    OP(			STRTRIM);
+    OP(			STR_TRIM);
+    return TCL_OK;
+}
+
+int
+TclCompileStringToUpperCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    OP(			STR_UPPER);
+    return TCL_OK;
+}
+
+int
+TclCompileStringToLowerCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    OP(			STR_LOWER);
+    return TCL_OK;
+}
+
+int
+TclCompileStringToTitleCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    OP(			STR_TITLE);
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 280bf64..48165e6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -566,6 +566,19 @@ InstructionDesc const tclInstructionTable[] = {
 	 * is number of values to concatenate.
 	 * Operation:	push concat(stk1 stk2 ... stktop) */
 
+    {"strUpper",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* [string toupper] core: converts whole string to upper case using
+	 * the default (extended "C" locale) rules.
+	 * Stack: ... string => ... newString */
+    {"strLower",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* [string tolower] core: converts whole string to upper case using
+	 * the default (extended "C" locale) rules.
+	 * Stack: ... string => ... newString */
+    {"strTitle",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* [string totitle] core: converts whole string to upper case using
+	 * the default (extended "C" locale) rules.
+	 * Stack: ... string => ... newString */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 4ae754c..1d21d39 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -769,14 +769,18 @@ typedef struct ByteCode {
 #define INST_EXPAND_DROP		165
 
 /* For compilation of [string trim] and related */
-#define INST_STRTRIM			166
-#define INST_STRTRIM_LEFT		167
-#define INST_STRTRIM_RIGHT		168
+#define INST_STR_TRIM			166
+#define INST_STR_TRIM_LEFT		167
+#define INST_STR_TRIM_RIGHT		168
 
 #define INST_CONCAT_STK			169
 
+#define INST_STR_UPPER			170
+#define INST_STR_LOWER			171
+#define INST_STR_TITLE			172
+
 /* The last opcode */
-#define LAST_INST_OPCODE		169
+#define LAST_INST_OPCODE		172
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index cb6afaf..3889ce0 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5002,6 +5002,55 @@ TEBCresume(
 	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
 	NEXT_INST_F(1, 1, 1);
 
+    case INST_STR_UPPER:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.25s\" => ", O2S(valuePtr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    s1 = TclGetStringFromObj(valuePtr, &length);
+	    TclNewStringObj(objResultPtr, s1, length);
+	    length = Tcl_UtfToUpper(TclGetString(objResultPtr));
+	    Tcl_SetObjLength(objResultPtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    length = Tcl_UtfToUpper(TclGetString(valuePtr));
+	    Tcl_SetObjLength(valuePtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
+	}
+    case INST_STR_LOWER:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.25s\" => ", O2S(valuePtr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    s1 = TclGetStringFromObj(valuePtr, &length);
+	    TclNewStringObj(objResultPtr, s1, length);
+	    length = Tcl_UtfToLower(TclGetString(objResultPtr));
+	    Tcl_SetObjLength(objResultPtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    length = Tcl_UtfToLower(TclGetString(valuePtr));
+	    Tcl_SetObjLength(valuePtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
+	}
+    case INST_STR_TITLE:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.25s\" => ", O2S(valuePtr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    s1 = TclGetStringFromObj(valuePtr, &length);
+	    TclNewStringObj(objResultPtr, s1, length);
+	    length = Tcl_UtfToTitle(TclGetString(objResultPtr));
+	    Tcl_SetObjLength(objResultPtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    length = Tcl_UtfToTitle(TclGetString(valuePtr));
+	    Tcl_SetObjLength(valuePtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
+	}
+
     case INST_STR_INDEX:
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
@@ -5271,7 +5320,7 @@ TEBCresume(
 	const char *string1, *string2;
 	int trim1, trim2;
 
-    case INST_STRTRIM:
+    case INST_STR_TRIM:
 	valuePtr = OBJ_UNDER_TOS;	/* String */
 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
 	string2 = TclGetStringFromObj(value2Ptr, &length2);
@@ -5292,7 +5341,7 @@ TEBCresume(
 		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
 	    NEXT_INST_F(1, 2, 1);
 	}
-    case INST_STRTRIM_LEFT:
+    case INST_STR_TRIM_LEFT:
 	valuePtr = OBJ_UNDER_TOS;	/* String */
 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
 	string2 = TclGetStringFromObj(value2Ptr, &length2);
@@ -5308,7 +5357,7 @@ TEBCresume(
 		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
 	    NEXT_INST_F(1, 2, 1);
 	}
-    case INST_STRTRIM_RIGHT:
+    case INST_STR_TRIM_RIGHT:
 	valuePtr = OBJ_UNDER_TOS;	/* String */
 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
 	string2 = TclGetStringFromObj(value2Ptr, &length2);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index cc8469b..6806302 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3620,6 +3620,15 @@ MODULE_SCOPE int	TclCompileStringMatchCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileStringRangeCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringToLowerCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringToTitleCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringToUpperCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileStringTrimCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12


From b5f69350e3ff6666d6077535041901c8d04b3617 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 31 Oct 2013 11:44:37 +0000
Subject: Windows dll's should be executable.

---
 compat/zlib/win32/zlib1.dll | Bin
 compat/zlib/win64/zlib1.dll | Bin
 2 files changed, 0 insertions(+), 0 deletions(-)
 mode change 100644 => 100755 compat/zlib/win32/zlib1.dll
 mode change 100644 => 100755 compat/zlib/win64/zlib1.dll

diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll
old mode 100644
new mode 100755
diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll
old mode 100644
new mode 100755
-- 
cgit v0.12


From 498d86acd9ca0d9d7bc004c1c14c19dc332b77a3 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 12 Nov 2013 11:45:04 +0000
Subject: Fix [5425f2c082]: [fconfigure -error] breaks the background
 processing of a pending [socket -async].

---
 tests/socket.test  | 28 ++++++++++++++++++++++++++++
 unix/tclUnixSock.c | 19 ++++++++++++++-----
 2 files changed, 42 insertions(+), 5 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 5542c09..f7e817b 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1841,6 +1841,7 @@ test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
         after cancel $after
         close $client
         close $server
+        unset x
     } -result {{} bye}
 test socket-14.5 {[socket -async] which fails before any connect() can be made} \
     -constraints [list socket supported_any] \
@@ -1850,6 +1851,33 @@ test socket-14.5 {[socket -async] which fails before any connect() can be made}
     } \
     -returnCodes 1 \
     -result {couldn't open socket: cannot assign requested address}
+test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] before the socket is connected} \
+    -constraints [list socket supported_any] \
+    -setup {
+        proc accept {s a p} {
+            puts $s bye
+            close $s
+        }
+        set server [socket -server accept -myaddr 127.0.0.1 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+        set x ""
+    } \
+    -body {
+        set client [socket -async localhost $port]
+        foreach _ {1 2} {
+            lappend x [lindex [fconfigure $client -sockname] 0]
+            lappend x [fconfigure $client -error]
+            update
+        }
+        lappend x [gets $client]
+    } \
+    -cleanup {
+        close $server
+        close $client
+        unset x
+    } \
+    -result [list ::1 "connection refused" 127.0.0.1 "" bye]
+
 ::tcltest::cleanupTests
 flush stdout
 return
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index a6360c2..7ef28d8 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -737,7 +737,10 @@ TcpGetOptionProc(
 
         if (statePtr->status == 0) {
             ret = getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
-                    (char *) &err, &optlen);
+                            (char *) &err, &optlen);
+            if (statePtr->flags & TCP_ASYNC_CONNECT) {
+                statePtr->status = err;
+            }
             if (ret < 0) {
                 err = errno;
             }
@@ -1054,12 +1057,17 @@ CreateClientSocket(
                  */
 
                 optlen = sizeof(int);
-                getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
-                        (char *) &status, &optlen);
-                state->status = status;
+
+                if (state->status == 0) {
+                    getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
+                            (char *) &status, &optlen);
+                    state->status = status;
+                } else {
+                    status = state->status;
+                    state->status = 0;
+                }
             }
 	    if (status == 0) {
-		CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT);
 		goto out;
 	    }
 	}
@@ -1067,6 +1075,7 @@ CreateClientSocket(
 
 out:
 
+    CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT);
     if (async_callback) {
         /*
          * An asynchonous connection has finally succeeded or failed.
-- 
cgit v0.12


From 68a9570548ce0893129ab3c5a19b38bfd3eb99fb Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 12 Nov 2013 13:12:21 +0000
Subject: socket-14.6 only makes sense where both, IPv4 and IPv6 are supported.

---
 tests/socket.test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/socket.test b/tests/socket.test
index f7e817b..51219e6 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1852,7 +1852,7 @@ test socket-14.5 {[socket -async] which fails before any connect() can be made}
     -returnCodes 1 \
     -result {couldn't open socket: cannot assign requested address}
 test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] before the socket is connected} \
-    -constraints [list socket supported_any] \
+    -constraints [list socket supported_inet supported_inet6] \
     -setup {
         proc accept {s a p} {
             puts $s bye
-- 
cgit v0.12


From 729e8b44d736e3ca4af72adb070a8b89cf6fb94e Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 12 Nov 2013 15:43:55 +0000
Subject: [528717] Slight rewording to clarify what the evaluation steps are.

---
 doc/Tcl.n | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/Tcl.n b/doc/Tcl.n
index be0b24d..e868388 100644
--- a/doc/Tcl.n
+++ b/doc/Tcl.n
@@ -28,7 +28,7 @@ First, the Tcl interpreter breaks the command into \fIwords\fR
 and performs substitutions as described below.
 These substitutions are performed in the same way for all
 commands.
-The first word is used to locate a command procedure to
+Secondly, first word is used to locate a command procedure to
 carry out the command, then all of the words of the command are
 passed to the command procedure.
 The command procedure is free to interpret each of its words
-- 
cgit v0.12


From dffcad90e2d661e520f735c824ddff5f1d630ddd Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 12 Nov 2013 15:47:21 +0000
Subject: Grammar check...

---
 doc/Tcl.n | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/Tcl.n b/doc/Tcl.n
index e868388..8b17f93 100644
--- a/doc/Tcl.n
+++ b/doc/Tcl.n
@@ -28,7 +28,7 @@ First, the Tcl interpreter breaks the command into \fIwords\fR
 and performs substitutions as described below.
 These substitutions are performed in the same way for all
 commands.
-Secondly, first word is used to locate a command procedure to
+Secondly, the first word is used to locate a command procedure to
 carry out the command, then all of the words of the command are
 passed to the command procedure.
 The command procedure is free to interpret each of its words
-- 
cgit v0.12


From 1cc85db9fe34f20eb5109b58d4d5bd0d65140129 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 15 Nov 2013 16:13:53 +0000
Subject: Don't leak getaddrinfo() results

---
 win/tclWinSock.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f4d5a90..84a33ea 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1359,10 +1359,10 @@ CreateSocket(
     }
 
   error:
-    if (addrlist == NULL) {
+    if (addrlist != NULL) {
 	freeaddrinfo(addrlist);
     }
-    if (myaddrlist == NULL) {
+    if (myaddrlist != NULL) {
 	freeaddrinfo(myaddrlist);
     }
 
-- 
cgit v0.12


From 4638909b08044425c05cc87efd7713ad9c6be4de Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sat, 16 Nov 2013 20:33:17 +0000
Subject: Map WSAEWOULDBLOCK to EWOULDBLOCK. Suggested by Reinhard Max.

---
 win/tclWinConsole.c | 4 ++--
 win/tclWinError.c   | 2 +-
 win/tclWinPipe.c    | 6 +++---
 win/tclWinSerial.c  | 4 ++--
 win/tclWinSock.c    | 6 +++---
 5 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 65e4aed..0ec22c5 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -800,7 +800,7 @@ ConsoleOutputProc(
 	 * the channel is in non-blocking mode.
 	 */
 
-	errno = EAGAIN;
+	errno = EWOULDBLOCK;
 	goto error;
     }
 
@@ -1079,7 +1079,7 @@ WaitForRead(
 	     * is in non-blocking mode.
 	     */
 
-	    errno = EAGAIN;
+	    errno = EWOULDBLOCK;
 	    return -1;
 	}
 
diff --git a/win/tclWinError.c b/win/tclWinError.c
index 49eeed3..4d3250d 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -292,7 +292,7 @@ static const unsigned char errorTable[] = {
  */
 
 static const unsigned char wsaErrorTable[] = {
-    EAGAIN,		/* WSAEWOULDBLOCK */
+    EWOULDBLOCK,	/* WSAEWOULDBLOCK */
     EINPROGRESS,	/* WSAEINPROGRESS */
     EALREADY,		/* WSAEALREADY */
     ENOTSOCK,		/* WSAENOTSOCK */
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 13caba9..77fc776 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1884,7 +1884,7 @@ PipeClose2Proc(
 		SetEvent(pipePtr->stopWriter);
 
 		if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) {
-		    return EAGAIN;
+		    return EWOULDBLOCK;
 		}
 
 	    } else {
@@ -2161,7 +2161,7 @@ PipeOutputProc(
 	 * the channel is in non-blocking mode.
 	 */
 
-	errno = EAGAIN;
+	errno = EWOULDBLOCK;
 	goto error;
     }
 
@@ -2712,7 +2712,7 @@ WaitForRead(
 	     * is in non-blocking mode.
 	     */
 
-	    errno = EAGAIN;
+	    errno = EWOULDBLOCK;
 	    return -1;
 	}
 
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 75d5ffc..b9c9a9f 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -932,7 +932,7 @@ SerialInputProc(
 		    bufSize = cStat.cbInQue;
 		}
 	    } else {
-		errno = *errorCode = EAGAIN;
+		errno = *errorCode = EWOULDBLOCK;
 		return -1;
 	    }
 	} else {
@@ -1034,7 +1034,7 @@ SerialOutputProc(
 	 * the channel is in non-blocking mode.
 	 */
 
-	errno = EAGAIN;
+	errno = EWOULDBLOCK;
 	goto error1;
     }
 
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 84a33ea..00df85f 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1318,7 +1318,7 @@ CreateSocket(
 		if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
 			== SOCKET_ERROR) {
 		    TclWinConvertError((DWORD) WSAGetLastError());
-		    if (Tcl_GetErrno() != EAGAIN) {
+		    if (Tcl_GetErrno() != EWOULDBLOCK) {
 			goto looperror;
 		    }
 
@@ -1441,7 +1441,7 @@ WaitForSocketEvent(
 	} else if (infoPtr->readyEvents & events) {
 	    break;
 	} else if (infoPtr->flags & SOCKET_ASYNC) {
-	    *errorCodePtr = EAGAIN;
+	    *errorCodePtr = EWOULDBLOCK;
 	    result = 0;
 	    break;
 	}
@@ -1926,7 +1926,7 @@ TcpOutputProc(
 	if (error == WSAEWOULDBLOCK) {
 	    infoPtr->readyEvents &= ~(FD_WRITE);
 	    if (infoPtr->flags & SOCKET_ASYNC) {
-		*errorCodePtr = EAGAIN;
+		*errorCodePtr = EWOULDBLOCK;
 		bytesWritten = -1;
 		break;
 	    }
-- 
cgit v0.12


From 643e5bc24ed7dd6a21ca1a562693d0d9ce4f2651 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 18 Nov 2013 11:00:51 +0000
Subject: Eliminate some redundant Tcl_GetErrno() calls.

---
 generic/tclIOGT.c | 5 +++--
 win/tclWinSock.c  | 5 +++--
 2 files changed, 6 insertions(+), 4 deletions(-)

diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index bfe6a10..825f408 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -661,12 +661,13 @@ TransformInputProc(
 	     * had some data before we report that instead of the request to
 	     * re-try.
 	     */
+		int error = Tcl_GetErrno();
 
-	    if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
+	    if ((error == EAGAIN) && (gotBytes > 0)) {
 		return gotBytes;
 	    }
 
-	    *errorCodePtr = Tcl_GetErrno();
+	    *errorCodePtr = error;
 	    return -1;
 	} else if (read == 0) {
 	    /*
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 00df85f..5ac8f47 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1317,8 +1317,9 @@ CreateSocket(
 
 		if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
 			== SOCKET_ERROR) {
-		    TclWinConvertError((DWORD) WSAGetLastError());
-		    if (Tcl_GetErrno() != EWOULDBLOCK) {
+		    DWORD error = (DWORD) WSAGetLastError();
+		    if (error != WSAEWOULDBLOCK) {
+			TclWinConvertError(error);
 			goto looperror;
 		    }
 
-- 
cgit v0.12


From 5a8572af1f72090ba2d223c007d9803397958c14 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Mon, 18 Nov 2013 12:35:58 +0000
Subject: To prepare for completion of the [socket -async] implementation on
 Windows [13d3af3ad5]:   *  Move the server code from CreateSocket to
 Tcl_OpenTcpServer.   *  Rename CreateSocket to CreateClientSocket.   *  Unify
 the naming convention of socket channels with Unix (sock + hex representation
 of the state/info structure).

---
 win/tclWinSock.c | 368 ++++++++++++++++++++++++++++++-------------------------
 1 file changed, 203 insertions(+), 165 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 5ac8f47..bd993fa 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -74,6 +74,10 @@
 #undef getsockopt
 #undef setsockopt
 
+/* "sock" + a pointer in hex + \0 */
+#define SOCK_CHAN_LENGTH        (4 + sizeof(void *) * 2 + 1)
+#define SOCK_TEMPLATE           "sock%lx"
+
 /*
  * The following variable is used to tell whether this module has been
  * initialized.  If 1, initialization of sockets was successful, if -1 then
@@ -210,8 +214,8 @@ static WNDCLASS windowClass;
  * Static functions defined in this file.
  */
 
-static SocketInfo *	CreateSocket(Tcl_Interp *interp, int port,
-			    const char *host, int server, const char *myaddr,
+static SocketInfo *	CreateClientSocket(Tcl_Interp *interp, int port,
+			    const char *host, const char *myaddr,
 			    int myport, int async);
 static void		InitSockets(void);
 static SocketInfo *	NewSocketInfo(SOCKET socket);
@@ -1101,10 +1105,10 @@ NewSocketInfo(
 /*
  *----------------------------------------------------------------------
  *
- * CreateSocket --
+ * CreateClientSocket --
  *
- *	This function opens a new socket and initializes the SocketInfo
- *	structure.
+ *	This function opens a new client socket and initializes the
+ *	SocketInfo structure.
  *
  * Results:
  *	Returns a new SocketInfo, or NULL with an error in interp.
@@ -1116,12 +1120,10 @@ NewSocketInfo(
  */
 
 static SocketInfo *
-CreateSocket(
+CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
     int port,			/* Port number to open. */
     const char *host,		/* Name of host on which to open port. */
-    int server,			/* 1 if socket should be a server socket, else
-				 * 0 for a client socket. */
     const char *myaddr,		/* Optional client-side address */
     int myport,			/* Optional client-side port */
     int async)			/* If nonzero, connect client socket
@@ -1155,7 +1157,7 @@ CreateSocket(
      * Construct the addresses for each end of the socket.
      */
 
-    if (!TclCreateSocketAddress(interp, &addrlist, host, port, server,
+    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0,
 	    &errorMsg)) {
 	goto error;
     }
@@ -1164,10 +1166,20 @@ CreateSocket(
 	goto error;
     }
 
-    if (server) {
+    for (addrPtr = addrlist; addrPtr != NULL;
+	 addrPtr = addrPtr->ai_next) {
+	for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
+	     myaddrPtr = myaddrPtr->ai_next) {
+	    /*
+	     * No need to try combinations of local and remote addresses
+	     * of different families.
+	     */
 
-	for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
-	    sock = socket(addrPtr->ai_family, SOCK_STREAM, 0);
+	    if (myaddrPtr->ai_family != addrPtr->ai_family) {
+		continue;
+	    }
+
+	    sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
 	    if (sock == INVALID_SOCKET) {
 		TclWinConvertError((DWORD) WSAGetLastError());
 		continue;
@@ -1187,158 +1199,52 @@ CreateSocket(
 	    TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
 
 	    /*
-	     * Make sure we use the same port when opening two server sockets
-	     * for IPv4 and IPv6.
-	     *
-	     * As sockaddr_in6 uses the same offset and size for the port
-	     * member as sockaddr_in, we can handle both through the IPv4 API.
+	     * Try to bind to a local port.
 	     */
 
-	    if (port == 0 && chosenport != 0) {
-		((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
-			htons(chosenport);
+	    if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
+		== SOCKET_ERROR) {
+		TclWinConvertError((DWORD) WSAGetLastError());
+		goto looperror;
 	    }
-
 	    /*
-	     * Bind to the specified port. Note that we must not call
-	     * setsockopt with SO_REUSEADDR because Microsoft allows addresses
-	     * to be reused even if they are still in use.
-	     *
-	     * Bind should not be affected by the socket having already been
-	     * set into nonblocking mode. If there is trouble, this is one
-	     * place to look for bugs.
+	     * Set the socket into nonblocking mode if the connect should
+	     * be done in the background.
 	     */
-
-	    if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
-		    == SOCKET_ERROR) {
+	    if (async && ioctlsocket(sock, (long) FIONBIO, &flag)
+		== SOCKET_ERROR) {
 		TclWinConvertError((DWORD) WSAGetLastError());
-		closesocket(sock);
-		continue;
-	    }
-	    if (port == 0 && chosenport == 0) {
-		address sockname;
-		socklen_t namelen = sizeof(sockname);
-
-		/*
-		 * Synchronize port numbers when binding to port 0 of multiple
-		 * addresses.
-		 */
-
-		if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
-		    chosenport = ntohs(sockname.sa4.sin_port);
-		}
+		goto looperror;
 	    }
 
 	    /*
-	     * Set the maximum number of pending connect requests to the max
-	     * value allowed on each platform (Win32 and Win32s may be
-	     * different, and there may be differences between TCP/IP stacks).
+	     * Attempt to connect to the remote socket.
 	     */
 
-	    if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
-		TclWinConvertError((DWORD) WSAGetLastError());
-		closesocket(sock);
-		continue;
-	    }
-
-	    if (infoPtr == NULL) {
-		/*
-		 * Add this socket to the global list of sockets.
-		 */
-
-		infoPtr = NewSocketInfo(sock);
-
-		/*
-		 * Set up the select mask for connection request events.
-		 */
-
-		infoPtr->selectEvents = FD_ACCEPT;
-		infoPtr->watchEvents |= FD_ACCEPT;
-
-	    } else {
-		AddSocketInfoFd( infoPtr, sock );
-	    }
-	}
-    } else {
-	for (addrPtr = addrlist; addrPtr != NULL;
-		addrPtr = addrPtr->ai_next) {
-	    for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
-		    myaddrPtr = myaddrPtr->ai_next) {
-		/*
-		 * No need to try combinations of local and remote addresses
-		 * of different families.
-		 */
-
-		if (myaddrPtr->ai_family != addrPtr->ai_family) {
-		    continue;
-		}
-
-		sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
-		if (sock == INVALID_SOCKET) {
-		    TclWinConvertError((DWORD) WSAGetLastError());
-		    continue;
-		}
-
-		/*
-		 * Win-NT has a misfeature that sockets are inherited in child
-		 * processes by default. Turn off the inherit bit.
-		 */
-
-		SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
-
-		/*
-		 * Set kernel space buffering
-		 */
-
-		TclSockMinimumBuffers((void *) sock, TCP_BUFFER_SIZE);
-
-		/*
-		 * Try to bind to a local port.
-		 */
-
-		if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
-			== SOCKET_ERROR) {
-		    TclWinConvertError((DWORD) WSAGetLastError());
+	    if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+		== SOCKET_ERROR) {
+		DWORD error = (DWORD) WSAGetLastError();
+		if (error != WSAEWOULDBLOCK) {
+		    TclWinConvertError(error);
 		    goto looperror;
 		}
+		
 		/*
-		 * Set the socket into nonblocking mode if the connect should
-		 * be done in the background.
+		 * The connection is progressing in the background.
 		 */
-		if (async && ioctlsocket(sock, (long) FIONBIO, &flag)
-			== SOCKET_ERROR) {
-		    TclWinConvertError((DWORD) WSAGetLastError());
-		    goto looperror;
-		}
-
-		/*
-		 * Attempt to connect to the remote socket.
-		 */
-
-		if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
-			== SOCKET_ERROR) {
-		    DWORD error = (DWORD) WSAGetLastError();
-		    if (error != WSAEWOULDBLOCK) {
-			TclWinConvertError(error);
-			goto looperror;
-		    }
-
-		    /*
-		     * The connection is progressing in the background.
-		     */
 
-		    asyncConnect = 1;
-		}
-		goto connected;
-
-	    looperror:
-		if (sock != INVALID_SOCKET) {
-		    closesocket(sock);
-		    sock = INVALID_SOCKET;
-		}
+		asyncConnect = 1;
+	    }
+	    goto connected;
+	    
+	looperror:
+	    if (sock != INVALID_SOCKET) {
+		closesocket(sock);
+		sock = INVALID_SOCKET;
 	    }
 	}
-	goto error;
+    }
+    goto error;
 
     connected:
 	/*
@@ -1357,7 +1263,6 @@ CreateSocket(
 	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
 	    infoPtr->selectEvents |= FD_CONNECT;
 	}
-    }
 
   error:
     if (addrlist != NULL) {
@@ -1496,12 +1401,12 @@ Tcl_OpenTcpClient(
      * Create a new client socket and wrap it in a channel.
      */
 
-    infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
+    infoPtr = CreateClientSocket(interp, port, host, myaddr, myport, async);
     if (infoPtr == NULL) {
 	return NULL;
     }
 
-    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
+    sprintf(channelName, SOCK_TEMPLATE, infoPtr);
 
     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
@@ -1564,7 +1469,7 @@ Tcl_MakeTcpClientChannel(
     infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
     SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
 
-    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
+    sprintf(channelName, SOCK_TEMPLATE, infoPtr);
     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
@@ -1598,36 +1503,169 @@ Tcl_OpenTcpServer(
 				 * clients. */
     ClientData acceptProcData)	/* Data for the callback. */
 {
-    SocketInfo *infoPtr;
-    char channelName[16 + TCL_INTEGER_SPACE];
+    SOCKET sock = INVALID_SOCKET;
+    unsigned short chosenport = 0;
+    struct addrinfo *addrPtr;	/* Socket address to listen on. */
+    SocketInfo *infoPtr = NULL;	/* The returned value. */
+    void *addrlist = NULL;
+    char channelName[SOCK_CHAN_LENGTH];
+    u_long flag = 1;		/* Indicates nonblocking mode. */
+    const char *errorMsg = NULL;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
     if (TclpHasSockets(interp) != TCL_OK) {
 	return NULL;
     }
 
     /*
-     * Create a new client socket and wrap it in a channel.
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
      */
 
-    infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
-    if (infoPtr == NULL) {
+    if (!SocketsEnabled()) {
 	return NULL;
     }
 
-    infoPtr->acceptProc = acceptProc;
-    infoPtr->acceptProcData = acceptProcData;
+    /*
+     * Construct the addresses for each end of the socket.
+     */
 
-    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
+    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 1, &errorMsg)) {
+	goto error;
+    }
 
-    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
-	    infoPtr, 0);
-    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
+    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
+	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
+                addrPtr->ai_protocol);
+	if (sock == INVALID_SOCKET) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    continue;
+	}
+	
+	/*
+	 * Win-NT has a misfeature that sockets are inherited in child
+	 * processes by default. Turn off the inherit bit.
+	 */
+	
+	SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
+	
+	/*
+	 * Set kernel space buffering
+	 */
+	
+	TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
+	
+	/*
+	 * Make sure we use the same port when opening two server sockets
+	 * for IPv4 and IPv6.
+	 *
+	 * As sockaddr_in6 uses the same offset and size for the port
+	 * member as sockaddr_in, we can handle both through the IPv4 API.
+	 */
+	
+	if (port == 0 && chosenport != 0) {
+	    ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
+		htons(chosenport);
+	}
+	
+	/*
+	 * Bind to the specified port. Note that we must not call
+	 * setsockopt with SO_REUSEADDR because Microsoft allows addresses
+	 * to be reused even if they are still in use.
+	 *
+	 * Bind should not be affected by the socket having already been
+	 * set into nonblocking mode. If there is trouble, this is one
+	 * place to look for bugs.
+	 */
+	
+	if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+	    == SOCKET_ERROR) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    closesocket(sock);
+	    continue;
+	}
+	if (port == 0 && chosenport == 0) {
+	    address sockname;
+	    socklen_t namelen = sizeof(sockname);
+	    
+	    /*
+	     * Synchronize port numbers when binding to port 0 of multiple
+	     * addresses.
+	     */
+	    
+	    if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
+		chosenport = ntohs(sockname.sa4.sin_port);
+	    }
+	}
+	
+	/*
+	 * Set the maximum number of pending connect requests to the max
+	 * value allowed on each platform (Win32 and Win32s may be
+	 * different, and there may be differences between TCP/IP stacks).
+	 */
+	
+	if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    closesocket(sock);
+	    continue;
+	}
+	
+	if (infoPtr == NULL) {
+	    /*
+	     * Add this socket to the global list of sockets.
+	     */
+	    infoPtr = NewSocketInfo(sock);
+	} else {
+	    AddSocketInfoFd( infoPtr, sock );
+	}
+    }
+
+error:
+     if (addrlist != NULL) {
+	freeaddrinfo(addrlist);
+    }
+
+    if (infoPtr != NULL) {
+
+	infoPtr->acceptProc = acceptProc;
+	infoPtr->acceptProcData = acceptProcData;
+	sprintf(channelName, SOCK_TEMPLATE, infoPtr);
+	infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+					    infoPtr, 0);	
+	/*
+	 * Set up the select mask for connection request events.
+	 */
+	
+	infoPtr->selectEvents = FD_ACCEPT;
+	infoPtr->watchEvents |= FD_ACCEPT;
+	
+	/*
+	 * Register for interest in events in the select mask. Note that this
+	 * automatically places the socket into non-blocking mode.
+	 */
+
+	ioctlsocket(sock, (long) FIONBIO, &flag);
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		    (LPARAM) infoPtr);
+	if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
 	    == TCL_ERROR) {
-	Tcl_Close(NULL, infoPtr->channel);
-	return NULL;
+	    Tcl_Close(NULL, infoPtr->channel);
+	    return NULL;
+	}
+	return infoPtr->channel;
     }
 
-    return infoPtr->channel;
+    if (interp != NULL) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't open socket: %s",
+		(errorMsg ? errorMsg : Tcl_PosixError(interp))));
+    }
+
+    if (sock != INVALID_SOCKET) {
+	closesocket(sock);
+    }
+    return NULL;
 }
 
 /*
@@ -1682,7 +1720,7 @@ TcpAccept(
     SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 	    (LPARAM) newInfoPtr);
 
-    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) newInfoPtr->sockets->fd);
+    sprintf(channelName, SOCK_TEMPLATE, newInfoPtr);
     newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
     if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
-- 
cgit v0.12


From 9b104b7167d18325a28a7e1c3891ce8513249e23 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Mon, 18 Nov 2013 13:32:30 +0000
Subject: Revert [3c0b0bbda6]. If this really is a problem, it needs to get
 fixed by other means than covering behind void pointers.

---
 generic/tclIOSock.c | 4 ++--
 generic/tclInt.h    | 5 +++--
 unix/tclUnixSock.c  | 5 ++---
 win/tclWinSock.c    | 5 ++---
 4 files changed, 9 insertions(+), 10 deletions(-)

diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 7d6c462..694501f 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -139,7 +139,7 @@ int
 TclCreateSocketAddress(
     Tcl_Interp *interp,                 /* Interpreter for querying
 					 * the desired socket family */
-    void **addrlist,		/* Socket address list */
+    struct addrinfo **addrlist,		/* Socket address list */
     const char *host,			/* Host. NULL implies INADDR_ANY */
     int port,				/* Port number */
     int willBind,			/* Is this an address to bind() to or
@@ -213,7 +213,7 @@ TclCreateSocketAddress(
 	hints.ai_flags |= AI_PASSIVE;
     } 
 
-    result = getaddrinfo(native, portstring, &hints, (struct addrinfo **) addrlist);
+    result = getaddrinfo(native, portstring, &hints, addrlist);
 
     if (host != NULL) {
 	Tcl_DStringFree(&ds);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index feea6dd..5c8dbfd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3001,8 +3001,9 @@ MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
 MODULE_SCOPE void	TclpFinalizePipes(void);
 MODULE_SCOPE void	TclpFinalizeSockets(void);
 MODULE_SCOPE int	TclCreateSocketAddress(Tcl_Interp *interp,
-			    void **addrlist, const char *host, int port,
-			    int willBind, const char **errorMsgPtr);
+			    struct addrinfo **addrlist,
+			    const char *host, int port, int willBind,
+			    const char **errorMsgPtr);
 MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
 			    Tcl_ThreadCreateProc *proc, ClientData clientData,
 			    int stackSize, int flags);
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 7ef28d8..49a6460 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -1140,7 +1140,7 @@ Tcl_OpenTcpClient(
 {
     TcpState *state;
     const char *errorMsg = NULL;
-    void *addrlist = NULL, *myaddrlist = NULL;
+    struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
     char channelName[SOCK_CHAN_LENGTH];
 
     /*
@@ -1285,8 +1285,7 @@ Tcl_OpenTcpServer(
     ClientData acceptProcData)	/* Data for the callback. */
 {
     int status = 0, sock = -1, reuseaddr = 1, chosenport = 0;
-    void *addrlist = NULL;
-    struct addrinfo *addrPtr;	/* socket address */
+    struct addrinfo *addrlist = NULL, *addrPtr;	/* socket address */
     TcpState *statePtr = NULL;
     char channelName[SOCK_CHAN_LENGTH];
     const char *errorMsg = NULL;
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 5ac8f47..11b4162 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1131,10 +1131,9 @@ CreateSocket(
     int asyncConnect = 0;	/* Will be 1 if async connect is in
 				 * progress. */
     unsigned short chosenport = 0;
-    void *addrlist = NULL, *myaddrlist = NULL;
-    struct addrinfo *addrPtr;
+    struct addrinfo *addrlist = NULL, *addrPtr;
 				/* Socket address to connect to. */
-    struct addrinfo *myaddrPtr;
+    struct addrinfo *myaddrlist = NULL, *myaddrPtr;
 				/* Socket address for our side. */
     const char *errorMsg = NULL;
     SOCKET sock = INVALID_SOCKET;
-- 
cgit v0.12


From 015b2e6c6503106478c6dd3affa36035264c7482 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 19 Nov 2013 09:09:42 +0000
Subject: Revert [5215b8740c] (Enh [2959069]), as it turns out that
 -fvisibility=hidden only affects definitions and not declarations. Therefore
 explicitely declaring each MODULE_SCOPE function as 
 __attribute__((__visibility__("hidden")) is much better. Suggested by Stuart
 Cassoff (Thanks!).

---
 unix/configure | 83 +++-------------------------------------------------------
 unix/tcl.m4    | 30 +++++----------------
 2 files changed, 10 insertions(+), 103 deletions(-)

diff --git a/unix/configure b/unix/configure
index 06ff7a4..5009807 100755
--- a/unix/configure
+++ b/unix/configure
@@ -6490,80 +6490,6 @@ if test "${tcl_cv_cc_visibility_hidden+set}" = set; then
   echo $ECHO_N "(cached) $ECHO_C" >&6
 else
 
-	    if test "$SHARED_BUILD" = 1; then
-
-		hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror"
-		cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h.  */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h.  */
-
-int
-main ()
-{
-#if !defined(__GNUC__) || __GNUC__ < 4
-#error visibility hidden is not supported for this compiler
-#endif
-
-  ;
-  return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
-  (eval $ac_compile) 2>conftest.er1
-  ac_status=$?
-  grep -v '^ *+' conftest.er1 >conftest.err
-  rm -f conftest.er1
-  cat conftest.err >&5
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); } &&
-	 { ac_try='test -z "$ac_c_werror_flag"
-			 || test ! -s conftest.err'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; } &&
-	 { ac_try='test -s conftest.$ac_objext'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; }; then
-  tcl_cv_cc_visibility_hidden=yes
-else
-  echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cc_visibility_hidden=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-		CFLAGS=$hold_cflags
-
-else
-
-		tcl_cv_cc_visibility_hidden=no
-
-fi
-
-
-fi
-echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5
-echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6
-    if test $tcl_cv_cc_visibility_hidden = yes; then
-
-	CFLAGS="$CFLAGS -fvisibility=hidden"
-
-cat >>confdefs.h <<\_ACEOF
-#define MODULE_SCOPE extern
-_ACEOF
-
-
-else
-
 	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
 	cat >conftest.$ac_ext <<_ACEOF
 /* confdefs.h.  */
@@ -6614,7 +6540,10 @@ fi
 rm -f conftest.err conftest.$ac_objext \
       conftest$ac_exeext conftest.$ac_ext
 	CFLAGS=$hold_cflags
-	if test $tcl_cv_cc_visibility_hidden = yes; then
+fi
+echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5
+echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6
+    if test $tcl_cv_cc_visibility_hidden = yes; then
 
 
 cat >>confdefs.h <<\_ACEOF
@@ -6630,9 +6559,6 @@ _ACEOF
 fi
 
 
-fi
-
-
     # Step 0.d: Disable -rpath support?
 
     echo "$as_me:$LINENO: checking if rpath support is requested" >&5
@@ -8145,7 +8071,6 @@ cat >>confdefs.h <<\_ACEOF
 #define MODULE_SCOPE __private_extern__
 _ACEOF
 
-		tcl_cv_cc_visibility_hidden=yes
 
 fi
 
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 194cf90..e3a0d15 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1045,34 +1045,17 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 
     AC_CACHE_CHECK([if compiler supports visibility "hidden"],
 	tcl_cv_cc_visibility_hidden, [
-	    AS_IF([test "$SHARED_BUILD" = 1], [
-		hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror"
-		AC_TRY_COMPILE(,[#if !defined(__GNUC__) || __GNUC__ < 4
-#error visibility hidden is not supported for this compiler
-#endif
-		], tcl_cv_cc_visibility_hidden=yes,
-		    tcl_cv_cc_visibility_hidden=no)
-		CFLAGS=$hold_cflags
-	    ], [
-		tcl_cv_cc_visibility_hidden=no
-	    ])
-    ])
-    AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [
-	CFLAGS="$CFLAGS -fvisibility=hidden"
-	AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])
-    ], [
 	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
 	AC_TRY_LINK([
 	    extern __attribute__((__visibility__("hidden"))) void f(void);
 	    void f(void) {}], [f();], tcl_cv_cc_visibility_hidden=yes,
 	    tcl_cv_cc_visibility_hidden=no)
-	CFLAGS=$hold_cflags
-	AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [
-	    AC_DEFINE(MODULE_SCOPE,
-		[extern __attribute__((__visibility__("hidden")))],
-		[Compiler support for module scope symbols])
-	    AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols])
-	])
+	CFLAGS=$hold_cflags])
+    AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [
+	AC_DEFINE(MODULE_SCOPE,
+	    [extern __attribute__((__visibility__("hidden")))],
+	    [Compiler support for module scope symbols])
+	AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols])
     ])
 
     # Step 0.d: Disable -rpath support?
@@ -1638,7 +1621,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	    AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
 		AC_DEFINE(MODULE_SCOPE, [__private_extern__],
 		    [Compiler support for module scope symbols])
-		tcl_cv_cc_visibility_hidden=yes
 	    ])
 	    CC_SEARCH_FLAGS=""
 	    LD_SEARCH_FLAGS=""
-- 
cgit v0.12


From 292a07fb1ed3636070430bbcda1f350629eba5e2 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 19 Nov 2013 11:50:03 +0000
Subject: Some formatting

---
 unix/tcl.m4 | 22 ++++++++++------------
 win/tcl.m4  |  2 +-
 2 files changed, 11 insertions(+), 13 deletions(-)

diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 687866e..8c29334 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -111,9 +111,9 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [
 			`ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \
 			`ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do
 		    if test -f "$i/unix/tclConfig.sh" ; then
-		    ac_cv_c_tclconfig="`(cd $i/unix; pwd)`"
-		    break
-		fi
+			ac_cv_c_tclconfig="`(cd $i/unix; pwd)`"
+			break
+		    fi
 		done
 	    fi
 	])
@@ -271,11 +271,10 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
 #
 # Results:
 #
-#	Subst the following vars:
+#	Substitutes the following vars:
 #		TCL_BIN_DIR
 #		TCL_SRC_DIR
 #		TCL_LIB_FILE
-#
 #------------------------------------------------------------------------
 
 AC_DEFUN([SC_LOAD_TCLCONFIG], [
@@ -439,11 +438,11 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [
 #	extension can't assume that an executable Tcl shell exists at
 #	build time.
 #
-# Arguments
+# Arguments:
 #	none
 #
-# Results
-#	Subst's the following values:
+# Results:
+#	Substitutes the following vars:
 #		TCLSH_PROG
 #------------------------------------------------------------------------
 
@@ -484,11 +483,11 @@ AC_DEFUN([SC_PROG_TCLSH], [
 #	when running tests from an extension build directory. It is not
 #	correct to use the TCLSH_PROG in cases like this.
 #
-# Arguments
+# Arguments:
 #	none
 #
-# Results
-#	Subst's the following values:
+# Results:
+#	Substitutes the following values:
 #		BUILD_TCLSH
 #------------------------------------------------------------------------
 
@@ -790,7 +789,6 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [
 #
 #	Defines the following vars:
 #		HAVE_LANGINFO	Triggers use of nl_langinfo if defined.
-#
 #------------------------------------------------------------------------
 
 AC_DEFUN([SC_ENABLE_LANGINFO], [
diff --git a/win/tcl.m4 b/win/tcl.m4
index 52c001f..625c329 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -247,7 +247,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
 #
 # Results:
 #
-#	Subst the following vars:
+#	Substitutes the following vars:
 #		TCL_BIN_DIR
 #		TCL_SRC_DIR
 #		TCL_LIB_FILE
-- 
cgit v0.12


From df9709eef5f83bb6070ddb864f042cf9daff7d96 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 20 Nov 2013 11:20:32 +0000
Subject: Bug Fix: EnvTraceProc() MUST always return NULL to indicate success.

---
 generic/tclEnv.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 6a21947..7c49d44 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -614,7 +614,7 @@ EnvTraceProc(
 	const char *value = TclGetEnv(name2, &valueString);
 
 	if (value == NULL) {
-	    return (char *) "no such variable";
+	    return NULL;
 	}
 	Tcl_SetVar2(interp, name1, name2, value, 0);
 	Tcl_DStringFree(&valueString);
-- 
cgit v0.12


From 960a377fd1879082dbe0266533202d47cfdd5683 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 20 Nov 2013 11:34:29 +0000
Subject: ... and don't break env-5.3 and env-5.5 test-cases.

---
 generic/tclEnv.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 7c49d44..8f51c1b 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -614,6 +614,7 @@ EnvTraceProc(
 	const char *value = TclGetEnv(name2, &valueString);
 
 	if (value == NULL) {
+	    Tcl_UnsetVar2(interp, name1, name2, 0);
 	    return NULL;
 	}
 	Tcl_SetVar2(interp, name1, name2, value, 0);
-- 
cgit v0.12


From 0be4102b2ac1be2e1d9d7960aa33308bdf206b02 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 20 Nov 2013 12:58:35 +0000
Subject: Fix env-5.1 test-case on Cygwin (and probably other platforms which
 don't have iso8859-1 as system-encoding)

---
 tests/env.test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/env.test b/tests/env.test
index 8115652..83d99e0 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -218,8 +218,8 @@ test env-4.5 {unsetting international environment variables} -setup {
     unset env(\ua7)
     getenv
 } -constraints {exec} -cleanup {
-    encoding system $sysenc
     unset env(\ub6)
+    encoding system $sysenc
 } -result {\u00b6=\u00a7}
 
 test env-5.0 {corner cases - set a value, it should exist} -body {
-- 
cgit v0.12


From da13f6ea8ce3f01699903c9125b1f90ad0ae2189 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 22 Nov 2013 13:21:52 +0000
Subject: revert accidental part of previous commit

---
 generic/regcustom.h | 4 ----
 generic/regex.h     | 4 ----
 2 files changed, 8 deletions(-)

diff --git a/generic/regcustom.h b/generic/regcustom.h
index d907ca7..1c970ea 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -74,11 +74,7 @@
 #endif
 /* Interface types */
 #define	__REG_WIDE_T	Tcl_UniChar
-#ifdef __CYGWIN__
-#define	__REG_REGOFF_T	int 	/* Not really right, but good enough... */
-#else
 #define	__REG_REGOFF_T	long	/* Not really right, but good enough... */
-#endif
 #define	__REG_VOID_T	void
 #define	__REG_CONST	const
 /* Names and declarations */
diff --git a/generic/regex.h b/generic/regex.h
index 4422f2a..9466fbb 100644
--- a/generic/regex.h
+++ b/generic/regex.h
@@ -106,11 +106,7 @@ extern "C" {
 #endif
 /* interface types */
 #define	__REG_WIDE_T	Tcl_UniChar
-#ifdef __CYGWIN__
-#define	__REG_REGOFF_T	int 	/* not really right, but good enough... */
-#else
 #define	__REG_REGOFF_T	long	/* not really right, but good enough... */
-#endif
 #define	__REG_VOID_T	void
 #define	__REG_CONST	const
 /* names and declarations */
-- 
cgit v0.12


From 8f8438c53e0a086672a12fec00764d770323caed Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 5 Dec 2013 15:15:23 +0000
Subject: New compiler and bytecodes for foreach and lmap: 70% faster

   * speed as measured by http://wiki.tcl.tk/39021: runs in <1/3 the time

   * still need to adapt array-set to use this

   * assemble.test-16.5 or 16.6 bombs in a purify/symbols build (?)

   * removing the old opcodes would force recompilation of old .tbc files or adaptation of tbcload
---
 generic/tcl.h         |   4 ++
 generic/tclCompCmds.c | 131 ++++++++++-----------------------------
 generic/tclCompile.c  |  10 +++
 generic/tclCompile.h  |  12 +++-
 generic/tclExecute.c  | 168 +++++++++++++++++++++++++++++++++++++++++++++++++-
 5 files changed, 220 insertions(+), 105 deletions(-)

diff --git a/generic/tcl.h b/generic/tcl.h
index 4bf81cc..aab299e 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -848,6 +848,10 @@ typedef struct Tcl_Obj {
 	    void *ptr;
 	    unsigned long value;
 	} ptrAndLongRep;
+	struct {
+	    long int1;
+	    long int2;
+	} twoIntValue;
     } internalRep;
 } Tcl_Obj;
 
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 9c43bfe..e934d92 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2469,18 +2469,12 @@ CompileEachloopCmd(
     ForeachInfo *infoPtr;	/* Points to the structure describing this
 				 * foreach command. Stored in a AuxData
 				 * record in the ByteCode. */
-    int firstValueTemp;		/* Index of the first temp var in the frame
-				 * used to point to a value list. */
-    int loopCtTemp;		/* Index of temp var holding the loop's
-				 * iteration count. */
     int collectVar = -1;	/* Index of temp var holding the result var
 				 * index. */
-
+    
     Tcl_Token *tokenPtr, *bodyTokenPtr;
-    unsigned char *jumpPc;
-    JumpFixup jumpFalseFixup;
-    int jumpBackDist, jumpBackOffset, infoIndex, range;
-    int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
+    int jumpBackOffset, infoIndex, range;
+    int numWords, numLists, numVars, loopIndex, i, j, code;
     DefineLineInformation;	/* TIP #280 */
 
     /*
@@ -2588,6 +2582,10 @@ CompileEachloopCmd(
 	loopIndex++;
     }
 
+    /*
+     * We will compile the foreach command.
+     */
+
     if (collect == TCL_EACH_COLLECT) {
 	collectVar = AnonymousLocal(envPtr);
 	if (collectVar < 0) {
@@ -2595,25 +2593,7 @@ CompileEachloopCmd(
 	}
     }
 	    
-    /*
-     * We will compile the foreach command. Reserve (numLists + 1) temporary
-     * variables:
-     *    - numLists temps to hold each value list
-     *    - 1 temp for the loop counter (index of next element in each list)
-     *
-     * At this time we don't try to reuse temporaries; if there are two
-     * nonoverlapping foreach loops, they don't share any temps.
-     */
-
     code = TCL_OK;
-    firstValueTemp = -1;
-    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-	tempVar = AnonymousLocal(envPtr);
-	if (loopIndex == 0) {
-	    firstValueTemp = tempVar;
-	}
-    }
-    loopCtTemp = AnonymousLocal(envPtr);
 
     /*
      * Create and initialize the ForeachInfo and ForeachVarList data
@@ -2624,8 +2604,8 @@ CompileEachloopCmd(
     infoPtr = ckalloc(sizeof(ForeachInfo)
 	    + numLists * sizeof(ForeachVarList *));
     infoPtr->numLists = numLists;
-    infoPtr->firstValueTemp = firstValueTemp;
-    infoPtr->loopCtTemp = loopCtTemp;
+    infoPtr->firstValueTemp = collect;
+    infoPtr->loopCtTemp = 0;
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
 	ForeachVarList *varListPtr;
 
@@ -2645,25 +2625,14 @@ CompileEachloopCmd(
     infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
 
     /*
-     * Create an exception record to handle [break] and [continue].
+     * Evaluate each value list and leave it on stack.
      */
 
-    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
-
-    /*
-     * Evaluate then store each value list in the associated temporary.
-     */
-
-    loopIndex = 0;
     for (i = 0, tokenPtr = parsePtr->tokenPtr;
 	    i < numWords-1;
 	    i++, tokenPtr = TokenAfter(tokenPtr)) {
 	if ((i%2 == 0) && (i > 0)) {
 	    CompileWord(envPtr, tokenPtr, interp, i);
-	    tempVar = (firstValueTemp + loopIndex);
-	    Emit14Inst(		INST_STORE_SCALAR, tempVar,	envPtr);
-	    TclEmitOpcode(	INST_POP,			envPtr);
-	    loopIndex++;
 	}
     }
 
@@ -2677,81 +2646,43 @@ CompileEachloopCmd(
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
-    /*
-     * Initialize the temporary var that holds the count of loop iterations.
-     */
-
-    TclEmitInstInt4(		INST_FOREACH_START4, infoIndex,	envPtr);
-
-    /*
-     * Top of loop code: assign each loop variable and check whether
-     * to terminate the loop.
-     */
-
-    ExceptionRangeTarget(envPtr, range, continueOffset);
-    TclEmitInstInt4(		INST_FOREACH_STEP4, infoIndex,	envPtr);
-    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-
+    TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
+    
     /*
      * Inline compile the loop body.
      */
 
+    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
+
     ExceptionRangeStarts(envPtr, range);
     BODY(bodyTokenPtr, numWords - 1);
     ExceptionRangeEnds(envPtr, range);
-
+    
     if (collect == TCL_EACH_COLLECT) {
 	Emit14Inst(		INST_LAPPEND_SCALAR, collectVar,envPtr);
     }
     TclEmitOpcode(		INST_POP,			envPtr);
 
     /*
-     * Jump back to the test at the top of the loop. Generate a 4 byte jump if
-     * the distance to the test is > 120 bytes. This is conservative and
-     * ensures that we won't have to replace this jump if we later need to
-     * replace the ifFalse jump with a 4 byte jump.
+     * Bottom of loop code: assign each loop variable and check whether
+     * to terminate the loop. Set the loop's break target. 
      */
 
-    jumpBackOffset = CurrentOffset(envPtr);
-    jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset;
-    if (jumpBackDist > 120) {
-	TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
-    } else {
-	TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
-    }
-
-    /*
-     * Fix the target of the jump after the foreach_step test.
-     */
-
-    if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) {
-	/*
-	 * Update the loop body's starting PC offset since it moved down.
-	 */
-
-	envPtr->exceptArrayPtr[range].codeOffset += 3;
-
-	/*
-	 * Update the jump back to the test at the top of the loop since it
-	 * also moved down 3 bytes.
-	 */
-
-	jumpBackOffset += 3;
-	jumpPc = (envPtr->codeStart + jumpBackOffset);
-	jumpBackDist += 3;
-	if (jumpBackDist > 120) {
-	    TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
-	} else {
-	    TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
-	}
-    }
+    ExceptionRangeTarget(envPtr, range, continueOffset);
+    TclEmitOpcode(INST_FOREACH_STEP, envPtr);
+    ExceptionRangeTarget(envPtr, range, breakOffset);
+    TclFinalizeLoopExceptionRange(envPtr, range);
+    TclEmitOpcode(INST_FOREACH_END, envPtr);
+    TclAdjustStackDepth(-(numLists+2), envPtr);
 
     /*
-     * Set the loop's break target.
+     * Set the jumpback distance from INST_FOREACH_STEP to the start of the
+     * body's code
      */
-
-    ExceptionRangeTarget(envPtr, range, breakOffset);
-    TclFinalizeLoopExceptionRange(envPtr, range);
+    
+    jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
+	    envPtr->exceptArrayPtr[range].codeOffset;
+    infoPtr->loopCtTemp = -jumpBackOffset;
 
     /*
      * The command's result is an empty string if not collecting, or the
@@ -2765,8 +2696,8 @@ CompileEachloopCmd(
     } else {
 	PushStringLiteral(envPtr, "");
     }
-
-  done:
+    
+    done:
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
 	if (varvList[loopIndex] != NULL) {
 	    ckfree(varvList[loopIndex]);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 3c8e4ef..7cd9796 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -545,6 +545,16 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Drops an element from the auxiliary stack, popping stack elements
 	 * until the matching stack depth is reached. */
 
+    /* New foreach implementation */
+    {"foreach_start",	  5,   +2,          1,	{OPERAND_AUX4}},
+	/* Initialize execution of a foreach loop. Operand is aux data index
+	 * of the ForeachInfo structure for the foreach command. It pushes 2
+	 * elements which hold runtime params for foreach_step, they are later
+	 * dropped by foreach_end together with the value lists. */ 
+    {"foreach_step",	  1,    0,         0,	{OPERAND_NONE}},
+	/* "Step" or begin next iteration of foreach loop. */
+    {"foreach_end",	  1,    0,         0,	{OPERAND_NONE}},
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index a39e0f1..c4e6222 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -586,8 +586,8 @@ typedef struct ByteCode {
 #define INST_CONTINUE			66
 
 /* Opcodes 67 to 68 */
-#define INST_FOREACH_START4		67
-#define INST_FOREACH_STEP4		68
+#define INST_FOREACH_START4		67 /* DEPRECATED */
+#define INST_FOREACH_STEP4		68 /* DEPRECATED */
 
 /* Opcodes 69 to 72 */
 #define INST_BEGIN_CATCH4		69
@@ -768,8 +768,14 @@ typedef struct ByteCode {
 
 #define INST_EXPAND_DROP		165
 
+/* New foreach implementation */
+
+#define INST_FOREACH_START              166
+#define INST_FOREACH_STEP               167
+#define INST_FOREACH_END                168
+
 /* The last opcode */
-#define LAST_INST_OPCODE		165
+#define LAST_INST_OPCODE		168
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d3c1227..32b64a2 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6029,7 +6029,7 @@ TEBCresume(
 	int varIndex, valIndex, continueLoop, j, iterTmpIndex;
 	long i;
 
-    case INST_FOREACH_START4:
+    case INST_FOREACH_START4: /* DEPRECATED */
 	/*
 	 * Initialize the temporary local var that holds the count of the
 	 * number of iterations of the loop body to -1.
@@ -6062,7 +6062,7 @@ TEBCresume(
 	NEXT_INST_F(5, 0, 0);
 #endif
 
-    case INST_FOREACH_STEP4:
+    case INST_FOREACH_STEP4: /* DEPRECATED */
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
 	 * the next value list element to each loop var.
@@ -6180,6 +6180,170 @@ TEBCresume(
 	} else {
 	    NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
 	}
+
+    }
+    {
+	ForeachInfo *infoPtr;
+	Tcl_Obj *listPtr, **elements, *tmpPtr;
+	ForeachVarList *varListPtr;
+	int numLists, iterMax, listLen, numVars;
+	int iterTmp, iterNum, listTmpDepth;
+	int varIndex, valIndex, j;
+	long i;
+
+    case INST_FOREACH_START:
+	/*
+	 * Initialize the data for the looping construct, pushing the
+	 * corresponding Tcl_Objs to the stack.
+	 */
+
+	
+	opnd = TclGetUInt4AtPtr(pc+1);
+	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
+	numLists = infoPtr->numLists;
+
+	/*
+	 * Compute the number of iterations that will be run: iterMax
+	 */
+
+	iterMax = 0;
+	listTmpDepth = numLists-1;
+	for (i = 0;  i < numLists;  i++) {
+	    varListPtr = infoPtr->varLists[i];
+	    numVars = varListPtr->numVars;
+	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
+	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
+		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
+			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
+		goto gotError;
+	    }
+	    if (Tcl_IsShared(listPtr)) {
+		objPtr = TclListObjCopy(NULL, listPtr);
+		Tcl_IncrRefCount(objPtr);
+		Tcl_DecrRefCount(listPtr);
+		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
+	    }
+	    iterTmp = (listLen + (numVars - 1))/numVars;
+	    if (iterTmp > iterMax) {
+		iterMax = iterTmp;
+	    }
+	    listTmpDepth--;
+	}
+	
+	/*
+	 * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
+	 * nul-string obj with the pointer stored in the ptrValue so that the
+	 * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but
+	 * it will never leave this scope and is read-only.
+	 */
+
+	TclNewObj(tmpPtr);
+	tmpPtr->internalRep.twoIntValue.int1 = 0;
+	tmpPtr->internalRep.twoIntValue.int2 = iterMax;
+	PUSH_OBJECT(tmpPtr); /* iterCounts object */
+		
+	/*
+	 * Store a pointer to the ForeachInfo struct; same dirty trick
+	 * as above 
+	 */
+	
+	TclNewObj(tmpPtr);
+	tmpPtr->internalRep.otherValuePtr = infoPtr;
+	PUSH_OBJECT(tmpPtr); /* infoPtr object */
+
+	/*
+	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
+	 * falls through.
+	 */ 
+
+	pc += 5 - infoPtr->loopCtTemp;
+	
+    case INST_FOREACH_STEP:
+	/*
+	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
+	 * the next value list element to each loop var.
+	 */
+
+	tmpPtr = OBJ_AT_TOS;
+	infoPtr = tmpPtr->internalRep.otherValuePtr;
+	numLists = infoPtr->numLists;
+
+	tmpPtr = OBJ_AT_DEPTH(1);
+	iterNum = tmpPtr->internalRep.twoIntValue.int1;
+	iterMax = tmpPtr->internalRep.twoIntValue.int2;
+
+	/*
+	 * If some list still has a remaining list element iterate one more
+	 * time. Assign to var the next element from its value list.
+	 */
+	    
+	if (iterNum < iterMax) {
+	    /*
+	     * Set the variables and jump back to run the body
+	     */
+
+	    tmpPtr->internalRep.twoIntValue.int1 = iterNum + 1;
+	    
+	    listTmpDepth = numLists + 1;
+
+	    for (i = 0;  i < numLists;  i++) {
+		varListPtr = infoPtr->varLists[i];
+		numVars = varListPtr->numVars;
+
+		listPtr = OBJ_AT_DEPTH(listTmpDepth);
+		TclListObjGetElements(interp, listPtr, &listLen, &elements);
+
+		valIndex = (iterNum * numVars);
+		for (j = 0;  j < numVars;  j++) {
+		    if (valIndex >= listLen) {
+			TclNewObj(valuePtr);
+		    } else {
+			valuePtr = elements[valIndex];
+		    }
+
+		    varIndex = varListPtr->varIndexes[j];
+		    varPtr = LOCAL(varIndex);
+		    while (TclIsVarLink(varPtr)) {
+			varPtr = varPtr->value.linkPtr;
+		    }
+		    if (TclIsVarDirectWritable(varPtr)) {
+			value2Ptr = varPtr->value.objPtr;
+			if (valuePtr != value2Ptr) {
+			    if (value2Ptr != NULL) {
+				TclDecrRefCount(value2Ptr);
+			    }
+			    varPtr->value.objPtr = valuePtr;
+			    Tcl_IncrRefCount(valuePtr);
+			}
+		    } else {
+			DECACHE_STACK_INFO();
+			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
+				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
+			    CACHE_STACK_INFO();
+			    TRACE_WITH_OBJ((
+				    "%u => ERROR init. index temp %d: ",
+				    opnd,varIndex), Tcl_GetObjResult(interp));
+			    goto gotError;
+			}
+			CACHE_STACK_INFO();
+		    }
+		    valIndex++;
+		}
+		listTmpDepth--;
+	    }
+	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
+	}
+
+	/*
+	 * FALL THROUGH
+	 */
+	pc++;
+
+    case INST_FOREACH_END:
+	tmpPtr = OBJ_AT_TOS;
+	infoPtr = tmpPtr->internalRep.otherValuePtr;
+	numLists = infoPtr->numLists;
+	NEXT_INST_V(1, numLists+2, 0);
     }
 
     case INST_BEGIN_CATCH4:
-- 
cgit v0.12


From 631b9c724ec78675e289d7f1dec92dc7d5165fc2 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 5 Dec 2013 16:01:16 +0000
Subject: add comments on field "misuse"

---
 generic/tclCompCmds.c | 2 +-
 generic/tclExecute.c  | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index e934d92..78c6c5a 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2677,7 +2677,7 @@ CompileEachloopCmd(
 
     /*
      * Set the jumpback distance from INST_FOREACH_STEP to the start of the
-     * body's code
+     * body's code. Misuse loopCtTemp for storing the jump size.
      */
     
     jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 32b64a2..191a897 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6331,6 +6331,7 @@ TEBCresume(
 		}
 		listTmpDepth--;
 	    }
+	    /* loopCtTemp being 'misused' for storing the jump size */
 	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
 	}
 
-- 
cgit v0.12


From ff9c2d4ad9a37c50a4921bada422365ae85d5ac1 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Thu, 5 Dec 2013 17:18:54 +0000
Subject: add comments on INST_FOREACH_*

---
 generic/tclExecute.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 191a897..fe05b30 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6259,6 +6259,7 @@ TEBCresume(
 	pc += 5 - infoPtr->loopCtTemp;
 	
     case INST_FOREACH_STEP:
+	/* THIS INSTRUCTION IS ONLY CALLED AS A CONTINUE TARGET */
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
 	 * the next value list element to each loop var.
@@ -6341,6 +6342,7 @@ TEBCresume(
 	pc++;
 
     case INST_FOREACH_END:
+	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
 	tmpPtr = OBJ_AT_TOS;
 	infoPtr = tmpPtr->internalRep.otherValuePtr;
 	numLists = infoPtr->numLists;
-- 
cgit v0.12


From 6c9f0c69b67589dd2c52c36bdd3fd3a7fb8e6f60 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 5 Dec 2013 20:45:45 +0000
Subject: Draft fix for Bug 0b874c344d.  Includes test.

---
 generic/tclCmdIL.c   | 60 ++++++++++++++++++++++++++++++++++++++++++++++++----
 tests/coroutine.test |  3 +++
 2 files changed, 59 insertions(+), 4 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index fa4ead4..57434c1 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -104,6 +104,8 @@ typedef struct SortInfo {
  * Forward declarations for procedures defined in this file:
  */
 
+static CmdFrame *	CmdFrameChain(CoroutineData *corPtr);
+static void		CmdFrameUnchain(CoroutineData *corPtr);
 static int		DictionaryCompare(const char *left, const char *right);
 static int		IfConditionCallback(ClientData data[],
 			    Tcl_Interp *interp, int result);
@@ -1167,20 +1169,22 @@ InfoFrameCmd(
 	 */
 
 	CmdFrame *lastPtr = NULL;
+	CmdFrame *tailPtr = CmdFrameChain(corPtr);
+	int offset = tailPtr ? tailPtr->level : 0;
 
 	runPtr = iPtr->cmdFramePtr;
 
 	/* TODO - deal with overflow */
-	topLevel += corPtr->caller.cmdFramePtr->level;
+	topLevel += offset;
 	while (runPtr) {
-	    runPtr->level += corPtr->caller.cmdFramePtr->level;
+	    runPtr->level += offset;
 	    lastPtr = runPtr;
 	    runPtr = runPtr->nextPtr;
 	}
 	if (lastPtr) {
-	    lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
+	    lastPtr->nextPtr = tailPtr;
 	} else {
-	    iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;
+	    iPtr->cmdFramePtr = tailPtr;
 	}
     }
 
@@ -1244,10 +1248,58 @@ InfoFrameCmd(
 	    runPtr->level = 1;
 	    runPtr->nextPtr = NULL;
 	}
+	CmdFrameUnchain(corPtr);
 
     }
     return code;
 }
+
+static void
+CmdFrameUnchain(
+    CoroutineData *corPtr)
+{
+    if (corPtr->callerEEPtr->corPtr) {
+	CmdFrame *endPtr = corPtr->callerEEPtr->corPtr->caller.cmdFramePtr;
+
+	if (corPtr->caller.cmdFramePtr == endPtr) {
+	    corPtr->caller.cmdFramePtr = NULL;
+	} else {
+	    CmdFrame *runPtr = corPtr->caller.cmdFramePtr;
+
+	    while (runPtr->nextPtr != endPtr) {
+	    	runPtr->level -= endPtr->level;
+		runPtr = runPtr->nextPtr;
+	    }
+	    runPtr->level = 1;
+	    runPtr->nextPtr = NULL;
+	}
+	CmdFrameUnchain(corPtr->callerEEPtr->corPtr);
+    }
+}
+
+static CmdFrame *
+CmdFrameChain(
+    CoroutineData *corPtr)
+{
+    if (corPtr->callerEEPtr->corPtr) {
+	CmdFrame *tailPtr = CmdFrameChain(corPtr->callerEEPtr->corPtr);
+	CmdFrame *lastPtr = NULL;
+	CmdFrame *runPtr = corPtr->caller.cmdFramePtr;
+	int offset = tailPtr ? tailPtr->level : 0;
+
+	while (runPtr) {
+	    runPtr->level += offset;
+	    lastPtr = runPtr;
+	    runPtr = runPtr->nextPtr;
+	}
+	if (lastPtr) {
+	    lastPtr->nextPtr = tailPtr;
+	} else {
+	    corPtr->caller.cmdFramePtr = tailPtr;
+	}
+    }
+    return corPtr->caller.cmdFramePtr;
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/tests/coroutine.test b/tests/coroutine.test
index 03c63ad..a360fd5 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -342,6 +342,9 @@ test coroutine-3.6 {info frame, bug #2910094} -setup {
     rename stack {}
     rename a {}
 } -result {}
+test coroutine-3.7 {bug 0b874c344d} {
+    dict get [coroutine X coroutine Y info frame 0] cmd
+} {coroutine X coroutine Y info frame 0}
 
 test coroutine-4.1 {bug #2093188} -setup {
     proc foo {} {
-- 
cgit v0.12


From ec2f589b56bb7241ee7f7b60aad33ccdfa46ec98 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Fri, 6 Dec 2013 00:02:16 +0000
Subject: tighter mem management

---
 generic/tclCompCmds.c | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 78c6c5a..da14af1 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2602,16 +2602,14 @@ CompileEachloopCmd(
      */
 
     infoPtr = ckalloc(sizeof(ForeachInfo)
-	    + numLists * sizeof(ForeachVarList *));
+	    + (numLists - 1) * sizeof(ForeachVarList *));
     infoPtr->numLists = numLists;
-    infoPtr->firstValueTemp = collect;
-    infoPtr->loopCtTemp = 0;
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
 	ForeachVarList *varListPtr;
 
 	numVars = varcList[loopIndex];
 	varListPtr = ckalloc(sizeof(ForeachVarList)
-		+ numVars * sizeof(int));
+		+ (numVars - 1) * sizeof(int));
 	varListPtr->numVars = numVars;
 	for (j = 0;  j < numVars;  j++) {
 	    const char *varName = varvList[loopIndex][j];
-- 
cgit v0.12


From bd06c04659422136285db5fbcb585c18d10b595d Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Fri, 6 Dec 2013 00:16:07 +0000
Subject: tighter mem management in array-set compiler

---
 generic/tclCompCmds.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index da14af1..73b1ec3 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -323,11 +323,11 @@ TclCompileArraySetCmd(
     keyVar = AnonymousLocal(envPtr);
     valVar = AnonymousLocal(envPtr);
 
-    infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *));
+    infoPtr = ckalloc(sizeof(ForeachInfo));
     infoPtr->numLists = 1;
     infoPtr->firstValueTemp = dataVar;
     infoPtr->loopCtTemp = iterVar;
-    infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int));
+    infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
     infoPtr->varLists[0]->numVars = 2;
     infoPtr->varLists[0]->varIndexes[0] = keyVar;
     infoPtr->varLists[0]->varIndexes[1] = valVar;
-- 
cgit v0.12


From 53009920c226ade2ef2f7f12b73ee9cc0bcf766b Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Fri, 6 Dec 2013 01:07:10 +0000
Subject: adapted the array-set compiler to use the new foreach opcodes

---
 generic/tclCompCmds.c | 83 +++++++++++++++++++--------------------------------
 generic/tclExecute.c  |  1 -
 2 files changed, 31 insertions(+), 53 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 73b1ec3..b8b2605 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -245,8 +245,8 @@ TclCompileArraySetCmd(
     Tcl_Token *varTokenPtr, *dataTokenPtr;
     int isScalar, localIndex, code = TCL_OK;
     int isDataLiteral, isDataValid, isDataEven, len;
-    int dataVar, iterVar, keyVar, valVar, infoIndex;
-    int back, fwd, offsetBack, offsetFwd;
+    int keyVar, valVar, infoIndex;
+    int fwd, offsetBack, offsetFwd;
     Tcl_Obj *literalObj;
     ForeachInfo *infoPtr;
 
@@ -290,6 +290,7 @@ TclCompileArraySetCmd(
 	code = TCL_ERROR;
 	goto done;
     }
+
     /*
      * Special case: literal empty value argument is just an "ensure array"
      * operation.
@@ -314,19 +315,28 @@ TclCompileArraySetCmd(
 	goto done;
     }
 
+    if (localIndex < 0) {
+	/*
+	 * a non-local variable: upvar from a local one! This consumes the
+	 * variable name that was left at stacktop.
+	 */
+	
+	localIndex = AnonymousLocal(envPtr);
+	PushStringLiteral(envPtr, "0");
+	TclEmitInstInt4(INST_REVERSE, 2,        		envPtr);
+	TclEmitInstInt4(INST_UPVAR, localIndex, 		envPtr);
+	TclEmitOpcode(INST_POP,          			envPtr);
+    }
+    
     /*
      * Prepare for the internal foreach.
      */
 
-    dataVar = AnonymousLocal(envPtr);
-    iterVar = AnonymousLocal(envPtr);
     keyVar = AnonymousLocal(envPtr);
     valVar = AnonymousLocal(envPtr);
 
     infoPtr = ckalloc(sizeof(ForeachInfo));
     infoPtr->numLists = 1;
-    infoPtr->firstValueTemp = dataVar;
-    infoPtr->loopCtTemp = iterVar;
     infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
     infoPtr->varLists[0]->numVars = 2;
     infoPtr->varLists[0]->varIndexes[0] = keyVar;
@@ -360,54 +370,23 @@ TclCompileArraySetCmd(
 	fwd = CurrentOffset(envPtr) - offsetFwd;
 	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
     }
-    Emit14Inst(		INST_STORE_SCALAR, dataVar,		envPtr);
-    TclEmitOpcode(	INST_POP,				envPtr);
 
-    if (localIndex >= 0) {
-	TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
-	TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
-	TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
-	TclEmitInstInt4(INST_FOREACH_START4, infoIndex,		envPtr);
-	offsetBack = CurrentOffset(envPtr);
-	TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex,		envPtr);
-	offsetFwd = CurrentOffset(envPtr);
-	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
-	Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
-	Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
-	Emit14Inst(	INST_STORE_ARRAY, localIndex,		envPtr);
-	TclEmitOpcode(	INST_POP,				envPtr);
-	back = offsetBack - CurrentOffset(envPtr);
-	TclEmitInstInt1(INST_JUMP1, back,			envPtr);
-	fwd = CurrentOffset(envPtr) - offsetFwd;
-	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
-    } else {
-	TclEmitOpcode(	INST_DUP,				envPtr);
-	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
-	TclEmitInstInt1(INST_JUMP_TRUE1, 4,			envPtr);
-	TclEmitOpcode(	INST_DUP,				envPtr);
-	TclEmitOpcode(	INST_ARRAY_MAKE_STK,			envPtr);
-	TclEmitInstInt4(INST_FOREACH_START4, infoIndex,		envPtr);
-	offsetBack = CurrentOffset(envPtr);
-	TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex,		envPtr);
-	offsetFwd = CurrentOffset(envPtr);
-	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
-	TclEmitOpcode(	INST_DUP,				envPtr);
-	Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
-	Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
-	TclEmitOpcode(	INST_STORE_ARRAY_STK,			envPtr);
-	TclEmitOpcode(	INST_POP,				envPtr);
-	back = offsetBack - CurrentOffset(envPtr);
-	TclEmitInstInt1(INST_JUMP1, back,			envPtr);
-	fwd = CurrentOffset(envPtr) - offsetFwd;
-	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
-	TclEmitOpcode(	INST_POP,				envPtr);
-    }
-    if (!isDataLiteral) {
-	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
-	TclEmitInt4(		dataVar,			envPtr);
-    }
+    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
+    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
+    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
+    TclEmitInstInt4(INST_FOREACH_START, infoIndex,	envPtr);
+    offsetBack = CurrentOffset(envPtr);
+    Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
+    Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
+    Emit14Inst(	INST_STORE_ARRAY, localIndex,		envPtr);
+    TclEmitOpcode(	INST_POP,			envPtr);
+    infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */
+    TclEmitOpcode( INST_FOREACH_STEP,			envPtr);
+    TclEmitOpcode( INST_FOREACH_END,			envPtr);
+    TclAdjustStackDepth(-3, envPtr);
     PushStringLiteral(envPtr,	"");
-  done:
+
+    done:
     Tcl_DecrRefCount(literalObj);
     return code;
 }
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fe05b30..a831cd6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6259,7 +6259,6 @@ TEBCresume(
 	pc += 5 - infoPtr->loopCtTemp;
 	
     case INST_FOREACH_STEP:
-	/* THIS INSTRUCTION IS ONLY CALLED AS A CONTINUE TARGET */
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
 	 * the next value list element to each loop var.
-- 
cgit v0.12


From 7631cbda15c13ff69b665f0b71ad20c866c00624 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 6 Dec 2013 09:28:45 +0000
Subject: Stop printing undefined values in disassembled code.

---
 generic/tclCompCmds.c | 42 +++++++++++++++++++++++++++++++++++++++++-
 generic/tclCompile.h  |  1 +
 generic/tclExecute.c  | 17 ++++++++---------
 3 files changed, 50 insertions(+), 10 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index b8b2605..bdab2ff 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -31,6 +31,9 @@ static void		FreeForeachInfo(ClientData clientData);
 static void		PrintForeachInfo(ClientData clientData,
 			    Tcl_Obj *appendObj, ByteCode *codePtr,
 			    unsigned int pcOffset);
+static void		PrintNewForeachInfo(ClientData clientData,
+			    Tcl_Obj *appendObj, ByteCode *codePtr,
+			    unsigned int pcOffset);
 static int		CompileEachloopCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    CompileEnv *envPtr, int collect);
@@ -49,6 +52,13 @@ const AuxDataType tclForeachInfoType = {
     PrintForeachInfo		/* printProc */
 };
 
+const AuxDataType tclNewForeachInfoType = {
+    "NewForeachInfo",		/* name */
+    DupForeachInfo,		/* dupProc */
+    FreeForeachInfo,		/* freeProc */
+    PrintNewForeachInfo		/* printProc */
+};
+
 const AuxDataType tclDictUpdateInfoType = {
     "DictUpdateInfo",		/* name */
     DupDictUpdateInfo,		/* dupProc */
@@ -2599,7 +2609,7 @@ CompileEachloopCmd(
 	}
 	infoPtr->varLists[loopIndex] = varListPtr;
     }
-    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+    infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
 
     /*
      * Evaluate each value list and leave it on stack.
@@ -2828,6 +2838,36 @@ PrintForeachInfo(
 	Tcl_AppendToObj(appendObj, "]", -1);
     }
 }
+
+static void
+PrintNewForeachInfo(
+    ClientData clientData,
+    Tcl_Obj *appendObj,
+    ByteCode *codePtr,
+    unsigned int pcOffset)
+{
+    register ForeachInfo *infoPtr = clientData;
+    register ForeachVarList *varsPtr;
+    int i, j;
+
+    Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
+	    infoPtr->loopCtTemp);
+    for (i=0 ; i<infoPtr->numLists ; i++) {
+	if (i) {
+	    Tcl_AppendToObj(appendObj, ",", -1);
+	}
+	Tcl_AppendToObj(appendObj, "[", -1);
+	varsPtr = infoPtr->varLists[i];
+	for (j=0 ; j<varsPtr->numVars ; j++) {
+	    if (j) {
+		Tcl_AppendToObj(appendObj, ",", -1);
+	    }
+	    Tcl_AppendPrintfToObj(appendObj, "%%v%u",
+		    (unsigned) varsPtr->varIndexes[j]);
+	}
+	Tcl_AppendToObj(appendObj, "]", -1);
+    }
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index c4e6222..8b1724b 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -908,6 +908,7 @@ typedef struct ForeachInfo {
 } ForeachInfo;
 
 MODULE_SCOPE const AuxDataType tclForeachInfoType;
+MODULE_SCOPE const AuxDataType tclNewForeachInfoType;
 
 #define FOREACHINFO(envPtr, index) \
     ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a831cd6..f496fe7 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6197,7 +6197,6 @@ TEBCresume(
 	 * corresponding Tcl_Objs to the stack.
 	 */
 
-	
 	opnd = TclGetUInt4AtPtr(pc+1);
 	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
 	numLists = infoPtr->numLists;
@@ -6229,7 +6228,7 @@ TEBCresume(
 	    }
 	    listTmpDepth--;
 	}
-	
+
 	/*
 	 * Store the iterNum and iterMax in a single Tcl_Obj; we keep a
 	 * nul-string obj with the pointer stored in the ptrValue so that the
@@ -6241,12 +6240,12 @@ TEBCresume(
 	tmpPtr->internalRep.twoIntValue.int1 = 0;
 	tmpPtr->internalRep.twoIntValue.int2 = iterMax;
 	PUSH_OBJECT(tmpPtr); /* iterCounts object */
-		
+
 	/*
 	 * Store a pointer to the ForeachInfo struct; same dirty trick
-	 * as above 
+	 * as above
 	 */
-	
+
 	TclNewObj(tmpPtr);
 	tmpPtr->internalRep.otherValuePtr = infoPtr;
 	PUSH_OBJECT(tmpPtr); /* infoPtr object */
@@ -6254,10 +6253,10 @@ TEBCresume(
 	/*
 	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
 	 * falls through.
-	 */ 
+	 */
 
 	pc += 5 - infoPtr->loopCtTemp;
-	
+
     case INST_FOREACH_STEP:
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
@@ -6276,14 +6275,14 @@ TEBCresume(
 	 * If some list still has a remaining list element iterate one more
 	 * time. Assign to var the next element from its value list.
 	 */
-	    
+
 	if (iterNum < iterMax) {
 	    /*
 	     * Set the variables and jump back to run the body
 	     */
 
 	    tmpPtr->internalRep.twoIntValue.int1 = iterNum + 1;
-	    
+
 	    listTmpDepth = numLists + 1;
 
 	    for (i = 0;  i < numLists;  i++) {
-- 
cgit v0.12


From 68864af6c2b0d93f8693c0f3447ffc7f8f92eb0e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 6 Dec 2013 10:04:48 +0000
Subject: Introducing a new union member in Tcl_Obj is not a good idea in a
 patch release, especially using "long". Better allow iterNum and iterMax to
 grow to ssize_t (or size_t) in Tcl 9 (or 8.x, why not?). Usage of "long" in
 public API causes interoperability problems between Cygwin64 and Win64
 (probably no-one cares except me).

---
 generic/tcl.h        |  4 ----
 generic/tclExecute.c | 10 +++++-----
 2 files changed, 5 insertions(+), 9 deletions(-)

diff --git a/generic/tcl.h b/generic/tcl.h
index aab299e..4bf81cc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -848,10 +848,6 @@ typedef struct Tcl_Obj {
 	    void *ptr;
 	    unsigned long value;
 	} ptrAndLongRep;
-	struct {
-	    long int1;
-	    long int2;
-	} twoIntValue;
     } internalRep;
 } Tcl_Obj;
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f496fe7..c3f5372 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6237,8 +6237,8 @@ TEBCresume(
 	 */
 
 	TclNewObj(tmpPtr);
-	tmpPtr->internalRep.twoIntValue.int1 = 0;
-	tmpPtr->internalRep.twoIntValue.int2 = iterMax;
+	tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
+	tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
 	PUSH_OBJECT(tmpPtr); /* iterCounts object */
 
 	/*
@@ -6268,8 +6268,8 @@ TEBCresume(
 	numLists = infoPtr->numLists;
 
 	tmpPtr = OBJ_AT_DEPTH(1);
-	iterNum = tmpPtr->internalRep.twoIntValue.int1;
-	iterMax = tmpPtr->internalRep.twoIntValue.int2;
+	iterNum = INT2PTR(tmpPtr->internalRep.twoPtrValue.ptr1);
+	iterMax = INT2PTR(tmpPtr->internalRep.twoPtrValue.ptr2);
 
 	/*
 	 * If some list still has a remaining list element iterate one more
@@ -6281,7 +6281,7 @@ TEBCresume(
 	     * Set the variables and jump back to run the body
 	     */
 
-	    tmpPtr->internalRep.twoIntValue.int1 = iterNum + 1;
+	    tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
 
 	    listTmpDepth = numLists + 1;
 
-- 
cgit v0.12


From c5df69b71626521628a0033c5e3720beaa366998 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 6 Dec 2013 10:17:58 +0000
Subject: Oops, wrong macro.

---
 generic/tclExecute.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c3f5372..b6d8841 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6268,8 +6268,8 @@ TEBCresume(
 	numLists = infoPtr->numLists;
 
 	tmpPtr = OBJ_AT_DEPTH(1);
-	iterNum = INT2PTR(tmpPtr->internalRep.twoPtrValue.ptr1);
-	iterMax = INT2PTR(tmpPtr->internalRep.twoPtrValue.ptr2);
+	iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
+	iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
 
 	/*
 	 * If some list still has a remaining list element iterate one more
-- 
cgit v0.12


From 3cfba0cf67f0c2170e26cbff26e5dcc8bc64bf61 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Fri, 6 Dec 2013 14:29:49 +0000
Subject: change NULL to INT2PTR(0), for clarity

---
 generic/tclExecute.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b6d8841..a3083bc 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6237,7 +6237,7 @@ TEBCresume(
 	 */
 
 	TclNewObj(tmpPtr);
-	tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
+	tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
 	tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
 	PUSH_OBJECT(tmpPtr); /* iterCounts object */
 
-- 
cgit v0.12


From 5b08f1d1ef025223ce9bc15d06dbdb88c247822a Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Tue, 10 Dec 2013 11:38:17 +0000
Subject: new INST_LMAP_COLLECT, speeds up lmap and eliminates the need for a
 temp var

---
 generic/tclCompCmds.c | 42 ++++++++++++++----------------------------
 generic/tclCompile.c  |  1 +
 generic/tclCompile.h  |  3 ++-
 generic/tclExecute.c  | 19 +++++++++++++++++++
 4 files changed, 36 insertions(+), 29 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index bdab2ff..cd43cfc 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2458,8 +2458,6 @@ CompileEachloopCmd(
     ForeachInfo *infoPtr;	/* Points to the structure describing this
 				 * foreach command. Stored in a AuxData
 				 * record in the ByteCode. */
-    int collectVar = -1;	/* Index of temp var holding the result var
-				 * index. */
     
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     int jumpBackOffset, infoIndex, range;
@@ -2575,13 +2573,6 @@ CompileEachloopCmd(
      * We will compile the foreach command.
      */
 
-    if (collect == TCL_EACH_COLLECT) {
-	collectVar = AnonymousLocal(envPtr);
-	if (collectVar < 0) {
-	    return TCL_ERROR;
-	}
-    }
-	    
     code = TCL_OK;
 
     /*
@@ -2612,6 +2603,14 @@ CompileEachloopCmd(
     infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
 
     /*
+     * Create the collecting object, unshared.
+     */
+    
+    if (collect == TCL_EACH_COLLECT) {
+	TclEmitInstInt4(INST_LIST, 0, envPtr);
+    }
+	    
+    /*
      * Evaluate each value list and leave it on stack.
      */
 
@@ -2623,16 +2622,6 @@ CompileEachloopCmd(
 	}
     }
 
-    /*
-     * Create temporary variable to capture return values from loop body.
-     */
-     
-    if (collect == TCL_EACH_COLLECT) {
-	PushStringLiteral(envPtr, "");
-	Emit14Inst(		INST_STORE_SCALAR, collectVar,	envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
-    }
-
     TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
     
     /*
@@ -2646,9 +2635,10 @@ CompileEachloopCmd(
     ExceptionRangeEnds(envPtr, range);
     
     if (collect == TCL_EACH_COLLECT) {
-	Emit14Inst(		INST_LAPPEND_SCALAR, collectVar,envPtr);
+	TclEmitOpcode(INST_LMAP_COLLECT, envPtr);
+    } else {
+	TclEmitOpcode(		INST_POP,			envPtr);
     }
-    TclEmitOpcode(		INST_POP,			envPtr);
 
     /*
      * Bottom of loop code: assign each loop variable and check whether
@@ -2672,15 +2662,11 @@ CompileEachloopCmd(
     infoPtr->loopCtTemp = -jumpBackOffset;
 
     /*
-     * The command's result is an empty string if not collecting, or the
-     * list of results from evaluating the loop body.
+     * The command's result is an empty string if not collecting. If
+     * collecting, it is automatically left on stack after FOREACH_END.
      */
 
-    if (collect == TCL_EACH_COLLECT) {
-	Emit14Inst(		INST_LOAD_SCALAR, collectVar,	envPtr);
-	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
-	TclEmitInt4(		collectVar,			envPtr);
-    } else {
+    if (collect != TCL_EACH_COLLECT) {
 	PushStringLiteral(envPtr, "");
     }
     
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 7cd9796..c7b7875 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -554,6 +554,7 @@ InstructionDesc const tclInstructionTable[] = {
     {"foreach_step",	  1,    0,         0,	{OPERAND_NONE}},
 	/* "Step" or begin next iteration of foreach loop. */
     {"foreach_end",	  1,    0,         0,	{OPERAND_NONE}},
+    {"lmap_collect",	  1,    0,         0,	{OPERAND_NONE}},
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 8b1724b..7f62849 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -773,9 +773,10 @@ typedef struct ByteCode {
 #define INST_FOREACH_START              166
 #define INST_FOREACH_STEP               167
 #define INST_FOREACH_END                168
+#define INST_LMAP_COLLECT               169
 
 /* The last opcode */
-#define LAST_INST_OPCODE		168
+#define LAST_INST_OPCODE		169
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index a3083bc..9261f19 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6345,6 +6345,25 @@ TEBCresume(
 	infoPtr = tmpPtr->internalRep.otherValuePtr;
 	numLists = infoPtr->numLists;
 	NEXT_INST_V(1, numLists+2, 0);
+
+    case INST_LMAP_COLLECT:
+	/*
+	 * This instruction is only issued by lmap. The stack is:
+	 *   - result
+	 *   - infoPtr
+	 *   - loop counters
+	 *   - valLists
+	 *   - collecting obj (unshared)
+	 * The instruction lappends the result to the collecting obj.
+	 */
+
+	tmpPtr = OBJ_AT_DEPTH(1);
+	infoPtr = tmpPtr->internalRep.otherValuePtr;
+	numLists = infoPtr->numLists;
+	
+	objPtr = OBJ_AT_DEPTH(3 + numLists);
+	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
+	NEXT_INST_F(1, 1, 0);
     }
 
     case INST_BEGIN_CATCH4:
-- 
cgit v0.12


From 05c6524f4576db17abf945a46f2a34d85d34a683 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Tue, 10 Dec 2013 12:05:06 +0000
Subject: fix stack computations for lmap

---
 generic/tclCompile.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c7b7875..6c2e2b6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -554,7 +554,7 @@ InstructionDesc const tclInstructionTable[] = {
     {"foreach_step",	  1,    0,         0,	{OPERAND_NONE}},
 	/* "Step" or begin next iteration of foreach loop. */
     {"foreach_end",	  1,    0,         0,	{OPERAND_NONE}},
-    {"lmap_collect",	  1,    0,         0,	{OPERAND_NONE}},
+    {"lmap_collect",	  1,   -1,         0,	{OPERAND_NONE}},
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
-- 
cgit v0.12


From 6af51247c19f071e11ea3f2b27724643bb7e0d70 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 13:49:20 +0000
Subject: simplifying: drop early the evaled script

---
 generic/tclCompCmds.c | 37 ++++++++-----------------------------
 1 file changed, 8 insertions(+), 29 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index cd43cfc..0a0aa8e 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -610,11 +610,10 @@ TclCompileCatchCmd(
 	ExceptionRangeStarts(envPtr, range);
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitInvoke(envPtr,	INST_EVAL_STK);
+	/* drop the script */
+	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
     }
-    /* Stack at this point:
-     *    nonsimple:  script <mark> result
-     *    simple:            <mark> result
-     */
 
     if (resultIndex == -1) {
 	/*
@@ -632,14 +631,7 @@ TclCompileCatchCmd(
 	TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
 	ExceptionRangeEnds(envPtr, range);
 	TclEmitOpcode(		INST_END_CATCH,			envPtr);
-
-	/*
-	 * Stack at this point:
-	 *    nonsimple:  script <mark> returnCode
-	 *    simple:            <mark> returnCode
-	 */
-
-	goto dropScriptAtEnd;
+	return TCL_OK;
     }
 
     /*
@@ -649,7 +641,6 @@ TclCompileCatchCmd(
 
     PushStringLiteral(envPtr, "0");
     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
-    /* Stack at this point: ?script? <mark> result TCL_OK */
 
     /* 
      * Emit the "error case" epilogue. Push the interpreter result and the
@@ -658,7 +649,7 @@ TclCompileCatchCmd(
 
     TclAdjustStackDepth(-2, envPtr);
     ExceptionRangeTarget(envPtr, range, catchOffset);
-    /* Stack at this point:  ?script? */
+    /* Stack at this point is empty */
     TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
     TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
 
@@ -666,7 +657,7 @@ TclCompileCatchCmd(
      * Update the target of the jump after the "no errors" code. 
      */
 
-    /* Stack at this point: ?script? result returnCode */
+    /* Stack at this point: result returnCode */
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
@@ -689,7 +680,7 @@ TclCompileCatchCmd(
 
     /*
      * At this point, the top of the stack is inconveniently ordered:
-     *		?script? result returnCode ?returnOptions?
+     *		result returnCode ?returnOptions?
      * Reverse the stack to bring the result to the top.
      */
 
@@ -707,7 +698,7 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_POP,			envPtr);
 
     /*
-     * Stack is now ?script? ?returnOptions? returnCode.
+     * Stack is now ?returnOptions? returnCode.
      * If the options dict has been requested, it is buried on the stack under
      * the return code. Reverse the stack to bring it to the top, store it and
      * remove it from the stack.
@@ -719,18 +710,6 @@ TclCompileCatchCmd(
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
-  dropScriptAtEnd:
-
-    /*
-     * Stack is now ?script? result. Get rid of the subst'ed script if it's
-     * hanging arond.
-     */
-
-    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
-    }
-
     return TCL_OK;
 }
 
-- 
cgit v0.12


From 13a7f30bb1ad0a3bb814f20efe88d5eb02d9e453 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 14:51:15 +0000
Subject: store options early: simplify compiler, reduce stack manipulations

---
 generic/tclCompCmds.c | 32 ++++++--------------------------
 1 file changed, 6 insertions(+), 26 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 0a0aa8e..65c50eb 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -614,6 +614,7 @@ TclCompileCatchCmd(
 	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
+    ExceptionRangeEnds(envPtr, range);
 
     if (resultIndex == -1) {
 	/*
@@ -669,47 +670,26 @@ TclCompileCatchCmd(
 
     if (optsIndex != -1) {
 	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
+	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
     /*
      * End the catch
      */
 
-    ExceptionRangeEnds(envPtr, range);
     TclEmitOpcode(		INST_END_CATCH,			envPtr);
 
     /*
      * At this point, the top of the stack is inconveniently ordered:
-     *		result returnCode ?returnOptions?
-     * Reverse the stack to bring the result to the top.
-     */
-
-    if (optsIndex != -1) {
-	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
-    } else {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-    }
-
-    /*
-     * Store the result and remove it from the stack.
+     *		result returnCode
+     * Reverse the stack to store the result.
      */
 
+    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
     Emit14Inst(			INST_STORE_SCALAR, resultIndex,	envPtr);
     TclEmitOpcode(		INST_POP,			envPtr);
 
-    /*
-     * Stack is now ?returnOptions? returnCode.
-     * If the options dict has been requested, it is buried on the stack under
-     * the return code. Reverse the stack to bring it to the top, store it and
-     * remove it from the stack.
-     */
-
-    if (optsIndex != -1) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
-    }
-
     return TCL_OK;
 }
 
-- 
cgit v0.12


From d83a8d3b91859aa6d510256f3b26c4a3d98bdd5d Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 15:16:20 +0000
Subject: simplify: remove the special case

---
 generic/tclCompCmds.c | 25 ++++---------------------
 1 file changed, 4 insertions(+), 21 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 65c50eb..dbc876a 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -616,25 +616,6 @@ TclCompileCatchCmd(
     }
     ExceptionRangeEnds(envPtr, range);
 
-    if (resultIndex == -1) {
-	/*
-	 * Special case when neither result nor options are being saved. In
-	 * that case, we can skip quite a bit of the command epilogue; all we
-	 * have to do is drop the result and push the return code (and, of
-	 * course, finish the catch context).
-	 */
-
-	TclEmitOpcode(		INST_POP,			envPtr);
-	PushStringLiteral(envPtr, "0");
-	TclEmitInstInt1(	INST_JUMP1, 3,			envPtr);
-	TclAdjustStackDepth(-1, envPtr);
-	ExceptionRangeTarget(envPtr, range, catchOffset);
-	TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
-	ExceptionRangeEnds(envPtr, range);
-	TclEmitOpcode(		INST_END_CATCH,			envPtr);
-	return TCL_OK;
-    }
-
     /*
      * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
      * and jump around the "error case" code.
@@ -687,8 +668,10 @@ TclCompileCatchCmd(
      */
 
     TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-    Emit14Inst(			INST_STORE_SCALAR, resultIndex,	envPtr);
-    TclEmitOpcode(		INST_POP,			envPtr);
+    if (resultIndex != -1) {
+	Emit14Inst(	INST_STORE_SCALAR, resultIndex,	envPtr);
+    }
+    TclEmitOpcode(	INST_POP,			envPtr);
 
     return TCL_OK;
 }
-- 
cgit v0.12


From c7d612f81758056c1d7511f1f4f8dff108ef76d7 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 15:55:28 +0000
Subject: new test, and fix for bug

---
 generic/tclCompCmds.c | 15 +++++++++------
 tests/compile.test    | 30 ++++++++++++++++++++++++++++++
 2 files changed, 39 insertions(+), 6 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index dbc876a..7997efa 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -645,14 +645,8 @@ TclCompileCatchCmd(
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
-    /*
-     * Push the return options if the caller wants them.
-     */
-
     if (optsIndex != -1) {
 	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
-	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
     /*
@@ -662,6 +656,15 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_END_CATCH,			envPtr);
 
     /*
+     * Push the return options if the caller wants them.
+     */
+
+    if (optsIndex != -1) {
+	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+    }
+
+    /*
      * At this point, the top of the stack is inconveniently ordered:
      *		result returnCode
      * Reverse the stack to store the result.
diff --git a/tests/compile.test b/tests/compile.test
index 36e24de..2852bf2 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -167,6 +167,36 @@ test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*}
     -cleanup {namespace delete catchtest}
 }
 
+test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{
+     -setup {
+	 namespace eval catchtest {
+	     variable options1 {}
+	 }
+	 trace add variable catchtest::options1 write catchtest::failtrace
+	 proc catchtest::failtrace {n1 n2 op} {
+	     return -code error "trace on $n1 fails by request"
+	 }
+     }
+    -body {
+	proc catchtest::x {} {
+	    variable options1
+	    set count 0
+	    for {set i 0} {$i < 10} {incr i} {
+		set status2 [catch {
+		    set status1 [catch {
+			return -code error -level 0 "original failure"
+		    } result1 options1]
+		} result2 options2]
+		incr count
+	    }
+	    list $count $result2
+	}
+	catchtest::x
+    }
+    -result {10 {can't set "options1": trace on options1 fails by request}}
+    -cleanup {namespace delete catchtest}
+}
+
 test compile-4.1 {TclCompileForCmd: command substituted test expression} {
     set i 0
     set j 0
-- 
cgit v0.12


From 1ef52b35f0c918fa1c081116f142afd4e244eaf1 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 16:27:59 +0000
Subject: comments

---
 generic/tclCompCmds.c | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 7997efa..e071bbd 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -645,6 +645,11 @@ TclCompileCatchCmd(
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
+    /*
+     * Push the return options if the caller wants them. This needs to happen
+     * before INST_END_CATCH
+     */
+
     if (optsIndex != -1) {
 	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
     }
@@ -656,7 +661,8 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_END_CATCH,			envPtr);
 
     /*
-     * Push the return options if the caller wants them.
+     * Save the result and return options if the caller wants them. This needs
+     * to happen after INST_END_CATCH (compile-3.6/7).
      */
 
     if (optsIndex != -1) {
-- 
cgit v0.12


From d2ffd68c98038a0690f6a6e2f9a32b6439a7fe7e Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 16:33:21 +0000
Subject: comments

---
 generic/tclCompCmds.c | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index e071bbd..43504bf 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -635,16 +635,13 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
     TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
 
-    /*
-     * Update the target of the jump after the "no errors" code. 
-     */
-
-    /* Stack at this point: result returnCode */
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
+    /* Stack at this point: result returnCode */
+
     /*
      * Push the return options if the caller wants them. This needs to happen
      * before INST_END_CATCH
-- 
cgit v0.12


From ee023de8d6942ebb02809d498f6dd46f634fa98d Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 11 Dec 2013 16:43:26 +0000
Subject: comments

---
 generic/tclCompCmds.c | 11 ++++-------
 1 file changed, 4 insertions(+), 7 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 43504bf..72b338c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -582,11 +582,7 @@ TclCompileCatchCmd(
     /*
      * We will compile the catch command. Declare the exception range that it
      * uses.
-     */
-
-    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-
-    /*
+     *
      * If the body is a simple word, compile a BEGIN_CATCH instruction,
      * followed by the instructions to eval the body.
      * Otherwise, compile instructions to substitute the body text before
@@ -599,6 +595,7 @@ TclCompileCatchCmd(
      * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
      */
 
+    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
 	ExceptionRangeStarts(envPtr, range);
@@ -635,13 +632,13 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
     TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
 
+    /* Stack at this point on both branches: result returnCode */
+
     if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
 	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
-    /* Stack at this point: result returnCode */
-
     /*
      * Push the return options if the caller wants them. This needs to happen
      * before INST_END_CATCH
-- 
cgit v0.12


From 959c0b7ee6f676289f4bcb26638947b88e7d576b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 12 Dec 2013 09:57:38 +0000
Subject: simple compilation of [string replace]

---
 generic/tclCmdMZ.c      |   2 +-
 generic/tclCompCmdsSZ.c | 116 ++++++++++++++++++++++++++++++++++++++++++++++++
 generic/tclInt.h        |   3 ++
 3 files changed, 120 insertions(+), 1 deletion(-)

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index da8ffe3..cefe850 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3339,7 +3339,7 @@ TclInitStringCmd(
 	{"match",	StringMatchCmd,	TclCompileStringMatchCmd, NULL, NULL, 0},
 	{"range",	StringRangeCmd,	TclCompileStringRangeCmd, NULL, NULL, 0},
 	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
-	{"replace",	StringRplcCmd,	NULL, NULL, NULL, 0},
+	{"replace",	StringRplcCmd,	TclCompileStringReplaceCmd, NULL, NULL, 0},
 	{"reverse",	StringRevCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
 	{"tolower",	StringLowerCmd,	TclCompileStringToLowerCmd, NULL, NULL, 0},
 	{"toupper",	StringUpperCmd,	TclCompileStringToUpperCmd, NULL, NULL, 0},
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index ca4b316..e7b3ddc 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -658,6 +658,122 @@ TclCompileStringRangeCmd(
     return TCL_OK;
 }
 
+int
+TclCompileStringReplaceCmd(
+    Tcl_Interp *interp,		/* Tcl interpreter for context. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
+				 * command. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds the resulting instructions. */
+{
+    Tcl_Token *tokenPtr, *valueTokenPtr, *replacementTokenPtr = NULL;
+    DefineLineInformation;	/* TIP #280 */
+    int idx1, idx2;
+
+    if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
+	return TCL_ERROR;
+    }
+    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if (parsePtr->numWords == 5) {
+	tokenPtr = TokenAfter(valueTokenPtr);
+	tokenPtr = TokenAfter(tokenPtr);
+	replacementTokenPtr = TokenAfter(tokenPtr);
+    }
+
+    /*
+     * Parse the indices. Will only compile special cases if both are
+     * constants and not an _integer_ less than zero (since we reserve
+     * negative indices here for end-relative indexing) or an end-based index
+     * greater than 'end' itself.
+     */
+
+    tokenPtr = TokenAfter(valueTokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
+	goto genericReplace;
+    }
+
+    tokenPtr = TokenAfter(tokenPtr);
+    if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
+	goto genericReplace;
+    }
+
+    /*
+     * We handle these replacements specially: first character (where
+     * idx1=idx2=0) and suffixes (where idx1=idx2=INDEX_END). Anything else
+     * and the semantics get rather screwy.
+     */
+
+    if (idx1 == 0 && idx2 == 0) {
+	int notEq, end;
+
+	/*
+	 * Just working with the first character.
+	 */
+
+	CompileWord(envPtr, valueTokenPtr, interp, 1);
+	if (replacementTokenPtr == NULL) {
+	    /* Drop first */
+	    OP44(	STR_RANGE_IMM, 1, INDEX_END);
+	    return TCL_OK;
+	}
+	/* Replace first */
+	CompileWord(envPtr, replacementTokenPtr, interp, 4);
+	OP4(		OVER, 1);
+	PUSH(		"");
+	OP(		STR_EQ);
+	JUMP1(		JUMP_FALSE, notEq);
+	OP(		POP);
+	JUMP1(		JUMP, end);
+	FIXJUMP1(notEq);
+	TclAdjustStackDepth(1, envPtr);
+	OP4(		REVERSE, 2);
+	OP44(		STR_RANGE_IMM, 1, INDEX_END);
+	OP1(		STR_CONCAT1, 2);
+	FIXJUMP1(end);
+	return TCL_OK;
+
+    } else if (idx1 == INDEX_END && idx2 == INDEX_END) {
+	int notEq, end;
+
+	/*
+	 * Just working with the last character.
+	 */
+
+	CompileWord(envPtr, valueTokenPtr, interp, 1);
+	if (replacementTokenPtr == NULL) {
+	    /* Drop last */
+	    OP44(	STR_RANGE_IMM, 0, INDEX_END-1);
+	    return TCL_OK;
+	}
+	/* Replace last */
+	CompileWord(envPtr, replacementTokenPtr, interp, 4);
+	OP4(		OVER, 1);
+	PUSH(		"");
+	OP(		STR_EQ);
+	JUMP1(		JUMP_FALSE, notEq);
+	OP(		POP);
+	JUMP1(		JUMP, end);
+	FIXJUMP1(notEq);
+	TclAdjustStackDepth(1, envPtr);
+	OP4(		REVERSE, 2);
+	OP44(		STR_RANGE_IMM, 0, INDEX_END-1);
+	OP4(		REVERSE, 2);
+	OP1(		STR_CONCAT1, 2);
+	FIXJUMP1(end);
+	return TCL_OK;
+
+    } else {
+	/*
+	 * Too complicated to optimize, but we know the number of arguments is
+	 * correct so we can issue a call of the "standard" implementation.
+	 */
+
+    genericReplace:
+	return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+}
+
 /*
  * Synch with tclCmdMZ.c
  */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index aac94ca..ad17415 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3621,6 +3621,9 @@ MODULE_SCOPE int	TclCompileStringMatchCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileStringRangeCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringReplaceCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileStringToLowerCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12


From 9c336539e4efc2577c7977a99679a133bf4569c5 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 13 Dec 2013 18:39:12 +0000
Subject: Simplify the coding of the unchain operation.

---
 generic/tclCmdIL.c | 40 +++++++++-------------------------------
 1 file changed, 9 insertions(+), 31 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 57434c1..fc2c367 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -105,7 +105,6 @@ typedef struct SortInfo {
  */
 
 static CmdFrame *	CmdFrameChain(CoroutineData *corPtr);
-static void		CmdFrameUnchain(CoroutineData *corPtr);
 static int		DictionaryCompare(const char *left, const char *right);
 static int		IfConditionCallback(ClientData data[],
 			    Tcl_Interp *interp, int result);
@@ -1150,7 +1149,7 @@ InfoFrameCmd(
 {
     Interp *iPtr = (Interp *) interp;
     int level, topLevel, code = TCL_OK;
-    CmdFrame *runPtr, *framePtr;
+    CmdFrame *runPtr, *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
     CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
 
     if (objc > 2) {
@@ -1235,36 +1234,13 @@ InfoFrameCmd(
     Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
 
   done:
-    if (corPtr) {
+    while (corPtr) {
+	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
 
-	if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) {
-	    iPtr->cmdFramePtr = NULL;
+	if (*cmdFramePtrPtr == endPtr) {
+	    *cmdFramePtrPtr = NULL;
 	} else {
-	    runPtr = iPtr->cmdFramePtr;
-	    while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) {
-	    	runPtr->level -= corPtr->caller.cmdFramePtr->level;
-		runPtr = runPtr->nextPtr;
-	    }
-	    runPtr->level = 1;
-	    runPtr->nextPtr = NULL;
-	}
-	CmdFrameUnchain(corPtr);
-
-    }
-    return code;
-}
-
-static void
-CmdFrameUnchain(
-    CoroutineData *corPtr)
-{
-    if (corPtr->callerEEPtr->corPtr) {
-	CmdFrame *endPtr = corPtr->callerEEPtr->corPtr->caller.cmdFramePtr;
-
-	if (corPtr->caller.cmdFramePtr == endPtr) {
-	    corPtr->caller.cmdFramePtr = NULL;
-	} else {
-	    CmdFrame *runPtr = corPtr->caller.cmdFramePtr;
+	    CmdFrame *runPtr = *cmdFramePtrPtr;
 
 	    while (runPtr->nextPtr != endPtr) {
 	    	runPtr->level -= endPtr->level;
@@ -1273,8 +1249,10 @@ CmdFrameUnchain(
 	    runPtr->level = 1;
 	    runPtr->nextPtr = NULL;
 	}
-	CmdFrameUnchain(corPtr->callerEEPtr->corPtr);
+	cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
+	corPtr = corPtr->callerEEPtr->corPtr;
     }
+    return code;
 }
 
 static CmdFrame *
-- 
cgit v0.12


From 12a14105a15ca9bae71b2020fdc9d1c1b1b95dff Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 15 Dec 2013 17:49:53 +0000
Subject: Improve descriptions of character escapes and ranges in Tcl.n.
 Improve output format handlers to cope with added escape for en-dashes.

---
 doc/Tcl.n                      | 39 ++++++++++++++++++++++-----------------
 tools/man2help2.tcl            |  2 +-
 tools/tcltk-man2html-utils.tcl |  1 +
 3 files changed, 24 insertions(+), 18 deletions(-)

diff --git a/doc/Tcl.n b/doc/Tcl.n
index 8b17f93..c7fa9f6 100644
--- a/doc/Tcl.n
+++ b/doc/Tcl.n
@@ -108,8 +108,8 @@ Variable substitution may take any of the following forms:
 \fIName\fR is the name of a scalar variable;  the name is a sequence
 of one or more characters that are a letter, digit, underscore,
 or namespace separators (two or more colons).
-Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
-\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR).
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
 .TP 15
 \fB$\fIname\fB(\fIindex\fB)\fR
 .
@@ -117,8 +117,8 @@ Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
 the name of an element within that array.
 \fIName\fR must contain only letters, digits, underscores, and
 namespace separators, and may be an empty string.
-Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR,
-\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR).
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
 Command substitutions, variable substitutions, and backslash
 substitutions are performed on the characters of \fIindex\fR.
 .TP 15
@@ -158,25 +158,25 @@ handled specially, along with the value that replaces each sequence.
 .RS
 .TP 7
 \e\fBa\fR
-Audible alert (bell) (0x7).
+Audible alert (bell) (Unicode U+000007).
 .TP 7
 \e\fBb\fR
-Backspace (0x8).
+Backspace (Unicode U+000008).
 .TP 7
 \e\fBf\fR
-Form feed (0xc).
+Form feed (Unicode U+00000C).
 .TP 7
 \e\fBn\fR
-Newline (0xa).
+Newline (Unicode U+00000A).
 .TP 7
 \e\fBr\fR
-Carriage-return (0xd).
+Carriage-return (Unicode U+00000D).
 .TP 7
 \e\fBt\fR
-Tab (0x9).
+Tab (Unicode U+000009).
 .TP 7
 \e\fBv\fR
-Vertical tab (0xb).
+Vertical tab (Unicode U+00000B).
 .TP 7
 \e\fB<newline>\fIwhiteSpace\fR
 .
@@ -194,8 +194,9 @@ Backslash
 \e\fIooo\fR 
 .
 The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal 
-value for the Unicode character that will be inserted, in the range \fI000\fR
-- \fI377\fR.  The parser will stop just before this range overflows, or when
+value for the Unicode character that will be inserted, in the range
+\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF).
+The parser will stop just before this range overflows, or when
 the maximum of three digits is reached.  The upper bits of the Unicode
 character will be 0.
 .TP 7
@@ -203,23 +204,27 @@ character will be 0.
 .
 The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit
 hexadecimal value for the Unicode character that will be inserted.  The upper
-bits of the Unicode character will be 0.
+bits of the Unicode character will be 0 (i.e., the character will be in the
+range U+000000\(enU+0000FF).
 .TP 7
 \e\fBu\fIhhhh\fR 
 .
 The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
 sixteen-bit hexadecimal value for the Unicode character that will be
-inserted.  The upper bits of the Unicode character will be 0.
+inserted.  The upper bits of the Unicode character will be 0 (i.e., the
+character will be in the range U+000000\(enU+00FFFF).
 .TP 7
 \e\fBU\fIhhhhhhhh\fR 
 .
 The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
 twenty-one-bit hexadecimal value for the Unicode character that will be
-inserted, in the range U+0000..U+10FFFF.  The parser will stop just
+inserted, in the range U+000000\(enU+10FFFF.  The parser will stop just
 before this range overflows, or when the maximum of eight digits
 is reached.  The upper bits of the Unicode character will be 0.
+.RS
 .PP
-The range U+010000..U+10FFFD is reserved for the future.
+The range U+010000\(enU+10FFFD is reserved for the future.
+.RE
 .PP
 Backslash substitution is not performed on words enclosed in braces,
 except for backslash-newline as described above.
diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl
index fe4e7ad..9c8f503 100644
--- a/tools/man2help2.tcl
+++ b/tools/man2help2.tcl
@@ -717,7 +717,7 @@ proc char {name} {
 	    textSetup
 	    puts -nonewline $file "\\'d7 "
 	}
-	{\(em} {
+	{\(em} - {\(en} {
 	    textSetup
 	    puts -nonewline $file "-"
 	}
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index bdd0079..8fd1245 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -142,6 +142,7 @@ proc process-text {text} {
 	    {\(+-}	"&#177;" \
 	    {\(co}	"&copy;" \
 	    {\(em}	"&#8212;" \
+	    {\(en}	"&#8211;" \
 	    {\(fm}	"&#8242;" \
 	    {\(mu}	"&#215;" \
 	    {\(mi}	"&#8722;" \
-- 
cgit v0.12


From f3e8b534b38e07387ab2c0c94653917863c57411 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 16 Dec 2013 21:01:35 +0000
Subject: Refactoring work on the "chain" operation.

---
 generic/tclCmdIL.c | 101 +++++++++++++++++++++++++----------------------------
 1 file changed, 48 insertions(+), 53 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index fc2c367..28fb3ce 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -104,7 +104,7 @@ typedef struct SortInfo {
  * Forward declarations for procedures defined in this file:
  */
 
-static CmdFrame *	CmdFrameChain(CoroutineData *corPtr);
+static void		CmdFrameChain(CoroutineData *corPtr);
 static int		DictionaryCompare(const char *left, const char *right);
 static int		IfConditionCallback(ClientData data[],
 			    Tcl_Interp *interp, int result);
@@ -1140,6 +1140,47 @@ TclInfoExistsCmd(
  *----------------------------------------------------------------------
  */
 
+static void
+Chain(
+    CmdFrame **cmdFramePtrPtr,
+    CoroutineData *corPtr)
+{
+    CmdFrame *tailPtr = corPtr->caller.cmdFramePtr;
+    CmdFrame *runPtr = *cmdFramePtrPtr;
+    int offset;
+
+    if (tailPtr == NULL) {
+	return;
+    }
+
+    if (runPtr == NULL) {
+	*cmdFramePtrPtr = tailPtr;
+	return;
+    }
+
+    offset = tailPtr->level;
+
+    while (runPtr->nextPtr) {
+	runPtr->level += offset;
+	runPtr = runPtr->nextPtr;
+    }
+    runPtr->level += offset;
+    runPtr->nextPtr = tailPtr;
+}
+
+static void
+CmdFrameChain(
+    CoroutineData *corPtr)
+{
+    CmdFrame **cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
+
+    corPtr = corPtr->callerEEPtr->corPtr;
+    if (corPtr) {
+	CmdFrameChain(corPtr);
+	Chain(cmdFramePtrPtr, corPtr);
+    }
+}
+
 static int
 InfoFrameCmd(
     ClientData dummy,		/* Not used. */
@@ -1149,7 +1190,7 @@ InfoFrameCmd(
 {
     Interp *iPtr = (Interp *) interp;
     int level, topLevel, code = TCL_OK;
-    CmdFrame *runPtr, *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
+    CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
     CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
 
     if (objc > 2) {
@@ -1157,36 +1198,13 @@ InfoFrameCmd(
 	return TCL_ERROR;
     }
 
-    topLevel = ((iPtr->cmdFramePtr == NULL)
-	    ? 0
-	    : iPtr->cmdFramePtr->level);
-
     if (corPtr) {
-	/*
-	 * A coroutine: must fix the level computations AND the cmdFrame chain,
-	 * which is interrupted at the base.
-	 */
-
-	CmdFrame *lastPtr = NULL;
-	CmdFrame *tailPtr = CmdFrameChain(corPtr);
-	int offset = tailPtr ? tailPtr->level : 0;
-
-	runPtr = iPtr->cmdFramePtr;
-
-	/* TODO - deal with overflow */
-	topLevel += offset;
-	while (runPtr) {
-	    runPtr->level += offset;
-	    lastPtr = runPtr;
-	    runPtr = runPtr->nextPtr;
-	}
-	if (lastPtr) {
-	    lastPtr->nextPtr = tailPtr;
-	} else {
-	    iPtr->cmdFramePtr = tailPtr;
-	}
+	CmdFrameChain(corPtr);
+	Chain(cmdFramePtrPtr, corPtr);
     }
 
+    topLevel = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level : 0;
+
     if (objc == 1) {
 	/*
 	 * Just "info frame".
@@ -1234,6 +1252,7 @@ InfoFrameCmd(
     Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
 
   done:
+    cmdFramePtrPtr = &iPtr->cmdFramePtr;
     while (corPtr) {
 	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
 
@@ -1254,30 +1273,6 @@ InfoFrameCmd(
     }
     return code;
 }
-
-static CmdFrame *
-CmdFrameChain(
-    CoroutineData *corPtr)
-{
-    if (corPtr->callerEEPtr->corPtr) {
-	CmdFrame *tailPtr = CmdFrameChain(corPtr->callerEEPtr->corPtr);
-	CmdFrame *lastPtr = NULL;
-	CmdFrame *runPtr = corPtr->caller.cmdFramePtr;
-	int offset = tailPtr ? tailPtr->level : 0;
-
-	while (runPtr) {
-	    runPtr->level += offset;
-	    lastPtr = runPtr;
-	    runPtr = runPtr->nextPtr;
-	}
-	if (lastPtr) {
-	    lastPtr->nextPtr = tailPtr;
-	} else {
-	    corPtr->caller.cmdFramePtr = tailPtr;
-	}
-    }
-    return corPtr->caller.cmdFramePtr;
-}
 
 /*
  *----------------------------------------------------------------------
-- 
cgit v0.12


From 974c8356eef0f2ca083bea7c55750256592e1f66 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 17 Dec 2013 21:19:36 +0000
Subject: Factor out the level offsetting into a final pass.  Let the first
 pass of the "chain" operation just stitch things together and count levels.

---
 generic/tclCmdIL.c | 43 +++++++++++++++++++++++++++----------------
 1 file changed, 27 insertions(+), 16 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 28fb3ce..e26c211 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -104,7 +104,7 @@ typedef struct SortInfo {
  * Forward declarations for procedures defined in this file:
  */
 
-static void		CmdFrameChain(CoroutineData *corPtr);
+static int		CmdFrameChain(CoroutineData *corPtr);
 static int		DictionaryCompare(const char *left, const char *right);
 static int		IfConditionCallback(ClientData data[],
 			    Tcl_Interp *interp, int result);
@@ -1140,45 +1140,47 @@ TclInfoExistsCmd(
  *----------------------------------------------------------------------
  */
 
-static void
+static int 
 Chain(
     CmdFrame **cmdFramePtrPtr,
     CoroutineData *corPtr)
 {
     CmdFrame *tailPtr = corPtr->caller.cmdFramePtr;
     CmdFrame *runPtr = *cmdFramePtrPtr;
-    int offset;
 
     if (tailPtr == NULL) {
-	return;
+	/* Think this can't happen. */
+	return 0;
     }
 
     if (runPtr == NULL) {
+	int toReturn = tailPtr->level;
+
 	*cmdFramePtrPtr = tailPtr;
-	return;
+	tailPtr->level = 0;
+	return toReturn;
     }
 
-    offset = tailPtr->level;
-
     while (runPtr->nextPtr) {
-	runPtr->level += offset;
 	runPtr = runPtr->nextPtr;
     }
-    runPtr->level += offset;
     runPtr->nextPtr = tailPtr;
+    return tailPtr->level;
 }
 
-static void
+static int
 CmdFrameChain(
     CoroutineData *corPtr)
 {
     CmdFrame **cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
+    int sum = 0;
 
     corPtr = corPtr->callerEEPtr->corPtr;
     if (corPtr) {
-	CmdFrameChain(corPtr);
-	Chain(cmdFramePtrPtr, corPtr);
+	sum += CmdFrameChain(corPtr);
+	sum += Chain(cmdFramePtrPtr, corPtr);
     }
+    return sum;
 }
 
 static int
@@ -1189,9 +1191,10 @@ InfoFrameCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Interp *iPtr = (Interp *) interp;
-    int level, topLevel, code = TCL_OK;
+    int level, code = TCL_OK;
     CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
     CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+    int topLevel = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level : 0;
 
     if (objc > 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
@@ -1199,11 +1202,19 @@ InfoFrameCmd(
     }
 
     if (corPtr) {
-	CmdFrameChain(corPtr);
-	Chain(cmdFramePtrPtr, corPtr);
+	topLevel += CmdFrameChain(corPtr);
+	topLevel += Chain(cmdFramePtrPtr, corPtr);
     }
 
-    topLevel = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level : 0;
+    framePtr = iPtr->cmdFramePtr;
+    while (framePtr) {
+	framePtr->level = topLevel--;
+	framePtr = framePtr->nextPtr;
+    }
+    if (topLevel) {
+	Tcl_Panic("Broken frame level calculation");
+    }
+    topLevel = iPtr->cmdFramePtr->level;
 
     if (objc == 1) {
 	/*
-- 
cgit v0.12


From 4cc4d69fe462a3661da5df84b1897b9959f6d5fd Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Wed, 18 Dec 2013 15:34:39 +0000
Subject: Making the optimizer pluggable by extensions; please review for
 committing to trunk

---
 generic/tclBasic.c    | 3 +++
 generic/tclCompile.c  | 4 +++-
 generic/tclCompile.h  | 2 +-
 generic/tclInt.h      | 9 ++++++++-
 generic/tclOptimize.c | 2 +-
 5 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a41351e..8ec94ca 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -526,6 +526,9 @@ Tcl_CreateInterp(void)
     iPtr->hiddenCmdTablePtr = NULL;
     iPtr->interpInfo = NULL;
 
+    TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
+    iPtr->extra.optimizer = TclOptimizeBytecode;
+
     iPtr->numLevels = 0;
     iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
     iPtr->framePtr = NULL;	/* Initialise as soon as :: is available */
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 6c2e2b6..525571d 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -765,7 +765,9 @@ TclSetByteCodeFromAny(
      * instruction generator boundaries.
      */
 
-    TclOptimizeBytecode(&compEnv);
+    if (iPtr->extra.optimizer) {
+	(iPtr->extra.optimizer)(&compEnv);
+    }
 
     /*
      * Invoke the compilation hook procedure if one exists.
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 7f62849..55dd37a 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1064,7 +1064,7 @@ MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
 MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
 MODULE_SCOPE int	TclLog2(int value);
 #endif
-MODULE_SCOPE void	TclOptimizeBytecode(CompileEnv *envPtr);
+MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
 #ifdef TCL_COMPILE_DEBUG
 MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5c8dbfd..8ccfadb 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1809,7 +1809,14 @@ typedef struct Interp {
     ClientData interpInfo;	/* Information used by tclInterp.c to keep
 				 * track of master/slave interps on a
 				 * per-interp basis. */
-    Tcl_HashTable unused2;	/* No longer used (was mathFuncTable) */
+    union {
+	void (*optimizer)(void *envPtr);
+	Tcl_HashTable unused2;	/* No longer used (was mathFuncTable). The
+				 * unused space in interp was repurposed for
+				 * pluggable bytecode optimizers. The core
+				 * contains one optimizer, which can be
+				 * selectively overriden by extensions. */
+    } extra;
 
     /*
      * Information related to procedures and variables. See tclProc.c and
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index 3b16e6e..74de7a3 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -427,7 +427,7 @@ AdvanceJumps(
 
 void
 TclOptimizeBytecode(
-    CompileEnv *envPtr)
+    void *envPtr)
 {
     ConvertZeroEffectToNOP(envPtr);
     AdvanceJumps(envPtr);
-- 
cgit v0.12


From 85c73dc9ce50fd5ec5798a10173e29ab8e2c1bd1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 18 Dec 2013 18:09:09 +0000
Subject: Big simplification of the bug fix.

---
 generic/tclCmdIL.c | 100 ++++++++++++++++++-----------------------------------
 1 file changed, 34 insertions(+), 66 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index e26c211..41c1eb6 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -104,7 +104,6 @@ typedef struct SortInfo {
  * Forward declarations for procedures defined in this file:
  */
 
-static int		CmdFrameChain(CoroutineData *corPtr);
 static int		DictionaryCompare(const char *left, const char *right);
 static int		IfConditionCallback(ClientData data[],
 			    Tcl_Interp *interp, int result);
@@ -1140,49 +1139,6 @@ TclInfoExistsCmd(
  *----------------------------------------------------------------------
  */
 
-static int 
-Chain(
-    CmdFrame **cmdFramePtrPtr,
-    CoroutineData *corPtr)
-{
-    CmdFrame *tailPtr = corPtr->caller.cmdFramePtr;
-    CmdFrame *runPtr = *cmdFramePtrPtr;
-
-    if (tailPtr == NULL) {
-	/* Think this can't happen. */
-	return 0;
-    }
-
-    if (runPtr == NULL) {
-	int toReturn = tailPtr->level;
-
-	*cmdFramePtrPtr = tailPtr;
-	tailPtr->level = 0;
-	return toReturn;
-    }
-
-    while (runPtr->nextPtr) {
-	runPtr = runPtr->nextPtr;
-    }
-    runPtr->nextPtr = tailPtr;
-    return tailPtr->level;
-}
-
-static int
-CmdFrameChain(
-    CoroutineData *corPtr)
-{
-    CmdFrame **cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
-    int sum = 0;
-
-    corPtr = corPtr->callerEEPtr->corPtr;
-    if (corPtr) {
-	sum += CmdFrameChain(corPtr);
-	sum += Chain(cmdFramePtrPtr, corPtr);
-    }
-    return sum;
-}
-
 static int
 InfoFrameCmd(
     ClientData dummy,		/* Not used. */
@@ -1194,27 +1150,36 @@ InfoFrameCmd(
     int level, code = TCL_OK;
     CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
     CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-    int topLevel = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level : 0;
+    int topLevel = 0;
 
     if (objc > 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
 	return TCL_ERROR;
     }
 
-    if (corPtr) {
-	topLevel += CmdFrameChain(corPtr);
-	topLevel += Chain(cmdFramePtrPtr, corPtr);
+    while (corPtr) {
+	while (*cmdFramePtrPtr) {
+	    topLevel++;
+	    cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
+	}
+	if (corPtr->caller.cmdFramePtr) {
+	    *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
+	}
+	corPtr = corPtr->callerEEPtr->corPtr;
     }
+    topLevel += (*cmdFramePtrPtr)->level;
 
-    framePtr = iPtr->cmdFramePtr;
-    while (framePtr) {
-	framePtr->level = topLevel--;
-	framePtr = framePtr->nextPtr;
-    }
-    if (topLevel) {
-	Tcl_Panic("Broken frame level calculation");
+    if (topLevel != iPtr->cmdFramePtr->level) {
+	framePtr = iPtr->cmdFramePtr;
+	while (framePtr) {
+	    framePtr->level = topLevel--;
+	    framePtr = framePtr->nextPtr;
+	}
+	if (topLevel) {
+	    Tcl_Panic("Broken frame level calculation");
+	}
+	topLevel = iPtr->cmdFramePtr->level;
     }
-    topLevel = iPtr->cmdFramePtr->level;
 
     if (objc == 1) {
 	/*
@@ -1264,22 +1229,25 @@ InfoFrameCmd(
 
   done:
     cmdFramePtrPtr = &iPtr->cmdFramePtr;
+    corPtr = iPtr->execEnvPtr->corPtr;
     while (corPtr) {
 	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
 
-	if (*cmdFramePtrPtr == endPtr) {
-	    *cmdFramePtrPtr = NULL;
-	} else {
-	    CmdFrame *runPtr = *cmdFramePtrPtr;
+	if (endPtr) {
+	    if (*cmdFramePtrPtr == endPtr) {
+		*cmdFramePtrPtr = NULL;
+	    } else {
+		CmdFrame *runPtr = *cmdFramePtrPtr;
 
-	    while (runPtr->nextPtr != endPtr) {
-	    	runPtr->level -= endPtr->level;
-		runPtr = runPtr->nextPtr;
+		while (runPtr->nextPtr != endPtr) {
+		    runPtr->level -= endPtr->level;
+		    runPtr = runPtr->nextPtr;
+		}
+		runPtr->level = 1;
+		runPtr->nextPtr = NULL;
 	    }
-	    runPtr->level = 1;
-	    runPtr->nextPtr = NULL;
+	    cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
 	}
-	cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
 	corPtr = corPtr->callerEEPtr->corPtr;
     }
     return code;
-- 
cgit v0.12


From 40ee4723305e14d61c083785f230b614b2829361 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 19 Dec 2013 14:35:50 +0000
Subject: Add TclRegisterLiteral() to internal stub table (from "mig-optimize"
 branch, looks like a good idea anyway)

---
 generic/tclCompile.h  | 2 --
 generic/tclInt.decls  | 6 ++++++
 generic/tclIntDecls.h | 6 ++++++
 generic/tclLiteral.c  | 3 ++-
 generic/tclStubInit.c | 1 +
 5 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 55dd37a..b421aaf 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1079,8 +1079,6 @@ MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
 			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
 			    int flags, int *localIndexPtr,
 			    int *isScalarPtr);
-MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
-			    char *bytes, int length, int flags);
 MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
 MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp, 
 			    const char *name, Namespace *nsPtr);
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index f0e907f..9f7b106 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -1006,6 +1006,12 @@ declare 249 {
 declare 250 {
     void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
 }
+
+# Allow extensions for optimization
+declare 251 {
+    int TclRegisterLiteral(void *envPtr,
+	    char *bytes, int length, int flags)
+}
 
 ##############################################################################
 
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 47c6afd..f95f999 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -614,6 +614,9 @@ EXTERN char *		TclDoubleDigits(double dv, int ndigits, int flags,
 /* 250 */
 EXTERN void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
 				int force);
+/* 251 */
+EXTERN int		TclRegisterLiteral(void *envPtr, char *bytes,
+				int length, int flags);
 
 typedef struct TclIntStubs {
     int magic;
@@ -870,6 +873,7 @@ typedef struct TclIntStubs {
     int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
     char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
     void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
+    int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */
 } TclIntStubs;
 
 extern const TclIntStubs *tclIntStubsPtr;
@@ -1299,6 +1303,8 @@ extern const TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclDoubleDigits) /* 249 */
 #define TclSetSlaveCancelFlags \
 	(tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
+#define TclRegisterLiteral \
+	(tclIntStubsPtr->tclRegisterLiteral) /* 251 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 11da6f8..2b0cc7e 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -358,7 +358,7 @@ TclFetchLiteral(
 
 int
 TclRegisterLiteral(
-    CompileEnv *envPtr,		/* Points to the CompileEnv in whose object
+    void *ePtr,		/* Points to the CompileEnv in whose object
 				 * array an object is found or created. */
     register char *bytes,	/* Points to string for which to find or
 				 * create an object in CompileEnv's object
@@ -372,6 +372,7 @@ TclRegisterLiteral(
 				 * the literal should not be shared accross
 				 * namespaces. */
 {
+    CompileEnv *envPtr = ePtr;
     Interp *iPtr = envPtr->iPtr;
     LiteralTable *localTablePtr = &envPtr->localLitTable;
     LiteralEntry *globalPtr, *localPtr;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 3f1c27b..e1918ef 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -551,6 +551,7 @@ static const TclIntStubs tclIntStubs = {
     TclCopyChannel, /* 248 */
     TclDoubleDigits, /* 249 */
     TclSetSlaveCancelFlags, /* 250 */
+    TclRegisterLiteral, /* 251 */
 };
 
 static const TclIntPlatStubs tclIntPlatStubs = {
-- 
cgit v0.12


From db7ebfac4369ff2b956e1f5d7a8865e88d4ffc50 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Fri, 20 Dec 2013 21:59:28 +0000
Subject: remove INST_TRY_CVT_TO_NUMERIC when it is known not be necessary
 (cherrypick from mig-optimize)

---
 generic/tclCompCmds.c   |  1 +
 generic/tclCompCmdsGR.c |  2 ++
 generic/tclCompCmdsSZ.c |  1 +
 generic/tclCompile.h    | 12 ++++++++++++
 4 files changed, 16 insertions(+)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 72b338c..b7fc9b5 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2276,6 +2276,7 @@ TclCompileForCmd(
 
     SetLineInformation(2);
     TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+    TclClearNumConversion(envPtr);
 
     jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
     if (jumpDist > 127) {
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index d00327d..b7c89df 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -229,6 +229,7 @@ TclCompileIfCmd(
 		SetLineInformation(wordIdx);
 		Tcl_ResetResult(interp);
 		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+		TclClearNumConversion(envPtr);
 		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
 		    TclExpandJumpFixupArray(&jumpFalseFixupArray);
 		}
@@ -478,6 +479,7 @@ TclCompileIncrCmd(
 	} else {
 	    SetLineInformation(2);
 	    CompileTokens(envPtr, incrTokenPtr, interp);
+	    TclClearNumConversion(envPtr);
 	}
     } else {			/* No incr amount given so use 1. */
 	haveImmValue = 1;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 754238f..3e4a55a 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -3071,6 +3071,7 @@ TclCompileWhileCmd(
 	}
 	SetLineInformation(1);
 	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+	TclClearNumConversion(envPtr);
 
 	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
 	if (jumpDist > 127) {
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b421aaf..287ab1d 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1309,6 +1309,18 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
     } 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
  * these macros are:
-- 
cgit v0.12


From db9c1d285e21754818474eaa9be0d31b7c05e7d5 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Sun, 22 Dec 2013 12:52:39 +0000
Subject: fix stack counting bug in new catch compiler, commit 62a51cdb45.

---
 generic/tclCompCmds.c | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index b7fc9b5..94d3a69 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -533,7 +533,7 @@ TclCompileCatchCmd(
 {
     JumpFixup jumpFixup;
     Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
-    int resultIndex, optsIndex, range;
+    int resultIndex, optsIndex, range, dropScript = 0;
     DefineLineInformation;	/* TIP #280 */
 
     /*
@@ -601,6 +601,7 @@ TclCompileCatchCmd(
 	ExceptionRangeStarts(envPtr, range);
 	BODY(cmdTokenPtr, 1);
     } else {
+	dropScript = 1;
 	SetLineInformation(1);
 	CompileTokens(envPtr, cmdTokenPtr, interp);
 	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
@@ -608,6 +609,7 @@ TclCompileCatchCmd(
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitInvoke(envPtr,	INST_EVAL_STK);
 	/* drop the script */
+	dropScript = 1;
 	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
@@ -626,8 +628,12 @@ TclCompileCatchCmd(
      * return code.
      */
 
-    TclAdjustStackDepth(-2, envPtr);
+    TclAdjustStackDepth(-2 + dropScript, envPtr);
     ExceptionRangeTarget(envPtr, range, catchOffset);
+    if (dropScript) {
+	TclEmitOpcode(		INST_POP,			envPtr);
+    }
+
     /* Stack at this point is empty */
     TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
     TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
-- 
cgit v0.12


From 187d698fba3de0798b35122985b1616defa1f8e2 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Sun, 22 Dec 2013 13:03:19 +0000
Subject: remove duplicate statement in previous commit

---
 generic/tclCompCmds.c | 1 -
 1 file changed, 1 deletion(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 94d3a69..d6f01a8 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -601,7 +601,6 @@ TclCompileCatchCmd(
 	ExceptionRangeStarts(envPtr, range);
 	BODY(cmdTokenPtr, 1);
     } else {
-	dropScript = 1;
 	SetLineInformation(1);
 	CompileTokens(envPtr, cmdTokenPtr, interp);
 	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
-- 
cgit v0.12


From 4c7d267ddb333ab1d5b6caddfdd8803def611dd0 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Sun, 22 Dec 2013 14:11:46 +0000
Subject: remove unnecessary messing around INST_CONTINUE and INST_BREAK: local
 continue/break are already converted to jumps, so that these are either
 caught or returned - in either case, the stacks are cleaned up properly by
 TEBC itself.

---
 generic/tclCompCmds.c | 14 ++++----------
 1 file changed, 4 insertions(+), 10 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index d6f01a8..c774a5e 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -489,17 +489,14 @@ TclCompileBreakCmd(
 
 	TclCleanupStackForBreakContinue(envPtr, auxPtr);
 	TclAddLoopBreakFixup(envPtr, auxPtr);
-	TclAdjustStackDepth(1, envPtr);
     } else {
 	/*
 	 * Emit a real break.
 	 */
 
-	PushStringLiteral(envPtr, "");
-	TclEmitOpcode(INST_DUP, envPtr);
-	TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr);
-	TclEmitInt4(0, envPtr);
+	TclEmitOpcode(INST_BREAK, envPtr);
     }
+    TclAdjustStackDepth(1, envPtr);
 
     return TCL_OK;
 }
@@ -735,17 +732,14 @@ TclCompileContinueCmd(
 
 	TclCleanupStackForBreakContinue(envPtr, auxPtr);
 	TclAddLoopContinueFixup(envPtr, auxPtr);
-	TclAdjustStackDepth(1, envPtr);
     } else {
 	/*
 	 * Emit a real continue.
 	 */
 
-	PushStringLiteral(envPtr, "");
-	TclEmitOpcode(INST_DUP, envPtr);
-	TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr);
-	TclEmitInt4(0, envPtr);
+	TclEmitOpcode(INST_CONTINUE, envPtr);
     }
+    TclAdjustStackDepth(1, envPtr);
 
     return TCL_OK;
 }
-- 
cgit v0.12


From 3b06f70775be10c7547c05c27e55d4ef0a65ee0c Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Mon, 23 Dec 2013 11:28:12 +0000
Subject: Added new tools for managing and verifying the stack depth during
 compilation. Used it in some spots in the compiler and in
 TclCompileCatchCommand.

---
 generic/tclCompCmds.c | 10 ++++++++--
 generic/tclCompile.c  | 34 +++++++++++++++++++++++++---------
 generic/tclCompile.h  | 15 +++++++++++++++
 3 files changed, 48 insertions(+), 11 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index c774a5e..323aa87 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -532,7 +532,8 @@ TclCompileCatchCmd(
     Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
     int resultIndex, optsIndex, range, dropScript = 0;
     DefineLineInformation;	/* TIP #280 */
-
+    int depth = TclGetStackDepth(envPtr);
+    
     /*
      * If syntax does not match what we expect for [catch], do not compile.
      * Let runtime checks determine if syntax has changed.
@@ -611,11 +612,13 @@ TclCompileCatchCmd(
     }
     ExceptionRangeEnds(envPtr, range);
 
+    
     /*
      * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
      * and jump around the "error case" code.
      */
 
+    TclCheckStackDepth(depth+1, envPtr);
     PushStringLiteral(envPtr, "0");
     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
 
@@ -624,12 +627,14 @@ TclCompileCatchCmd(
      * return code.
      */
 
-    TclAdjustStackDepth(-2 + dropScript, envPtr);
     ExceptionRangeTarget(envPtr, range, catchOffset);
+    TclSetStackDepth(depth + dropScript, envPtr);
+    
     if (dropScript) {
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
+
     /* Stack at this point is empty */
     TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
     TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
@@ -678,6 +683,7 @@ TclCompileCatchCmd(
     }
     TclEmitOpcode(	INST_POP,			envPtr);
 
+    TclCheckStackDepth(depth+1, envPtr);
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 525571d..f3e9db3 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1722,7 +1722,7 @@ TclCompileInvocation(
     int numWords,
     CompileEnv *envPtr)
 {
-    int wordIdx = 0;
+    int wordIdx = 0, depth = TclGetStackDepth(envPtr);
     DefineLineInformation;
 
     if (cmdObj) {
@@ -1755,6 +1755,7 @@ TclCompileInvocation(
     } else {
 	TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx);
     }
+    TclCheckStackDepth(depth+1, envPtr);
 }
 
 static void
@@ -1767,7 +1768,8 @@ CompileExpanded(
 {
     int wordIdx = 0;
     DefineLineInformation;
-
+    int depth = TclGetStackDepth(envPtr);
+    
     StartExpanding(envPtr);
     if (cmdObj) {
 	CompileCmdLiteral(interp, cmdObj, envPtr);
@@ -1813,6 +1815,7 @@ CompileExpanded(
      */
 
     TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
+    TclCheckStackDepth(depth+1, envPtr);
 }
 
 static int 
@@ -1824,6 +1827,7 @@ CompileCmdCompileProc(
 {
     int unwind = 0, incrOffset = -1;
     DefineLineInformation;
+    int depth = TclGetStackDepth(envPtr);
 
     /*
      * Emit of the INST_START_CMD instruction is controlled by the value of
@@ -1871,6 +1875,7 @@ CompileCmdCompileProc(
 		TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
 	    }
 	}
+	TclCheckStackDepth(depth+1, envPtr);
 	return TCL_OK;
     }
 
@@ -1913,7 +1918,8 @@ CompileCommandTokens(
     int *clNext = envPtr->clNext;
     int cmdIdx = envPtr->numCommands;
     int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
-
+    int depth = TclGetStackDepth(envPtr);
+    
     assert (parsePtr->numWords > 0);
 
     /* Pre-Compile */
@@ -2004,6 +2010,7 @@ CompileCommandTokens(
     eclPtr->loc[wlineat].line = wlines;
     eclPtr->loc[wlineat].next = NULL;
 
+    TclCheckStackDepth(depth, envPtr);
     return cmdIdx;
 }
 
@@ -2023,6 +2030,7 @@ TclCompileScript(
 				 * Initial value of -1 indicates this routine
 				 * has not yet generated any bytecode. */
     const char *p = script;	/* Where we are in our compile. */
+    int depth = TclGetStackDepth(envPtr);
 
     if (envPtr->iPtr == NULL) {
 	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
@@ -2134,6 +2142,7 @@ TclCompileScript(
 	envPtr->codeNext--;
 	envPtr->currStackDepth++;
     }
+    TclCheckStackDepth(depth+1, envPtr);
 }
 
 /*
@@ -2244,6 +2253,7 @@ TclCompileTokens(
 #define NUM_STATIC_POS 20
     int isLiteral, maxNumCL, numCL;
     int *clPosition = NULL;
+    int depth = TclGetStackDepth(envPtr);
 
     /*
      * For the handling of continuation lines in literals we first check if
@@ -2421,6 +2431,7 @@ TclCompileTokens(
     if (maxNumCL) {
 	ckfree(clPosition);
     }
+    TclCheckStackDepth(depth+1, envPtr);
 }
 
 /*
@@ -3936,7 +3947,8 @@ TclEmitInvoke(
     ExceptionAux *auxBreakPtr, *auxContinuePtr;
     int arg1, arg2, wordCount = 0, expandCount = 0;
     int loopRange = 0, breakRange = 0, continueRange = 0;
-
+    int cleanup, depth = TclGetStackDepth(envPtr);
+    
     /*
      * Parse the arguments.
      */
@@ -3944,30 +3956,31 @@ TclEmitInvoke(
     va_start(argList, opcode);
     switch (opcode) {
     case INST_INVOKE_STK1:
-	wordCount = arg1 = va_arg(argList, int);
+	wordCount = arg1 = cleanup = va_arg(argList, int);
 	arg2 = 0;
 	break;
     case INST_INVOKE_STK4:
-	wordCount = arg1 = va_arg(argList, int);
+	wordCount = arg1 = cleanup = va_arg(argList, int);
 	arg2 = 0;
 	break;
     case INST_INVOKE_REPLACE:
 	arg1 = va_arg(argList, int);
 	arg2 = va_arg(argList, int);
 	wordCount = arg1 + arg2 - 1;
+	cleanup = arg1 + 1;
 	break;
     default:
 	Tcl_Panic("unexpected opcode");
     case INST_EVAL_STK:
-	wordCount = 1;
+	wordCount = cleanup = 1;
 	arg1 = arg2 = 0;
 	break;
     case INST_RETURN_STK:
-	wordCount = 2;
+	wordCount = cleanup = 2;
 	arg1 = arg2 = 0;
 	break;
     case INST_INVOKE_EXPANDED:
-	wordCount = arg1 = va_arg(argList, int);
+	wordCount = arg1 = cleanup = va_arg(argList, int);
 	arg2 = 0;
 	expandCount = 1;
 	break;
@@ -4070,6 +4083,7 @@ TclEmitInvoke(
 	    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
 	    TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
 	    TclAddLoopBreakFixup(envPtr, auxBreakPtr);
+	    TclAdjustStackDepth(1, envPtr);
 
 	    envPtr->currStackDepth = savedStackDepth;
 	    envPtr->expandCount = savedExpandCount;
@@ -4081,6 +4095,7 @@ TclEmitInvoke(
 	    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
 	    TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
 	    TclAddLoopContinueFixup(envPtr, auxContinuePtr);
+	    TclAdjustStackDepth(1, envPtr);
 
 	    envPtr->currStackDepth = savedStackDepth;
 	    envPtr->expandCount = savedExpandCount;
@@ -4089,6 +4104,7 @@ TclEmitInvoke(
 	TclFinalizeLoopExceptionRange(envPtr, loopRange);
 	TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127);
     }
+    TclCheckStackDepth(depth+1-cleanup, envPtr);
 }
 
 /*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 287ab1d..b3c8442 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1169,6 +1169,21 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 	(envPtr)->currStackDepth += (delta);				\
     } while (0)
 
+#define TclGetStackDepth(envPtr)		\
+    ((envPtr)->currStackDepth)
+
+#define TclSetStackDepth(depth, envPtr)		\
+    (envPtr)->currStackDepth = (depth)
+
+#define TclCheckStackDepth(depth, envPtr)				\
+    do {								\
+	int dd = (depth);						\
+	if (dd != (envPtr)->currStackDepth) {				\
+	    Tcl_Panic("bad stack depth computations: is %i, should be %i", \
+		    (envPtr)->currStackDepth, dd);		\
+	}								\
+    } while (0)
+
 /*
  * Macro used to update the stack requirements. It is called by the macros
  * TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
-- 
cgit v0.12


From 0dc5e35d3b0f0bda4129dd72223c109c778a4331 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 24 Dec 2013 18:57:46 +0000
Subject: interim commit; not yet working

---
 generic/tclExecute.c | 120 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 120 insertions(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 73f388b..d178934 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5157,6 +5157,126 @@ TEBCresume(
 	int length3;
 	Tcl_Obj *value3Ptr;
 
+    case INST_STR_REPLACE:
+	valuePtr = OBJ_AT_DEPTH(3);
+	length = Tcl_GetCharLength(valuePtr) - 1;
+	value3Ptr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
+		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(value3Ptr)));
+	if (TclGetIntForIndexM(interp, OBJ_AT_DEPTH(2), length,
+		    &fromIdx) != TCL_OK
+	    || TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
+		    &toIdx) != TCL_OK) {
+	    goto gotError;
+	}
+	if (fromIdx < 0) {
+	    fromIdx = 0;
+	}
+
+	if (fromIdx > toIdx || fromIdx > length) {
+	    TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 3, 0);
+	}
+
+	if (fromIdx == 0 && toIdx == length) {
+	    objResultPtr = value3Ptr;
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 4, 1);
+	}
+
+	length3 = Tcl_GetCharLength(value3Ptr);
+
+	/*
+	 * Remove substring. In-place.
+	 */
+
+	if (length3 == 0 && !Tcl_IsShared(valuePtr) && toIdx == length) {
+	    Tcl_SetObjLength(valuePtr, fromIdx);
+	    TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 3, 0);
+	}
+
+	// Splice in place.
+
+	if (length3 == toIdx - fromIdx) {
+	    unsigned char *bytes1, *bytes2;
+
+	    if (Tcl_IsShared(valuePtr)) {
+		objResultPtr = Tcl_DuplicateObj(valuePtr);
+		// splice "in place"
+		if (TclIsPureByteArray(objResultPtr)
+			&& TclIsPureByteArray(value3Ptr)) {
+		    bytes1 = Tcl_GetByteArrayFromObj(objResultPtr);
+		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr);
+		} else {
+		}
+		NEXT_INST_F(1, 4, 1);
+	    } else {
+		// splice "in place"
+		if (TclIsPureByteArray(valuePtr)
+			&& TclIsPureByteArray(value3Ptr)) {
+		    bytes1 = Tcl_GetByteArrayFromObj(valuePtr);
+		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr);
+		} else {
+		}
+		NEXT_INST_F(1, 3, 0);
+	    }
+	}
+
+	/*
+	 * Get the unicode representation; this is where we guarantee to lose
+	 * bytearrays.
+	 */
+
+	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+	length--;
+
+	/*
+	 * Remove substring using copying.
+	 */
+
+	if (length3 == 0) {
+	    if (fromIdx > 0) {
+		objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
+		if (toIdx < length) {
+		    Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+			    length - toIdx);
+		}
+	    } else {
+		objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
+			length - toIdx);
+	    }
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 4, 1);
+	}
+
+	/*
+	 * Splice string pieces by full copying.
+	 */
+
+	if (fromIdx > 0) {
+	    objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
+	    Tcl_AppendObjToObj(objResultPtr, value3Ptr);
+	    if (toIdx < length) {
+		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+			length - toIdx);
+	    }
+	} else if (Tcl_IsShared(value3Ptr)) {
+	    objResultPtr = Tcl_DuplicateObj(value3Ptr);
+	    if (toIdx < length) {
+		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+			length - toIdx);
+	    }
+	} else {
+	    objResultPtr = value3Ptr;
+	    if (toIdx < length) {
+		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+			length - toIdx);
+	    }
+	}
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_F(1, 4, 1);
+
     case INST_STR_MAP:
 	valuePtr = OBJ_AT_TOS;		/* "Main" string. */
 	value3Ptr = OBJ_UNDER_TOS;	/* "Target" string. */
-- 
cgit v0.12


From 7ccc50d8b67a7e642928d04bfb66ec3ee4052fbb Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 28 Dec 2013 17:21:39 +0000
Subject: completed instruction implementation

---
 generic/tclCompile.c |  4 +++
 generic/tclCompile.h |  3 ++-
 generic/tclExecute.c | 72 +++++++++++++++++++++++++++++++++++++---------------
 3 files changed, 57 insertions(+), 22 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index db97c45..5474535 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -606,6 +606,10 @@ InstructionDesc const tclInstructionTable[] = {
 	/* [string totitle] core: converts whole string to upper case using
 	 * the default (extended "C" locale) rules.
 	 * Stack: ... string => ... newString */
+    {"strReplace",	 1,	-3,	  0,	{OPERAND_NONE}},
+	/* [string replace] core: replaces a non-empty range of one string
+	 * with the contents of another.
+	 * Stack: ... string fromIdx toIdx replacement => ... newString */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 6226f7f..207b710 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -784,9 +784,10 @@ typedef struct ByteCode {
 #define INST_STR_UPPER			174
 #define INST_STR_LOWER			175
 #define INST_STR_TITLE			176
+#define INST_STR_REPLACE		177
 
 /* The last opcode */
-#define LAST_INST_OPCODE		176
+#define LAST_INST_OPCODE		177
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d178934..3ba252f 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5158,30 +5158,41 @@ TEBCresume(
 	Tcl_Obj *value3Ptr;
 
     case INST_STR_REPLACE:
-	valuePtr = OBJ_AT_DEPTH(3);
+	value3Ptr = POP_OBJECT();
+	valuePtr = OBJ_AT_DEPTH(2);
 	length = Tcl_GetCharLength(valuePtr) - 1;
-	value3Ptr = OBJ_AT_TOS;
 	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
-		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(value3Ptr)));
-	if (TclGetIntForIndexM(interp, OBJ_AT_DEPTH(2), length,
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
+	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
 		    &fromIdx) != TCL_OK
-	    || TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
+	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
 		    &toIdx) != TCL_OK) {
+	    TclDecrRefCount(value3Ptr);
 	    goto gotError;
 	}
+	TclDecrRefCount(OBJ_AT_TOS);
+	(void) POP_OBJECT();
+	TclDecrRefCount(OBJ_AT_TOS);
+	(void) POP_OBJECT();
 	if (fromIdx < 0) {
 	    fromIdx = 0;
 	}
 
 	if (fromIdx > toIdx || fromIdx > length) {
 	    TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
-	    NEXT_INST_F(1, 3, 0);
+	    TclDecrRefCount(value3Ptr);
+	    NEXT_INST_F(1, 0, 0);
+	}
+
+	if (toIdx > length) {
+	    toIdx = length;
 	}
 
 	if (fromIdx == 0 && toIdx == length) {
-	    objResultPtr = value3Ptr;
-	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	    NEXT_INST_F(1, 4, 1);
+	    TclDecrRefCount(OBJ_AT_TOS);
+	    OBJ_AT_TOS = value3Ptr;
+	    TRACE_APPEND(("%.30s\n", O2S(value3Ptr)));
+	    NEXT_INST_F(1, 0, 0);
 	}
 
 	length3 = Tcl_GetCharLength(value3Ptr);
@@ -5191,35 +5202,52 @@ TEBCresume(
 	 */
 
 	if (length3 == 0 && !Tcl_IsShared(valuePtr) && toIdx == length) {
+	    TclDecrRefCount(value3Ptr);
 	    Tcl_SetObjLength(valuePtr, fromIdx);
 	    TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
-	    NEXT_INST_F(1, 3, 0);
+	    NEXT_INST_F(1, 0, 0);
 	}
 
-	// Splice in place.
+	/*
+	 * See if we can splice in place. This happens when the number of
+	 * characters being replaced is the same as the number of characters
+	 * in the string to be inserted.
+	 */
 
 	if (length3 == toIdx - fromIdx) {
 	    unsigned char *bytes1, *bytes2;
 
 	    if (Tcl_IsShared(valuePtr)) {
 		objResultPtr = Tcl_DuplicateObj(valuePtr);
-		// splice "in place"
 		if (TclIsPureByteArray(objResultPtr)
 			&& TclIsPureByteArray(value3Ptr)) {
-		    bytes1 = Tcl_GetByteArrayFromObj(objResultPtr);
-		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr);
+		    bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
+		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
+		    memcpy(bytes1 + fromIdx, bytes2, length3);
 		} else {
+		    ustring1 = Tcl_GetUnicode(objResultPtr);
+		    ustring2 = Tcl_GetUnicode(value3Ptr);
+		    memcpy(ustring1 + fromIdx, ustring2,
+			    length3 * sizeof(Tcl_UniChar));
 		}
-		NEXT_INST_F(1, 4, 1);
+		Tcl_InvalidateStringRep(objResultPtr);
+		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+		NEXT_INST_F(1, 1, 1);
 	    } else {
-		// splice "in place"
 		if (TclIsPureByteArray(valuePtr)
 			&& TclIsPureByteArray(value3Ptr)) {
-		    bytes1 = Tcl_GetByteArrayFromObj(valuePtr);
-		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr);
+		    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, NULL);
+		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
+		    memcpy(bytes1 + fromIdx, bytes2, length3);
 		} else {
+		    ustring1 = Tcl_GetUnicode(valuePtr);
+		    ustring2 = Tcl_GetUnicode(value3Ptr);
+		    memcpy(ustring1 + fromIdx, ustring2,
+			    length3 * sizeof(Tcl_UniChar));
 		}
-		NEXT_INST_F(1, 3, 0);
+		Tcl_InvalidateStringRep(valuePtr);
+		TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
+		NEXT_INST_F(1, 0, 0);
 	    }
 	}
 
@@ -5246,8 +5274,9 @@ TEBCresume(
 		objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
 			length - toIdx);
 	    }
+	    TclDecrRefCount(value3Ptr);
 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	    NEXT_INST_F(1, 4, 1);
+	    NEXT_INST_F(1, 1, 1);
 	}
 
 	/*
@@ -5274,8 +5303,9 @@ TEBCresume(
 			length - toIdx);
 	    }
 	}
+	TclDecrRefCount(value3Ptr);
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_F(1, 4, 1);
+	NEXT_INST_F(1, 1, 1);
 
     case INST_STR_MAP:
 	valuePtr = OBJ_AT_TOS;		/* "Main" string. */
-- 
cgit v0.12


From 348916814c5f0e9bac693424abe20aefe1150869 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 29 Dec 2013 16:59:15 +0000
Subject: use the new instruction

---
 generic/tclCompCmdsSZ.c | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 110476e..649a76a 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -765,12 +765,25 @@ TclCompileStringReplaceCmd(
 
     } else {
 	/*
-	 * Too complicated to optimize, but we know the number of arguments is
-	 * correct so we can issue a call of the "standard" implementation.
+	 * Need to process indices at runtime. This could be because the
+	 * indices are not constants, or because we need to resolve them to
+	 * absolute indices to work out if a replacement is going to happen.
+	 * In any case, to runtime it is.
 	 */
 
     genericReplace:
-	return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+	CompileWord(envPtr, valueTokenPtr, interp, 1);
+	tokenPtr = TokenAfter(valueTokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 2);
+	tokenPtr = TokenAfter(tokenPtr);
+	CompileWord(envPtr, tokenPtr, interp, 3);
+	if (replacementTokenPtr != NULL) {
+	    CompileWord(envPtr, replacementTokenPtr, interp, 4);
+	} else {
+	    PUSH(	"");
+	}
+	OP(		STR_REPLACE);
+	return TCL_OK;
     }
 }
 
-- 
cgit v0.12


From 295782408448c9a034b86367186e93bc84f0ce7b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 29 Dec 2013 18:48:09 +0000
Subject: precondition was wrong, and needed to flush part of the
 string/internal rep

---
 generic/tclExecute.c | 32 +++++++++++++++++++++++++++-----
 1 file changed, 27 insertions(+), 5 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 3ba252f..bbc3731 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5214,7 +5214,7 @@ TEBCresume(
 	 * in the string to be inserted.
 	 */
 
-	if (length3 == toIdx - fromIdx) {
+	if (length3 - 1 == toIdx - fromIdx) {
 	    unsigned char *bytes1, *bytes2;
 
 	    if (Tcl_IsShared(valuePtr)) {
@@ -5225,10 +5225,21 @@ TEBCresume(
 		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
 		    memcpy(bytes1 + fromIdx, bytes2, length3);
 		} else {
-		    ustring1 = Tcl_GetUnicode(objResultPtr);
-		    ustring2 = Tcl_GetUnicode(value3Ptr);
+		    ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
+		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
 		    memcpy(ustring1 + fromIdx, ustring2,
 			    length3 * sizeof(Tcl_UniChar));
+
+		    /*
+		     * Magic! Flush the info in the string internal rep that
+		     * refers to the about-to-be-invalidated UTF-8 rep. This
+		     * sets the 'allocated' field of the String structure to 0
+		     * to indicate that a new buffer needs to be allocated.
+		     * This is safe; we know we've got a tclStringTypePtr set
+		     * at this point (post Tcl_GetUnicodeFromObj).
+		     */
+
+		    ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0;
 		}
 		Tcl_InvalidateStringRep(objResultPtr);
 		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
@@ -5240,10 +5251,21 @@ TEBCresume(
 		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
 		    memcpy(bytes1 + fromIdx, bytes2, length3);
 		} else {
-		    ustring1 = Tcl_GetUnicode(valuePtr);
-		    ustring2 = Tcl_GetUnicode(value3Ptr);
+		    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, NULL);
+		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
 		    memcpy(ustring1 + fromIdx, ustring2,
 			    length3 * sizeof(Tcl_UniChar));
+
+		    /*
+		     * Magic! Flush the info in the string internal rep that
+		     * refers to the about-to-be-invalidated UTF-8 rep. This
+		     * sets the 'allocated' field of the String structure to 0
+		     * to indicate that a new buffer needs to be allocated.
+		     * This is safe; we know we've got a tclStringTypePtr set
+		     * at this point (post Tcl_GetUnicodeFromObj).
+		     */
+
+		    ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0;
 		}
 		Tcl_InvalidateStringRep(valuePtr);
 		TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
-- 
cgit v0.12


From 6b5eaa39012660c8f02bd6f4375089298006e987 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 30 Dec 2013 08:12:52 +0000
Subject: corrected comment

---
 generic/tclCompCmdsSZ.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 649a76a..c4af5ce 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -700,8 +700,8 @@ TclCompileStringReplaceCmd(
 
     /*
      * We handle these replacements specially: first character (where
-     * idx1=idx2=0) and suffixes (where idx1=idx2=INDEX_END). Anything else
-     * and the semantics get rather screwy.
+     * idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything
+     * else and the semantics get rather screwy.
      */
 
     if (idx1 == 0 && idx2 == 0) {
-- 
cgit v0.12


From 96f3f9a79df5d9ce6166a00452822684e177b743 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 30 Dec 2013 08:16:21 +0000
Subject: allow generation by assembler

---
 generic/tclAssembly.c | 7 ++++---
 generic/tclCompile.c  | 8 ++++----
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index cd0a42d..b7bd1cd 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -453,9 +453,9 @@ static const TalInstDesc TalInstructionTable[] = {
 					 | INST_STORE_ARRAY4),	2,	1},
     {"storeArrayStk",	ASSEM_1BYTE,	INST_STORE_ARRAY_STK,	3,	1},
     {"storeStk",	ASSEM_1BYTE,	INST_STORE_STK,		2,	1},
-    {"strLower",	ASSEM_1BYTE,	INST_STR_LOWER,		1,	1},
-    {"strTitle",	ASSEM_1BYTE,	INST_STR_TITLE,		1,	1},
-    {"strUpper",	ASSEM_1BYTE,	INST_STR_UPPER,		1,	1},
+    {"strcaseLower",	ASSEM_1BYTE,	INST_STR_LOWER,		1,	1},
+    {"strcaseTitle",	ASSEM_1BYTE,	INST_STR_TITLE,		1,	1},
+    {"strcaseUpper",	ASSEM_1BYTE,	INST_STR_UPPER,		1,	1},
     {"strcmp",		ASSEM_1BYTE,	INST_STR_CMP,		2,	1},
     {"strcat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
     {"streq",		ASSEM_1BYTE,	INST_STR_EQ,		2,	1},
@@ -466,6 +466,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"strmatch",	ASSEM_BOOL,	INST_STR_MATCH,		2,	1},
     {"strneq",		ASSEM_1BYTE,	INST_STR_NEQ,		2,	1},
     {"strrange",	ASSEM_1BYTE,	INST_STR_RANGE,		3,	1},
+    {"strreplace",	ASSEM_1BYTE,	INST_STR_REPLACE,	4,	1},
     {"strrfind",	ASSEM_1BYTE,	INST_STR_FIND_LAST,	2,	1},
     {"strtrim",		ASSEM_1BYTE,	INST_STR_TRIM,		2,	1},
     {"strtrimLeft",	ASSEM_1BYTE,	INST_STR_TRIM_LEFT,	2,	1},
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 5474535..4ce5a66 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -594,19 +594,19 @@ InstructionDesc const tclInstructionTable[] = {
 	 * is number of values to concatenate.
 	 * Operation:	push concat(stk1 stk2 ... stktop) */
 
-    {"strUpper",	 1,	0,	  0,	{OPERAND_NONE}},
+    {"strcaseUpper",	 1,	0,	  0,	{OPERAND_NONE}},
 	/* [string toupper] core: converts whole string to upper case using
 	 * the default (extended "C" locale) rules.
 	 * Stack: ... string => ... newString */
-    {"strLower",	 1,	0,	  0,	{OPERAND_NONE}},
+    {"strcaseLower",	 1,	0,	  0,	{OPERAND_NONE}},
 	/* [string tolower] core: converts whole string to upper case using
 	 * the default (extended "C" locale) rules.
 	 * Stack: ... string => ... newString */
-    {"strTitle",	 1,	0,	  0,	{OPERAND_NONE}},
+    {"strcaseTitle",	 1,	0,	  0,	{OPERAND_NONE}},
 	/* [string totitle] core: converts whole string to upper case using
 	 * the default (extended "C" locale) rules.
 	 * Stack: ... string => ... newString */
-    {"strReplace",	 1,	-3,	  0,	{OPERAND_NONE}},
+    {"strreplace",	 1,	-3,	  0,	{OPERAND_NONE}},
 	/* [string replace] core: replaces a non-empty range of one string
 	 * with the contents of another.
 	 * Stack: ... string fromIdx toIdx replacement => ... newString */
-- 
cgit v0.12


From 1749e8cdf33e8232f22acc08f9ce4301b00ba7eb Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 30 Dec 2013 08:37:49 +0000
Subject: implement [namespace origin] in bytecode

---
 generic/tclAssembly.c   |  1 +
 generic/tclCompCmdsGR.c | 22 ++++++++++++++++++++++
 generic/tclCompile.c    |  5 +++++
 generic/tclCompile.h    |  4 +++-
 generic/tclExecute.c    | 26 ++++++++++++++++++++++++--
 generic/tclInt.h        |  3 +++
 generic/tclNamesp.c     |  2 +-
 7 files changed, 59 insertions(+), 4 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index b7bd1cd..89c286a 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -437,6 +437,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"nop",		ASSEM_1BYTE,	INST_NOP,		0,	0},
     {"not",		ASSEM_1BYTE,	INST_LNOT,		1,	1},
     {"nsupvar",		ASSEM_LVT4,	INST_NSUPVAR,		2,	1},
+    {"originCmd",	ASSEM_1BYTE,	INST_ORIGIN_COMMAND,	1,	1},
     {"over",		ASSEM_OVER,	INST_OVER,		INT_MIN,-1-1},
     {"pop",		ASSEM_1BYTE,	INST_POP,		1,	0},
     {"pushReturnCode",	ASSEM_1BYTE,	INST_PUSH_RETURN_CODE,	0,	1},
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index fc54620..df8895f 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -1956,6 +1956,28 @@ TclCompileNamespaceCodeCmd(
 }
 
 int
+TclCompileNamespaceOriginCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr;
+    DefineLineInformation;	/* TIP #280 */
+
+    if (parsePtr->numWords != 2) {
+	return TCL_ERROR;
+    }
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+    CompileWord(envPtr,	tokenPtr,			interp, 1);
+    TclEmitOpcode(	INST_ORIGIN_COMMAND,		envPtr);
+    return TCL_OK;
+}
+
+int
 TclCompileNamespaceQualifiersCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
     Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 4ce5a66..0732fe5 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -611,6 +611,11 @@ InstructionDesc const tclInstructionTable[] = {
 	 * with the contents of another.
 	 * Stack: ... string fromIdx toIdx replacement => ... newString */
 
+    {"originCmd",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Reports which command was the origin (via namespace import chain)
+	 * of the command named on the top of the stack.
+	 * Stack:  ... cmdName => ... fullOriginalCmdName */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 207b710..fb66e90 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -786,8 +786,10 @@ typedef struct ByteCode {
 #define INST_STR_TITLE			176
 #define INST_STR_REPLACE		177
 
+#define INST_ORIGIN_COMMAND		178
+
 /* The last opcode */
-#define LAST_INST_OPCODE		177
+#define LAST_INST_OPCODE		178
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index bbc3731..14ff3dd 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4402,15 +4402,37 @@ TEBCresume(
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_F(1, 1, 1);
     }
-    case INST_RESOLVE_COMMAND: {
-	Tcl_Command cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
+    {
+	Tcl_Command cmd, origCmd;
 
+    case INST_RESOLVE_COMMAND:
+	cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
 	TclNewObj(objResultPtr);
 	if (cmd != NULL) {
 	    Tcl_GetCommandFullName(interp, cmd, objResultPtr);
 	}
 	TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr);
 	NEXT_INST_F(1, 1, 1);
+
+    case INST_ORIGIN_COMMAND:
+	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+	cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
+	if (cmd == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+		    TclGetString(OBJ_AT_TOS), NULL);
+	    TRACE_APPEND(("ERROR: not command\n"));
+	    goto gotError;
+	}
+	origCmd = TclGetOriginalCommand(cmd);
+	if (origCmd == NULL) {
+	    origCmd = cmd;
+	}
+	TclNewObj(objResultPtr);
+	Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
+	TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
+	NEXT_INST_F(1, 1, 1);
     }
     case INST_TCLOO_SELF: {
 	CallFrame *framePtr = iPtr->varFramePtr;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1ad32df..94ee836 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3571,6 +3571,9 @@ MODULE_SCOPE int	TclCompileNamespaceCodeCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileNamespaceCurrentCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileNamespaceOriginCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index cd44455..8f2f10e 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -171,7 +171,7 @@ static const EnsembleImplMap defaultNamespaceMap[] = {
     {"forget",	   NamespaceForgetCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
     {"import",	   NamespaceImportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
     {"inscope",	   NamespaceInscopeCmd,	NULL, NRNamespaceInscopeCmd, NULL, 0},
-    {"origin",	   NamespaceOriginCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"origin",	   NamespaceOriginCmd,	TclCompileNamespaceOriginCmd, NULL, NULL, 0},
     {"parent",	   NamespaceParentCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"path",	   NamespacePathCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
-- 
cgit v0.12


From a8aff291ddf774fee8b1da5ccf150cc3fddae5af Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 30 Dec 2013 11:40:44 +0000
Subject: Factor out the definition of the default string trim set; define it
 once only.

---
 generic/tclCmdMZ.c      | 35 +---------------------------
 generic/tclCompCmdsSZ.c | 32 +-------------------------
 generic/tclStringTrim.h | 61 +++++++++++++++++++++++++++++++++++++++++++++++++
 unix/Makefile.in        |  5 ++--
 4 files changed, 66 insertions(+), 67 deletions(-)
 create mode 100644 generic/tclStringTrim.h

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index cefe850..d477216 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -18,6 +18,7 @@
 
 #include "tclInt.h"
 #include "tclRegexp.h"
+#include "tclStringTrim.h"
 
 static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
 			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
@@ -31,40 +32,6 @@ static int		TryPostHandler(ClientData data[], Tcl_Interp *interp,
 			    int result);
 static int		UniCharIsAscii(int character);
 static int		UniCharIsHexDigit(int character);
-
-/*
- * Default set of characters to trim in [string trim] and friends. This is a
- * UTF-8 literal string containing all Unicode space characters [TIP #413]
- *
- * Synch with tclCompCmdsSZ.c
- */
-
-#define DEFAULT_TRIM_SET \
-	"\x09\x0a\x0b\x0c\x0d " /* ASCII */\
-	"\xc0\x80" /*     nul (U+0000) */\
-	"\xc2\x85" /*     next line (U+0085) */\
-	"\xc2\xa0" /*     non-breaking space (U+00a0) */\
-	"\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
-	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
-	"\xe2\x80\x80" /* en quad (U+2000) */\
-	"\xe2\x80\x81" /* em quad (U+2001) */\
-	"\xe2\x80\x82" /* en space (U+2002) */\
-	"\xe2\x80\x83" /* em space (U+2003) */\
-	"\xe2\x80\x84" /* three-per-em space (U+2004) */\
-	"\xe2\x80\x85" /* four-per-em space (U+2005) */\
-	"\xe2\x80\x86" /* six-per-em space (U+2006) */\
-	"\xe2\x80\x87" /* figure space (U+2007) */\
-	"\xe2\x80\x88" /* punctuation space (U+2008) */\
-	"\xe2\x80\x89" /* thin space (U+2009) */\
-	"\xe2\x80\x8a" /* hair space (U+200a) */\
-	"\xe2\x80\x8b" /* zero width space (U+200b) */\
-	"\xe2\x80\xa8" /* line separator (U+2028) */\
-	"\xe2\x80\xa9" /* paragraph separator (U+2029) */\
-	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
-	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
-	"\xe2\x81\xa0" /* word joiner (U+2060) */\
-	"\xe3\x80\x80" /* ideographic space (U+3000) */\
-	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index c4af5ce..0f2790f 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -17,6 +17,7 @@
 
 #include "tclInt.h"
 #include "tclCompile.h"
+#include "tclStringTrim.h"
 
 /*
  * Prototypes for procedures defined later in this file:
@@ -787,37 +788,6 @@ TclCompileStringReplaceCmd(
     }
 }
 
-/*
- * Synch with tclCmdMZ.c
- */
-
-#define DEFAULT_TRIM_SET \
-	"\x09\x0a\x0b\x0c\x0d " /* ASCII */\
-	"\xc0\x80" /*     nul (U+0000) */\
-	"\xc2\x85" /*     next line (U+0085) */\
-	"\xc2\xa0" /*     non-breaking space (U+00a0) */\
-	"\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
-	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
-	"\xe2\x80\x80" /* en quad (U+2000) */\
-	"\xe2\x80\x81" /* em quad (U+2001) */\
-	"\xe2\x80\x82" /* en space (U+2002) */\
-	"\xe2\x80\x83" /* em space (U+2003) */\
-	"\xe2\x80\x84" /* three-per-em space (U+2004) */\
-	"\xe2\x80\x85" /* four-per-em space (U+2005) */\
-	"\xe2\x80\x86" /* six-per-em space (U+2006) */\
-	"\xe2\x80\x87" /* figure space (U+2007) */\
-	"\xe2\x80\x88" /* punctuation space (U+2008) */\
-	"\xe2\x80\x89" /* thin space (U+2009) */\
-	"\xe2\x80\x8a" /* hair space (U+200a) */\
-	"\xe2\x80\x8b" /* zero width space (U+200b) */\
-	"\xe2\x80\xa8" /* line separator (U+2028) */\
-	"\xe2\x80\xa9" /* paragraph separator (U+2029) */\
-	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
-	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
-	"\xe2\x81\xa0" /* word joiner (U+2060) */\
-	"\xe3\x80\x80" /* ideographic space (U+3000) */\
-	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
-
 int
 TclCompileStringTrimLCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
diff --git a/generic/tclStringTrim.h b/generic/tclStringTrim.h
new file mode 100644
index 0000000..63544a7
--- /dev/null
+++ b/generic/tclStringTrim.h
@@ -0,0 +1,61 @@
+/*
+ * tclStringTrim.h --
+ *
+ *	This file contains the definition of what characters are to be trimmed
+ *	from a string by [string trim] by default. It's only needed by Tcl's
+ *	implementation; it does not form a public or private API at all.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
+ * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2003-2013 Donal K. Fellows.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef TCL_STRING_TRIM_H
+#define TCL_STRING_TRIM_H
+
+/*
+ * Default set of characters to trim in [string trim] and friends. This is a
+ * UTF-8 literal string containing all Unicode space characters. [TIP #413]
+ */
+
+#define DEFAULT_TRIM_SET \
+	"\x09\x0a\x0b\x0c\x0d " /* ASCII */\
+	"\xc0\x80" /*     nul (U+0000) */\
+	"\xc2\x85" /*     next line (U+0085) */\
+	"\xc2\xa0" /*     non-breaking space (U+00a0) */\
+	"\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
+	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
+	"\xe2\x80\x80" /* en quad (U+2000) */\
+	"\xe2\x80\x81" /* em quad (U+2001) */\
+	"\xe2\x80\x82" /* en space (U+2002) */\
+	"\xe2\x80\x83" /* em space (U+2003) */\
+	"\xe2\x80\x84" /* three-per-em space (U+2004) */\
+	"\xe2\x80\x85" /* four-per-em space (U+2005) */\
+	"\xe2\x80\x86" /* six-per-em space (U+2006) */\
+	"\xe2\x80\x87" /* figure space (U+2007) */\
+	"\xe2\x80\x88" /* punctuation space (U+2008) */\
+	"\xe2\x80\x89" /* thin space (U+2009) */\
+	"\xe2\x80\x8a" /* hair space (U+200a) */\
+	"\xe2\x80\x8b" /* zero width space (U+200b) */\
+	"\xe2\x80\xa8" /* line separator (U+2028) */\
+	"\xe2\x80\xa9" /* paragraph separator (U+2029) */\
+	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
+	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
+	"\xe2\x81\xa0" /* word joiner (U+2060) */\
+	"\xe3\x80\x80" /* ideographic space (U+3000) */\
+	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
+
+#endif /* TCL_STRING_TRIM_H */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/unix/Makefile.in b/unix/Makefile.in
index a0d0c87..2b8e6b9 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1035,6 +1035,7 @@ IOHDR=$(GENERIC_DIR)/tclIO.h
 MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
 PARSEHDR=$(GENERIC_DIR)/tclParse.h
 NREHDR=$(GENERIC_DIR)/tclInt.h
+TRIMHDR=$(GENERIC_DIR)/tclStringTrim.h
 
 regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
 		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
@@ -1080,7 +1081,7 @@ tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c
 tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c $(TCLREHDRS)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdIL.c
 
-tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS)
+tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS) $(TRIMHDR)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdMZ.c
 
 tclDate.o: $(GENERIC_DIR)/tclDate.c
@@ -1092,7 +1093,7 @@ tclCompCmds.o: $(GENERIC_DIR)/tclCompCmds.c $(COMPILEHDR)
 tclCompCmdsGR.o: $(GENERIC_DIR)/tclCompCmdsGR.c $(COMPILEHDR)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsGR.c
 
-tclCompCmdsSZ.o: $(GENERIC_DIR)/tclCompCmdsSZ.c $(COMPILEHDR)
+tclCompCmdsSZ.o: $(GENERIC_DIR)/tclCompCmdsSZ.c $(COMPILEHDR) $(TRIMHDR)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsSZ.c
 
 tclCompExpr.o: $(GENERIC_DIR)/tclCompExpr.c $(COMPILEHDR)
-- 
cgit v0.12


From 97a9d67a6651017b5b10fe38078583043b1cb1d7 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 30 Dec 2013 11:56:54 +0000
Subject: put the other definition of a trim set in the header file too

---
 generic/tclCompCmds.c   |  7 -------
 generic/tclStringTrim.h |  7 +++++++
 generic/tclUtil.c       | 16 ++++++++++------
 unix/Makefile.in        |  2 +-
 4 files changed, 18 insertions(+), 14 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 51ac9ed..05b6d07 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -65,13 +65,6 @@ const AuxDataType tclDictUpdateInfoType = {
     FreeDictUpdateInfo,		/* freeProc */
     PrintDictUpdateInfo		/* printProc */
 };
-
-/*
- * The definition of what whitespace is stripped when [concat]enating. Must be
- * kept in synch with tclUtil.c
- */
-
-#define CONCAT_WS	" \f\v\r\t\n"
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclStringTrim.h b/generic/tclStringTrim.h
index 63544a7..669f10b 100644
--- a/generic/tclStringTrim.h
+++ b/generic/tclStringTrim.h
@@ -50,6 +50,13 @@
 	"\xe3\x80\x80" /* ideographic space (U+3000) */\
 	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
 
+/*
+ * The whitespace trimming set used when [concat]enating. This is a subset of
+ * the above, and deliberately so.
+ */
+
+#define CONCAT_TRIM_SET " \f\v\r\t\n"
+
 #endif /* TCL_STRING_TRIM_H */
 
 /*
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index b089132..2d00adf 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -14,6 +14,7 @@
 
 #include "tclInt.h"
 #include "tclParse.h"
+#include "tclStringTrim.h"
 #include <math.h>
 
 /*
@@ -1768,8 +1769,7 @@ TclTrimLeft(
  */
 
 /* The whitespace characters trimmed during [concat] operations */
-#define CONCAT_WS " \f\v\r\t\n"
-#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1)
+#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)
 
 char *
 Tcl_Concat(
@@ -1825,7 +1825,8 @@ Tcl_Concat(
 	 * Trim away the leading whitespace.
 	 */
 
-	trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
+		CONCAT_WS_SIZE);
 	element += trim;
 	elemLength -= trim;
 
@@ -1834,7 +1835,8 @@ Tcl_Concat(
 	 * a final backslash character.
 	 */
 
-	trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
+		CONCAT_WS_SIZE);
 	trim -= trim && (element[elemLength - trim - 1] == '\\');
 	elemLength -= trim;
 
@@ -1959,7 +1961,8 @@ Tcl_ConcatObj(
 	 * Trim away the leading whitespace.
 	 */
 
-	trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
+		CONCAT_WS_SIZE);
 	element += trim;
 	elemLength -= trim;
 
@@ -1968,7 +1971,8 @@ Tcl_ConcatObj(
 	 * a final backslash character.
 	 */
 
-	trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
+	trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
+		CONCAT_WS_SIZE);
 	trim -= trim && (element[elemLength - trim - 1] == '\\');
 	elemLength -= trim;
 
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 2b8e6b9..71851e6 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1309,7 +1309,7 @@ tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c
 tclTrace.o: $(GENERIC_DIR)/tclTrace.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTrace.c
 
-tclUtil.o: $(GENERIC_DIR)/tclUtil.c $(PARSEHDR)
+tclUtil.o: $(GENERIC_DIR)/tclUtil.c $(PARSEHDR) $(TRIMHDR)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c
 
 tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c
-- 
cgit v0.12


From 30c59f7cd7e2c15c29aeea8b6754f97682d07c28 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Tue, 31 Dec 2013 12:14:50 +0000
Subject: clarify the resume sequence in TEBCresume; make checkInterp a local
 variable, remove it from the saved struct

---
 generic/tclExecute.c | 42 ++++++++++++++----------------------------
 1 file changed, 14 insertions(+), 28 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 9261f19..657b5b2 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -178,7 +178,6 @@ typedef struct TEBCdata {
     ptrdiff_t *catchTop;	/* this level: they record the state when a */
     int cleanup;		/* new codePtr was received for NR */
     Tcl_Obj *auxObjList;	/* execution. */
-    int checkInterp;
     CmdFrame cmdFrame;
     void *stack[1];		/* Start of the actual combined catch and obj
 				 * stacks; the struct will be expanded as
@@ -1992,7 +1991,6 @@ TclNRExecuteByteCode(
     TD->catchTop    = initCatchTop;
     TD->cleanup     = 0;
     TD->auxObjList  = NULL;
-    TD->checkInterp = 0;
 
     /*
      * TIP #280: Initialize the frame. Do not push it yet: it will be pushed
@@ -2078,9 +2076,6 @@ TEBCresume(
 #define auxObjList	(TD->auxObjList)
 #define catchTop	(TD->catchTop)
 #define codePtr		(TD->codePtr)
-#define checkInterp	(TD->checkInterp)
-			/* Indicates when a check of interp readyness is
-			 * necessary. Set by CACHE_STACK_INFO() */
 
     /*
      * Globals: variables that store state, must remain valid at all times.
@@ -2098,6 +2093,8 @@ TEBCresume(
 
     int cleanup = 0;
     Tcl_Obj *objResultPtr;
+    int checkInterp;            /* Indicates when a check of interp readyness
+				 * is necessary. Set by CACHE_STACK_INFO() */
 
     /*
      * Locals - variables that are used within opcodes or bounded sections of
@@ -2129,10 +2126,18 @@ TEBCresume(
     }
 #endif
 
-    if (data[1] /* resume from invocation */) {
+    if (!data[1]) {
+	/* bytecode is starting from scratch */
+	checkInterp = 0;
+	goto cleanup0;
+    } else {
+        /* resume from invocation */
+	CACHE_STACK_INFO();
 	if (iPtr->execEnvPtr->rewind) {
 	    result = TCL_ERROR;
+	    goto abnormalReturn;
 	}
+
 	NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
 	if (bcFramePtr->cmdObj) {
 	    Tcl_DecrRefCount(bcFramePtr->cmdObj);
@@ -2148,7 +2153,6 @@ TEBCresume(
 	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
 	}
 
-	CACHE_STACK_INFO();
 	if (result == TCL_OK) {
 	    /*
 	     * Push the call's object result and continue execution with the
@@ -2180,30 +2184,12 @@ TEBCresume(
 	    }
 #endif
 	    NEXT_INST_V(0, cleanup, -1);
+	} else {
+	    pc--;
+	    goto processExceptionReturn;
 	}
-
-	/*
-	 * Result not TCL_OK: fall through
-	 */
     }
 
-    if (iPtr->execEnvPtr->rewind) {
-	result = TCL_ERROR;
-	goto abnormalReturn;
-    }
-
-    if (result != TCL_OK) {
-	pc--;
-	goto processExceptionReturn;
-    }
-
-    /*
-     * Loop executing instructions until a "done" instruction, a TCL_RETURN,
-     * or some error.
-     */
-
-    goto cleanup0;
-
     /*
      * Targets for standard instruction endings; unrolled for speed in the
      * most frequent cases (instructions that consume up to two stack
-- 
cgit v0.12


From 0fa7053fd789959b2c0f1efcb486958e16e22ba0 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 31 Dec 2013 16:26:55 +0000
Subject: more peephole optimizations in TEBC, and better instruction execution
 traces

---
 generic/tclExecute.c | 360 ++++++++++++++++++++++++++++++---------------------
 1 file changed, 212 insertions(+), 148 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 657b5b2..6d98cea 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -384,6 +384,8 @@ VarHashCreateVar(
 	printf a;			\
 	break;				\
     }
+#   define TRACE_ERROR(interp) \
+    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 #   define TRACE_WITH_OBJ(a, objPtr) \
     while (traceInstructions) {					\
 	fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels,	\
@@ -400,6 +402,7 @@ VarHashCreateVar(
 #else /* !TCL_COMPILE_DEBUG */
 #   define TRACE(a)
 #   define TRACE_APPEND(a)
+#   define TRACE_ERROR(interp)
 #   define TRACE_WITH_OBJ(a, objPtr)
 #   define O2S(objPtr)
 #endif /* TCL_COMPILE_DEBUG */
@@ -2745,9 +2748,9 @@ TEBCresume(
 	 */
 
 	objPtr = OBJ_AT_TOS;
+	TRACE(("\"%.30s\" => ", O2S(objPtr)));
 	if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
-	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(objPtr)),
-		    Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	(void) POP_OBJECT();
@@ -2791,6 +2794,7 @@ TEBCresume(
 	    PUSH_OBJECT(objv[i]);
 	}
 
+	TRACE_APPEND(("OK\n"));
 	Tcl_DecrRefCount(objPtr);
 	NEXT_INST_F(5, 0, 0);
     }
@@ -3135,7 +3139,7 @@ TEBCresume(
 	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
 		TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd);
 	if (varPtr == NULL) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	cleanup = 1;
@@ -3161,7 +3165,7 @@ TEBCresume(
 		TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1,
 		&arrayPtr);
 	if (!varPtr) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -3188,7 +3192,7 @@ TEBCresume(
 		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
 	CACHE_STACK_INFO();
 	if (!objResultPtr) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
@@ -3337,7 +3341,7 @@ TEBCresume(
 	varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG,
 		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
 	if (!varPtr) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	cleanup = ((part2Ptr == NULL)? 2 : 3);
@@ -3387,7 +3391,7 @@ TEBCresume(
 	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
 		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
 	if (!varPtr) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	goto doCallPtrSetVar;
@@ -3435,7 +3439,7 @@ TEBCresume(
 		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
 	CACHE_STACK_INFO();
 	if (!objResultPtr) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 #ifndef TCL_COMPILE_DEBUG
@@ -3512,7 +3516,7 @@ TEBCresume(
 	if (!varPtr) {
 	    Tcl_AddErrorInfo(interp,
 		    "\n    (reading value of variable to increment)");
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    Tcl_DecrRefCount(incrPtr);
 	    goto gotError;
 	}
@@ -3538,7 +3542,7 @@ TEBCresume(
 	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
 		TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd);
 	if (!varPtr) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    Tcl_DecrRefCount(incrPtr);
 	    goto gotError;
 	}
@@ -3650,8 +3654,7 @@ TEBCresume(
 	    TclNewLongObj(incrPtr, increment);
 	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
 		Tcl_DecrRefCount(incrPtr);
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	    Tcl_DecrRefCount(incrPtr);
@@ -3688,8 +3691,7 @@ TEBCresume(
 	    }
 	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
 		Tcl_DecrRefCount(incrPtr);
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	    Tcl_DecrRefCount(incrPtr);
@@ -3700,8 +3702,7 @@ TEBCresume(
 	    CACHE_STACK_INFO();
 	    Tcl_DecrRefCount(incrPtr);
 	    if (objResultPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	}
@@ -3722,6 +3723,8 @@ TEBCresume(
      */
 
     case INST_EXIST_SCALAR:
+	cleanup = 0;
+	pcAdjustment = 5;
 	opnd = TclGetUInt4AtPtr(pc+1);
 	varPtr = LOCAL(opnd);
 	while (TclIsVarLink(varPtr)) {
@@ -3738,16 +3741,11 @@ TEBCresume(
 		varPtr = NULL;
 	    }
 	}
-
-	/*
-	 * Tricky! Arrays always exist.
-	 */
-
-	objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_F(5, 0, 1);
+	goto afterExistsPeephole;
 
     case INST_EXIST_ARRAY:
+	cleanup = 1;
+	pcAdjustment = 5;
 	opnd = TclGetUInt4AtPtr(pc+1);
 	part2Ptr = OBJ_AT_TOS;
 	arrayPtr = LOCAL(opnd);
@@ -3758,7 +3756,7 @@ TEBCresume(
 	if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) {
 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
 	    if (!varPtr || !ReadTraced(varPtr)) {
-		goto doneExistArray;
+		goto afterExistsPeephole;
 	    }
 	}
 	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access",
@@ -3775,13 +3773,11 @@ TEBCresume(
 		varPtr = NULL;
 	    }
 	}
-    doneExistArray:
-	objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_F(5, 1, 1);
+	goto afterExistsPeephole;
 
     case INST_EXIST_ARRAY_STK:
 	cleanup = 2;
+	pcAdjustment = 1;
 	part2Ptr = OBJ_AT_TOS;		/* element name */
 	part1Ptr = OBJ_UNDER_TOS;	/* array name */
 	TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr)));
@@ -3789,6 +3785,7 @@ TEBCresume(
 
     case INST_EXIST_STK:
 	cleanup = 1;
+	pcAdjustment = 1;
 	part2Ptr = NULL;
 	part1Ptr = OBJ_AT_TOS;		/* variable name */
 	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
@@ -3808,9 +3805,31 @@ TEBCresume(
 		varPtr = NULL;
 	    }
 	}
-	objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
+
+	/*
+	 * Peep-hole optimisation: if you're about to jump, do jump from here.
+	 */
+
+    afterExistsPeephole: {
+	int found = (varPtr && !TclIsVarUndefined(varPtr));
+
+	pc += pcAdjustment;
+#ifndef TCL_COMPILE_DEBUG
+	switch (*pc) {
+	case INST_JUMP_FALSE1:
+	    NEXT_INST_V((found? 2 : TclGetInt1AtPtr(pc+1)), cleanup, 0);
+	case INST_JUMP_TRUE1:
+	    NEXT_INST_V((found? TclGetInt1AtPtr(pc+1) : 2), cleanup, 0);
+	case INST_JUMP_FALSE4:
+	    NEXT_INST_V((found? 5 : TclGetInt4AtPtr(pc+1)), cleanup, 0);
+	case INST_JUMP_TRUE4:
+	    NEXT_INST_V((found? TclGetInt4AtPtr(pc+1) : 5), cleanup, 0);
+	}
+#endif
+	objResultPtr = TCONST(found ? 1 : 0);
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_V(1, cleanup, 1);
+	NEXT_INST_V(0, cleanup, 1);
+    }
 
     /*
      *	   End of INST_EXIST instructions.
@@ -3828,7 +3847,7 @@ TEBCresume(
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
-	TRACE(("%s %u\n", (flags?"normal":"noerr"), opnd));
+	TRACE(("%s %u => ", (flags?"normal":"noerr"), opnd));
 	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
 	    /*
 	     * No errors, no traces, no searches: just make the variable cease
@@ -3841,6 +3860,7 @@ TEBCresume(
 		goto slowUnsetScalar;
 	    }
 	    varPtr->value.objPtr = NULL;
+	    TRACE_APPEND(("OK\n"));
 	    NEXT_INST_F(6, 0, 0);
 	}
 
@@ -3861,7 +3881,7 @@ TEBCresume(
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
-	TRACE(("%s %u \"%.30s\"\n",
+	TRACE(("%s %u \"%.30s\" => ",
 		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
 	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
 	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
@@ -3877,12 +3897,14 @@ TEBCresume(
 		    goto slowUnsetArray;
 		}
 		varPtr->value.objPtr = NULL;
+		TRACE_APPEND(("OK\n"));
 		NEXT_INST_F(6, 1, 0);
 	    } else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) {
 		/*
 		 * Don't need to do anything here.
 		 */
 
+		TRACE_APPEND(("OK\n"));
 		NEXT_INST_F(6, 1, 0);
 	    }
 	}
@@ -3906,7 +3928,7 @@ TEBCresume(
 	cleanup = 2;
 	part2Ptr = OBJ_AT_TOS;		/* element name */
 	part1Ptr = OBJ_UNDER_TOS;	/* array name */
-	TRACE(("%s \"%.30s(%.30s)\"\n", (flags?"normal":"noerr"),
+	TRACE(("%s \"%.30s(%.30s)\" => ", (flags?"normal":"noerr"),
 		O2S(part1Ptr), O2S(part2Ptr)));
 	goto doUnsetStk;
 
@@ -3915,7 +3937,7 @@ TEBCresume(
 	cleanup = 1;
 	part2Ptr = NULL;
 	part1Ptr = OBJ_AT_TOS;		/* variable name */
-	TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr)));
+	TRACE(("%s \"%.30s\" => ", (flags?"normal":"noerr"), O2S(part1Ptr)));
 
     doUnsetStk:
 	DECACHE_STACK_INFO();
@@ -3924,11 +3946,12 @@ TEBCresume(
 	    goto errorInUnset;
 	}
 	CACHE_STACK_INFO();
+	TRACE_APPEND(("OK\n"));
 	NEXT_INST_V(2, cleanup, 0);
 
     errorInUnset:
 	CACHE_STACK_INFO();
-	TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	TRACE_ERROR(interp);
 	goto gotError;
 
 	/*
@@ -3990,8 +4013,7 @@ TEBCresume(
 		    TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
 	    CACHE_STACK_INFO();
 	    if (result == TCL_ERROR) {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	}
@@ -4024,7 +4046,7 @@ TEBCresume(
 	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG,
 		"set", /*createPart1*/1, /*createPart2*/0, &arrayPtr);
 	if (varPtr == NULL) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
     doArrayMake:
@@ -4037,8 +4059,7 @@ TEBCresume(
 		TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
 			"variable isn't array", opnd);
 		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
-		TRACE_APPEND(("ERROR: bad array ref: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	    TclSetVarArray(varPtr);
@@ -4066,9 +4087,11 @@ TEBCresume(
 	Namespace *savedNsPtr;
 
     case INST_UPVAR:
-	TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);
+	TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
 
 	if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4083,13 +4106,16 @@ TEBCresume(
 		/*createPart2*/ 1, &varPtr);
 	iPtr->varFramePtr = savedFramePtr;
 	if (!otherPtr) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	goto doLinkVars;
 
     case INST_NSUPVAR:
-	TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
+	TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
 	if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4104,16 +4130,18 @@ TEBCresume(
 		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
 	iPtr->varFramePtr->nsPtr = savedNsPtr;
 	if (!otherPtr) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	goto doLinkVars;
 
     case INST_VARIABLE:
-	TRACE(("variable "));
+	TRACE(("%d, %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_AT_TOS)));
 	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
 		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
 		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
 	if (!otherPtr) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4131,7 +4159,7 @@ TEBCresume(
 	 * if there are no errors; otherwise, let it handle the case.
 	 */
 
-	opnd = TclGetInt4AtPtr(pc+1);;
+	opnd = TclGetInt4AtPtr(pc+1);
 	varPtr = LOCAL(opnd);
 	if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr)
 		&& (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
@@ -4143,6 +4171,7 @@ TEBCresume(
 		Var *linkPtr = varPtr->value.linkPtr;
 
 		if (linkPtr == otherPtr) {
+		    TRACE_APPEND(("already linked\n"));
 		    NEXT_INST_F(5, 1, 0);
 		}
 		if (TclIsVarInHash(linkPtr)) {
@@ -4159,6 +4188,7 @@ TEBCresume(
 	    }
 	} else if (TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0,
 		opnd) != TCL_OK) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4167,6 +4197,7 @@ TEBCresume(
 	 * variables - and [variable] did not push it at all.
 	 */
 
+	TRACE_APPEND(("link made\n"));
 	NEXT_INST_F(5, 1, 0);
     }
 
@@ -4213,31 +4244,29 @@ TEBCresume(
 
     doCondJump:
 	valuePtr = OBJ_AT_TOS;
+	TRACE(("%d => ", jmpOffset[
+		(*pc==INST_JUMP_FALSE1 || *pc==INST_JUMP_FALSE4) ? 0 : 1]));
 
 	/* TODO - check claim that taking address of b harms performance */
 	/* TODO - consider optimization search for constants */
 	if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) {
-	    TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[
-		    ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4))
-		    ? 0 : 1]), Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
 #ifdef TCL_COMPILE_DEBUG
 	if (b) {
 	    if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
-		TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1],
-			O2S(valuePtr),
+		TRACE_APPEND(("%.20s true, new pc %u\n", O2S(valuePtr),
 			(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
 	    } else {
-		TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr)));
+		TRACE_APPEND(("%.20s true\n", O2S(valuePtr)));
 	    }
 	} else {
 	    if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
-		TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr)));
+		TRACE_APPEND(("%.20s false\n", O2S(valuePtr)));
 	    } else {
-		TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0],
-			O2S(valuePtr),
+		TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr),
 			(unsigned)(pc + jmpOffset[0] - codePtr->codeStart)));
 	    }
 	}
@@ -4256,7 +4285,7 @@ TEBCresume(
 
 	opnd = TclGetInt4AtPtr(pc+1);
 	jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData;
-	TRACE(("%d => %.20s ", opnd, O2S(OBJ_AT_TOS)));
+	TRACE(("%d \"%.20s\" => ", opnd, O2S(OBJ_AT_TOS)));
 	hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS));
 	if (hPtr != NULL) {
 	    int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr));
@@ -4351,9 +4380,8 @@ TEBCresume(
 	register CallFrame *framePtr = iPtr->varFramePtr;
 	register CallFrame *rootFramePtr = iPtr->rootFramePtr;
 
-	valuePtr = OBJ_AT_TOS;
-	if (TclGetIntFromObj(interp, valuePtr, &level) != TCL_OK) {
-	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+	if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) {
+	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(OBJ_AT_TOS)),
 		    Tcl_GetObjResult(interp));
 	    goto gotError;
 	}
@@ -4366,11 +4394,11 @@ TEBCresume(
 	    /* Empty loop body */
 	}
 	if (framePtr == rootFramePtr) {
-	    Tcl_AppendResult(interp, "bad level \"", TclGetString(valuePtr),
-		    "\"", NULL);
-	    TRACE_APPEND(("ERROR: bad level\n"));
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
+	    TRACE_ERROR(interp);
 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
-		    TclGetString(valuePtr), NULL);
+		    TclGetString(OBJ_AT_TOS), NULL);
 	    goto gotError;
 	}
 	objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
@@ -4466,19 +4494,19 @@ TEBCresume(
 	NEXT_INST_V(5, opnd, 1);
 
     case INST_LIST_LENGTH:
-	valuePtr = OBJ_AT_TOS;
-	if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) {
-	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
-		    Tcl_GetObjResult(interp));
+	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
+	if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	TclNewIntObj(objResultPtr, length);
-	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+	TRACE_APPEND(("%d\n", length));
 	NEXT_INST_F(1, 1, 1);
 
     case INST_LIST_INDEX:	/* lindex with objc == 3 */
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
 
 	/*
 	 * Extract the desired list element.
@@ -4496,8 +4524,7 @@ TEBCresume(
 
 	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
 	if (!objResultPtr) {
-	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr),
-		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4505,8 +4532,7 @@ TEBCresume(
 	 * Stash the list element on the stack.
 	 */
 
-	TRACE(("%.20s %.20s => %s\n",
-		O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
 	NEXT_INST_F(1, 2, -1);	/* Already has the correct refCount */
 
     case INST_LIST_INDEX_IMM:	/* lindex with objc==3 and index in bytecode
@@ -4518,6 +4544,7 @@ TEBCresume(
 
 	valuePtr = OBJ_AT_TOS;
 	opnd = TclGetInt4AtPtr(pc+1);
+	TRACE(("\%.30s\" %d => ", O2S(valuePtr), opnd));
 
 	/*
 	 * Get the contents of the list, making sure that it really is a list
@@ -4525,8 +4552,7 @@ TEBCresume(
 	 */
 
 	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
-	    TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
-		    Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4549,8 +4575,7 @@ TEBCresume(
 	    TclNewObj(objResultPtr);
 	}
 
-	TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd),
-		objResultPtr);
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
 	NEXT_INST_F(pcAdjustment, 1, 1);
 
     case INST_LIST_INDEX_MULTI:	/* 'lindex' with multiple index args */
@@ -4565,10 +4590,11 @@ TEBCresume(
 	 * Do the 'lindex' operation.
 	 */
 
+	TRACE(("%d => ", opnd));
 	objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices),
 		numIndices, &OBJ_AT_DEPTH(numIndices - 1));
 	if (!objResultPtr) {
-	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4576,7 +4602,7 @@ TEBCresume(
 	 * Set result.
 	 */
 
-	TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
 	NEXT_INST_V(5, opnd, -1);
 
     case INST_LSET_FLAT:
@@ -4586,6 +4612,7 @@ TEBCresume(
 
 	opnd = TclGetUInt4AtPtr(pc + 1);
 	numIndices = opnd - 2;
+	TRACE(("%d => ", opnd));
 
 	/*
 	 * Get the old value of variable, and remove the stack ref. This is
@@ -4604,7 +4631,7 @@ TEBCresume(
 	objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
 		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
 	if (!objResultPtr) {
-	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4612,7 +4639,7 @@ TEBCresume(
 	 * Set result.
 	 */
 
-	TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
 	NEXT_INST_V(5, numIndices+1, -1);
 
     case INST_LSET_LIST:	/* 'lset' with 4 args */
@@ -4632,6 +4659,8 @@ TEBCresume(
 
 	valuePtr = OBJ_AT_TOS;
 	value2Ptr = OBJ_UNDER_TOS;
+	TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
+		O2S(value2Ptr), O2S(valuePtr), O2S(objPtr)));
 
 	/*
 	 * Compute the new variable value.
@@ -4639,8 +4668,7 @@ TEBCresume(
 
 	objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
 	if (!objResultPtr) {
-	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
-		    Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4648,7 +4676,7 @@ TEBCresume(
 	 * Set result.
 	 */
 
-	TRACE(("=> %s\n", O2S(objResultPtr)));
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
 	NEXT_INST_F(1, 2, -1);
 
     case INST_LIST_RANGE_IMM:	/* lrange with objc==4 and both indices in
@@ -4661,6 +4689,8 @@ TEBCresume(
 	valuePtr = OBJ_AT_TOS;
 	fromIdx = TclGetInt4AtPtr(pc+1);
 	toIdx = TclGetInt4AtPtr(pc+5);
+	TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1),
+		TclGetInt4AtPtr(pc+5)));
 
 	/*
 	 * Get the contents of the list, making sure that it really is a list
@@ -4668,8 +4698,7 @@ TEBCresume(
 	 */
 
 	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
-	    TRACE_WITH_OBJ(("\"%.30s\" %d %d => ERROR: ", O2S(valuePtr),
-		    fromIdx, toIdx), Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -4726,8 +4755,6 @@ TEBCresume(
 		List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1;
 
 		if (listPtr->refCount == 1) {
-		    TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr),
-			    TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)));
 		    for (index=toIdx+1; index<objc ; index++) {
 			TclDecrRefCount(objv[index]);
 		    }
@@ -4743,8 +4770,7 @@ TEBCresume(
 	    TclNewObj(objResultPtr);
 	}
 
-	TRACE_WITH_OBJ(("\"%.30s\" %d %d => ", O2S(valuePtr),
-		TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)), objResultPtr);
+	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
 	NEXT_INST_F(9, 1, 1);
 
     case INST_LIST_IN:
@@ -4753,9 +4779,9 @@ TEBCresume(
 	valuePtr = OBJ_UNDER_TOS;
 
 	s1 = TclGetStringFromObj(valuePtr, &s1len);
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
 	if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
-	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr),
-		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	match = 0;
@@ -4786,7 +4812,7 @@ TEBCresume(
 	    match = !match;
 	}
 
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+	TRACE_APPEND(("%d\n", match));
 
 	/*
 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
@@ -4818,7 +4844,7 @@ TEBCresume(
 	    objResultPtr = Tcl_DuplicateObj(valuePtr);
 	    if (Tcl_ListObjAppendList(interp, objResultPtr,
 		    value2Ptr) != TCL_OK) {
-		TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+		TRACE_ERROR(interp);
 		TclDecrRefCount(objResultPtr);
 		goto gotError;
 	    }
@@ -4826,7 +4852,7 @@ TEBCresume(
 	    NEXT_INST_F(1, 2, 1);
 	} else {
 	    if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){
-		TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
@@ -4980,6 +5006,7 @@ TEBCresume(
     case INST_STR_INDEX:
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
+	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
 
 	/*
 	 * Get char length to calulate what 'end' means.
@@ -4987,6 +5014,7 @@ TEBCresume(
 
 	length = Tcl_GetCharLength(valuePtr);
 	if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -5012,18 +5040,18 @@ TEBCresume(
 	    objResultPtr = Tcl_NewStringObj(buf, length);
 	}
 
-	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
-		O2S(objResultPtr)));
+	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
 	NEXT_INST_F(1, 2, 1);
 
     case INST_STR_RANGE:
-	TRACE(("\"%.20s\" %s %s =>",
+	TRACE(("\"%.20s\" %.20s %.20s =>",
 		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
 	length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
 	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
 		    &fromIdx) != TCL_OK
 	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
 		    &toIdx) != TCL_OK) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -5626,8 +5654,7 @@ TEBCresume(
 	    TRACE_APPEND(("DIVIDE BY ZERO\n"));
 	    goto divideByZero;
 	} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
-	    TRACE_APPEND(("ERROR: %s\n",
-		    TclGetString(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	} else if (objResultPtr == NULL) {
 	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
@@ -5799,8 +5826,7 @@ TEBCresume(
 	    TRACE_APPEND(("EXPONENT OF ZERO\n"));
 	    goto exponOfZero;
 	} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
-	    TRACE_APPEND(("ERROR: %s\n",
-		    TclGetString(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	} else if (objResultPtr == NULL) {
 	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
@@ -6055,6 +6081,7 @@ TEBCresume(
 	 */
 
 	opnd = TclGetUInt4AtPtr(pc+1);
+	TRACE(("%u => ", opnd));
 	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
 	numLists = infoPtr->numLists;
 
@@ -6081,8 +6108,8 @@ TEBCresume(
 	    listVarPtr = LOCAL(listTmpIndex);
 	    listPtr = listVarPtr->value.objPtr;
 	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
-		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
-			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
+		TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
+			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
 		goto gotError;
 	    }
 	    if (listLen > iterNum * numVars) {
@@ -6137,9 +6164,9 @@ TEBCresume(
 			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
 				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
 			    CACHE_STACK_INFO();
-			    TRACE_WITH_OBJ((
-				    "%u => ERROR init. index temp %d: ",
-				    opnd,varIndex), Tcl_GetObjResult(interp));
+			    TRACE_APPEND((
+				    "ERROR init. index temp %d: %s\n",
+				    varIndex, O2S(Tcl_GetObjResult(interp))));
 			    TclDecrRefCount(listPtr);
 			    goto gotError;
 			}
@@ -6151,7 +6178,7 @@ TEBCresume(
 		listTmpIndex++;
 	    }
 	}
-	TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists,
+	TRACE_APPEND(("%d lists, iter %d, %s loop\n", opnd, numLists,
 		iterNum, (continueLoop? "continue" : "exit")));
 
 	/*
@@ -6320,10 +6347,14 @@ TEBCresume(
 	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
 	}
 
+#ifdef TCL_COMPILE_DEBUG
+	NEXT_INST_F(1, 0, 0);
+#else
 	/*
 	 * FALL THROUGH
 	 */
 	pc++;
+#endif
 
     case INST_FOREACH_END:
 	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
@@ -6440,6 +6471,7 @@ TEBCresume(
     case INST_DICT_GET:
     case INST_DICT_EXISTS: {
 	register Tcl_Interp *interp2 = interp;
+	register int found;
 
 	opnd = TclGetUInt4AtPtr(pc+1);
 	TRACE(("%u => ", opnd));
@@ -6452,7 +6484,8 @@ TEBCresume(
 		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
 	    if (dictPtr == NULL) {
 		if (*pc == INST_DICT_EXISTS) {
-		    goto dictNotExists;
+		    found = 0;
+		    goto afterDictExists;
 		}
 		TRACE_WITH_OBJ((
 			"ERROR tracing dictionary path into \"%s\": ",
@@ -6464,34 +6497,56 @@ TEBCresume(
 	if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
 		&objResultPtr) == TCL_OK) {
 	    if (*pc == INST_DICT_EXISTS) {
-		objResultPtr = TCONST(objResultPtr ? 1 : 0);
-		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-		NEXT_INST_V(5, opnd+1, 1);
+		found = (objResultPtr ? 1 : 0);
+		goto afterDictExists;
 	    }
-	    if (objResultPtr) {
-		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-		NEXT_INST_V(5, opnd+1, 1);
+	    if (!objResultPtr) {
+		DECACHE_STACK_INFO();
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"key \"%s\" not known in dictionary",
+			TclGetString(OBJ_AT_TOS)));
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
+			TclGetString(OBJ_AT_TOS), NULL);
+		CACHE_STACK_INFO();
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
-	    DECACHE_STACK_INFO();
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "key \"%s\" not known in dictionary",
-		    TclGetString(OBJ_AT_TOS)));
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
-		    TclGetString(OBJ_AT_TOS), NULL);
-	    CACHE_STACK_INFO();
-	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	    NEXT_INST_V(5, opnd+1, 1);
+	} else if (*pc != INST_DICT_EXISTS) {
+	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
+		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
+	    goto gotError;
 	} else {
-	    if (*pc == INST_DICT_EXISTS) {
-	    dictNotExists:
-		objResultPtr = TCONST(0);
-		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-		NEXT_INST_V(5, opnd+1, 1);
-	    }
-	    TRACE_WITH_OBJ((
-		    "%u => ERROR reading leaf dictionary key \"%s\": ",
-		    opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
+	    found = 0;
 	}
-	goto gotError;
+    afterDictExists:
+#ifndef TCL_COMPILE_DEBUG
+	/*
+	 * The INST_DICT_EXISTS instruction is usually followed by a
+	 * conditional jump, so we can take advantage of this to do some
+	 * peephole optimization (note that we're careful to not close out
+	 * someone doing something else).
+	 */
+
+	pc += 5;
+	switch (*pc) {
+	case INST_JUMP_FALSE1:
+	    NEXT_INST_V((found ? 2 : TclGetInt1AtPtr(pc+1)), opnd+1, 0);
+	case INST_JUMP_FALSE4:
+	    NEXT_INST_V((found ? 5 : TclGetInt4AtPtr(pc+1)), opnd+1, 0);
+	case INST_JUMP_TRUE1:
+	    NEXT_INST_V((found ? TclGetInt1AtPtr(pc+1) : 2), opnd+1, 0);
+	case INST_JUMP_TRUE4:
+	    NEXT_INST_V((found ? TclGetInt4AtPtr(pc+1) : 5), opnd+1, 0);
+	default:
+	    pc -= 5;
+	    /* fall through to non-debug handling */
+	}
+#endif
+	TRACE_APPEND(("%d\n", found));
+	objResultPtr = TCONST(found);
+	NEXT_INST_V(5, opnd+1, 1);
     }
 
     case INST_DICT_SET:
@@ -6588,8 +6643,7 @@ TEBCresume(
 	    CACHE_STACK_INFO();
 	    TclDecrRefCount(dictPtr);
 	    if (objResultPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	}
@@ -6598,7 +6652,7 @@ TEBCresume(
 	    NEXT_INST_V(10, cleanup, 0);
 	}
 #endif
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
 	NEXT_INST_V(9, cleanup, 1);
 
     case INST_DICT_APPEND:
@@ -6631,6 +6685,7 @@ TEBCresume(
 	    if (allocateDict) {
 		TclDecrRefCount(dictPtr);
 	    }
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
@@ -6679,6 +6734,7 @@ TEBCresume(
 		    if (allocateDict) {
 			TclDecrRefCount(dictPtr);
 		    }
+		    TRACE_ERROR(interp);
 		    goto gotError;
 		}
 		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
@@ -6688,6 +6744,7 @@ TEBCresume(
 		    if (allocateDict) {
 			TclDecrRefCount(dictPtr);
 		    }
+		    TRACE_ERROR(interp);
 		    goto gotError;
 		}
 
@@ -6724,8 +6781,7 @@ TEBCresume(
 	    CACHE_STACK_INFO();
 	    TclDecrRefCount(dictPtr);
 	    if (objResultPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	}
@@ -6745,6 +6801,7 @@ TEBCresume(
 	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
 		&valuePtr, &done) != TCL_OK) {
 	    ckfree(searchPtr);
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	TclNewObj(statePtr);
@@ -6814,12 +6871,12 @@ TEBCresume(
     case INST_DICT_UPDATE_START:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	opnd2 = TclGetUInt4AtPtr(pc+5);
+	TRACE(("%u => ", opnd));
 	varPtr = LOCAL(opnd);
 	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
-	TRACE(("%u => \n", opnd));
 	if (TclIsVarDirectReadable(varPtr)) {
 	    dictPtr = varPtr->value.objPtr;
 	} else {
@@ -6828,11 +6885,13 @@ TEBCresume(
 		    TCL_LEAVE_ERR_MSG, opnd);
 	    CACHE_STACK_INFO();
 	    if (dictPtr == NULL) {
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	}
 	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
 		&keyPtrPtr) != TCL_OK) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	if (length != duiPtr->length) {
@@ -6841,6 +6900,7 @@ TEBCresume(
 	for (i=0 ; i<length ; i++) {
 	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
 		    &valuePtr) != TCL_OK) {
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	    varPtr = LOCAL(duiPtr->varIndices[i]);
@@ -6856,21 +6916,23 @@ TEBCresume(
 		    valuePtr, TCL_LEAVE_ERR_MSG,
 		    duiPtr->varIndices[i]) == NULL) {
 		CACHE_STACK_INFO();
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	    CACHE_STACK_INFO();
 	}
+	TRACE_APPEND(("OK\n"));
 	NEXT_INST_F(9, 0, 0);
 
     case INST_DICT_UPDATE_END:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	opnd2 = TclGetUInt4AtPtr(pc+5);
+	TRACE(("%u => ", opnd));
 	varPtr = LOCAL(opnd);
 	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
-	TRACE(("%u => ", opnd));
 	if (TclIsVarDirectReadable(varPtr)) {
 	    dictPtr = varPtr->value.objPtr;
 	} else {
@@ -6879,11 +6941,13 @@ TEBCresume(
 	    CACHE_STACK_INFO();
 	}
 	if (dictPtr == NULL) {
+	    TRACE_APPEND(("storage was unset\n"));
 	    NEXT_INST_F(9, 1, 0);
 	}
 	if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
 		|| TclListObjGetElements(interp, OBJ_AT_TOS, &length,
 			&keyPtrPtr) != TCL_OK) {
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	allocdict = Tcl_IsShared(dictPtr);
@@ -6929,26 +6993,26 @@ TEBCresume(
 		if (allocdict) {
 		    TclDecrRefCount(dictPtr);
 		}
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	}
+	TRACE_APPEND(("written back\n"));
 	NEXT_INST_F(9, 1, 0);
 
     case INST_DICT_EXPAND:
 	dictPtr = OBJ_UNDER_TOS;
 	listPtr = OBJ_AT_TOS;
+	TRACE(("%.30s %.30s =>", O2S(dictPtr), O2S(listPtr)));
 	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
-	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
-		    O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
 	if (objResultPtr == NULL) {
-	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
-		    O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
-	TRACE((" => "));
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_F(1, 2, 1);
 
@@ -6959,14 +7023,14 @@ TEBCresume(
 	TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
 		O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr)));
 	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    TclDecrRefCount(keysPtr);
 	    goto gotError;
 	}
 	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
 		TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
 	if (varPtr == NULL) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    TclDecrRefCount(keysPtr);
 	    goto gotError;
 	}
@@ -6976,7 +7040,7 @@ TEBCresume(
 	CACHE_STACK_INFO();
 	TclDecrRefCount(keysPtr);
 	if (result != TCL_OK) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	TRACE_APPEND(("OK\n"));
@@ -6990,7 +7054,7 @@ TEBCresume(
 	TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr),
 		O2S(keysPtr)));
 	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	while (TclIsVarLink(varPtr)) {
@@ -7001,7 +7065,7 @@ TEBCresume(
 		objc, objv, keysPtr);
 	CACHE_STACK_INFO();
 	if (result != TCL_OK) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	TRACE_APPEND(("OK\n"));
-- 
cgit v0.12


From d7977520d36dfb4586c6ae79c3fa3e6fc33f3b26 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 31 Dec 2013 17:28:16 +0000
Subject: more cleaning up of error-case instruction tracing

---
 generic/tclExecute.c | 21 ++++++++-------------
 1 file changed, 8 insertions(+), 13 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 82808f6..82daad7 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4391,12 +4391,11 @@ TEBCresume(
 	register CallFrame *framePtr = iPtr->varFramePtr;
 	register CallFrame *rootFramePtr = iPtr->rootFramePtr;
 
+	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
 	if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) {
-	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(OBJ_AT_TOS)),
-		    Tcl_GetObjResult(interp));
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
-	TRACE(("%d => ", level));
 	if (level <= 0) {
 	    level += framePtr->level;
 	}
@@ -5204,6 +5203,7 @@ TEBCresume(
 	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
 		    &toIdx) != TCL_OK) {
 	    TclDecrRefCount(value3Ptr);
+	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 	TclDecrRefCount(OBJ_AT_TOS);
@@ -5587,6 +5587,7 @@ TEBCresume(
 	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
 	valuePtr = OBJ_AT_TOS;		/* String */
 	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
 
 	/*
 	 * Compile and match the regular expression.
@@ -5597,23 +5598,17 @@ TEBCresume(
 		    Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
 
 	    if (regExpr == NULL) {
-		goto regexpFailure;
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
-
 	    match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
-
 	    if (match < 0) {
-	    regexpFailure:
-#ifdef TCL_COMPILE_DEBUG
-		objResultPtr = Tcl_GetObjResult(interp);
-		TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
-			O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
-#endif
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	}
 
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+	TRACE_APPEND(("%d\n", match));
 
 	/*
 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
-- 
cgit v0.12


From 16764976baae41730e54afdca94fdf9fd18dceed Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 31 Dec 2013 23:34:57 +0000
Subject: another jump peephole, this time with string comparisons

---
 generic/tclExecute.c | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6d98cea..c7d0918 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4987,6 +4987,20 @@ TEBCresume(
 		break;
 	    }
 	}
+
+#ifndef TCL_COMPILE_DEBUG
+	switch (*(pc+1)) {
+	case INST_JUMP_FALSE1:
+	    NEXT_INST_F((match? 3 : TclGetInt1AtPtr(pc+2)+1), 2, 0);
+	case INST_JUMP_TRUE1:
+	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+2)+1 : 3), 2, 0);
+	case INST_JUMP_FALSE4:
+	    NEXT_INST_F((match? 6 : TclGetInt4AtPtr(pc+2)+1), 2, 0);
+	case INST_JUMP_TRUE4:
+	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+2)+1 : 6), 2, 0);
+	}
+#endif
+
 	if (match < 0) {
 	    TclNewIntObj(objResultPtr, -1);
 	} else {
-- 
cgit v0.12


From 5f9ff26a4f64abc4d9b6c5e2f5b58e522f2b9537 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 1 Jan 2014 16:19:14 +0000
Subject: factor out a common peephole stanza

---
 generic/tclExecute.c | 216 +++++++++++++++++++--------------------------------
 1 file changed, 79 insertions(+), 137 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c7d0918..411cb8b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -319,6 +319,70 @@ VarHashCreateVar(
 	}							\
     } while (0)
 
+#ifndef TCL_COMPILE_DEBUG
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+    do {								\
+	pc += (pcAdjustment);						\
+	switch (*pc) {							\
+	case INST_JUMP_FALSE1:						\
+	    NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+	case INST_JUMP_TRUE1:						\
+	    NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+	case INST_JUMP_FALSE4:						\
+	    NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+	case INST_JUMP_TRUE4:						\
+	    NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+	default:							\
+	    if ((condition) < 0) {					\
+		TclNewIntObj(objResultPtr, -1);				\
+	    } else {							\
+		objResultPtr = TCONST((condition) > 0);			\
+	    }								\
+	    NEXT_INST_F(0, (cleanup), 1);				\
+	}								\
+    } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+    do {								\
+	pc += (pcAdjustment);						\
+	switch (*pc) {							\
+	case INST_JUMP_FALSE1:						\
+	    NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
+	case INST_JUMP_TRUE1:						\
+	    NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
+	case INST_JUMP_FALSE4:						\
+	    NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
+	case INST_JUMP_TRUE4:						\
+	    NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
+	default:							\
+	    if ((condition) < 0) {					\
+		TclNewIntObj(objResultPtr, -1);				\
+	    } else {							\
+		objResultPtr = TCONST((condition) > 0);			\
+	    }								\
+	    NEXT_INST_V(0, (cleanup), 1);				\
+	}								\
+    } while (0)
+#else /* TCL_COMPILE_DEBUG */
+#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
+    do{									\
+	if ((condition) < 0) {						\
+	    TclNewIntObj(objResultPtr, -1);				\
+	} else {							\
+	    objResultPtr = TCONST((condition) > 0);			\
+	}								\
+	NEXT_INST_F((pcAdjustment), (cleanup), 1);			\
+    } while (0)
+#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
+    do{									\
+	if ((condition) < 0) {						\
+	    TclNewIntObj(objResultPtr, -1);				\
+	} else {							\
+	    objResultPtr = TCONST((condition) > 0);			\
+	}								\
+	NEXT_INST_V((pcAdjustment), (cleanup), 1);			\
+    } while (0)
+#endif
+
 /*
  * Macros used to cache often-referenced Tcl evaluation stack information
  * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
@@ -3813,22 +3877,8 @@ TEBCresume(
     afterExistsPeephole: {
 	int found = (varPtr && !TclIsVarUndefined(varPtr));
 
-	pc += pcAdjustment;
-#ifndef TCL_COMPILE_DEBUG
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_V((found? 2 : TclGetInt1AtPtr(pc+1)), cleanup, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_V((found? TclGetInt1AtPtr(pc+1) : 2), cleanup, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_V((found? 5 : TclGetInt4AtPtr(pc+1)), cleanup, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_V((found? TclGetInt4AtPtr(pc+1) : 5), cleanup, 0);
-	}
-#endif
-	objResultPtr = TCONST(found ? 1 : 0);
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_V(0, cleanup, 1);
+	TRACE_APPEND(("%d\n", found ? 1 : 0));
+	JUMP_PEEPHOLE_V(found, pcAdjustment, cleanup);
     }
 
     /*
@@ -4820,21 +4870,7 @@ TEBCresume(
 	 * for branching.
 	 */
 
-	pc++;
-#ifndef TCL_COMPILE_DEBUG
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((match ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((match ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((match ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
-	}
-#endif
-	objResultPtr = TCONST(match);
-	NEXT_INST_F(0, 2, 1);
+	JUMP_PEEPHOLE_F(match, 1, 2);
 
     case INST_LIST_CONCAT:
 	value2Ptr = OBJ_AT_TOS;
@@ -4988,27 +5024,10 @@ TEBCresume(
 	    }
 	}
 
-#ifndef TCL_COMPILE_DEBUG
-	switch (*(pc+1)) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((match? 3 : TclGetInt1AtPtr(pc+2)+1), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+2)+1 : 3), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((match? 6 : TclGetInt4AtPtr(pc+2)+1), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+2)+1 : 6), 2, 0);
-	}
-#endif
+	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr),
+		(match < 0 ? -1 : match > 0 : 1 : 0)));
 
-	if (match < 0) {
-	    TclNewIntObj(objResultPtr, -1);
-	} else {
-	    objResultPtr = TCONST(match > 0);
-	}
-	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
-		O2S(objResultPtr)));
-	NEXT_INST_F(1, 2, 1);
+	JUMP_PEEPHOLE_F(match, 1, 2);
 
     case INST_STR_LEN:
 	valuePtr = OBJ_AT_TOS;
@@ -5268,21 +5287,7 @@ TEBCresume(
 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
 	 */
 
-	pc += 2;
-#ifndef TCL_COMPILE_DEBUG
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
-	}
-#endif
-	objResultPtr = TCONST(match);
-	NEXT_INST_F(0, 2, 1);
+	JUMP_PEEPHOLE_F(match, 2, 2);
 
     case INST_REGEXP:
 	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
@@ -5321,21 +5326,7 @@ TEBCresume(
 	 * Adjustment is 2 due to the nocase byte.
 	 */
 
-	pc += 2;
-#ifndef TCL_COMPILE_DEBUG
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
-	}
-#endif
-	objResultPtr = TCONST(match);
-	NEXT_INST_F(0, 2, 1);
+	JUMP_PEEPHOLE_F(match, 2, 2);
     }
 
     /*
@@ -5433,21 +5424,7 @@ TEBCresume(
 	 */
 
     foundResult:
-	pc++;
-#ifndef TCL_COMPILE_DEBUG
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
-	}
-#endif
-	objResultPtr = TCONST(iResult);
-	NEXT_INST_F(0, 2, 1);
+	JUMP_PEEPHOLE_F(iResult, 1, 2);
     }
 
     case INST_MOD:
@@ -6535,7 +6512,8 @@ TEBCresume(
 	    found = 0;
 	}
     afterDictExists:
-#ifndef TCL_COMPILE_DEBUG
+	TRACE_APPEND(("%d\n", found));
+
 	/*
 	 * The INST_DICT_EXISTS instruction is usually followed by a
 	 * conditional jump, so we can take advantage of this to do some
@@ -6543,24 +6521,7 @@ TEBCresume(
 	 * someone doing something else).
 	 */
 
-	pc += 5;
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_V((found ? 2 : TclGetInt1AtPtr(pc+1)), opnd+1, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_V((found ? 5 : TclGetInt4AtPtr(pc+1)), opnd+1, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_V((found ? TclGetInt1AtPtr(pc+1) : 2), opnd+1, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_V((found ? TclGetInt4AtPtr(pc+1) : 5), opnd+1, 0);
-	default:
-	    pc -= 5;
-	    /* fall through to non-debug handling */
-	}
-#endif
-	TRACE_APPEND(("%d\n", found));
-	objResultPtr = TCONST(found);
-	NEXT_INST_V(5, opnd+1, 1);
+	JUMP_PEEPHOLE_V(found, 5, opnd+1);
     }
 
     case INST_DICT_SET:
@@ -6851,8 +6812,9 @@ TEBCresume(
 	    PUSH_OBJECT(valuePtr);
 	    PUSH_OBJECT(keyPtr);
 	}
+	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
+		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
 
-#ifndef TCL_COMPILE_DEBUG
 	/*
 	 * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
 	 * followed by a conditional jump, so we can take advantage of this to
@@ -6860,27 +6822,7 @@ TEBCresume(
 	 * out someone doing something else).
 	 */
 
-	pc += 5;
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((done ? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((done ? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((done ? TclGetInt1AtPtr(pc+1) : 2), 0, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((done ? TclGetInt4AtPtr(pc+1) : 5), 0, 0);
-	default:
-	    pc -= 5;
-	    /* fall through to non-debug handling */
-	}
-#endif
-
-	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
-		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
-	objResultPtr = TCONST(done);
-	/* TODO: consider opt like INST_FOREACH_STEP4 */
-	NEXT_INST_F(5, 0, 1);
+	JUMP_PEEPHOLE_F(done, 5, 0);
 
     case INST_DICT_UPDATE_START:
 	opnd = TclGetUInt4AtPtr(pc+1);
-- 
cgit v0.12


From 019149dcdede4ca73450dc77d0ec916ed5757ac2 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 2 Jan 2014 03:10:43 +0000
Subject: more fixes to instruction tracing; ensure all places that need
 DECACHE_STACK_INFO have it. jan.nijtmans: Branch moved aside an hidden, so
 future bisects are not affected by this branch mistakes.

---
 generic/tclExecute.c | 213 +++++++++++++++++++++++++++++----------------------
 1 file changed, 123 insertions(+), 90 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 411cb8b..37588c5 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2220,41 +2220,41 @@ TEBCresume(
 	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
 	}
 
-	if (result == TCL_OK) {
-	    /*
-	     * Push the call's object result and continue execution with the
-	     * next instruction.
-	     */
+	if (result != TCL_OK) {
+	    pc--;
+	    goto processExceptionReturn;
+	}
 
-	    TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
-		    objc, cmdNameBuf), Tcl_GetObjResult(interp));
+	/*
+	 * Push the call's object result and continue execution with the next
+	 * instruction.
+	 */
 
-	    /*
-	     * Reset the interp's result to avoid possible duplications of
-	     * large objects [Bug 781585]. We do not call Tcl_ResetResult to
-	     * avoid any side effects caused by the resetting of errorInfo and
-	     * errorCode [Bug 804681], which are not needed here. We chose
-	     * instead to manipulate the interp's object result directly.
-	     *
-	     * Note that the result object is now in objResultPtr, it keeps
-	     * the refCount it had in its role of iPtr->objResultPtr.
-	     */
+	TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+		objc, cmdNameBuf), Tcl_GetObjResult(interp));
 
-	    objResultPtr = Tcl_GetObjResult(interp);
-	    TclNewObj(objPtr);
-	    Tcl_IncrRefCount(objPtr);
-	    iPtr->objResultPtr = objPtr;
+	/*
+	 * Reset the interp's result to avoid possible duplications of large
+	 * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
+	 * side effects caused by the resetting of errorInfo and errorCode
+	 * [Bug 804681], which are not needed here. We chose instead to
+	 * manipulate the interp's object result directly.
+	 *
+	 * Note that the result object is now in objResultPtr, it keeps the
+	 * refCount it had in its role of iPtr->objResultPtr.
+	 */
+
+	objResultPtr = Tcl_GetObjResult(interp);
+	TclNewObj(objPtr);
+	Tcl_IncrRefCount(objPtr);
+	iPtr->objResultPtr = objPtr;
 #ifndef TCL_COMPILE_DEBUG
-	    if (*pc == INST_POP) {
-		TclDecrRefCount(objResultPtr);
-		NEXT_INST_V(1, cleanup, 0);
-	    }
-#endif
-	    NEXT_INST_V(0, cleanup, -1);
-	} else {
-	    pc--;
-	    goto processExceptionReturn;
+	if (*pc == INST_POP) {
+	    TclDecrRefCount(objResultPtr);
+	    NEXT_INST_V(1, cleanup, 0);
 	}
+#endif
+	NEXT_INST_V(0, cleanup, -1);
     }
 
     /*
@@ -2474,8 +2474,10 @@ TEBCresume(
 	    TRACE_APPEND(("ERROR: yield outside coroutine\n"));
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "yield can only be called in a coroutine", -1));
+	    DECACHE_STACK_INFO();
 	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
 		    NULL);
+	    CACHE_STACK_INFO();
 	    goto gotError;
 	}
 
@@ -2520,7 +2522,9 @@ TEBCresume(
 	    TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "tailcall can only be called from a proc or lambda", -1));
+	    DECACHE_STACK_INFO();
 	    Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+	    CACHE_STACK_INFO();
 	    goto gotError;
 	}
 
@@ -2598,7 +2602,7 @@ TEBCresume(
     case INST_OVER:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	objResultPtr = OBJ_AT_DEPTH(opnd);
-	TRACE_WITH_OBJ(("=> "), objResultPtr);
+	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
 	NEXT_INST_F(5, 0, 1);
 
     case INST_REVERSE: {
@@ -2613,6 +2617,7 @@ TEBCresume(
 	    *b = tmpPtr;
 	    a++; b--;
 	}
+	TRACE(("%u => OK\n", opnd));
 	NEXT_INST_F(5, 0, 0);
     }
 
@@ -2783,6 +2788,7 @@ TEBCresume(
 	objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
 	objPtr->length = 0;
 	PUSH_TAUX_OBJ(objPtr);
+	TRACE(("=> mark depth as %d\n", CURR_DEPTH));
 	NEXT_INST_F(1, 0, 0);
 
     case INST_EXPAND_DROP:
@@ -2799,6 +2805,7 @@ TEBCresume(
 	/* Ugly abuse! */
 	starting = 1;
 #endif
+	TRACE(("=> drop %d items\n", objc));
 	NEXT_INST_V(1, objc, 0);
 
     case INST_EXPAND_STKTOP: {
@@ -3578,8 +3585,10 @@ TEBCresume(
 	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
 		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
 	if (!varPtr) {
+	    DECACHE_STACK_INFO();
 	    Tcl_AddErrorInfo(interp,
 		    "\n    (reading value of variable to increment)");
+	    CACHE_STACK_INFO();
 	    TRACE_ERROR(interp);
 	    Tcl_DecrRefCount(incrPtr);
 	    goto gotError;
@@ -3897,7 +3906,7 @@ TEBCresume(
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
-	TRACE(("%s %u => ", (flags?"normal":"noerr"), opnd));
+	TRACE(("%s %u => ", (flags ? "normal" : "noerr"), opnd));
 	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
 	    /*
 	     * No errors, no traces, no searches: just make the variable cease
@@ -3978,7 +3987,7 @@ TEBCresume(
 	cleanup = 2;
 	part2Ptr = OBJ_AT_TOS;		/* element name */
 	part1Ptr = OBJ_UNDER_TOS;	/* array name */
-	TRACE(("%s \"%.30s(%.30s)\" => ", (flags?"normal":"noerr"),
+	TRACE(("%s \"%.30s(%.30s)\" => ", (flags ? "normal" : "noerr"),
 		O2S(part1Ptr), O2S(part2Ptr)));
 	goto doUnsetStk;
 
@@ -3987,7 +3996,8 @@ TEBCresume(
 	cleanup = 1;
 	part2Ptr = NULL;
 	part1Ptr = OBJ_AT_TOS;		/* variable name */
-	TRACE(("%s \"%.30s\" => ", (flags?"normal":"noerr"), O2S(part1Ptr)));
+	TRACE(("%s \"%.30s\" => ", (flags ? "normal" : "noerr"),
+		O2S(part1Ptr)));
 
     doUnsetStk:
 	DECACHE_STACK_INFO();
@@ -4010,7 +4020,7 @@ TEBCresume(
 
     case INST_DICT_DONE:
 	opnd = TclGetUInt4AtPtr(pc+1);
-	TRACE(("%u\n", opnd));
+	TRACE(("%u => OK\n", opnd));
 	varPtr = LOCAL(opnd);
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
@@ -4108,7 +4118,9 @@ TEBCresume(
 
 		TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
 			"variable isn't array", opnd);
+		DECACHE_STACK_INFO();
 		Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+		CACHE_STACK_INFO();
 		TRACE_ERROR(interp);
 		goto gotError;
 	    }
@@ -4447,8 +4459,10 @@ TEBCresume(
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
 	    TRACE_ERROR(interp);
+	    DECACHE_STACK_INFO();
 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
 		    TclGetString(OBJ_AT_TOS), NULL);
+	    CACHE_STACK_INFO();
 	    goto gotError;
 	}
 	objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
@@ -4475,7 +4489,9 @@ TEBCresume(
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "self may only be called from inside a method",
 		    -1));
+	    DECACHE_STACK_INFO();
 	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+	    CACHE_STACK_INFO();
 	    goto gotError;
 	}
 	contextPtr = framePtr->clientData;
@@ -5024,16 +5040,15 @@ TEBCresume(
 	    }
 	}
 
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr),
+	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
 		(match < 0 ? -1 : match > 0 : 1 : 0)));
-
 	JUMP_PEEPHOLE_F(match, 1, 2);
 
     case INST_STR_LEN:
 	valuePtr = OBJ_AT_TOS;
 	length = Tcl_GetCharLength(valuePtr);
 	TclNewIntObj(objResultPtr, length);
-	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+	TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
 	NEXT_INST_F(1, 1, 1);
 
     case INST_STR_INDEX:
@@ -5150,27 +5165,27 @@ TEBCresume(
 	value2Ptr = OBJ_AT_DEPTH(2);	/* "Source" string. */
 	if (value3Ptr == value2Ptr) {
 	    objResultPtr = valuePtr;
-	    NEXT_INST_V(1, 3, 1);
+	    goto doneStringMap;
 	} else if (valuePtr == value2Ptr) {
 	    objResultPtr = value3Ptr;
-	    NEXT_INST_V(1, 3, 1);
+	    goto doneStringMap;
 	}
 	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
 	if (length == 0) {
 	    objResultPtr = valuePtr;
-	    NEXT_INST_V(1, 3, 1);
+	    goto doneStringMap;
 	}
 	ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
 	if (length2 > length || length2 == 0) {
 	    objResultPtr = valuePtr;
-	    NEXT_INST_V(1, 3, 1);
+	    goto doneStringMap;
 	} else if (length2 == length) {
 	    if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
 		objResultPtr = valuePtr;
 	    } else {
 		objResultPtr = value3Ptr;
 	    }
-	    NEXT_INST_V(1, 3, 1);
+	    goto doneStringMap;
 	}
 	ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
 
@@ -5199,6 +5214,7 @@ TEBCresume(
 
 	    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
 	}
+    doneStringMap:
 	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
 		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
 	NEXT_INST_V(1, 3, 1);
@@ -5221,7 +5237,6 @@ TEBCresume(
 
 	TRACE(("%.20s %.20s => %d\n",
 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-
 	TclNewIntObj(objResultPtr, match);
 	NEXT_INST_F(1, 2, 1);
 
@@ -5293,6 +5308,7 @@ TEBCresume(
 	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
 	valuePtr = OBJ_AT_TOS;		/* String */
 	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
+	TRACE(("%.20s %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
 
 	/*
 	 * Compile and match the regular expression.
@@ -5303,23 +5319,17 @@ TEBCresume(
 		    Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
 
 	    if (regExpr == NULL) {
-		goto regexpFailure;
+		TRACE_ERROR(interp);
+		goto gotError;
 	    }
-
 	    match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
-
 	    if (match < 0) {
-	    regexpFailure:
-#ifdef TCL_COMPILE_DEBUG
-		objResultPtr = Tcl_GetObjResult(interp);
-		TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
-			O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
-#endif
+		TRACE_ERROR(interp);
 		goto gotError;
 	    }
 	}
 
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+	TRACE_APPEND(("%d\n", match));
 
 	/*
 	 * Peep-hole optimisation: if you're about to jump, do jump from here.
@@ -5424,6 +5434,8 @@ TEBCresume(
 	 */
 
     foundResult:
+	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+		iResult));
 	JUMP_PEEPHOLE_F(iResult, 1, 2);
     }
 
@@ -5511,13 +5523,13 @@ TEBCresume(
 		if (l2 < 0) {
 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			    "negative shift argument", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
 		    DECACHE_STACK_INFO();
 		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
 			    "domain error: argument not in valid range",
 			    NULL);
 		    CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
 		    goto gotError;
 		} else if (l1 == 0) {
 		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
@@ -5559,13 +5571,13 @@ TEBCresume(
 		if (l2 < 0) {
 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			    "negative shift argument", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
 		    DECACHE_STACK_INFO();
 		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
 			    "domain error: argument not in valid range",
 			    NULL);
 		    CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
 		    goto gotError;
 		} else if (l1 == 0) {
 		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
@@ -5582,12 +5594,12 @@ TEBCresume(
 
 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			    "integer value too large to represent", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
 		    DECACHE_STACK_INFO();
 		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
 			    "integer value too large to represent", NULL);
 		    CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
 		    goto gotError;
 		} else {
 		    int shift = (int) l2;
@@ -5835,7 +5847,7 @@ TEBCresume(
 	/* TODO - check claim that taking address of b harms performance */
 	/* TODO - consider optimization search for constants */
 	if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
-	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
+	    TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr),
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
 	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
@@ -5844,18 +5856,20 @@ TEBCresume(
 	}
 	/* TODO: Consider peephole opt. */
 	objResultPtr = TCONST(!b);
+	TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr);
 	NEXT_INST_F(1, 1, 1);
     }
 
     case INST_BITNOT:
 	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
 	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
 		|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
 	    /*
 	     * ... ~$NonInteger => raise an error.
 	     */
 
-	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+	    TRACE_APPEND(("ERROR: illegal type %s\n",
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
 	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
@@ -5866,23 +5880,28 @@ TEBCresume(
 	    l1 = *((const long *) ptr1);
 	    if (Tcl_IsShared(valuePtr)) {
 		TclNewLongObj(objResultPtr, ~l1);
+		TRACE_APPEND(("%s\n", O2S(objResultPtr)));
 		NEXT_INST_F(1, 1, 1);
 	    }
 	    TclSetLongObj(valuePtr, ~l1);
+	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
 	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
 	if (objResultPtr != NULL) {
+	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
 	    NEXT_INST_F(1, 1, 1);
 	} else {
+	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
 
     case INST_UMINUS:
 	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
 	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
 		|| IsErroringNaNType(type1)) {
-	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+	    TRACE_APPEND(("ERROR: illegal type %s \n",
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
 	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
@@ -5892,23 +5911,28 @@ TEBCresume(
 	switch (type1) {
 	case TCL_NUMBER_NAN:
 	    /* -NaN => NaN */
+	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	case TCL_NUMBER_LONG:
 	    l1 = *((const long *) ptr1);
 	    if (l1 != LONG_MIN) {
 		if (Tcl_IsShared(valuePtr)) {
 		    TclNewLongObj(objResultPtr, -l1);
+		    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
 		    NEXT_INST_F(1, 1, 1);
 		}
 		TclSetLongObj(valuePtr, -l1);
+		TRACE_APPEND(("%s\n", O2S(valuePtr)));
 		NEXT_INST_F(1, 0, 0);
 	    }
 	    /* FALLTHROUGH */
 	}
 	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
 	if (objResultPtr != NULL) {
+	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
 	    NEXT_INST_F(1, 1, 1);
 	} else {
+	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
 
@@ -5921,6 +5945,7 @@ TEBCresume(
 	 */
 
 	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
 
 	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
 	    if (*pc == INST_UPLUS) {
@@ -5928,7 +5953,7 @@ TEBCresume(
 		 * ... +$NonNumeric => raise an error.
 		 */
 
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+		TRACE_APPEND(("ERROR: illegal type %s\n",
 			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
 		DECACHE_STACK_INFO();
 		IllegalExprOperandType(interp, pc, valuePtr);
@@ -5937,7 +5962,7 @@ TEBCresume(
 	    }
 
 	    /* ... TryConvertToNumeric($NonNumeric) is acceptable */
-	    TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
+	    TRACE_APPEND(("not numeric\n"));
 	    NEXT_INST_F(1, 0, 0);
 	}
 	if (IsErroringNaNType(type1)) {
@@ -5946,7 +5971,7 @@ TEBCresume(
 		 * ... +$NonNumeric => raise an error.
 		 */
 
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+		TRACE_APPEND(("ERROR: illegal type %s\n",
 			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
 		DECACHE_STACK_INFO();
 		IllegalExprOperandType(interp, pc, valuePtr);
@@ -5956,8 +5981,7 @@ TEBCresume(
 		 * Numeric conversion of NaN -> error.
 		 */
 
-		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
-			O2S(objResultPtr)));
+		TRACE_APPEND(("ERROR: IEEE floating pt error\n"));
 		DECACHE_STACK_INFO();
 		TclExprFloatError(interp, *((const double *) ptr1));
 		CACHE_STACK_INFO();
@@ -5975,7 +5999,7 @@ TEBCresume(
 	 */
 
 	if (valuePtr->bytes == NULL) {
-	    TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+	    TRACE_APPEND(("numeric, same Tcl_Obj\n"));
 	    NEXT_INST_F(1, 0, 0);
 	}
 	if (Tcl_IsShared(valuePtr)) {
@@ -5990,11 +6014,11 @@ TEBCresume(
 	    valuePtr->bytes = NULL;
 	    objResultPtr = Tcl_DuplicateObj(valuePtr);
 	    valuePtr->bytes = savedString;
-	    TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
+	    TRACE_APPEND(("numeric, new Tcl_Obj\n"));
 	    NEXT_INST_F(1, 1, 1);
 	}
 	TclInvalidateStringRep(valuePtr);
-	TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+	TRACE_APPEND(("numeric, same Tcl_Obj\n"));
 	NEXT_INST_F(1, 0, 0);
     }
 
@@ -6011,6 +6035,7 @@ TEBCresume(
 	*/
 	result = TCL_BREAK;
 	cleanup = 0;
+	TRACE(("=> BREAK!\n"));
 	goto processExceptionReturn;
 
     case INST_CONTINUE:
@@ -6021,6 +6046,7 @@ TEBCresume(
 	*/
 	result = TCL_CONTINUE;
 	cleanup = 0;
+	TRACE(("=> CONTINUE!\n"));
 	goto processExceptionReturn;
 
     {
@@ -6204,6 +6230,7 @@ TEBCresume(
 	opnd = TclGetUInt4AtPtr(pc+1);
 	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
 	numLists = infoPtr->numLists;
+	TRACE(("%u => ", opnd));
 
 	/*
 	 * Compute the number of iterations that will be run: iterMax
@@ -6216,8 +6243,8 @@ TEBCresume(
 	    numVars = varListPtr->numVars;
 	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
 	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
-		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
-			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
+		TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s",
+			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)));
 		goto gotError;
 	    }
 	    if (Tcl_IsShared(listPtr)) {
@@ -6253,6 +6280,7 @@ TEBCresume(
 	TclNewObj(tmpPtr);
 	tmpPtr->internalRep.otherValuePtr = infoPtr;
 	PUSH_OBJECT(tmpPtr); /* infoPtr object */
+	TRACE_APPEND(("jump to loop step\n"));
 
 	/*
 	 * Jump directly to the INST_FOREACH_STEP instruction; the C code just
@@ -6270,6 +6298,7 @@ TEBCresume(
 	tmpPtr = OBJ_AT_TOS;
 	infoPtr = tmpPtr->internalRep.otherValuePtr;
 	numLists = infoPtr->numLists;
+	TRACE(("=> "));
 
 	tmpPtr = OBJ_AT_DEPTH(1);
 	iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
@@ -6323,9 +6352,8 @@ TEBCresume(
 			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
 				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
 			    CACHE_STACK_INFO();
-			    TRACE_WITH_OBJ((
-				    "%u => ERROR init. index temp %d: ",
-				    opnd,varIndex), Tcl_GetObjResult(interp));
+			    TRACE_APPEND(("ERROR init. index temp %d: %.30s",
+				    varIndex, O2S(Tcl_GetObjResult(interp))));
 			    goto gotError;
 			}
 			CACHE_STACK_INFO();
@@ -6334,10 +6362,12 @@ TEBCresume(
 		}
 		listTmpDepth--;
 	    }
+	    TRACE_APPEND(("jump to loop start\n"));
 	    /* loopCtTemp being 'misused' for storing the jump size */
 	    NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
 	}
 
+	TRACE_APPEND(("loop has no more iterations\n"));
 #ifdef TCL_COMPILE_DEBUG
 	NEXT_INST_F(1, 0, 0);
 #else
@@ -6352,6 +6382,7 @@ TEBCresume(
 	tmpPtr = OBJ_AT_TOS;
 	infoPtr = tmpPtr->internalRep.otherValuePtr;
 	numLists = infoPtr->numLists;
+	TRACE(("=> loop terminated\n"));
 	NEXT_INST_V(1, numLists+2, 0);
 
     case INST_LMAP_COLLECT:
@@ -6368,6 +6399,7 @@ TEBCresume(
 	tmpPtr = OBJ_AT_DEPTH(1);
 	infoPtr = tmpPtr->internalRep.otherValuePtr;
 	numLists = infoPtr->numLists;
+	TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));
 	
 	objPtr = OBJ_AT_DEPTH(3 + numLists);
 	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
@@ -6433,7 +6465,8 @@ TEBCresume(
 	if (code < TCL_ERROR || code > TCL_CONTINUE) {
 	    code = TCL_CONTINUE + 1;
 	}
-	NEXT_INST_F(2*code -1, 1, 0);
+	TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1));
+	NEXT_INST_F(2*code-1, 1, 0);
     }
 
     /*
@@ -6450,10 +6483,10 @@ TEBCresume(
 
     case INST_DICT_VERIFY:
 	dictPtr = OBJ_AT_TOS;
-	TRACE(("=> "));
+	TRACE(("\"%.30s\" => ", O2S(dictPtr)));
 	if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
-	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%s\": %s\n",
-		    O2S(OBJ_AT_DEPTH(opnd)), O2S(Tcl_GetObjResult(interp))));
+	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
+		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
 	    goto gotError;
 	}
 	TRACE_APPEND(("OK\n"));
@@ -6479,7 +6512,7 @@ TEBCresume(
 		    goto afterDictExists;
 		}
 		TRACE_WITH_OBJ((
-			"ERROR tracing dictionary path into \"%s\": ",
+			"ERROR tracing dictionary path into \"%.30s\": ",
 			O2S(OBJ_AT_DEPTH(opnd))),
 			Tcl_GetObjResult(interp));
 		goto gotError;
@@ -6492,10 +6525,10 @@ TEBCresume(
 		goto afterDictExists;
 	    }
 	    if (!objResultPtr) {
-		DECACHE_STACK_INFO();
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 			"key \"%s\" not known in dictionary",
 			TclGetString(OBJ_AT_TOS)));
+		DECACHE_STACK_INFO();
 		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
 			TclGetString(OBJ_AT_TOS), NULL);
 		CACHE_STACK_INFO();
@@ -6595,8 +6628,8 @@ TEBCresume(
 	    if (allocateDict) {
 		TclDecrRefCount(dictPtr);
 	    }
-	    TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",
-		    opnd, opnd2), Tcl_GetObjResult(interp));
+	    TRACE_APPEND(("ERROR updating dictionary: %s\n",
+		    O2S(Tcl_GetObjResult(interp))));
 	    goto checkForCatch;
 	}
 
@@ -6959,7 +6992,7 @@ TEBCresume(
     case INST_DICT_EXPAND:
 	dictPtr = OBJ_UNDER_TOS;
 	listPtr = OBJ_AT_TOS;
-	TRACE(("%.30s %.30s =>", O2S(dictPtr), O2S(listPtr)));
+	TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr)));
 	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
 	    TRACE_ERROR(interp);
 	    goto gotError;
@@ -6969,7 +7002,7 @@ TEBCresume(
 	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
 	NEXT_INST_F(1, 2, 1);
 
     case INST_DICT_RECOMBINE_STK:
@@ -7117,10 +7150,10 @@ TEBCresume(
 	if (traceInstructions) {
 	    objPtr = Tcl_GetObjResult(interp);
 	    if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
-		TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+		TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ",
 			result, O2S(objPtr)));
 	    } else {
-		TRACE_APPEND(("%s, result= \"%s\"\n",
+		TRACE_APPEND(("%s, result=\"%.30s\"\n",
 			StringForResultCode(result), O2S(objPtr)));
 	    }
 	}
@@ -7133,8 +7166,8 @@ TEBCresume(
 	 */
 
     divideByZero:
-	DECACHE_STACK_INFO();
 	Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
+	DECACHE_STACK_INFO();
 	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
 	CACHE_STACK_INFO();
 	goto gotError;
@@ -7145,9 +7178,9 @@ TEBCresume(
 	 */
 
     exponOfZero:
-	DECACHE_STACK_INFO();
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"exponentiation of zero by negative power", -1));
+	DECACHE_STACK_INFO();
 	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
 		"exponentiation of zero by negative power", NULL);
 	CACHE_STACK_INFO();
-- 
cgit v0.12


From 61fd69a37510ad47b187a6072edf47a4aebc19ce Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 2 Jan 2014 08:35:01 +0000
Subject: oops...

---
 generic/tclExecute.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 37588c5..94ddab1 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6244,7 +6244,7 @@ TEBCresume(
 	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
 	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
 		TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s",
-			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)));
+			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
 		goto gotError;
 	    }
 	    if (Tcl_IsShared(listPtr)) {
-- 
cgit v0.12


From 292e2af7bb58a0e65d97b00604f9e59dc2ffa9ce Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 2 Jan 2014 08:50:08 +0000
Subject: ... and more silly errors

---
 generic/tclExecute.c | 8 ++++----
 unix/Makefile.in     | 1 +
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 94ddab1..37a7397 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2788,7 +2788,7 @@ TEBCresume(
 	objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
 	objPtr->length = 0;
 	PUSH_TAUX_OBJ(objPtr);
-	TRACE(("=> mark depth as %d\n", CURR_DEPTH));
+	TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
 	NEXT_INST_F(1, 0, 0);
 
     case INST_EXPAND_DROP:
@@ -5041,7 +5041,7 @@ TEBCresume(
 	}
 
 	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
-		(match < 0 ? -1 : match > 0 : 1 : 0)));
+		(match < 0 ? -1 : match > 0 ? 1 : 0)));
 	JUMP_PEEPHOLE_F(match, 1, 2);
 
     case INST_STR_LEN:
@@ -6195,8 +6195,8 @@ TEBCresume(
 		listTmpIndex++;
 	    }
 	}
-	TRACE_APPEND(("%d lists, iter %d, %s loop\n", opnd, numLists,
-		iterNum, (continueLoop? "continue" : "exit")));
+	TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+		numLists, iterNum, (continueLoop? "continue" : "exit")));
 
 	/*
 	 * Run-time peep-hole optimisation: the compiler ALWAYS follows
diff --git a/unix/Makefile.in b/unix/Makefile.in
index a0d0c87..f74d516 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1195,6 +1195,7 @@ tclLoadDld.o: $(UNIX_DIR)/tclLoadDld.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDld.c
 
 tclLoadDyld.o: $(UNIX_DIR)/tclLoadDyld.c
+	@echo Warnings are expected from compiling tclLoadDyld.c: deprecated API use
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDyld.c
 
 tclLoadNone.o: $(GENERIC_DIR)/tclLoadNone.c
-- 
cgit v0.12


From c3ba561b42a9a5ebac6660b70f30f37c923e0551 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 2 Jan 2014 15:30:53 +0000
Subject: redevelop code to have more in common with the interpreted [string
 is] and to remove non-working types

---
 generic/tclCompCmdsSZ.c | 147 +++++++++++++++++++++++++-----------------------
 1 file changed, 78 insertions(+), 69 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 440b5bf..06cca50 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -435,56 +435,59 @@ TclCompileStringIsCmd(
 {
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    int numWords = parsePtr->numWords;
-    enum IsType {
-	TypeBool, TypeBoolFalse, TypeBoolTrue,
-	TypeFloat,
-	TypeInteger, TypeNarrowInt, TypeWideInt,
-	TypeList /*, TypeDict */
+    static const char *const isClasses[] = {
+	"alnum",	"alpha",	"ascii",	"control",
+	"boolean",	"digit",	"double",	"entier",
+	"false",	"graph",	"integer",	"list",
+	"lower",	"print",	"punct",	"space",
+	"true",		"upper",	"wideinteger",	"wordchar",
+	"xdigit",	NULL
+    };
+    enum isClasses {
+	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
+	STR_IS_BOOL,	STR_IS_DIGIT,	STR_IS_DOUBLE,	STR_IS_ENTIER,
+	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INT,	STR_IS_LIST,
+	STR_IS_LOWER,	STR_IS_PRINT,	STR_IS_PUNCT,	STR_IS_SPACE,
+	STR_IS_TRUE,	STR_IS_UPPER,	STR_IS_WIDE,	STR_IS_WORD,
+	STR_IS_XDIGIT
     };
-    enum IsType t;
     JumpFixup jumpFixup;
-    int start, range;
-    int allowEmpty = 0;
+    int t, range, allowEmpty = 0;
+    Tcl_Obj *isClass;
 
-    if (numWords < 2 || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+    if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
 	return TCL_ERROR;
     }
-#define GotLiteral(tokenPtr,word) \
-    ((tokenPtr)[1].size > 1 && (tokenPtr)[1].start[0] == word[0] &&	\
-	    strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
-
-    if (GotLiteral(tokenPtr, "boolean")) {
-	t = TypeBool;
-    } else if (GotLiteral(tokenPtr, "double")) {
-	t = TypeFloat;
-    } else if (GotLiteral(tokenPtr, "entier")) {
-	t = TypeInteger;
-    } else if (GotLiteral(tokenPtr, "false")) {
-	t = TypeBoolFalse;
-    } else if (GotLiteral(tokenPtr, "integer")) {
-	t = TypeNarrowInt;
-	return TCL_ERROR; // Not yet implemented
-    } else if (GotLiteral(tokenPtr, "list")) {
-	t = TypeList;
-    } else if (GotLiteral(tokenPtr, "true")) {
-	t = TypeBoolTrue;
-    } else if (GotLiteral(tokenPtr, "wideinteger")) {
-	t = TypeWideInt;
-	return TCL_ERROR; // Not yet implemented
-    } else {
-	/*
-	 * We don't handle character class checks in bytecode currently.
-	 */
-
+    isClass = Tcl_NewObj();
+    if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) {
+	Tcl_DecrRefCount(isClass);
 	return TCL_ERROR;
+    } else if (Tcl_GetIndexFromObj(interp, isClass, isClasses, "class", 0,
+	    &t) != TCL_OK) {
+	Tcl_DecrRefCount(isClass);
+	TclCompileSyntaxError(interp, envPtr);
+	return TCL_OK;
     }
-    if (numWords != 3 && numWords != 4) {
+    Tcl_DecrRefCount(isClass);
+
+#define GotLiteral(tokenPtr, word) \
+    ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD &&			\
+     (tokenPtr)[1].size > 1 &&						\
+     (tokenPtr)[1].start[0] == word[0] &&				\
+     strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
+
+    /*
+     * Cannot handle the -failindex option at all, and that's the only legal
+     * way to have more than 4 arguments.
+     */
+
+    if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
 	return TCL_ERROR;
     }
+
     tokenPtr = TokenAfter(tokenPtr);
-    if (numWords == 3) {
-	allowEmpty = (t != TypeList);
+    if (parsePtr->numWords == 3) {
+	allowEmpty = (t != STR_IS_LIST);
     } else {
 	if (!GotLiteral(tokenPtr, "-strict")) {
 	    return TCL_ERROR;
@@ -494,18 +497,47 @@ TclCompileStringIsCmd(
 #undef GotLiteral
 
     /*
+     * Some types are not currently handled. Character classes are a prime
+     * example of this.
+     */
+
+    switch (t) {
+    case STR_IS_ALNUM:
+    case STR_IS_ALPHA:
+    case STR_IS_ASCII:
+    case STR_IS_CONTROL:
+    case STR_IS_DIGIT:
+    case STR_IS_GRAPH:
+    case STR_IS_LOWER:
+    case STR_IS_PRINT:
+    case STR_IS_PUNCT:
+    case STR_IS_SPACE:
+    case STR_IS_UPPER:
+    case STR_IS_WORD:
+    case STR_IS_XDIGIT:
+	return TCL_ERROR;
+
+    case STR_IS_BOOL:
+    case STR_IS_FALSE:
+    case STR_IS_INT:
+    case STR_IS_TRUE:
+    case STR_IS_WIDE:
+	/* Not yet implemented */
+	return TCL_ERROR;
+    }
+
+    /*
      * Push the word to check.
      */
 
-    CompileWord(envPtr, tokenPtr, interp, numWords-1);
+    CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
 
     /*
      * Next, do the type check. First, we push a catch range; most of the
      * type-check operations throw an exception on failure.
      */
 
-    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
-    start = 0;
+    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
     TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
     ExceptionRangeStarts(envPtr, range);
 
@@ -514,22 +546,7 @@ TclCompileStringIsCmd(
      */
 
     switch (t) {
-    case TypeBool:
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	TclEmitOpcode(		INST_LNOT,			envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
-	break;
-    case TypeBoolFalse:
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	start = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
-	break;
-    case TypeBoolTrue:
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	start = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
-	break;
-    case TypeFloat:
+    case STR_IS_DOUBLE:
 	/*
 	 * Careful! Preserve behavior of NaN which is a double (that is, true
 	 * for the purposes of a type check) but most math ops fail on it. The
@@ -550,16 +567,12 @@ TclCompileStringIsCmd(
 	TclEmitOpcode(		INST_UMINUS,			envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
 	break;
-    case TypeInteger:
+    case STR_IS_ENTIER:
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitOpcode(		INST_BITNOT,			envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
 	break;
-    case TypeNarrowInt:
-	Tcl_Panic("not yet implemented");
-    case TypeWideInt:
-	Tcl_Panic("not yet implemented");
-    case TypeList:
+    case STR_IS_LIST:
 	TclEmitOpcode(		INST_DUP,			envPtr);
 	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
 	TclEmitOpcode(		INST_POP,			envPtr);
@@ -579,10 +592,6 @@ TclCompileStringIsCmd(
     PushLiteral(envPtr, "1", 1);
     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
     ExceptionRangeTarget(envPtr, range, catchOffset);
-    if (start != 0) {
-	TclStoreInt1AtPtr(CurrentOffset(envPtr) - start,
-		envPtr->codeStart + start + 1);
-    }
     TclEmitOpcode(		INST_END_CATCH,			envPtr);
     if (allowEmpty) {
 	PushLiteral(envPtr, "", 0);
-- 
cgit v0.12


From 46e4bced044a19d781735a5c6f55a3a307dff7dc Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Sun, 5 Jan 2014 12:01:04 +0000
Subject: reducing TEBCdata: pc and cleanup now passed in the NREcallback

---
 generic/tclExecute.c | 40 ++++++++++++++++------------------------
 1 file changed, 16 insertions(+), 24 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 37a7397..3601b22 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -174,28 +174,24 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
 typedef struct TEBCdata {
     ByteCode *codePtr;		/* Constant until the BC returns */
 				/* -----------------------------------------*/
-    const unsigned char *pc;	/* These fields are used on return TO this */
-    ptrdiff_t *catchTop;	/* this level: they record the state when a */
-    int cleanup;		/* new codePtr was received for NR */
-    Tcl_Obj *auxObjList;	/* execution. */
-    CmdFrame cmdFrame;
+    ptrdiff_t *catchTop;	/* These fields are used on return TO this */
+    Tcl_Obj *auxObjList;	/* this level: they record the state when a */
+    CmdFrame cmdFrame;		/* new codePtr was received for NR */
+                                /* execution. */
     void *stack[1];		/* Start of the actual combined catch and obj
 				 * stacks; the struct will be expanded as
 				 * necessary */
 } TEBCdata;
 
 #define TEBC_YIELD() \
-    do {								\
-	esPtr->tosPtr = tosPtr;						\
-	TD->pc = pc;							\
-	TD->cleanup = cleanup;						\
-	TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \
+    do {						\
+	esPtr->tosPtr = tosPtr;				\
+	TclNRAddCallback(interp, TEBCresume,		\
+		TD, pc, INT2PTR(cleanup), NULL);	\
     } while (0)
 
 #define TEBC_DATA_DIG() \
     do {					\
-	pc = TD->pc;				\
-	cleanup = TD->cleanup;			\
 	tosPtr = esPtr->tosPtr;			\
     } while (0)
 
@@ -2032,10 +2028,6 @@ TclNRExecuteByteCode(
 		* sizeof(void *);
     int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
 
-    if (iPtr->execEnvPtr->rewind) {
-	return TCL_ERROR;
-    }
-
     codePtr->refCount++;
 
     /*
@@ -2054,9 +2046,7 @@ TclNRExecuteByteCode(
     esPtr->tosPtr = initTosPtr;
 
     TD->codePtr     = codePtr;
-    TD->pc	    = codePtr->codeStart;
     TD->catchTop    = initCatchTop;
-    TD->cleanup     = 0;
     TD->auxObjList  = NULL;
 
     /*
@@ -2086,8 +2076,8 @@ TclNRExecuteByteCode(
      * Push the callback for bytecode execution
      */
 
-    TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
-	    NULL, NULL);
+    TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
+	    /* cleanup */ INT2PTR(0), NULL);
     return TCL_OK;
 }
 
@@ -2150,7 +2140,8 @@ TEBCresume(
 
     Tcl_Obj **tosPtr;		/* Cached pointer to top of evaluation
 				 * stack. */
-    const unsigned char *pc;	/* The current program counter. */
+    const unsigned char *pc = data[1];
+                                /* The current program counter. */
     unsigned char inst;         /* The currently running instruction */
     
     /*
@@ -2158,7 +2149,7 @@ TEBCresume(
      * executing an instruction.
      */
 
-    int cleanup = 0;
+    int cleanup = PTR2INT(data[2]);
     Tcl_Obj *objResultPtr;
     int checkInterp;            /* Indicates when a check of interp readyness
 				 * is necessary. Set by CACHE_STACK_INFO() */
@@ -2186,16 +2177,17 @@ TEBCresume(
     TEBC_DATA_DIG();
 
 #ifdef TCL_COMPILE_DEBUG
-    if (!data[1] && (tclTraceExec >= 2)) {
+    if (!pc && (tclTraceExec >= 2)) {
 	PrintByteCodeInfo(codePtr);
 	fprintf(stdout, "  Starting stack top=%d\n", (int) CURR_DEPTH);
 	fflush(stdout);
     }
 #endif
 
-    if (!data[1]) {
+    if (!pc) {
 	/* bytecode is starting from scratch */
 	checkInterp = 0;
+	pc = codePtr->codeStart;
 	goto cleanup0;
     } else {
         /* resume from invocation */
-- 
cgit v0.12


From f63ef2c79888c0b68ff4e0ae7815e11e2075de65 Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Sun, 5 Jan 2014 14:10:42 +0000
Subject: skip the switch(result) on returning TCL_OK from a proc

---
 generic/tclProc.c | 72 +++++++++++++++++++++++++------------------------------
 1 file changed, 32 insertions(+), 40 deletions(-)

diff --git a/generic/tclProc.c b/generic/tclProc.c
index 1314719..ce1c767 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -1855,9 +1855,39 @@ InterpProcNR2(
     }
 
     /*
-     * Process the result code.
+     * Free the stack-allocated compiled locals and CallFrame. It is important
+     * to pop the call frame without freeing it first: the compiledLocals
+     * cannot be freed before the frame is popped, as the local variables must
+     * be deleted. But the compiledLocals must be freed first, as they were
+     * allocated later on the stack.
      */
 
+    if (result != TCL_OK) {
+	goto process;
+    }
+    
+    done: 
+    if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
+	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+	Tcl_Obj *r = Tcl_GetObjResult(interp);
+
+	TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
+		TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
+		TclGetString(r), r);
+    }
+
+    freePtr = iPtr->framePtr;
+    Tcl_PopCallFrame(interp);		/* Pop but do not free. */
+    TclStackFree(interp, freePtr->compiledLocals);
+					/* Free compiledLocals. */
+    TclStackFree(interp, freePtr);	/* Free CallFrame. */
+    return result;
+
+    /*
+     * Process any non-TCL_OK result code.
+     */
+
+    process:
     switch (result) {
     case TCL_RETURN:
 	/*
@@ -1892,46 +1922,8 @@ InterpProcNR2(
 	 */
 
 	errorProc(interp, procNameObj);
-
-    default:
-	/*
-	 * Process other results (OK and non-standard) by doing nothing
-	 * special, skipping directly to the code afterwards that cleans up
-	 * associated memory.
-	 *
-	 * Non-standard results are processed by passing them through quickly.
-	 * This means they all work as exceptions, unwinding the stack quickly
-	 * and neatly. Who knows how well they are handled by third-party code
-	 * though...
-	 */
-
-	(void) 0;		/* do nothing */
-    }
-
-    if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
-	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
-	Tcl_Obj *r = Tcl_GetObjResult(interp);
-
-	TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
-		TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
-		TclGetString(r), r);
     }
-
-    /*
-     * Free the stack-allocated compiled locals and CallFrame. It is important
-     * to pop the call frame without freeing it first: the compiledLocals
-     * cannot be freed before the frame is popped, as the local variables must
-     * be deleted. But the compiledLocals must be freed first, as they were
-     * allocated later on the stack.
-     */
-
-    freePtr = iPtr->framePtr;
-    Tcl_PopCallFrame(interp);		/* Pop but do not free. */
-    TclStackFree(interp, freePtr->compiledLocals);
-					/* Free compiledLocals. */
-    TclStackFree(interp, freePtr);	/* Free CallFrame. */
-
-    return result;
+    goto done;
 }
 
 /*
-- 
cgit v0.12


From 92f27b7095220ef6e508c9a0216e0fce97b3d2ae Mon Sep 17 00:00:00 2001
From: mig <mig>
Date: Sun, 5 Jan 2014 15:01:52 +0000
Subject: fix arraySet compiler to set -errorcode instead of -errorCode in
 return options

---
 generic/tclCompCmds.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 323aa87..3d5bfe0 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -278,7 +278,7 @@ TclCompileArraySetCmd(
 
     if (isDataValid && !isDataEven) {
 	PushStringLiteral(envPtr, "list must have an even number of elements");
-	PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
+	PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
 	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
 	TclEmitInt4(		0,				envPtr);
 	goto done;
@@ -373,7 +373,7 @@ TclCompileArraySetCmd(
 	offsetFwd = CurrentOffset(envPtr);
 	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
 	PushStringLiteral(envPtr, "list must have an even number of elements");
-	PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
+	PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
 	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
 	TclEmitInt4(		0,				envPtr);
 	TclAdjustStackDepth(-1, envPtr);
-- 
cgit v0.12


From c01192cf149de63a2a22afde7ac9adecd73f051d Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 5 Jan 2014 17:31:38 +0000
Subject: factor out a common stanza

---
 generic/tclExecute.c | 61 ++++++++++++++++++++++++++++++++++------------------
 1 file changed, 40 insertions(+), 21 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f25b588..612a5cb 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1996,6 +1996,41 @@ TclIncrObj(
 /*
  *----------------------------------------------------------------------
  *
+ * ArgumentBCEnter --
+ *
+ *	This is a helper for TclNRExecuteByteCode/TEBCresume that encapsulates
+ *	a code sequence that is fairly common in the code but *not* commonly
+ *	called.
+ *
+ * Results:
+ *	None
+ *
+ * Side effects:
+ *	May register information about the bytecode in the command frame.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ArgumentBCEnter(
+    Tcl_Interp *interp,
+    ByteCode *codePtr,
+    TEBCdata *tdPtr,
+    const unsigned char *pc,
+    int objc,
+    Tcl_Obj **objv)
+{
+    int cmd;
+
+    if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
+	TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
+		pc - codePtr->codeStart);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclNRExecuteByteCode --
  *
  *	This procedure executes the instructions of a ByteCode structure. It
@@ -2205,7 +2240,7 @@ TEBCresume(
 	}
 	iPtr->cmdFramePtr = bcFramePtr->nextPtr;
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
+	    TclArgumentBCRelease(interp, bcFramePtr);
 	}
 	if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
 	    iPtr->flags |= ERR_ALREADY_LOGGED;
@@ -2487,11 +2522,7 @@ TEBCresume(
 	iPtr->cmdFramePtr = bcFramePtr;
 
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    int cmd;
-	    if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
-		TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
-			codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
-	    }
+	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
 	}
 
 	pc++;
@@ -2961,11 +2992,7 @@ TEBCresume(
 	iPtr->cmdFramePtr = bcFramePtr;
 
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    int cmd;
-	    if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
-		TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
-			codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
-	    }
+	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
 	}
 
 	DECACHE_STACK_INFO();
@@ -3110,11 +3137,7 @@ TEBCresume(
 	bcFramePtr->data.tebc.pc = (char *) pc;
 	iPtr->cmdFramePtr = bcFramePtr;
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    int cmd;
-	    if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
-		TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
-			codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
-	    }
+	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
 	}
 	iPtr->ensembleRewrite.sourceObjs = objv;
 	iPtr->ensembleRewrite.numRemovedObjs = opnd;
@@ -4559,11 +4582,7 @@ TEBCresume(
 	iPtr->cmdFramePtr = bcFramePtr;
 
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    int cmd;
-	    if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
-		TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
-			codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
-	    }
+	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
 	}
 
 	pcAdjustment = 2;
-- 
cgit v0.12


From 23573493d5f31cddea12c4e9b6f8ae5a5d3f50c9 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 7 Jan 2014 13:59:30 +0000
Subject: reduce the overhead of NR-enabled TclOO [next]

---
 generic/tclExecute.c | 136 +++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 127 insertions(+), 9 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 612a5cb..5b42124 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -800,7 +800,8 @@ static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, int numWords);
 static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, int numWords);
 static Tcl_NRPostProc	CopyCallback;
 static Tcl_NRPostProc	ExprObjCallback;
-
+static Tcl_NRPostProc	FinalizeOONext;
+static Tcl_NRPostProc	FinalizeOONextFilter;
 static Tcl_NRPostProc   TEBCresume;
 
 /*
@@ -4535,6 +4536,7 @@ TEBCresume(
      */
 
     {
+	Object *oPtr;
 	CallFrame *framePtr;
 	CallContext *contextPtr;
 
@@ -4578,6 +4580,53 @@ TEBCresume(
 	}
 	contextPtr = framePtr->clientData;
 
+	if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
+	    /*
+	     * We're at the end of the chain; generate an error message unless
+	     * the interpreter is being torn down, in which case we might be
+	     * getting here because of methods/destructors doing a [next] (or
+	     * equivalent) unexpectedly.
+	     */
+
+	    const char *methodType;
+
+	    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+		methodType = "constructor";
+	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+		methodType = "destructor";
+	    } else {
+		methodType = "method";
+	    }
+
+	    TRACE_APPEND(("ERROR: no TclOO next impl\n"));
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "no next %s implementation", methodType));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+
+#ifdef TCL_COMPILE_DEBUG
+	if (tclTraceExec >= 2) {
+	    int i;
+
+	    if (traceInstructions) {
+		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+		TRACE(("next_in_chain "));
+	    } else {
+		fprintf(stdout, "%d: (%u) invoking next_in_chain ",
+			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart));
+	    }
+	    for (i = 0;  i < objc;  i++) {
+		TclPrintObject(stdout, objv[i], 15);
+		fprintf(stdout, " ");
+	    }
+	    fprintf(stdout, "\n");
+	    fflush(stdout);
+	}
+#endif /*TCL_COMPILE_DEBUG*/
+
 	bcFramePtr->data.tebc.pc = (char *) pc;
 	iPtr->cmdFramePtr = bcFramePtr;
 
@@ -4591,14 +4640,31 @@ TEBCresume(
 	iPtr->varFramePtr = framePtr->callerVarPtr;
 	pc += pcAdjustment;
 	TEBC_YIELD();
-	TclNRAddCallback(interp, TclOONextRestoreFrame, framePtr,
-		NULL, NULL, NULL);
-	/* TODO: consider merging another layer of processing */
-	return TclNRObjectContextInvokeNext(interp,
-		(Tcl_ObjectContext) contextPtr, opnd, &OBJ_AT_DEPTH(opnd-1), 1);
-    }
-    {
-	Object *oPtr;
+	oPtr = contextPtr->oPtr;
+	if (oPtr->flags & FILTER_HANDLING) {
+	    TclNRAddCallback(interp, FinalizeOONextFilter,
+		    framePtr, contextPtr, INT2PTR(contextPtr->index),
+		    INT2PTR(contextPtr->skip));
+	} else {
+	    TclNRAddCallback(interp, FinalizeOONext,
+		    framePtr, contextPtr, INT2PTR(contextPtr->index),
+		    INT2PTR(contextPtr->skip));
+	}
+	if (contextPtr->callPtr->chain[++contextPtr->index].isFilter
+		|| contextPtr->callPtr->flags & FILTER_HANDLING) {
+	    oPtr->flags |= FILTER_HANDLING;
+	} else {
+	    oPtr->flags &= ~FILTER_HANDLING;
+	}
+	contextPtr->skip = 1;
+	{
+	    register Method *const mPtr =
+		    contextPtr->callPtr->chain[contextPtr->index].mPtr;
+
+	    return mPtr->typePtr->callProc(mPtr->clientData, interp,
+		    (Tcl_ObjectContext) contextPtr, opnd,
+		    &OBJ_AT_DEPTH(opnd-1));
+	}
 
     case INST_TCLOO_IS_OBJECT:
 	oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
@@ -7766,6 +7832,58 @@ TEBCresume(
 #undef auxObjList
 #undef catchTop
 #undef TCONST
+
+static int
+FinalizeOONext(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    CallContext *contextPtr = data[1];
+
+    /*
+     * Reset the variable lookup frame.
+     */
+
+    iPtr->varFramePtr = data[0];
+
+    /*
+     * Restore the call chain context index as we've finished the inner invoke
+     * and want to operate in the outer context again.
+     */
+
+    contextPtr->index = PTR2INT(data[2]);
+    contextPtr->skip = PTR2INT(data[3]);
+    contextPtr->oPtr->flags &= ~FILTER_HANDLING;
+    return result;
+}
+
+static int
+FinalizeOONextFilter(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    CallContext *contextPtr = data[1];
+
+    /*
+     * Reset the variable lookup frame.
+     */
+
+    iPtr->varFramePtr = data[0];
+
+    /*
+     * Restore the call chain context index as we've finished the inner invoke
+     * and want to operate in the outer context again.
+     */
+
+    contextPtr->index = PTR2INT(data[2]);
+    contextPtr->skip = PTR2INT(data[3]);
+    contextPtr->oPtr->flags |= FILTER_HANDLING;
+    return result;
+}
 
 /*
  *----------------------------------------------------------------------
-- 
cgit v0.12


From 8bb7405765b9aed27270dfd145037e3c5884a34a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 7 Jan 2014 14:13:37 +0000
Subject: make function static once more; not needed outside of source file

---
 generic/tclInt.h     |  1 -
 generic/tclOOBasic.c | 21 +++++++++------------
 2 files changed, 9 insertions(+), 13 deletions(-)

diff --git a/generic/tclInt.h b/generic/tclInt.h
index f10beae..3aaa30b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2734,7 +2734,6 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
-MODULE_SCOPE Tcl_NRPostProc TclOONextRestoreFrame;
 
 MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
 MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 49c917b..6084cf2 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -17,14 +17,11 @@
 #include "tclOOInt.h"
 
 static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
-static int		AfterNRDestructor(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		DecrRefsPostClassConstructor(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		FinalizeConstruction(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		FinalizeEval(ClientData data[],
-			    Tcl_Interp *interp, int result);
+static Tcl_NRPostProc	AfterNRDestructor;
+static Tcl_NRPostProc	DecrRefsPostClassConstructor;
+static Tcl_NRPostProc	FinalizeConstruction;
+static Tcl_NRPostProc	FinalizeEval;
+static Tcl_NRPostProc	NextRestoreFrame;
 
 /*
  * ----------------------------------------------------------------------
@@ -806,7 +803,7 @@ TclOONextObjCmd(
      * that this is like [uplevel 1] and not [eval].
      */
 
-    TclNRAddCallback(interp, TclOONextRestoreFrame, framePtr, NULL,NULL,NULL);
+    TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
     iPtr->varFramePtr = framePtr->callerVarPtr;
     return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
 }
@@ -875,7 +872,7 @@ TclOONextToObjCmd(
 	     * context. Note that this is like [uplevel 1] and not [eval].
 	     */
 
-	    TclNRAddCallback(interp, TclOONextRestoreFrame, framePtr,
+	    TclNRAddCallback(interp, NextRestoreFrame, framePtr,
 		    contextPtr, INT2PTR(contextPtr->index), NULL);
 	    contextPtr->index = i-1;
 	    iPtr->varFramePtr = framePtr->callerVarPtr;
@@ -905,8 +902,8 @@ TclOONextToObjCmd(
     return TCL_ERROR;
 }
 
-int
-TclOONextRestoreFrame(
+static int
+NextRestoreFrame(
     ClientData data[],
     Tcl_Interp *interp,
     int result)
-- 
cgit v0.12


From b9663aff14aff96677a1252092a006ae19f81a8c Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 8 Jan 2014 11:04:44 +0000
Subject: Make DEFAULT_TRIM_SET a MODULE_SCOPE string constant, so its value
 can be shared in tclCmdMZ.o and TclCompCmdsSZ.o and it no longer pollutes the
 tclStringTrim.h header file.

---
 generic/tclCmdMZ.c      | 45 +++++++++++++++++++++++++++++++++++++++------
 generic/tclCompCmdsSZ.c |  6 +++---
 generic/tclStringTrim.h | 27 +--------------------------
 3 files changed, 43 insertions(+), 35 deletions(-)

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d477216..c02cd1a 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -32,6 +32,39 @@ static int		TryPostHandler(ClientData data[], Tcl_Interp *interp,
 			    int result);
 static int		UniCharIsAscii(int character);
 static int		UniCharIsHexDigit(int character);
+
+/*
+ * Default set of characters to trim in [string trim] and friends. This is a
+ * UTF-8 literal string containing all Unicode space characters [TIP #413]
+ */
+
+const char tclDefaultTrimSet[] = 
+	"\x09\x0a\x0b\x0c\x0d " /* ASCII */
+	"\xc0\x80" /*     nul (U+0000) */
+	"\xc2\x85" /*     next line (U+0085) */
+	"\xc2\xa0" /*     non-breaking space (U+00a0) */
+	"\xe1\x9a\x80" /* ogham space mark (U+1680) */
+	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */
+	"\xe2\x80\x80" /* en quad (U+2000) */
+	"\xe2\x80\x81" /* em quad (U+2001) */
+	"\xe2\x80\x82" /* en space (U+2002) */
+	"\xe2\x80\x83" /* em space (U+2003) */
+	"\xe2\x80\x84" /* three-per-em space (U+2004) */
+	"\xe2\x80\x85" /* four-per-em space (U+2005) */
+	"\xe2\x80\x86" /* six-per-em space (U+2006) */
+	"\xe2\x80\x87" /* figure space (U+2007) */
+	"\xe2\x80\x88" /* punctuation space (U+2008) */
+	"\xe2\x80\x89" /* thin space (U+2009) */
+	"\xe2\x80\x8a" /* hair space (U+200a) */
+	"\xe2\x80\x8b" /* zero width space (U+200b) */
+	"\xe2\x80\xa8" /* line separator (U+2028) */
+	"\xe2\x80\xa9" /* paragraph separator (U+2029) */
+	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */
+	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */
+	"\xe2\x81\xa0" /* word joiner (U+2060) */
+	"\xe3\x80\x80" /* ideographic space (U+3000) */
+	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
+;
 
 /*
  *----------------------------------------------------------------------
@@ -3158,8 +3191,8 @@ StringTrimCmd(
     if (objc == 3) {
 	string2 = TclGetStringFromObj(objv[2], &length2);
     } else if (objc == 2) {
-	string2 = DEFAULT_TRIM_SET;
-	length2 = strlen(DEFAULT_TRIM_SET);
+	string2 = tclDefaultTrimSet;
+	length2 = strlen(tclDefaultTrimSet);
     } else {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
 	return TCL_ERROR;
@@ -3206,8 +3239,8 @@ StringTrimLCmd(
     if (objc == 3) {
 	string2 = TclGetStringFromObj(objv[2], &length2);
     } else if (objc == 2) {
-	string2 = DEFAULT_TRIM_SET;
-	length2 = strlen(DEFAULT_TRIM_SET);
+	string2 = tclDefaultTrimSet;
+	length2 = strlen(tclDefaultTrimSet);
     } else {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
 	return TCL_ERROR;
@@ -3252,8 +3285,8 @@ StringTrimRCmd(
     if (objc == 3) {
 	string2 = TclGetStringFromObj(objv[2], &length2);
     } else if (objc == 2) {
-	string2 = DEFAULT_TRIM_SET;
-	length2 = strlen(DEFAULT_TRIM_SET);
+	string2 = tclDefaultTrimSet;
+	length2 = strlen(tclDefaultTrimSet);
     } else {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
 	return TCL_ERROR;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 0f2790f..c54a06a 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -810,7 +810,7 @@ TclCompileStringTrimLCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr,			interp, 2);
     } else {
-	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+	PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
     }
     OP(			STR_TRIM_LEFT);
     return TCL_OK;
@@ -838,7 +838,7 @@ TclCompileStringTrimRCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr,			interp, 2);
     } else {
-	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+	PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
     }
     OP(			STR_TRIM_RIGHT);
     return TCL_OK;
@@ -866,7 +866,7 @@ TclCompileStringTrimCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr,			interp, 2);
     } else {
-	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
+	PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
     }
     OP(			STR_TRIM);
     return TCL_OK;
diff --git a/generic/tclStringTrim.h b/generic/tclStringTrim.h
index 669f10b..030e4ec 100644
--- a/generic/tclStringTrim.h
+++ b/generic/tclStringTrim.h
@@ -23,32 +23,7 @@
  * UTF-8 literal string containing all Unicode space characters. [TIP #413]
  */
 
-#define DEFAULT_TRIM_SET \
-	"\x09\x0a\x0b\x0c\x0d " /* ASCII */\
-	"\xc0\x80" /*     nul (U+0000) */\
-	"\xc2\x85" /*     next line (U+0085) */\
-	"\xc2\xa0" /*     non-breaking space (U+00a0) */\
-	"\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
-	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
-	"\xe2\x80\x80" /* en quad (U+2000) */\
-	"\xe2\x80\x81" /* em quad (U+2001) */\
-	"\xe2\x80\x82" /* en space (U+2002) */\
-	"\xe2\x80\x83" /* em space (U+2003) */\
-	"\xe2\x80\x84" /* three-per-em space (U+2004) */\
-	"\xe2\x80\x85" /* four-per-em space (U+2005) */\
-	"\xe2\x80\x86" /* six-per-em space (U+2006) */\
-	"\xe2\x80\x87" /* figure space (U+2007) */\
-	"\xe2\x80\x88" /* punctuation space (U+2008) */\
-	"\xe2\x80\x89" /* thin space (U+2009) */\
-	"\xe2\x80\x8a" /* hair space (U+200a) */\
-	"\xe2\x80\x8b" /* zero width space (U+200b) */\
-	"\xe2\x80\xa8" /* line separator (U+2028) */\
-	"\xe2\x80\xa9" /* paragraph separator (U+2029) */\
-	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
-	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
-	"\xe2\x81\xa0" /* word joiner (U+2060) */\
-	"\xe3\x80\x80" /* ideographic space (U+3000) */\
-	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
+MODULE_SCOPE const char tclDefaultTrimSet[];
 
 /*
  * The whitespace trimming set used when [concat]enating. This is a subset of
-- 
cgit v0.12


From acf1cebeab93607fc83206e77534b5fada8726ef Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 9 Jan 2014 10:49:04 +0000
Subject: use compact form

---
 generic/tclCompCmdsSZ.c | 51 ++++++++++++++++++++++++-------------------------
 1 file changed, 25 insertions(+), 26 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 06cca50..345dd9f 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -451,8 +451,7 @@ TclCompileStringIsCmd(
 	STR_IS_TRUE,	STR_IS_UPPER,	STR_IS_WIDE,	STR_IS_WORD,
 	STR_IS_XDIGIT
     };
-    JumpFixup jumpFixup;
-    int t, range, allowEmpty = 0;
+    int t, range, allowEmpty = 0, end;
     Tcl_Obj *isClass;
 
     if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
@@ -538,7 +537,7 @@ TclCompileStringIsCmd(
      */
 
     range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-    TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
+    OP4(		BEGIN_CATCH4, range);
     ExceptionRangeStarts(envPtr, range);
 
     /*
@@ -554,28 +553,28 @@ TclCompileStringIsCmd(
 	 * this is true for).
 	 */
 
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	TclEmitOpcode(		INST_NEQ,			envPtr);
-	TclEmitInstInt1(	INST_JUMP_TRUE1, 5,		envPtr);
+	OP(		DUP);
+	OP(		DUP);
+	OP(		NEQ);
+	OP1(		JUMP_TRUE1, 5);
 
 	/*
 	 * Type check for all other double values.
 	 */
 
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	TclEmitOpcode(		INST_UMINUS,			envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
+	OP(		DUP);
+	OP(		UMINUS);
+	OP(		POP);
 	break;
     case STR_IS_ENTIER:
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	TclEmitOpcode(		INST_BITNOT,			envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
+	OP(		DUP);
+	OP(		BITNOT);
+	OP(		POP);
 	break;
     case STR_IS_LIST:
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
+	OP(		DUP);
+	OP(		LIST_LENGTH);
+	OP(		POP);
 	break;
     }
 
@@ -587,20 +586,20 @@ TclCompileStringIsCmd(
      */
 
     ExceptionRangeEnds(envPtr, range);
-    TclEmitOpcode(		INST_END_CATCH,			envPtr);
-    TclEmitOpcode(		INST_POP,			envPtr);
-    PushLiteral(envPtr, "1", 1);
-    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+    OP(			END_CATCH);
+    OP(			POP);
+    PUSH(		"1");
+    JUMP1(		JUMP, end);
     ExceptionRangeTarget(envPtr, range, catchOffset);
-    TclEmitOpcode(		INST_END_CATCH,			envPtr);
+    OP(			END_CATCH);
     if (allowEmpty) {
-	PushLiteral(envPtr, "", 0);
-	TclEmitOpcode(		INST_STR_EQ,			envPtr);
+	PUSH(		"");
+	OP(		STR_EQ);
     } else {
-	TclEmitOpcode(		INST_POP,			envPtr);
-	PushLiteral(envPtr, "0", 1);
+	OP(		POP);
+	PUSH(		"0");
     }
-    TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
+    FIXJUMP1(	end);
     return TCL_OK;
 }
 
-- 
cgit v0.12


From c3c6e803684022dcc788ddbfc4a59a6d0dfde102 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 10 Jan 2014 15:58:41 +0000
Subject: a different approach

---
 generic/tclAssembly.c   |   4 +-
 generic/tclCompCmdsSZ.c | 150 ++++++++++++++++++++++++++----------------------
 generic/tclCompile.c    |   4 ++
 generic/tclCompile.h    |   4 +-
 generic/tclExecute.c    |   8 +++
 5 files changed, 98 insertions(+), 72 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 89c286a..70379c6 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -437,6 +437,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"nop",		ASSEM_1BYTE,	INST_NOP,		0,	0},
     {"not",		ASSEM_1BYTE,	INST_LNOT,		1,	1},
     {"nsupvar",		ASSEM_LVT4,	INST_NSUPVAR,		2,	1},
+    {"numericType",	ASSEM_1BYTE,	INST_NUM_TYPE,		1,	1},
     {"originCmd",	ASSEM_1BYTE,	INST_ORIGIN_COMMAND,	1,	1},
     {"over",		ASSEM_OVER,	INST_OVER,		INT_MIN,-1-1},
     {"pop",		ASSEM_1BYTE,	INST_POP,		1,	0},
@@ -516,7 +517,8 @@ static const unsigned char NonThrowingByteCodes[] = {
     INST_RESOLVE_COMMAND,					/* 154 */
     INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT,	/* 166-168 */
     INST_CONCAT_STK,						/* 169 */
-    INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE		/* 170-172 */
+    INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE,		/* 170-172 */
+    INST_NUM_TYPE						/* 180 */
 };
 
 /*
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 345dd9f..1436a20 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -500,7 +500,7 @@ TclCompileStringIsCmd(
      * example of this.
      */
 
-    switch (t) {
+    switch ((enum isClasses) t) {
     case STR_IS_ALNUM:
     case STR_IS_ALPHA:
     case STR_IS_ASCII:
@@ -514,93 +514,103 @@ TclCompileStringIsCmd(
     case STR_IS_UPPER:
     case STR_IS_WORD:
     case STR_IS_XDIGIT:
+	/* Not yet implemented */
 	return TCL_ERROR;
 
     case STR_IS_BOOL:
     case STR_IS_FALSE:
-    case STR_IS_INT:
     case STR_IS_TRUE:
-    case STR_IS_WIDE:
 	/* Not yet implemented */
 	return TCL_ERROR;
-    }
-
-    /*
-     * Push the word to check.
-     */
-
-    CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
 
-    /*
-     * Next, do the type check. First, we push a catch range; most of the
-     * type-check operations throw an exception on failure.
-     */
-
-    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-    OP4(		BEGIN_CATCH4, range);
-    ExceptionRangeStarts(envPtr, range);
-
-    /*
-     * Issue the type-check itself for the specific type.
-     */
+    case STR_IS_DOUBLE: {
+	int satisfied, isEmpty;
 
-    switch (t) {
-    case STR_IS_DOUBLE:
-	/*
-	 * Careful! Preserve behavior of NaN which is a double (that is, true
-	 * for the purposes of a type check) but most math ops fail on it. The
-	 * key is that it is not == to itself (and is the only value which
-	 * this is true for).
-	 */
+	CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+	if (allowEmpty) {
+	    OP(		DUP);
+	    PUSH(	"");
+	    OP(		STR_EQ);
+	    JUMP1(	JUMP_TRUE, isEmpty);
+	    OP(		NUM_TYPE);
+	    JUMP1(	JUMP_TRUE, satisfied);
+	    PUSH(	"0");
+	    JUMP1(	JUMP, end);
+	    FIXJUMP1(	isEmpty);
+	    OP(		POP);
+	    FIXJUMP1(	satisfied);
+	} else {
+	    OP(		NUM_TYPE);
+	    JUMP1(	JUMP_TRUE, satisfied);
+	    PUSH(	"0");
+	    JUMP1(	JUMP, end);
+	    TclAdjustStackDepth(-1, envPtr);
+	    FIXJUMP1(	satisfied);
+	}
+	PUSH(		"1");
+	FIXJUMP1(	end);
+	return TCL_OK;
+    }
 
-	OP(		DUP);
-	OP(		DUP);
-	OP(		NEQ);
-	OP1(		JUMP_TRUE1, 5);
+    case STR_IS_INT:
+    case STR_IS_WIDE:
+    case STR_IS_ENTIER:
+	CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+	if (allowEmpty) {
+	    int testNumType;
+
+	    OP(		DUP);
+	    OP(		NUM_TYPE);
+	    OP(		DUP);
+	    JUMP1(	JUMP_TRUE, testNumType);
+	    OP(		POP);
+	    PUSH(	"");
+	    OP(		STR_EQ);
+	    JUMP1(	JUMP, end);
+	    TclAdjustStackDepth(1, envPtr);
+	    FIXJUMP1(	testNumType);
+	    OP4(	REVERSE, 2);
+	    OP(		POP);
+	} else {
+	    OP(		NUM_TYPE);
+	    OP(		DUP);
+	    JUMP1(	JUMP_FALSE, end);
+	}
 
-	/*
-	 * Type check for all other double values.
-	 */
+	switch (t) {
+	case STR_IS_INT:
+	    PUSH(	"1");
+	    OP(		EQ);
+	    break;
+	case STR_IS_WIDE:
+	    PUSH(	"2");
+	    OP(		LE);
+	    break;
+	case STR_IS_ENTIER:
+	    PUSH(	"3");
+	    OP(		LE);
+	    break;
+	}
+	FIXJUMP1(	end);
+	return TCL_OK;
 
-	OP(		DUP);
-	OP(		UMINUS);
-	OP(		POP);
-	break;
-    case STR_IS_ENTIER:
-	OP(		DUP);
-	OP(		BITNOT);
-	OP(		POP);
-	break;
     case STR_IS_LIST:
+	CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+	range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+	OP4(		BEGIN_CATCH4, range);
+	ExceptionRangeStarts(envPtr, range);
 	OP(		DUP);
 	OP(		LIST_LENGTH);
 	OP(		POP);
-	break;
-    }
-
-    /*
-     * Based on whether the exception was thrown (or conditional branch taken,
-     * in the case of true/false checks), push the correct boolean value. This
-     * is also where we deal with what happens with empty values in non-strict
-     * mode.
-     */
-
-    ExceptionRangeEnds(envPtr, range);
-    OP(			END_CATCH);
-    OP(			POP);
-    PUSH(		"1");
-    JUMP1(		JUMP, end);
-    ExceptionRangeTarget(envPtr, range, catchOffset);
-    OP(			END_CATCH);
-    if (allowEmpty) {
-	PUSH(		"");
-	OP(		STR_EQ);
-    } else {
+	ExceptionRangeEnds(envPtr, range);
+	ExceptionRangeTarget(envPtr, range, catchOffset);
 	OP(		POP);
-	PUSH(		"0");
+	OP(		PUSH_RETURN_CODE);
+	OP(		END_CATCH);
+	OP(		LNOT);
+	return TCL_OK;
     }
-    FIXJUMP1(	end);
-    return TCL_OK;
+    return TCL_ERROR;
 }
 
 int
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index ee67e24..c01571f 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -621,6 +621,10 @@ InstructionDesc const tclInstructionTable[] = {
 	/* Push the identity of the current TclOO object (i.e., the name of
 	 * its current public access command) on the stack. */
 
+    {"numericType",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Pushes the numeric type code of the word at the top of the stack.
+	 * Stack:  ... value => ... typeCode */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 6ecadf4..6bf5daf 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -792,8 +792,10 @@ typedef struct ByteCode {
 
 #define INST_TCLOO_NEXT			179
 
+#define INST_NUM_TYPE			180
+
 /* The last opcode */
-#define LAST_INST_OPCODE		179
+#define LAST_INST_OPCODE		180
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 5b42124..2707ec1 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5776,6 +5776,14 @@ TEBCresume(
 	int type1, type2;
 	long l1, l2, lResult;
 
+    case INST_NUM_TYPE:
+	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
+	    type1 = 0;
+	}
+	TclNewIntObj(objResultPtr, type1);
+	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
+	NEXT_INST_F(1, 1, 1);
+
     case INST_EQ:
     case INST_NEQ:
     case INST_LT:
-- 
cgit v0.12


From aa2c40934df3fdefbb39338f7eef44e79c3c551e Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 13 Jan 2014 08:06:43 +0000
Subject: extend [string is] to booleans

---
 generic/tclAssembly.c   |  1 +
 generic/tclCompCmdsSZ.c | 51 +++++++++++++++++++++++++++++++++++++++++++++----
 generic/tclCompile.c    |  3 +++
 generic/tclCompile.h    |  3 ++-
 generic/tclExecute.c    | 11 +++++++++++
 5 files changed, 64 insertions(+), 5 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 70379c6..f10bca8 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -478,6 +478,7 @@ static const TalInstDesc TalInstructionTable[] = {
     {"tclooIsObject",	ASSEM_1BYTE,	INST_TCLOO_IS_OBJECT,	1,	1},
     {"tclooNamespace",	ASSEM_1BYTE,	INST_TCLOO_NS,		1,	1},
     {"tclooSelf",	ASSEM_1BYTE,	INST_TCLOO_SELF,	0,	1},
+    {"tryCvtToBoolean",	ASSEM_1BYTE,	INST_TRY_CVT_TO_BOOLEAN,1,	2},
     {"tryCvtToNumeric",	ASSEM_1BYTE,	INST_TRY_CVT_TO_NUMERIC,1,	1},
     {"uminus",		ASSEM_1BYTE,	INST_UMINUS,		1,	1},
     {"unset",		ASSEM_BOOL_LVT4,INST_UNSET_SCALAR,	0,	0},
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 1436a20..91bb94c 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -514,14 +514,57 @@ TclCompileStringIsCmd(
     case STR_IS_UPPER:
     case STR_IS_WORD:
     case STR_IS_XDIGIT:
-	/* Not yet implemented */
-	return TCL_ERROR;
+	return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
 
     case STR_IS_BOOL:
     case STR_IS_FALSE:
     case STR_IS_TRUE:
-	/* Not yet implemented */
-	return TCL_ERROR;
+	CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+	OP(		TRY_CVT_TO_BOOLEAN);
+	switch (t) {
+	    int over, over2;
+
+	case STR_IS_BOOL:
+	    if (allowEmpty) {
+		JUMP1(	JUMP_TRUE, over);
+		PUSH(	"");
+		OP(	STR_EQ);
+		JUMP1(	JUMP, over2);
+		FIXJUMP1(over);
+		OP(	POP);
+		PUSH(	"1");
+		FIXJUMP1(over2);
+	    } else {
+		OP4(	REVERSE, 2);
+		OP(	POP);
+	    }
+	    return TCL_OK;
+	case STR_IS_TRUE:
+	    JUMP1(	JUMP_TRUE, over);
+	    if (allowEmpty) {
+		PUSH(	"");
+		OP(	STR_EQ);
+	    } else {
+		OP(	POP);
+		PUSH(	"0");
+	    }
+	    FIXJUMP1(	over);
+	    OP(		LNOT);
+	    OP(		LNOT);
+	    return TCL_OK;
+	case STR_IS_FALSE:
+	    JUMP1(	JUMP_TRUE, over);
+	    if (allowEmpty) {
+		PUSH(	"");
+		OP(	STR_NEQ);
+	    } else {
+		OP(	POP);
+		PUSH(	"1");
+	    }
+	    FIXJUMP1(	over);
+	    OP(		LNOT);
+	    return TCL_OK;
+	}
 
     case STR_IS_DOUBLE: {
 	int satisfied, isEmpty;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c01571f..39fa241 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -624,6 +624,9 @@ InstructionDesc const tclInstructionTable[] = {
     {"numericType",	 1,	0,	  0,	{OPERAND_NONE}},
 	/* Pushes the numeric type code of the word at the top of the stack.
 	 * Stack:  ... value => ... typeCode */
+    {"tryCvtToBoolean",	 1,	+1,	  0,	{OPERAND_NONE}},
+	/* Try converting stktop to boolean if possible. No errors.
+	 * Stack:  ... value => ... value isStrictBool */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 6bf5daf..a08a93a 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -793,9 +793,10 @@ typedef struct ByteCode {
 #define INST_TCLOO_NEXT			179
 
 #define INST_NUM_TYPE			180
+#define INST_TRY_CVT_TO_BOOLEAN		181
 
 /* The last opcode */
-#define LAST_INST_OPCODE		180
+#define LAST_INST_OPCODE		181
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2707ec1..989b7b6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6461,6 +6461,17 @@ TEBCresume(
      * -----------------------------------------------------------------
      */
 
+    case INST_TRY_CVT_TO_BOOLEAN:
+	valuePtr = OBJ_AT_TOS;
+	if (valuePtr->typePtr == &tclBooleanType) {
+	    objResultPtr = TCONST(1);
+	} else {
+	    int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
+	    objResultPtr = TCONST(result);
+	}
+	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
+	NEXT_INST_F(1, 0, 1);
+
     case INST_BREAK:
 	/*
 	DECACHE_STACK_INFO();
-- 
cgit v0.12


From e0791bfa1b98a28520902dbb5018ffdcb5925860 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 15 Jan 2014 19:04:52 +0000
Subject: [2992970] Restore the safety of Tcl_AppendObjToObj(x, x) for
 bytearrays. Also moves overflow checking to TclAppendBytesToByteArray() and
 adds the ability to call TABTBA() with bytes==NULL, for appending unspecified
 bytes.  That is, the string grows, but the new bytes are of undetermined
 value.  Like Tcl_NewByteArrayObj(NULL, length) this option is useful for
 manipulating buffers.  The TABTBA growth algorithm is also enhanced a bit,
 copying over a fuller implementation from GrowStringBuffer() in
 tclStringObj.c

---
 generic/tclBinary.c    | 74 ++++++++++++++++++++++----------------------------
 generic/tclStringObj.c | 42 ++++++++++++++++++++--------
 2 files changed, 64 insertions(+), 52 deletions(-)

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 4e977f2..981f174 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -610,9 +610,7 @@ UpdateStringOfByteArray(
  *
  *	This function appends an array of bytes to a byte array object. Note
  *	that the object *must* be unshared, and the array of bytes *must not*
- *	refer to the object being appended to.  Also the caller must have
- *	already checked that the final length of the bytearray after the
- *	append operations is complete will not overflow the int range.
+ *	refer to the object being appended to.
  *
  * Results:
  *	None.
@@ -631,6 +629,7 @@ TclAppendBytesToByteArray(
     int len)
 {
     ByteArray *byteArrayPtr;
+    int needed;
 
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -639,64 +638,57 @@ TclAppendBytesToByteArray(
 	Tcl_Panic("%s must be called with definite number of bytes to append",
 		"TclAppendBytesToByteArray");
     }
+    if (len == 0) {
+	/* Append zero bytes is a no-op. */
+	return;
+    }
     if (objPtr->typePtr != &tclByteArrayType) {
 	SetByteArrayFromAny(NULL, objPtr);
     }
     byteArrayPtr = GET_BYTEARRAY(objPtr);
 
+    if (len > INT_MAX - byteArrayPtr->used) {
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+    }
+
+    needed = byteArrayPtr->used + len;
     /*
      * If we need to, resize the allocated space in the byte array.
      */
 
-    if (byteArrayPtr->used + len > byteArrayPtr->allocated) {
-	unsigned int attempt, used = byteArrayPtr->used;
-	ByteArray *tmpByteArrayPtr = NULL;
+    if (needed > byteArrayPtr->allocated) {
+	ByteArray *ptr = NULL;
+	int attempt;
 
-	attempt = byteArrayPtr->allocated;
-	if (attempt < 1) {
-	    /*
-	     * No allocated bytes, so must be none used too. We use this
-	     * method to calculate how many bytes to allocate because we can
-	     * end up with a zero-length buffer otherwise, when doubling can
-	     * cause trouble. [Bug 3067036]
-	     */
-
-	    attempt = len + 1;
-	} else {
-	    do {
-		attempt *= 2;
-	    } while (attempt < used+len);
+	if (needed <= INT_MAX/2) {
+	    /* Try to allocate double the total space that is needed. */
+	    attempt = 2 * needed;
+	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
 	}
+	if (ptr == NULL) {
+	    /* Try to allocate double the increment that is needed (plus). */
+	    unsigned int limit = INT_MAX - needed;
+	    unsigned int extra = len + TCL_MIN_GROWTH;
+	    int growth = (int) ((extra > limit) ? limit : extra);
 
-	if (BYTEARRAY_SIZE(attempt) > BYTEARRAY_SIZE(used)) {
-	    tmpByteArrayPtr = attemptckrealloc(byteArrayPtr,
-		    BYTEARRAY_SIZE(attempt));
+	    attempt = needed + growth;
+	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
 	}
-
-	if (tmpByteArrayPtr == NULL) {
-	    attempt = used + len;
-	    if (BYTEARRAY_SIZE(attempt) < BYTEARRAY_SIZE(used)) {
-		Tcl_Panic("attempt to allocate a bigger buffer than we can handle");
-	    }
-	    tmpByteArrayPtr = ckrealloc(byteArrayPtr,
-		    BYTEARRAY_SIZE(attempt));
+	if (ptr == NULL) {
+	    /* Last chance: Try to allocate exactly what is needed. */
+	    attempt = needed;
+	    ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
 	}
-
-	byteArrayPtr = tmpByteArrayPtr;
+	byteArrayPtr = ptr;
 	byteArrayPtr->allocated = attempt;
-	byteArrayPtr->used = used;
 	SET_BYTEARRAY(objPtr, byteArrayPtr);
     }
 
-    /*
-     * Do the append if there's any point.
-     */
-
-    if (len > 0) {
+    if (bytes) {
 	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
-	byteArrayPtr->used += len;
-	TclInvalidateStringRep(objPtr);
     }
+    byteArrayPtr->used += len;
+    TclInvalidateStringRep(objPtr);
 }
 
 /*
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index e495c2e..1512f0c 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1281,23 +1281,43 @@ Tcl_AppendObjToObj(
 
     if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
 	    && TclIsPureByteArray(appendObjPtr)) {
-	unsigned char *bytesSrc;
-	int lengthSrc, lengthTotal;
+	int lengthSrc;
 
 	/*
-	 * We do not assume that objPtr and appendObjPtr must be distinct!
-	 * This makes this code a bit more complex than it otherwise would be,
-	 * but in turn makes it much safer.
+	 * You might expect the code here to be
+	 *
+
+	    bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
+	    TclAppendBytesToByteArray(objPtr, bytes, length);
+
+	 *
+	 * and essentially all of the time that would be fine.  However,
+	 * it would run into trouble in the case where objPtr and
+	 * appendObjPtr point to the same thing.  That may never be a
+	 * good idea.  It seems to violate Copy On Write, and we don't
+	 * have any tests for the situation, since making any Tcl commands
+	 * that call Tcl_AppendObjToObj() do that appears impossible
+	 * (They honor Copy On Write!).  For the sake of extensions that
+	 * go off into that realm, though, here's a more complex approach
+	 * that can handle all the cases.
 	 */
 
+	/* Get lengths */
 	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
 	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
-	lengthTotal = length + lengthSrc;
-	if (((length > lengthSrc) ? length : lengthSrc) > lengthTotal) {
-	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
-	}
-	bytesSrc = Tcl_GetByteArrayFromObj(appendObjPtr, NULL);
-	TclAppendBytesToByteArray(objPtr, bytesSrc, lengthSrc);
+
+	/* Grow buffer enough for the append */
+	TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
+
+	/* Reset objPtr back to the original value */
+	Tcl_SetByteArrayLength(objPtr, length);
+
+	/*
+	 * Now do the append secure that buffer growth cannot cause
+	 * any trouble.
+	 */
+	TclAppendBytesToByteArray(objPtr,
+		Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
 	return;
     }
 
-- 
cgit v0.12


From ab8fd1e3f28322c8d57229cd2e171fea351097af Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 19 Jan 2014 18:39:24 +0000
Subject: added compilation for [nextto]

---
 generic/tclAssembly.c   |   1 +
 generic/tclCompCmdsGR.c |  25 +++++++++
 generic/tclCompile.c    |  14 ++++-
 generic/tclCompile.h    |   3 +-
 generic/tclExecute.c    | 132 +++++++++++++++++++++++++++++++++++++++++++-----
 generic/tclInt.h        |   3 ++
 generic/tclOO.c         |   3 +-
 generic/tclOOBasic.c    |  20 ++++++--
 8 files changed, 179 insertions(+), 22 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 89c286a..7b775a9 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -26,6 +26,7 @@
  *-   jumpTable testing
  *-   syntax (?)
  *-   returnCodeBranch
+ *-   tclooNext, tclooNextClass
  */
 
 #include "tclInt.h"
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index b8a7e0f..b3e273f 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -3075,6 +3075,31 @@ TclCompileObjectNextCmd(
 }
 
 int
+TclCompileObjectNextToCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
+    int i;
+
+    if (parsePtr->numWords < 2 || parsePtr->numWords > 255) {
+	return TCL_ERROR;
+    }
+
+    for (i=0 ; i<parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    TclEmitInstInt1(	INST_TCLOO_NEXT_CLASS, i,	envPtr);
+    return TCL_OK;
+}
+
+int
 TclCompileObjectSelfCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
     Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index ee67e24..bd97e3e 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -618,8 +618,18 @@ InstructionDesc const tclInstructionTable[] = {
 	 * Stack:  ... cmdName => ... fullOriginalCmdName */
 
     {"tclooNext",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
-	/* Push the identity of the current TclOO object (i.e., the name of
-	 * its current public access command) on the stack. */
+	/* Call the next item on the TclOO call chain, passing opnd arguments
+	 * (min 1, max 255, *includes* "next").  The result of the invoked
+	 * method implementation will be pushed on the stack in place of the
+	 * arguments (similar to invokeStk).
+	 * Stack:  ... "next" arg2 arg3 -- argN => ... result */
+    {"tclooNextClass",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
+	/* Call the following item on the TclOO call chain defined by class
+	 * className, passing opnd arguments (min 2, max 255, *includes*
+	 * "nextto" and the class name). The result of the invoked method
+	 * implementation will be pushed on the stack in place of the
+	 * arguments (similar to invokeStk).
+	 * Stack:  ... "nextto" className arg3 arg4 -- argN => ... result */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 6ecadf4..b047855 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -791,9 +791,10 @@ typedef struct ByteCode {
 #define INST_ORIGIN_COMMAND		178
 
 #define INST_TCLOO_NEXT			179
+#define INST_TCLOO_NEXT_CLASS		180
 
 /* The last opcode */
-#define LAST_INST_OPCODE		179
+#define LAST_INST_OPCODE		180
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 5b42124..ac0ea12 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4539,6 +4539,7 @@ TEBCresume(
 	Object *oPtr;
 	CallFrame *framePtr;
 	CallContext *contextPtr;
+	int skip, newDepth;
 
     case INST_TCLOO_SELF:
 	framePtr = iPtr->varFramePtr;
@@ -4563,9 +4564,111 @@ TEBCresume(
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
 
+    case INST_TCLOO_NEXT_CLASS:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	framePtr = iPtr->varFramePtr;
+	valuePtr = OBJ_AT_DEPTH(opnd - 2);
+	objv = &OBJ_AT_DEPTH(opnd - 1);
+	skip = 2;
+	TRACE(("%d => ", opnd));
+	if (framePtr == NULL ||
+		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
+	    TRACE_APPEND(("ERROR: no TclOO call context\n"));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "nextto may only be called from inside a method",
+		    -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+	contextPtr = framePtr->clientData;
+
+	oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
+	if (oPtr == NULL) {
+	    TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
+	    goto gotError;
+	} else {
+	    Class *classPtr = oPtr->classPtr;
+	    struct MInvoke *miPtr;
+	    int i;
+	    const char *methodType;
+
+	    if (classPtr == NULL) {
+		TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr)));
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"\"%s\" is not a class", TclGetString(valuePtr)));
+		DECACHE_STACK_INFO();
+		Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
+		CACHE_STACK_INFO();
+		goto gotError;
+	    }
+
+	    for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
+		miPtr = contextPtr->callPtr->chain + i;
+		if (!miPtr->isFilter &&
+			miPtr->mPtr->declaringClassPtr == classPtr) {
+		    newDepth = i;
+#ifdef TCL_COMPILE_DEBUG
+		    if (tclTraceExec >= 2) {
+			if (traceInstructions) {
+			    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+			} else {
+			    fprintf(stdout, "%d: (%u) invoking ",
+				    iPtr->numLevels,
+				    (unsigned)(pc - codePtr->codeStart));
+			}
+			for (i = 0;  i < opnd;  i++) {
+			    TclPrintObject(stdout, objv[i], 15);
+			    fprintf(stdout, " ");
+			}
+			fprintf(stdout, "\n");
+			fflush(stdout);
+		    }
+#endif /*TCL_COMPILE_DEBUG*/
+		    goto doInvokeNext;
+		}
+	    }
+
+	    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+		methodType = "constructor";
+	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+		methodType = "destructor";
+	    } else {
+		methodType = "method";
+	    }
+
+	    TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
+		    O2S(valuePtr)));
+	    for (i=contextPtr->index ; i>=0 ; i--) {
+		miPtr = contextPtr->callPtr->chain + i;
+		if (miPtr->isFilter
+			|| miPtr->mPtr->declaringClassPtr != classPtr) {
+		    continue;
+		}
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"%s implementation by \"%s\" not reachable from here",
+			methodType, TclGetString(valuePtr)));
+		DECACHE_STACK_INFO();
+		Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+			NULL);
+		CACHE_STACK_INFO();
+		goto gotError;
+	    }
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s has no non-filter implementation by \"%s\"",
+		    methodType, TclGetString(valuePtr)));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+
     case INST_TCLOO_NEXT:
 	opnd = TclGetUInt1AtPtr(pc+1);
+	objv = &OBJ_AT_DEPTH(opnd - 1);
 	framePtr = iPtr->varFramePtr;
+	skip = 1;
 	TRACE(("%d => ", opnd));
 	if (framePtr == NULL ||
 		!(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
@@ -4580,7 +4683,8 @@ TEBCresume(
 	}
 	contextPtr = framePtr->clientData;
 
-	if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
+	newDepth = contextPtr->index + 1;
+	if (newDepth >= contextPtr->callPtr->numChain) {
 	    /*
 	     * We're at the end of the chain; generate an error message unless
 	     * the interpreter is being torn down, in which case we might be
@@ -4605,33 +4709,31 @@ TEBCresume(
 	    Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
 	    CACHE_STACK_INFO();
 	    goto gotError;
-	}
-
 #ifdef TCL_COMPILE_DEBUG
-	if (tclTraceExec >= 2) {
+	} else if (tclTraceExec >= 2) {
 	    int i;
 
 	    if (traceInstructions) {
 		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
-		TRACE(("next_in_chain "));
 	    } else {
-		fprintf(stdout, "%d: (%u) invoking next_in_chain ",
+		fprintf(stdout, "%d: (%u) invoking ",
 			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart));
 	    }
-	    for (i = 0;  i < objc;  i++) {
+	    for (i = 0;  i < opnd;  i++) {
 		TclPrintObject(stdout, objv[i], 15);
 		fprintf(stdout, " ");
 	    }
 	    fprintf(stdout, "\n");
 	    fflush(stdout);
-	}
 #endif /*TCL_COMPILE_DEBUG*/
+	}
 
+    doInvokeNext:
 	bcFramePtr->data.tebc.pc = (char *) pc;
 	iPtr->cmdFramePtr = bcFramePtr;
 
 	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
+	    ArgumentBCEnter(interp, codePtr, TD, pc, opnd, objv);
 	}
 
 	pcAdjustment = 2;
@@ -4640,6 +4742,7 @@ TEBCresume(
 	iPtr->varFramePtr = framePtr->callerVarPtr;
 	pc += pcAdjustment;
 	TEBC_YIELD();
+
 	oPtr = contextPtr->oPtr;
 	if (oPtr->flags & FILTER_HANDLING) {
 	    TclNRAddCallback(interp, FinalizeOONextFilter,
@@ -4650,20 +4753,21 @@ TEBCresume(
 		    framePtr, contextPtr, INT2PTR(contextPtr->index),
 		    INT2PTR(contextPtr->skip));
 	}
-	if (contextPtr->callPtr->chain[++contextPtr->index].isFilter
+	contextPtr->skip = skip;
+	contextPtr->index = newDepth;
+	if (contextPtr->callPtr->chain[newDepth].isFilter
 		|| contextPtr->callPtr->flags & FILTER_HANDLING) {
 	    oPtr->flags |= FILTER_HANDLING;
 	} else {
 	    oPtr->flags &= ~FILTER_HANDLING;
 	}
-	contextPtr->skip = 1;
+
 	{
 	    register Method *const mPtr =
-		    contextPtr->callPtr->chain[contextPtr->index].mPtr;
+		    contextPtr->callPtr->chain[newDepth].mPtr;
 
 	    return mPtr->typePtr->callProc(mPtr->clientData, interp,
-		    (Tcl_ObjectContext) contextPtr, opnd,
-		    &OBJ_AT_DEPTH(opnd-1));
+		    (Tcl_ObjectContext) contextPtr, opnd, objv);
 	}
 
     case INST_TCLOO_IS_OBJECT:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3aaa30b..7932a58 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3592,6 +3592,9 @@ MODULE_SCOPE int	TclCompileNoOp(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileObjectNextCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileObjectNextToCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileObjectSelfCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 9a0682d..de00733 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -440,8 +440,9 @@ InitFoundation(
     cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
 	    NULL, TclOONextObjCmd, NULL, NULL);
     cmdPtr->compileProc = TclCompileObjectNextCmd;
-    Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
+    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
 	    NULL, TclOONextToObjCmd, NULL, NULL);
+    cmdPtr->compileProc = TclCompileObjectNextToCmd;
     cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
 	    TclOOSelfObjCmd, NULL, NULL);
     cmdPtr->compileProc = TclCompileObjectSelfCmd;
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 6084cf2..0b0516b 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -821,6 +821,7 @@ TclOONextToObjCmd(
     CallContext *contextPtr;
     int i;
     Tcl_Object object;
+    const char *methodType;
 
     /*
      * Start with sanity checks on the calling context to make sure that we
@@ -886,19 +887,30 @@ TclOONextToObjCmd(
      * is on the chain but unreachable, or not on the chain at all.
      */
 
+    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
+	methodType = "constructor";
+    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
+	methodType = "destructor";
+    } else {
+	methodType = "method";
+    }
+
     for (i=contextPtr->index ; i>=0 ; i--) {
 	struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
 
 	if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "method implementation by \"%s\" not reachable from here",
-		    TclGetString(objv[1])));
+		    "%s implementation by \"%s\" not reachable from here",
+		    methodType, TclGetString(objv[1])));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
+		    NULL);
 	    return TCL_ERROR;
 	}
     }
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "method has no non-filter implementation by \"%s\"",
-	    TclGetString(objv[1])));
+	    "%s has no non-filter implementation by \"%s\"",
+	    methodType, TclGetString(objv[1])));
+    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
     return TCL_ERROR;
 }
 
-- 
cgit v0.12


From 61bfac2613d3cc063099ad9e6de3110491b6f5df Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 21 Jan 2014 15:07:59 +0000
Subject: implementation of [yieldto] in bytecode

---
 generic/tclBasic.c      |  2 +-
 generic/tclCompCmdsSZ.c | 45 +++++++++++++++++++++++++++++++
 generic/tclCompile.c    |  7 +++++
 generic/tclCompile.h    |  4 ++-
 generic/tclExecute.c    | 71 ++++++++++++++++++++++++++++++++++++++++++-------
 generic/tclInt.h        |  3 +++
 6 files changed, 121 insertions(+), 11 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7c02706..e355229 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -259,7 +259,7 @@ static const CmdInfo builtInCmds[] = {
     {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	CMD_IS_SAFE},
     {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	CMD_IS_SAFE},
     {"yield",		NULL,			TclCompileYieldCmd,	TclNRYieldObjCmd,	CMD_IS_SAFE},
-    {"yieldto",		NULL,			NULL,			TclNRYieldToObjCmd,	CMD_IS_SAFE},
+    {"yieldto",		NULL,			TclCompileYieldToCmd,	TclNRYieldToObjCmd,	CMD_IS_SAFE},
 
     /*
      * Commands in the OS-interface. Note that many of these are unsafe.
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 0f2790f..5c132b4 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -3447,6 +3447,51 @@ TclCompileYieldCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileYieldToCmd --
+ *
+ *	Procedure called to compile the "yieldto" command.
+ *
+ * Results:
+ *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ *	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "yieldto" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileYieldToCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    Command *cmdPtr,		/* Points to defintion of command being
+				 * compiled. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    int i;
+
+    if (parsePtr->numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    OP(		NS_CURRENT);
+    for (i = 1 ; i < parsePtr->numWords ; i++) {
+	CompileWord(envPtr, tokenPtr, interp, i);
+	tokenPtr = TokenAfter(tokenPtr);
+    }
+    OP4(	LIST, i);
+    OP(		YIELD_TO_INVOKE);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * CompileUnaryOpCmd --
  *
  *	Utility routine to compile the unary operator commands.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index bd97e3e..f75ac83 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -631,6 +631,13 @@ InstructionDesc const tclInstructionTable[] = {
 	 * arguments (similar to invokeStk).
 	 * Stack:  ... "nextto" className arg3 arg4 -- argN => ... result */
 
+    {"yieldToInvoke",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* Makes the current coroutine yield the value at the top of the
+	 * stack, invoking the given command/args with resolution in the given
+	 * namespace (all packed into a list), and places the list of values
+	 * that are the response back on top of the stack when it resumes.
+	 * Stack:  ... [list ns cmd arg1 ... argN] => ... resumeList */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b047855..7994e2c 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -793,8 +793,10 @@ typedef struct ByteCode {
 #define INST_TCLOO_NEXT			179
 #define INST_TCLOO_NEXT_CLASS		180
 
+#define INST_YIELD_TO_INVOKE		181
+
 /* The last opcode */
-#define LAST_INST_OPCODE		180
+#define LAST_INST_OPCODE		181
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ac0ea12..575f227 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2494,9 +2494,12 @@ TEBCresume(
 	TRACE_APPEND(("\n"));
 	goto processExceptionReturn;
 
-    case INST_YIELD: {
-	CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
+    {
+	CoroutineData *corPtr;
+	int yieldParameter;
 
+    case INST_YIELD:
+	corPtr = iPtr->execEnvPtr->corPtr;
 	TRACE(("%.30s => ", O2S(OBJ_AT_TOS)));
 	if (!corPtr) {
 	    TRACE_APPEND(("ERROR: yield outside coroutine\n"));
@@ -2510,11 +2513,63 @@ TEBCresume(
 	}
 
 #ifdef TCL_COMPILE_DEBUG
-	TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr);
-	if (traceInstructions) {
-	    fprintf(stdout, "\n");
+	if (tclTraceExec >= 2) {
+	    if (traceInstructions) {
+		TRACE_APPEND(("YIELD...\n"));
+	    } else {
+		fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n",
+			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+			Tcl_GetString(OBJ_AT_TOS));
+	    }
+	    fflush(stdout);
+	}
+#endif
+	yieldParameter = 0;
+	Tcl_SetObjResult(interp, OBJ_AT_TOS);
+	goto doYield;
+
+    case INST_YIELD_TO_INVOKE:
+	corPtr = iPtr->execEnvPtr->corPtr;
+	valuePtr = OBJ_AT_TOS;
+	if (!corPtr) {
+	    TRACE(("[%.30s] => ERROR: yield outside coroutine\n",
+		    O2S(valuePtr)));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "yieldto can only be called in a coroutine", -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
+		    NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
+
+#ifdef TCL_COMPILE_DEBUG
+	if (tclTraceExec >= 2) {
+	    if (traceInstructions) {
+		TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
+	    } else {
+		/* FIXME: What is the right thing to trace? */
+		fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
+			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+			Tcl_GetString(valuePtr));
+	    }
+	    fflush(stdout);
 	}
 #endif
+
+	/*
+	 * Install a tailcall record in the caller and continue with the
+	 * yield. The yield is switched into multi-return mode (via the
+	 * 'yieldParameter').
+	 */
+
+	Tcl_IncrRefCount(valuePtr);
+	iPtr->execEnvPtr = corPtr->callerEEPtr;
+	TclSetTailcall(interp, valuePtr);
+	iPtr->execEnvPtr = corPtr->eePtr;
+	yieldParameter = (PTR2INT(NULL)+1);	/*==CORO_ACTIVATE_YIELDM*/
+
+    doYield:
 	/* TIP #280: Record the last piece of info needed by
 	 * 'TclGetSrcInfoForPc', and push the frame.
 	 */
@@ -2529,11 +2584,8 @@ TEBCresume(
 	pc++;
 	cleanup = 1;
 	TEBC_YIELD();
-	
-	Tcl_SetObjResult(interp, OBJ_AT_TOS);
 	TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
-		INT2PTR(0), NULL, NULL);
-
+		INT2PTR(yieldParameter), NULL, NULL);
 	return TCL_OK;
     }
 
@@ -2553,6 +2605,7 @@ TEBCresume(
 	}
 
 #ifdef TCL_COMPILE_DEBUG
+	/* FIXME: What is the right thing to trace? */
 	{
 	    register int i;
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 7932a58..6ddb015 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3688,6 +3688,9 @@ MODULE_SCOPE int	TclCompileWhileCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileYieldCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileYieldToCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileBasic0ArgCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
-- 
cgit v0.12


From 78a75740ae5c82cc161e49e5e28a306fa9f2a580 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 22 Jan 2014 09:07:45 +0000
Subject: [a90d9331bc]: must not crash when yieldto called in vanishing
 namespace

---
 generic/tclBasic.c   | 18 ++++------
 generic/tclExecute.c | 11 +++++++
 tests/coroutine.test | 92 +++++++++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 105 insertions(+), 16 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e355229..cb9428c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -8431,11 +8431,13 @@ TclNRYieldToObjCmd(
 	return TCL_ERROR;
     }
 
-    /*
-     * Add the tailcall in the caller env, then just yield.
-     *
-     * This is essentially code from TclNRTailcallObjCmd
-     */
+    if (((Namespace *) TclGetCurrentNamespace(interp))->flags & NS_DYING) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"yieldto called in deleted namespace", -1));
+        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+		NULL);
+        return TCL_ERROR;
+    }
 
     /*
      * Add the tailcall in the caller env, then just yield.
@@ -8444,15 +8446,9 @@ TclNRYieldToObjCmd(
      */
 
     listPtr = Tcl_NewListObj(objc, objv);
-
     nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
-    if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
-	    || (nsPtr != ns1Ptr)) {
-	Tcl_Panic("yieldto failed to find the proper namespace");
-    }
     TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
 
-
     /*
      * Add the callback in the caller's env, then instruct TEBC to yield.
      */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 575f227..6749120 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2542,6 +2542,17 @@ TEBCresume(
 	    CACHE_STACK_INFO();
 	    goto gotError;
 	}
+	if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) {
+	    TRACE(("[%.30s] => ERROR: yield in deleted\n",
+		    O2S(valuePtr)));
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "yieldto called in deleted namespace", -1));
+	    DECACHE_STACK_INFO();
+	    Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+		    NULL);
+	    CACHE_STACK_INFO();
+	    goto gotError;
+	}
 
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceExec >= 2) {
diff --git a/tests/coroutine.test b/tests/coroutine.test
index a360fd5..05b58c9 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -1,4 +1,4 @@
-# Commands covered:  coroutine, yield, [info coroutine]
+# Commands covered:  coroutine, yield, yieldto, [info coroutine]
 #
 # This file contains a collection of tests for experimental commands that are
 # found in ::tcl::unsupported. The tests will migrate to normal test files
@@ -612,7 +612,6 @@ test coroutine-7.3 {yielding between coroutines} -body {
 } -cleanup {
     catch {rename juggler ""}
 } -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}}
-
 test coroutine-7.4 {Bug 8ff0cb9fe1} -setup {
     proc foo {a b} {catch yield; return 1}
 } -cleanup {
@@ -620,7 +619,6 @@ test coroutine-7.4 {Bug 8ff0cb9fe1} -setup {
 } -body {
     coroutine demo lsort -command foo {a b}
 } -result {b a}
-
 test coroutine-7.5 {return codes} {
     set result {}
     foreach code {0 1 2 3 4 5} {
@@ -628,14 +626,12 @@ test coroutine-7.5 {return codes} {
     }
     set result
 } {0 1 2 3 4 5}
-
 test coroutine-7.6 {Early yield crashes} {
     proc foo args {}
     trace add execution foo enter {catch yield}
     coroutine demo foo
     rename foo {}
 } {}
-
 test coroutine-7.7 {Bug 2486550} -setup {
     interp hide {} yield
 } -body {
@@ -644,6 +640,92 @@ test coroutine-7.7 {Bug 2486550} -setup {
     demo
     interp expose {} yield
 } -result ok
+test coroutine-7.8 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	yieldto ::return -level 0 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    namespace delete cotest
+    namespace eval cotest {}
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	set y ::yieldto
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	$y ::return -level 0 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    namespace delete cotest
+    namespace eval cotest {}
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	yieldto ::return -level 0 -cotest [namespace delete ::cotest] 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	set y ::yieldto
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	$y ::return -level 0 -cotest [namespace delete ::cotest] 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
 
 
 # cleanup
-- 
cgit v0.12


From 6e072443704a589149fea001df51f9870b78c323 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 22 Jan 2014 09:14:57 +0000
Subject: minor tidying up

---
 generic/tclBasic.c | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cb9428c..46b532b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -8416,8 +8416,7 @@ TclNRYieldToObjCmd(
 {
     CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
     Tcl_Obj *listPtr, *nsObjPtr;
-    Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
-    Tcl_Namespace *ns1Ptr;
+    Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
@@ -8431,7 +8430,7 @@ TclNRYieldToObjCmd(
 	return TCL_ERROR;
     }
 
-    if (((Namespace *) TclGetCurrentNamespace(interp))->flags & NS_DYING) {
+    if (((Namespace *) nsPtr)->flags & NS_DYING) {
         Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"yieldto called in deleted namespace", -1));
         Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
-- 
cgit v0.12


From 75c91591589708f766539aef319bfb7d80d7f0a8 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 22 Jan 2014 13:48:16 +0000
Subject: remove unused variable

---
 generic/tclBasic.c | 1 -
 1 file changed, 1 deletion(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cb9428c..1aea752 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -8417,7 +8417,6 @@ TclNRYieldToObjCmd(
     CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
     Tcl_Obj *listPtr, *nsObjPtr;
     Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
-    Tcl_Namespace *ns1Ptr;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
-- 
cgit v0.12


From 60e360f12b1c25a8e89f5893a564ca17d3b99217 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 29 Jan 2014 13:59:32 +0000
Subject: Compile [string is] with character classes in a non-awful way. Needs
 more work to make resulting bytecode disassemble nicely.

---
 generic/tclCompCmdsSZ.c | 99 ++++++++++++++++++++++++++++++++++++++++++++-----
 generic/tclCompile.c    |  5 +++
 generic/tclCompile.h    | 37 +++++++++++++++++-
 generic/tclExecute.c    | 19 ++++++++++
 4 files changed, 150 insertions(+), 10 deletions(-)

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 1a69a89..639b4a5 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -452,6 +452,7 @@ TclCompileStringIsCmd(
 	STR_IS_XDIGIT
     };
     int t, range, allowEmpty = 0, end;
+    InstStringClassType strClassType;
     Tcl_Obj *isClass;
 
     if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
@@ -486,7 +487,7 @@ TclCompileStringIsCmd(
 
     tokenPtr = TokenAfter(tokenPtr);
     if (parsePtr->numWords == 3) {
-	allowEmpty = (t != STR_IS_LIST);
+	allowEmpty = 1;
     } else {
 	if (!GotLiteral(tokenPtr, "-strict")) {
 	    return TCL_ERROR;
@@ -496,30 +497,77 @@ TclCompileStringIsCmd(
 #undef GotLiteral
 
     /*
-     * Some types are not currently handled. Character classes are a prime
-     * example of this.
+     * Compile the code. There are several main classes of check here.
+     *	1. Character classes
+     *	2. Booleans
+     *	3. Integers
+     *	4. Floats
+     *	5. Lists
      */
 
+    CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
+
     switch ((enum isClasses) t) {
     case STR_IS_ALNUM:
+	strClassType = STR_CLASS_ALNUM;
+	goto compileStrClass;
     case STR_IS_ALPHA:
+	strClassType = STR_CLASS_ALPHA;
+	goto compileStrClass;
     case STR_IS_ASCII:
+	strClassType = STR_CLASS_ASCII;
+	goto compileStrClass;
     case STR_IS_CONTROL:
+	strClassType = STR_CLASS_CONTROL;
+	goto compileStrClass;
     case STR_IS_DIGIT:
+	strClassType = STR_CLASS_DIGIT;
+	goto compileStrClass;
     case STR_IS_GRAPH:
+	strClassType = STR_CLASS_GRAPH;
+	goto compileStrClass;
     case STR_IS_LOWER:
+	strClassType = STR_CLASS_LOWER;
+	goto compileStrClass;
     case STR_IS_PRINT:
+	strClassType = STR_CLASS_PRINT;
+	goto compileStrClass;
     case STR_IS_PUNCT:
+	strClassType = STR_CLASS_PUNCT;
+	goto compileStrClass;
     case STR_IS_SPACE:
+	strClassType = STR_CLASS_SPACE;
+	goto compileStrClass;
     case STR_IS_UPPER:
+	strClassType = STR_CLASS_UPPER;
+	goto compileStrClass;
     case STR_IS_WORD:
+	strClassType = STR_CLASS_WORD;
+	goto compileStrClass;
     case STR_IS_XDIGIT:
-	return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+	strClassType = STR_CLASS_XDIGIT;
+    compileStrClass:
+	if (allowEmpty) {
+	    OP1(	STR_CLASS, strClassType);
+	} else {
+	    int over, over2;
+
+	    OP(		DUP);
+	    OP1(	STR_CLASS, strClassType);
+	    JUMP1(	JUMP_TRUE, over);
+	    OP(		POP);
+	    PUSH(	"0");
+	    JUMP1(	JUMP, over2);
+	    FIXJUMP1(over);
+	    PUSH(	"");
+	    OP(		STR_NEQ);
+	    FIXJUMP1(over2);
+	}
+	return TCL_OK;
 
     case STR_IS_BOOL:
     case STR_IS_FALSE:
     case STR_IS_TRUE:
-	CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
 	OP(		TRY_CVT_TO_BOOLEAN);
 	switch (t) {
 	    int over, over2;
@@ -569,7 +617,6 @@ TclCompileStringIsCmd(
     case STR_IS_DOUBLE: {
 	int satisfied, isEmpty;
 
-	CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
 	if (allowEmpty) {
 	    OP(		DUP);
 	    PUSH(	"");
@@ -598,7 +645,6 @@ TclCompileStringIsCmd(
     case STR_IS_INT:
     case STR_IS_WIDE:
     case STR_IS_ENTIER:
-	CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
 	if (allowEmpty) {
 	    int testNumType;
 
@@ -638,7 +684,6 @@ TclCompileStringIsCmd(
 	return TCL_OK;
 
     case STR_IS_LIST:
-	CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
 	range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
 	OP4(		BEGIN_CATCH4, range);
 	ExceptionRangeStarts(envPtr, range);
@@ -653,7 +698,8 @@ TclCompileStringIsCmd(
 	OP(		LNOT);
 	return TCL_OK;
     }
-    return TCL_ERROR;
+
+    return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
 }
 
 int
@@ -1171,6 +1217,41 @@ TclCompileStringToTitleCmd(
 }
 
 /*
+ * Support definitions for the [string is] compilation.
+ */
+
+static int
+UniCharIsAscii(
+    int character)
+{
+    return (character >= 0) && (character < 0x80);
+}
+
+static int
+UniCharIsHexDigit(
+    int character)
+{
+    return (character >= 0) && (character < 0x80) && isxdigit(character);
+}
+
+StringClassDesc const tclStringClassTable[] = {
+    {"alnum",	Tcl_UniCharIsAlnum},
+    {"alpha",	Tcl_UniCharIsAlpha},
+    {"ascii",	UniCharIsAscii},
+    {"control", Tcl_UniCharIsControl},
+    {"digit",	Tcl_UniCharIsDigit},
+    {"graph",	Tcl_UniCharIsGraph},
+    {"lower",	Tcl_UniCharIsLower},
+    {"print",	Tcl_UniCharIsPrint},
+    {"punct",	Tcl_UniCharIsPunct},
+    {"space",	Tcl_UniCharIsSpace},
+    {"upper",	Tcl_UniCharIsUpper},
+    {"word",	Tcl_UniCharIsWordChar},
+    {"xdigit",	UniCharIsHexDigit},
+    {NULL,	NULL}
+};
+
+/*
  *----------------------------------------------------------------------
  *
  * TclCompileSubstCmd --
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index fdc3e26..08a7a4c 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -644,6 +644,11 @@ InstructionDesc const tclInstructionTable[] = {
     {"tryCvtToBoolean",	 1,	+1,	  0,	{OPERAND_NONE}},
 	/* Try converting stktop to boolean if possible. No errors.
 	 * Stack:  ... value => ... value isStrictBool */
+    {"strclass",	 2,	0,	  1,	{OPERAND_UINT1}},
+	/* See if all the characters of the given string are a member of the
+	 * specified (by opnd) character class. Note that an empty string will
+	 * satisfy the class check (standard definition of "all").
+	 * Stack:  ... stringValue => ... boolean */
 
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index d6d515d..502a2e6 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -797,9 +797,10 @@ typedef struct ByteCode {
 
 #define INST_NUM_TYPE			182
 #define INST_TRY_CVT_TO_BOOLEAN		183
+#define INST_STR_CLASS			184
 
 /* The last opcode */
-#define LAST_INST_OPCODE		183
+#define LAST_INST_OPCODE		184
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
@@ -844,6 +845,40 @@ typedef struct InstructionDesc {
 MODULE_SCOPE InstructionDesc const tclInstructionTable[];
 
 /*
+ * Constants used by INST_STRING_CLASS to indicate character classes. These
+ * correspond closely by name with what [string is] can support, but there is
+ * no requirement to keep the values the same.
+ */
+
+typedef enum InstStringClassType {
+    STR_CLASS_ALNUM,		/* Unicode alphabet or digit characters. */
+    STR_CLASS_ALPHA,		/* Unicode alphabet characters. */
+    STR_CLASS_ASCII,		/* Characters in range U+000000..U+00007F. */
+    STR_CLASS_CONTROL,		/* Unicode control characters. */
+    STR_CLASS_DIGIT,		/* Unicode digit characters. */
+    STR_CLASS_GRAPH,		/* Unicode printing characters, excluding
+				 * space. */
+    STR_CLASS_LOWER,		/* Unicode lower-case alphabet characters. */
+    STR_CLASS_PRINT,		/* Unicode printing characters, including
+				 * spaces. */
+    STR_CLASS_PUNCT,		/* Unicode punctuation characters. */
+    STR_CLASS_SPACE,		/* Unicode space characters. */
+    STR_CLASS_UPPER,		/* Unicode upper-case alphabet characters. */
+    STR_CLASS_WORD,		/* Unicode word (alphabetic, digit, connector
+				 * punctuation) characters. */
+    STR_CLASS_XDIGIT		/* Characters that can be used as digits in
+				 * hexadecimal numbers ([0-9A-Fa-f]). */
+} InstStringClassType;
+
+typedef struct StringClassDesc {
+    const char *name;		/* Name of the class. */
+    int (*comparator)(int);	/* Function to test if a single unicode
+				 * character is a member of the class. */
+} StringClassDesc;
+
+MODULE_SCOPE StringClassDesc const tclStringClassTable[];
+
+/*
  * Compilation of some Tcl constructs such as if commands and the logical or
  * (||) and logical and (&&) operators in expressions requires the generation
  * of forward jumps. Since the PC target of these jumps isn't known when the
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 916de17..58d85e1 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5810,6 +5810,25 @@ TEBCresume(
 
 	TclNewIntObj(objResultPtr, match);
 	NEXT_INST_F(1, 2, 1);
+
+    case INST_STR_CLASS:
+	opnd = TclGetInt1AtPtr(pc+1);
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
+		O2S(valuePtr)));
+	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+	match = 1;
+	if (length > 0) {
+	    end = ustring1 + length;
+	    for (p=ustring1 ; p<end ; p++) {
+		if (!tclStringClassTable[opnd].comparator(*p)) {
+		    match = 0;
+		    break;
+		}
+	    }
+	}
+	TRACE_APPEND(("%d\n", match));
+	JUMP_PEEPHOLE_F(match, 2, 1);
     }
 
     case INST_STR_MATCH:
-- 
cgit v0.12


From 696b86227c0d696dd8624610b194a8bc67e6d112 Mon Sep 17 00:00:00 2001
From: andreask <andreask>
Date: Wed, 29 Jan 2014 23:18:58 +0000
Subject: Squashed C99 syntax breaking the native AIX cc.

---
 generic/tclAssembly.c | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 7b775a9..55a0c3f 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -50,7 +50,7 @@ typedef enum BasicBlockCatchState {
     BBCS_UNKNOWN = 0,		/* Catch context has not yet been identified */
     BBCS_NONE,			/* Block is outside of any catch */
     BBCS_INCATCH,		/* Block is within a catch context */
-    BBCS_CAUGHT,		/* Block is within a catch context and
+    BBCS_CAUGHT 		/* Block is within a catch context and
 				 * may be executed after an exception fires */
 } BasicBlockCatchState;
 
@@ -121,7 +121,7 @@ enum BasicBlockFlags {
 				 * marking it as the start of a 'catch'
 				 * sequence. The 'jumpTarget' is the exception
 				 * exit from the catch block. */
-    BB_ENDCATCH = (1 << 5),	/* Block ends with an 'endCatch' instruction,
+    BB_ENDCATCH = (1 << 5)	/* Block ends with an 'endCatch' instruction,
 				 * unwinding the catch from the exception
 				 * stack. */
 };
@@ -184,7 +184,7 @@ typedef enum TalInstType {
 				 * produces N */
     ASSEM_SINT1,		/* One 1-byte signed-integer operand
 				 * (INCR_STK_IMM) */
-    ASSEM_SINT4_LVT4,		/* Signed 4-byte integer operand followed by
+    ASSEM_SINT4_LVT4		/* Signed 4-byte integer operand followed by
 				 * LVT entry.  Fixed arity */
 } TalInstType;
 
-- 
cgit v0.12


From 347264f196f57e2f4433f33dbaa6c8e2e4a2c83d Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 2 Feb 2014 14:42:12 +0000
Subject: improve the disassembly

---
 generic/tclCompile.c | 7 ++++++-
 generic/tclCompile.h | 3 ++-
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 08a7a4c..c5d0107 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -644,7 +644,7 @@ InstructionDesc const tclInstructionTable[] = {
     {"tryCvtToBoolean",	 1,	+1,	  0,	{OPERAND_NONE}},
 	/* Try converting stktop to boolean if possible. No errors.
 	 * Stack:  ... value => ... value isStrictBool */
-    {"strclass",	 2,	0,	  1,	{OPERAND_UINT1}},
+    {"strclass",	 2,	0,	  1,	{OPERAND_SCLS1}},
 	/* See if all the characters of the given string are a member of the
 	 * specified (by opnd) character class. Note that an empty string will
 	 * satisfy the class check (standard definition of "all").
@@ -5097,6 +5097,11 @@ FormatInstruction(
 	    }
 	    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;
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 502a2e6..5665ca9 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -825,8 +825,9 @@ typedef enum InstOperandType {
 				 * variable table. */
     OPERAND_LVT4,		/* Four byte unsigned index into the local
 				 * variable table. */
-    OPERAND_AUX4		/* Four byte unsigned index into the aux data
+    OPERAND_AUX4,		/* Four byte unsigned index into the aux data
 				 * table. */
+    OPERAND_SCLS1		/* Index into tclStringClassTable. */
 } InstOperandType;
 
 typedef struct InstructionDesc {
-- 
cgit v0.12


From dc81fd618b33c6e9c6b8fa4b9595229ce3809f01 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 4 Feb 2014 08:15:52 +0000
Subject: [971cb4f1db]: Make debugging traces less inclined to serious visual
 corruption

---
 generic/tclExecute.c | 28 ++++++++++++++++++++++++----
 1 file changed, 24 insertions(+), 4 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ac78370..89305e6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5905,14 +5905,34 @@ TEBCresume(
 	    trim2 = 0;
 	}
     createTrimmedString:
+	/*
+	 * Careful here; trim set often contains non-ASCII characters so we
+	 * take care when printing. [Bug 971cb4f1db]
+	 */
+
+#ifdef TCL_COMPILE_DEBUG
+	if (traceInstructions) {
+	    TRACE(("\"%.30s\" ", O2S(valuePtr)));
+	    TclPrintObject(stdout, value2Ptr, 30);
+	    printf(" => ");
+	}
+#endif
 	if (trim1 == 0 && trim2 == 0) {
-	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
-		    O2S(valuePtr), O2S(value2Ptr)), valuePtr);
+#ifdef TCL_COMPILE_DEBUG
+	    if (traceInstructions) {
+		TclPrintObject(stdout, valuePtr, 30);
+		printf("\n");
+	    }
+#endif
 	    NEXT_INST_F(1, 1, 0);
 	} else {
 	    objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
-	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ",
-		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
+#ifdef TCL_COMPILE_DEBUG
+	    if (traceInstructions) {
+		TclPrintObject(stdout, objResultPtr, 30);
+		printf("\n");
+	    }
+#endif
 	    NEXT_INST_F(1, 2, 1);
 	}
     }
-- 
cgit v0.12


From a72ae0f931f9ac8a78ef7b78f854ae68e66f9dd1 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 4 Feb 2014 09:02:23 +0000
Subject: make the printing of source much less inclined to be fazed by
 non-ASCII chars

---
 generic/tclCompile.c | 26 ++++++++++++++++++++++----
 1 file changed, 22 insertions(+), 4 deletions(-)

diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c5d0107..347e3f0 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -5318,7 +5318,7 @@ PrintSourceToObj(
     int maxChars)		/* Maximum number of chars to print. */
 {
     register const char *p;
-    register int i = 0;
+    register int i = 0, len;
 
     if (stringPtr == NULL) {
 	Tcl_AppendToObj(appendObj, "\"\"", -1);
@@ -5327,32 +5327,50 @@ PrintSourceToObj(
 
     Tcl_AppendToObj(appendObj, "\"", -1);
     p = stringPtr;
-    for (;  (*p != '\0') && (i < maxChars);  p++, i++) {
-	switch (*p) {
+    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:
-	    Tcl_AppendPrintfToObj(appendObj, "%c", *p);
+	    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
-- 
cgit v0.12


From d8e6ba4a3b30e39fc7cde4cb5550d2157c95e194 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 10 Feb 2014 11:59:22 +0000
Subject: Eliminate all usage of WIN32 and __WIN32__ macros: Some compilers
 (e.g. Clang/LLVM) don't define it, and _WIN32 is much more portable anyway.
 See:
 [http://nadeausoftware.com/articles/2012/01/c_c_tip_how_use_compiler_predefined_macros_detect_operating_system#WindowsCygwinnonPOSIXandMinGW]

---
 generic/tcl.h             | 35 ++++++++++++++++-------------------
 generic/tclClock.c        |  2 +-
 generic/tclCmdAH.c        |  2 +-
 generic/tclDecls.h        | 24 ++++++++++++------------
 generic/tclEnv.c          |  4 ++--
 generic/tclFCmd.c         |  2 +-
 generic/tclIOUtil.c       |  8 ++++----
 generic/tclIntDecls.h     |  0
 generic/tclIntPlatDecls.h | 16 ++++++++--------
 generic/tclLoad.c         |  4 ++--
 generic/tclMain.c         |  2 +-
 generic/tclPathObj.c      |  6 +++---
 generic/tclPlatDecls.h    |  6 +++---
 generic/tclStubInit.c     | 20 ++++++++++----------
 generic/tclTest.c         |  6 +++---
 generic/tclThreadJoin.c   |  4 ++--
 tools/genStubs.tcl        |  6 +++---
 win/configure             |  4 ++--
 win/tcl.m4                |  4 ++--
 win/tclWin32Dll.c         |  4 ++--
 win/tclWinTest.c          |  2 +-
 21 files changed, 79 insertions(+), 82 deletions(-)
 mode change 100644 => 100755 generic/tclDecls.h
 mode change 100644 => 100755 generic/tclIntDecls.h
 mode change 100644 => 100755 generic/tclIntPlatDecls.h
 mode change 100644 => 100755 generic/tclPlatDecls.h
 mode change 100644 => 100755 generic/tclStubInit.c

diff --git a/generic/tcl.h b/generic/tcl.h
index b7237bf..b93b3ac 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -67,15 +67,12 @@ extern "C" {
  * We use this method because there is no autoconf equivalent.
  */
 
-#ifndef __WIN32__
-#   if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
+#ifdef _WIN32
+#   ifndef __WIN32__
 #	define __WIN32__
-#	ifndef WIN32
-#	    define WIN32
-#	endif
-#	ifndef _WIN32
-#	    define _WIN32
-#	endif
+#   endif
+#   ifndef WIN32
+#	define WIN32
 #   endif
 #endif
 
@@ -83,11 +80,11 @@ extern "C" {
  * STRICT: See MSDN Article Q83456
  */
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #   ifndef STRICT
 #	define STRICT
 #   endif
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
 
 /*
  * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
@@ -191,7 +188,7 @@ extern "C" {
  *       MSVCRT.
  */
 
-#if (defined(__WIN32__) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
+#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
 #   define HAVE_DECLSPEC 1
 #   ifdef STATIC_BUILD
 #       define DLLIMPORT
@@ -315,14 +312,14 @@ extern "C" {
  * VOID. This block is skipped under Cygwin and Mingw.
  */
 
-#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
+#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
 #ifndef VOID
 #define VOID void
 typedef char CHAR;
 typedef short SHORT;
 typedef long LONG;
 #endif
-#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
+#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
 
 /*
  * Macro to use instead of "void" for arguments that must have type "void *"
@@ -390,7 +387,7 @@ typedef long LONG;
  */
 
 #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
-#   if defined(__WIN32__)
+#   if defined(_WIN32)
 #      define TCL_WIDE_INT_TYPE __int64
 #      ifdef __BORLANDC__
 #         define TCL_LL_MODIFIER	"L"
@@ -400,7 +397,7 @@ typedef long LONG;
 #   elif defined(__GNUC__)
 #      define TCL_WIDE_INT_TYPE long long
 #      define TCL_LL_MODIFIER	"ll"
-#   else /* ! __WIN32__ && ! __GNUC__ */
+#   else /* ! _WIN32 && ! __GNUC__ */
 /*
  * Don't know what platform it is and configure hasn't discovered what is
  * going on for us. Try to guess...
@@ -415,7 +412,7 @@ typedef long LONG;
 #	     define TCL_WIDE_INT_TYPE long long
 #         endif
 #      endif /* NO_LIMITS_H */
-#   endif /* __WIN32__ */
+#   endif /* _WIN32 */
 #endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
 #ifdef TCL_WIDE_INT_IS_LONG
 #   undef TCL_WIDE_INT_TYPE
@@ -447,7 +444,7 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 #   define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))
 #endif /* TCL_WIDE_INT_IS_LONG */
 
-#if defined(__WIN32__)
+#if defined(_WIN32)
 #   ifdef __BORLANDC__
 	typedef struct stati64 Tcl_StatBuf;
 #   elif defined(_WIN64)
@@ -562,7 +559,7 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream;
  * will be called as the main fuction of the new thread created by that call.
  */
 
-#if defined __WIN32__
+#if defined _WIN32
 typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
 #else
 typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
@@ -574,7 +571,7 @@ typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
  * in generic/tclThreadTest.c for it's usage.
  */
 
-#if defined __WIN32__
+#if defined _WIN32
 #   define Tcl_ThreadCreateType		unsigned __stdcall
 #   define TCL_THREAD_CREATE_RETURN	return 0
 #else
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 6d2976d..50d480c 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -19,7 +19,7 @@
  * Windows has mktime. The configurators do not check.
  */
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #define HAVE_MKTIME 1
 #endif
 
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index f90819a..d90a747 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1590,7 +1590,7 @@ FileAttrIsOwnedCmd(
 	 * test for equivalence to the current user.
 	 */
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32) || defined(__CYGWIN__)
 	value = 1;
 #else
 	value = (geteuid() == buf.st_uid);
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
old mode 100644
new mode 100755
index 830c998..91c0add
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -63,7 +63,7 @@ EXTERN void		Tcl_DbCkfree(char *ptr, const char *file, int line);
 /* 8 */
 EXTERN char *		Tcl_DbCkrealloc(char *ptr, unsigned int size,
 				const char *file, int line);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 9 */
 EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
 				Tcl_FileProc *proc, ClientData clientData);
@@ -73,7 +73,7 @@ EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
 EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
 				Tcl_FileProc *proc, ClientData clientData);
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 10 */
 EXTERN void		Tcl_DeleteFileHandler(int fd);
 #endif /* UNIX */
@@ -511,7 +511,7 @@ EXTERN Tcl_Interp *	Tcl_GetMaster(Tcl_Interp *interp);
 EXTERN const char *	Tcl_GetNameOfExecutable(void);
 /* 166 */
 EXTERN Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 167 */
 EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
 				const char *chanID, int forWriting,
@@ -1835,19 +1835,19 @@ typedef struct TclStubs {
     char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
     void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
     char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     void (*reserved9)(void);
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     void (*tcl_DeleteFileHandler) (int fd); /* 10 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     void (*reserved10)(void);
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
@@ -2009,10 +2009,10 @@ typedef struct TclStubs {
     Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
     const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
     Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     void (*reserved167)(void);
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
@@ -2513,7 +2513,7 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_DbCkfree) /* 7 */
 #define Tcl_DbCkrealloc \
 	(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 #define Tcl_CreateFileHandler \
 	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
 #endif /* UNIX */
@@ -2521,7 +2521,7 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_CreateFileHandler \
 	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 #define Tcl_DeleteFileHandler \
 	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
 #endif /* UNIX */
@@ -2841,7 +2841,7 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
 #define Tcl_GetObjResult \
 	(tclStubsPtr->tcl_GetObjResult) /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 #define Tcl_GetOpenFile \
 	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
 #endif /* UNIX */
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 8f51c1b..cd1a954 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -444,7 +444,7 @@ TclUnsetEnv(
      * that no = should be included, and Windows requires it.
      */
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32) || defined(__CYGWIN__)
     string = ckalloc(length + 2);
     memcpy(string, name, (size_t) length);
     string[length] = '=';
@@ -453,7 +453,7 @@ TclUnsetEnv(
     string = ckalloc(length + 1);
     memcpy(string, name, (size_t) length);
     string[length] = '\0';
-#endif /* WIN32 */
+#endif /* _WIN32 */
 
     Tcl_UtfToExternalDString(NULL, string, -1, &envString);
     string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 13377d3..6452fff 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -517,7 +517,7 @@ CopyRenameOneFile(
 	 * 16 bits and we get collisions. See bug #2015723.
 	 */
 
-#if !defined(WIN32) && !defined(__CYGWIN__)
+#if !defined(_WIN32) && !defined(__CYGWIN__)
 	if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
 	    if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
 		    (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 6259216..f624cb7 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -19,7 +19,7 @@
  */
 
 #include "tclInt.h"
-#ifdef __WIN32__
+#ifdef _WIN32
 #   include "tclWinInt.h"
 #endif
 #include "tclFileSystem.h"
@@ -792,7 +792,7 @@ TclFinalizeFilesystem(void)
      * filesystem is likely to fail.
      */
 
-#ifdef __WIN32__
+#ifdef _WIN32
     TclWinEncodingsCleanup();
 #endif
 }
@@ -819,7 +819,7 @@ TclResetFilesystem(void)
     filesystemList = &nativeFilesystemRecord;
     theFilesystemEpoch++;
 
-#ifdef __WIN32__
+#ifdef _WIN32
     /*
      * Cleans up the win32 API filesystem proc lookup table. This must happen
      * very late in finalization so that deleting of copied dlls can occur.
@@ -3255,7 +3255,7 @@ Tcl_LoadFile(
 	return TCL_ERROR;
     }
 
-#ifndef __WIN32__
+#ifndef _WIN32
     /*
      * Do we need to set appropriate permissions on the file? This may be
      * required on some systems. On Unix we could loop over the file
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
old mode 100644
new mode 100755
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
old mode 100644
new mode 100755
index 72719fe..2c74b5a
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -13,7 +13,7 @@
 #ifndef _TCLINTPLATDECLS
 #define _TCLINTPLATDECLS
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #   define Tcl_DirEntry void
 #   define DIR void
 #endif
@@ -45,7 +45,7 @@ extern "C" {
  * Exported function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 0 */
 EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
 				Tcl_Channel chan);
@@ -104,7 +104,7 @@ EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
 				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
 				Tcl_Obj *resultingNameObj);
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 /* 0 */
 EXTERN void		TclWinConvertError(DWORD errCode);
 /* 1 */
@@ -258,7 +258,7 @@ typedef struct TclIntPlatStubs {
     int magic;
     void *hooks;
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
     void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
     int (*tclpCloseFile) (TclFile file); /* 1 */
     Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
@@ -291,7 +291,7 @@ typedef struct TclIntPlatStubs {
     int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
     int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     void (*tclWinConvertError) (DWORD errCode); /* 0 */
     void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
     struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
@@ -371,7 +371,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
  * Inline function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
 #define TclGetAndDetachPids \
 	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
 #define TclpCloseFile \
@@ -420,7 +420,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 #define TclUnixOpenTemporaryFile \
 	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 #define TclWinConvertError \
 	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
 #define TclWinConvertWSAError \
@@ -550,7 +550,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 #undef TclpInetNtoa
 #define TclpInetNtoa inet_ntoa
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32) || defined(__CYGWIN__)
 #   undef TclWinNToHS
 #   define TclWinNToHS ntohs
 #else
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 5cacab1..7c70e03 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -830,7 +830,7 @@ Tcl_UnloadObjCmd(
 	 * Unload the shared library from the application memory...
 	 */
 
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
 	/*
 	 * Some Unix dlls are poorly behaved - registering things like atexit
 	 * calls that can't be unregistered. If you unload such dlls, you get
@@ -1151,7 +1151,7 @@ TclFinalizeLoad(void)
 	pkgPtr = firstPackagePtr;
 	firstPackagePtr = pkgPtr->nextPtr;
 
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
 	/*
 	 * Some Unix dlls are poorly behaved - registering things like atexit
 	 * calls that can't be unregistered. If you unload such dlls, you get
diff --git a/generic/tclMain.c b/generic/tclMain.c
index faea75a..360f5e9 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -47,7 +47,7 @@
  * we have to translate that to strcmp here.
  */
 
-#ifndef __WIN32__
+#ifndef _WIN32
 #   define TCHAR char
 #   define TEXT(arg) arg
 #   define _tcscmp strcmp
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index b7f3dcf..fe6063f 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -512,7 +512,7 @@ TclFSGetPathType(
 
     if (PATHFLAGS(pathPtr) == 0) {
 	/* The path is not absolute... */
-#ifdef __WIN32__
+#ifdef _WIN32
 	/* ... on Windows we must make another call to determine whether
 	 * it's relative or volumerelative [Bug 2571597]. */
 	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
@@ -1956,7 +1956,7 @@ Tcl_FSGetNormalizedPath(
 		/*
 		 * We have a refCount on the cwd.
 		 */
-#ifdef __WIN32__
+#ifdef _WIN32
 	    } else if (type == TCL_PATH_VOLUME_RELATIVE) {
 		/*
 		 * Only Windows has volume-relative paths.
@@ -1969,7 +1969,7 @@ Tcl_FSGetNormalizedPath(
 		    return NULL;
 		}
 		pureNormalized = 0;
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
 	    }
 	}
 
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
old mode 100644
new mode 100755
index 681854d..abc8ee8
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -50,7 +50,7 @@ extern "C" {
  * Exported function declarations:
  */
 
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 /* 0 */
 EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
 				Tcl_DString *dsPtr);
@@ -75,7 +75,7 @@ typedef struct TclPlatStubs {
     int magic;
     void *hooks;
 
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
     char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
 #endif /* WIN */
@@ -97,7 +97,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
  * Inline function declarations:
  */
 
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 #define Tcl_WinUtfToTChar \
 	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
 #define Tcl_WinTCharToUtf \
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
old mode 100644
new mode 100755
index e1918ef..097269f
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -90,7 +90,7 @@ static unsigned short TclWinNToHS(unsigned short ns) {
 }
 #endif
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #   define TclUnixWaitForFile 0
 #   define TclUnixCopyFile 0
 #   define TclUnixOpenTemporaryFile 0
@@ -557,7 +557,7 @@ static const TclIntStubs tclIntStubs = {
 static const TclIntPlatStubs tclIntPlatStubs = {
     TCL_STUB_MAGIC,
     0,
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
     TclGetAndDetachPids, /* 0 */
     TclpCloseFile, /* 1 */
     TclpCreateCommandChannel, /* 2 */
@@ -590,7 +590,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
     TclWinCPUID, /* 29 */
     TclUnixOpenTemporaryFile, /* 30 */
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     TclWinConvertError, /* 0 */
     TclWinConvertWSAError, /* 1 */
     TclWinGetServByName, /* 2 */
@@ -661,7 +661,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
 static const TclPlatStubs tclPlatStubs = {
     TCL_STUB_MAGIC,
     0,
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     Tcl_WinUtfToTChar, /* 0 */
     Tcl_WinTCharToUtf, /* 1 */
 #endif /* WIN */
@@ -758,19 +758,19 @@ const TclStubs tclStubs = {
     Tcl_DbCkalloc, /* 6 */
     Tcl_DbCkfree, /* 7 */
     Tcl_DbCkrealloc, /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     Tcl_CreateFileHandler, /* 9 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     0, /* 9 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     Tcl_CreateFileHandler, /* 9 */
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     Tcl_DeleteFileHandler, /* 10 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     0, /* 10 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
@@ -932,10 +932,10 @@ const TclStubs tclStubs = {
     Tcl_GetMaster, /* 164 */
     Tcl_GetNameOfExecutable, /* 165 */
     Tcl_GetObjResult, /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     Tcl_GetOpenFile, /* 167 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     0, /* 167 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index f121d0d..a27c95a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -414,7 +414,7 @@ static int		TestNRELevels(ClientData clientData,
 static int		TestInterpResolverCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
 static int		TestcpuidCmd(ClientData dummy,
 			    Tcl_Interp* interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -681,7 +681,7 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
 	    NULL, NULL);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
     Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
 	    (ClientData) 0, NULL);
 #endif
@@ -6648,7 +6648,7 @@ TestNumUtfCharsCmd(
     return TCL_OK;
 }
 
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index 4b09e1c..5c70a62 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -14,7 +14,7 @@
 
 #include "tclInt.h"
 
-#ifdef WIN32
+#ifdef _WIN32
 
 /*
  * The information about each joinable thread is remembered in a structure as
@@ -305,7 +305,7 @@ TclSignalExitThread(
 
     Tcl_MutexUnlock(&threadPtr->threadMutex);
 }
-#endif /* WIN32 */
+#endif /* _WIN32 */
 
 /*
  * Local Variables:
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index b45e560..7a75dc6 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -283,7 +283,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
     set text ""
     switch $plat {
 	win {
-	    append text "#if defined(__WIN32__)"
+	    append text "#if defined(_WIN32)"
 	    if {$withCygwin} {
 		append text " || defined(__CYGWIN__)"
 	    }
@@ -294,7 +294,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
 	    append text "#endif /* WIN */\n"
 	}
 	unix {
-	    append text "#if !defined(__WIN32__)"
+	    append text "#if !defined(_WIN32)"
 	    if {$withCygwin} {
 		append text " && !defined(__CYGWIN__)"
 	    }
@@ -320,7 +320,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
 	    append text "#endif /* AQUA */\n"
 	}
 	x11 {
-	    append text "#if !(defined(__WIN32__)"
+	    append text "#if !(defined(_WIN32)"
 	    if {$withCygwin} {
 		append text " || defined(__CYGWIN__)"
 	    }
diff --git a/win/configure b/win/configure
index 569172e..2affd38 100755
--- a/win/configure
+++ b/win/configure
@@ -3340,7 +3340,7 @@ cat confdefs.h >>conftest.$ac_ext
 cat >>conftest.$ac_ext <<_ACEOF
 /* end confdefs.h.  */
 
-	    #ifndef __WIN32__
+	    #ifndef _WIN32
 		#error cross-compiler
 	    #endif
 
@@ -3463,7 +3463,7 @@ cat confdefs.h >>conftest.$ac_ext
 cat >>conftest.$ac_ext <<_ACEOF
 /* end confdefs.h.  */
 
-		#ifdef __WIN32__
+		#ifdef _WIN32
 		    #error win32
 		#endif
 
diff --git a/win/tcl.m4 b/win/tcl.m4
index 625c329..d12ae10 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -572,7 +572,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
       AC_CACHE_CHECK(for cross-compile version of gcc,
 	ac_cv_cross,
 	AC_TRY_COMPILE([
-	    #ifndef __WIN32__
+	    #ifndef _WIN32
 		#error cross-compiler
 	    #endif
 	], [],
@@ -639,7 +639,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	AC_CACHE_CHECK(for mingw32 version of gcc,
 	    ac_cv_win32,
 	    AC_TRY_COMPILE([
-		#ifdef __WIN32__
+		#ifdef _WIN32
 		    #error win32
 		#endif
 	    ], [],
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 634e1d2..688fa8d 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -69,7 +69,7 @@ TCL_DECLARE_MUTEX(mountPointMap)
  * We will need this below.
  */
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #ifndef STATIC_BUILD
 
 /*
@@ -137,7 +137,7 @@ DllMain(
     return TRUE;
 }
 #endif /* !STATIC_BUILD */
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
 
 /*
  *----------------------------------------------------------------------
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index b83c0ba..6027e32 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -17,7 +17,7 @@
 /*
  * For TestplatformChmod on Windows
  */
-#ifdef __WIN32__
+#ifdef _WIN32
 #include <aclapi.h>
 #endif
 
-- 
cgit v0.12


From 67d68fe341c4c825148b48d7fd74d2136ac8fa6a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 11 Feb 2014 10:58:30 +0000
Subject: Fix execute permission bit (should not be set) for *Decls.h files

---
 generic/tclDecls.h        | 0
 generic/tclIntDecls.h     | 0
 generic/tclIntPlatDecls.h | 0
 generic/tclPlatDecls.h    | 0
 generic/tclStubInit.c     | 0
 5 files changed, 0 insertions(+), 0 deletions(-)
 mode change 100755 => 100644 generic/tclDecls.h
 mode change 100755 => 100644 generic/tclIntDecls.h
 mode change 100755 => 100644 generic/tclIntPlatDecls.h
 mode change 100755 => 100644 generic/tclPlatDecls.h
 mode change 100755 => 100644 generic/tclStubInit.c

diff --git a/generic/tclDecls.h b/generic/tclDecls.h
old mode 100755
new mode 100644
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
old mode 100755
new mode 100644
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
old mode 100755
new mode 100644
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
old mode 100755
new mode 100644
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
old mode 100755
new mode 100644
-- 
cgit v0.12


From bd474d3d6b7f770543d6e93ca2b6c9212c551bdf Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 16 Feb 2014 08:18:29 +0000
Subject: [9bf7e67b37]: minor documentation blooper

---
 doc/tclvars.n | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/tclvars.n b/doc/tclvars.n
index 2fec222..9d7a4ce 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -10,7 +10,7 @@
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
-argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceEval, tcl_wordchars, tcl_version \- Variables used by Tcl
+argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
 .BE
 .SH DESCRIPTION
 .PP
-- 
cgit v0.12


From eb24399a17b85fad292fe5137bb9ea641f8b7896 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 23 Feb 2014 13:07:36 +0000
Subject: [3597178]: Improve documentation of what's going on with encodings

---
 doc/encoding.n | 34 +++++++++++++++++++++++++++-------
 doc/string.n   | 28 ++++++++++++++++++++++++----
 2 files changed, 51 insertions(+), 11 deletions(-)

diff --git a/doc/encoding.n b/doc/encoding.n
index be1dc3f..5782199 100644
--- a/doc/encoding.n
+++ b/doc/encoding.n
@@ -14,10 +14,21 @@ encoding \- Manipulate encodings
 .BE
 .SH INTRODUCTION
 .PP
-Strings in Tcl are encoded using 16-bit Unicode characters.  Different
-operating system interfaces or applications may generate strings in
-other encodings such as Shift-JIS.  The \fBencoding\fR command helps
-to bridge the gap between Unicode and these other formats.
+Strings in Tcl are logically a sequence of 16-bit Unicode characters.
+These strings are represented in memory as a sequence of bytes that
+may be in one of several encodings: modified UTF\-8 (which uses 1 to 3
+bytes per character), 16-bit
+.QW Unicode
+(which uses 2 bytes per character, with an endianness that is
+dependent on the host architecture), and binary (which uses a single
+byte per character but only handles a restricted range of characters).
+Tcl does not guarantee to always use the same encoding for the same
+string.
+.PP
+Different operating system interfaces or applications may generate
+strings in other encodings such as Shift\-JIS.  The \fBencoding\fR
+command helps to bridge the gap between Unicode and these other
+formats.
 .SH DESCRIPTION
 .PP
 Performs one of several encoding related operations, depending on
@@ -37,8 +48,9 @@ system encoding is used.
 Convert \fIstring\fR from Unicode to the specified \fIencoding\fR.
 The result is a sequence of bytes that represents the converted
 string.  Each byte is stored in the lower 8-bits of a Unicode
-character.  If \fIencoding\fR is not specified, the current
-system encoding is used.
+character (indeed, the resulting string is a binary string as far as
+Tcl is concerned, at least initially).  If \fIencoding\fR is not
+specified, the current system encoding is used.
 .TP
 \fBencoding dirs\fR ?\fIdirectoryList\fR?
 .
@@ -56,6 +68,11 @@ searchable directory, that element is ignored.
 .
 Returns a list containing the names of all of the encodings that are
 currently available. 
+The encodings
+.QW utf-8
+and
+.QW iso8859-1
+are guaranteed to be present in the list.
 .TP
 \fBencoding system\fR ?\fIencoding\fR?
 .
@@ -73,7 +90,7 @@ However, because the \fBsource\fR command always reads files using the
 current system encoding, Tcl will only source such files correctly
 when the encoding used to write the file is the same.  This tends not
 to be true in an internationalized setting.  For example, if such a
-file was sourced in North America (where the ISO8859-1 is normally
+file was sourced in North America (where the ISO8859\-1 is normally
 used), each byte in the file would be treated as a separate character
 that maps to the 00 page in Unicode.  The resulting Tcl strings will
 not contain the expected Japanese characters.  Instead, they will
@@ -93,3 +110,6 @@ which is the Hiragana letter HA.
 Tcl_GetEncoding(3)
 .SH KEYWORDS
 encoding, unicode
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/string.n b/doc/string.n
index 76005fc..163abdd 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -343,10 +343,13 @@ misleading.
 \fBstring bytelength \fIstring\fR
 .
 Returns a decimal string giving the number of bytes used to represent
-\fIstring\fR in memory.  Because UTF\-8 uses one to three bytes to
-represent Unicode characters, the byte length will not be the same as
-the character length in general.  The cases where a script cares about
-the byte length are rare.
+\fIstring\fR in memory when encoded as Tcl's internal modified UTF\-8;
+Tcl may use other encodings for \fIstring\fR as well, and does not
+guarantee to only use a single encoding for a particular \fIstring\fR.
+Because UTF\-8 uses a variable number of bytes to represent Unicode
+characters, the byte length will not be the same as the character
+length in general.  The cases where a script cares about the byte
+length are rare.
 .RS
 .PP
 In almost all cases, you should use the
@@ -354,10 +357,27 @@ In almost all cases, you should use the
 Tcl byte array value).  Refer to the \fBTcl_NumUtfChars\fR manual
 entry for more details on the UTF\-8 representation.
 .PP
+Formally, the \fBstring bytelength\fR operation returns the content of
+the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling
+\fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated.
+This is highly unlikely to be useful to Tcl scripts, as Tcl's internal
+encoding is not strict UTF\-8, but rather a modified CESU\-8 with a
+denormalized NUL (identical to that used in a number of places by
+Java's serialization mechanism) to enable basic processing with
+non-Unicode-aware C functions.  As this representation should only
+ever be used by Tcl's implementation, the number of bytes used to
+store the representation is of very low value (except to C extension
+code, which has direct access for the purpose of memory management,
+etc.)
+.PP
 \fICompatibility note:\fR it is likely that this subcommand will be
 withdrawn in a future version of Tcl. It is better to use the
 \fBencoding convertto\fR command to convert a string to a known
 encoding and then apply \fBstring length\fR to that.
+.PP
+.CS
+\fBstring length\fR [encoding convertto utf-8 $theString]
+.CE
 .RE
 .TP
 \fBstring wordend \fIstring charIndex\fR
-- 
cgit v0.12


From 259729fa361e6d184ef91be067a93309e14cd998 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 25 Feb 2014 15:49:52 +0000
Subject: [8d5f5b8034] Flush internal representations in [string tolower] of
 unshared obj

---
 generic/tclExecute.c | 3 +++
 tests/string.test    | 9 +++++++++
 2 files changed, 12 insertions(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 89305e6..41730d3 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5392,6 +5392,7 @@ TEBCresume(
 	} else {
 	    length = Tcl_UtfToUpper(TclGetString(valuePtr));
 	    Tcl_SetObjLength(valuePtr, length);
+	    TclFreeIntRep(valuePtr);
 	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
@@ -5408,6 +5409,7 @@ TEBCresume(
 	} else {
 	    length = Tcl_UtfToLower(TclGetString(valuePtr));
 	    Tcl_SetObjLength(valuePtr, length);
+	    TclFreeIntRep(valuePtr);
 	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
@@ -5424,6 +5426,7 @@ TEBCresume(
 	} else {
 	    length = Tcl_UtfToTitle(TclGetString(valuePtr));
 	    Tcl_SetObjLength(valuePtr, length);
+	    TclFreeIntRep(valuePtr);
 	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
diff --git a/tests/string.test b/tests/string.test
index 740cdc6..cf658a2 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -1398,6 +1398,9 @@ test string-15.9 {string tolower} {
 test string-15.10 {string tolower, unicode} {
      string tolower ABCabc\xc7\xe7
 } "abcabc\xe7\xe7"
+test string-15.11 {string tolower, compiled} {
+    lindex [string tolower [list A B [list C]]] 1
+} b
 
 test string-16.1 {string toupper} {
     list [catch {string toupper} msg] $msg
@@ -1429,6 +1432,9 @@ test string-16.9 {string toupper} {
 test string-16.10 {string toupper, unicode} {
     string toupper ABCabc\xc7\xe7
 } "ABCABC\xc7\xc7"
+test string-16.11 {string toupper, compiled} {
+    lindex [string toupper [list a b [list c]]] 1
+} B
 
 test string-17.1 {string totitle} {
     list [catch {string totitle} msg] $msg
@@ -1451,6 +1457,9 @@ test string-17.6 {string totitle, unicode} {
 test string-17.7 {string totitle, unicode} {
     string totitle \u01f3BCabc\xc7\xe7
 } "\u01f2bcabc\xe7\xe7"
+test string-17.8 {string totitle, compiled} {
+    lindex [string totitle [list aa bb [list cc]]] 0
+} Aa
 
 test string-18.1 {string trim} {
     list [catch {string trim} msg] $msg
-- 
cgit v0.12


From 33648948cab45a58ba614f448459fdcb133023dc Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 26 Feb 2014 13:16:18 +0000
Subject: Simplify macro handling in tclOO*Decls.h, just as already done in
 "novem" [0c37ab8944], itcl*Decls.h and tdbc*Decls.h. This doesn't change the
 way symbols are exported. This simplifications were already present in the
 Tcl 8.6.2 headers, but those were buggy when tclOO was linked in statically
 without using stubs.

---
 generic/tclOO.decls     |  1 +
 generic/tclOODecls.h    | 78 ++++++++++++++++++++++++-------------------------
 generic/tclOOIntDecls.h | 45 ++++++++++------------------
 3 files changed, 55 insertions(+), 69 deletions(-)

diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 5d6f2c2..265ba88 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -18,6 +18,7 @@ library tclOO
 
 interface tclOO
 hooks tclOOInt
+scspec TCLAPI
 
 declare 0 {
     Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index d3b9e59..9fd62ec 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -5,19 +5,19 @@
 #ifndef _TCLOODECLS
 #define _TCLOODECLS
 
-#undef TCL_STORAGE_CLASS
-#ifdef BUILD_tcl
-#   define TCL_STORAGE_CLASS DLLEXPORT
-#else
-#   ifdef USE_TCL_STUBS
-#      undef USE_TCLOO_STUBS
-#      define USE_TCLOO_STUBS
-#      define TCL_STORAGE_CLASS
+#ifndef TCLAPI
+#   ifdef BUILD_tcl
+#	define TCLAPI extern DLLEXPORT
 #   else
-#      define TCL_STORAGE_CLASS DLLIMPORT
+#	define TCLAPI extern DLLIMPORT
 #   endif
 #endif
 
+#ifdef USE_TCL_STUBS
+#   undef USE_TCLOO_STUBS
+#   define USE_TCLOO_STUBS
+#endif
+
 /* !BEGIN!: Do not edit below this line. */
 
 #ifdef __cplusplus
@@ -29,92 +29,92 @@ extern "C" {
  */
 
 /* 0 */
-EXTERN Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
+TCLAPI Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
 				Tcl_Object sourceObject,
 				const char *targetName,
 				const char *targetNamespaceName);
 /* 1 */
-EXTERN Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
+TCLAPI Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
 /* 2 */
-EXTERN Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
+TCLAPI Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
 /* 3 */
-EXTERN Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
+TCLAPI Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
 /* 4 */
-EXTERN Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
+TCLAPI Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
 /* 5 */
-EXTERN Tcl_Namespace *	Tcl_GetObjectNamespace(Tcl_Object object);
+TCLAPI Tcl_Namespace *	Tcl_GetObjectNamespace(Tcl_Object object);
 /* 6 */
-EXTERN Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
+TCLAPI Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
 /* 7 */
-EXTERN Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
+TCLAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
 /* 8 */
-EXTERN int		Tcl_MethodIsPublic(Tcl_Method method);
+TCLAPI int		Tcl_MethodIsPublic(Tcl_Method method);
 /* 9 */
-EXTERN int		Tcl_MethodIsType(Tcl_Method method,
+TCLAPI int		Tcl_MethodIsType(Tcl_Method method,
 				const Tcl_MethodType *typePtr,
 				ClientData *clientDataPtr);
 /* 10 */
-EXTERN Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
+TCLAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
 /* 11 */
-EXTERN Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
+TCLAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Obj *nameObj,
 				int isPublic, const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 12 */
-EXTERN Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
 				Tcl_Obj *nameObj, int isPublic,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 13 */
-EXTERN Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
+TCLAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
 				Tcl_Class cls, const char *nameStr,
 				const char *nsNameStr, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 14 */
-EXTERN int		Tcl_ObjectDeleted(Tcl_Object object);
+TCLAPI int		Tcl_ObjectDeleted(Tcl_Object object);
 /* 15 */
-EXTERN int		Tcl_ObjectContextIsFiltering(
+TCLAPI int		Tcl_ObjectContextIsFiltering(
 				Tcl_ObjectContext context);
 /* 16 */
-EXTERN Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+TCLAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
 /* 17 */
-EXTERN Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
+TCLAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
 /* 18 */
-EXTERN int		Tcl_ObjectContextSkippedArgs(
+TCLAPI int		Tcl_ObjectContextSkippedArgs(
 				Tcl_ObjectContext context);
 /* 19 */
-EXTERN ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
+TCLAPI ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 20 */
-EXTERN void		Tcl_ClassSetMetadata(Tcl_Class clazz,
+TCLAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 21 */
-EXTERN ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
+TCLAPI ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 22 */
-EXTERN void		Tcl_ObjectSetMetadata(Tcl_Object object,
+TCLAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 23 */
-EXTERN int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+TCLAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
 				Tcl_ObjectContext context, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 24 */
-EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
 				Tcl_Object object);
 /* 25 */
-EXTERN void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+TCLAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
 				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
 /* 26 */
-EXTERN void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
+TCLAPI void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 27 */
-EXTERN void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
+TCLAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 28 */
-EXTERN Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
+TCLAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
 				Tcl_Object object);
 
 typedef struct {
@@ -231,6 +231,4 @@ extern const TclOOStubs *tclOOStubsPtr;
 
 /* !END!: Do not edit above this line. */
 
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
 #endif /* _TCLOODECLS */
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
index 4f70e5b..74a8d81 100644
--- a/generic/tclOOIntDecls.h
+++ b/generic/tclOOIntDecls.h
@@ -5,17 +5,6 @@
 #ifndef _TCLOOINTDECLS
 #define _TCLOOINTDECLS
 
-#undef TCL_STORAGE_CLASS
-#ifdef BUILD_tcl
-#   define TCL_STORAGE_CLASS DLLEXPORT
-#else
-#   ifdef USE_TCL_STUBS
-#      define TCL_STORAGE_CLASS
-#   else
-#      define TCL_STORAGE_CLASS DLLIMPORT
-#   endif
-#endif
-
 /* !BEGIN!: Do not edit below this line. */
 
 #ifdef __cplusplus
@@ -27,46 +16,46 @@ extern "C" {
  */
 
 /* 0 */
-EXTERN Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
+TCLAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
 /* 1 */
-EXTERN Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
+TCLAPI Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 2 */
-EXTERN Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
+TCLAPI Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
 				Class *clsPtr, int flags, Tcl_Obj *nameObj,
 				const char *namePtr, Tcl_Obj *argsObj,
 				Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 3 */
-EXTERN Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
+TCLAPI Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 4 */
-EXTERN Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+TCLAPI Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
 				int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 5 */
-EXTERN int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
+TCLAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
 				int objc, Tcl_Obj *const *objv,
 				int publicOnly, Class *startCls);
 /* 6 */
-EXTERN int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
+TCLAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
 /* 7 */
-EXTERN Method *		TclOONewForwardMethod(Tcl_Interp *interp,
+TCLAPI Method *		TclOONewForwardMethod(Tcl_Interp *interp,
 				Class *clsPtr, int isPublic,
 				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
 /* 8 */
-EXTERN Method *		TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+TCLAPI Method *		TclOONewForwardInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
 				Tcl_Obj *prefixObj);
 /* 9 */
-EXTERN Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+TCLAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Object oPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -75,7 +64,7 @@ EXTERN Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 10 */
-EXTERN Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
+TCLAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Class clsPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -84,22 +73,22 @@ EXTERN Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 11 */
-EXTERN int		TclOOInvokeObject(Tcl_Interp *interp,
+TCLAPI int		TclOOInvokeObject(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Class startCls,
 				int publicPrivate, int objc,
 				Tcl_Obj *const *objv);
 /* 12 */
-EXTERN void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
+TCLAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 13 */
-EXTERN void		TclOOClassSetFilters(Tcl_Interp *interp,
+TCLAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
 				Class *classPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 14 */
-EXTERN void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
+TCLAPI void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
 				Class *const *mixins);
 /* 15 */
-EXTERN void		TclOOClassSetMixins(Tcl_Interp *interp,
+TCLAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
 				Class *classPtr, int numMixins,
 				Class *const *mixins);
 
@@ -174,6 +163,4 @@ extern const TclOOIntStubs *tclOOIntStubsPtr;
 
 /* !END!: Do not edit above this line. */
 
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
 #endif /* _TCLOOINTDECLS */
-- 
cgit v0.12


From 67ca0cb05fe3153db733521fbff66e5ba180358c Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 28 Feb 2014 10:47:53 +0000
Subject: Broken intermediate state.

Calling back to CreateClientSocket() from the event loop works, but
the final failed or succeeded state of an asyncronous socket does not
get notified to the channel correctly.
---
 unix/tclUnixSock.c |  15 +++
 win/tclWinSock.c   | 365 ++++++++++++++++++++++++++++++++---------------------
 2 files changed, 234 insertions(+), 146 deletions(-)

diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 49a6460..c866903 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -163,6 +163,18 @@ static TclInitProcessGlobalValueProc InitializeHostName;
 static ProcessGlobalValue hostName =
 	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
 
+void printaddrinfo(struct addrinfo *addrlist, char *prefix)
+{
+    char host[NI_MAXHOST], port[NI_MAXSERV];
+    struct addrinfo *ai;
+    for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
+	getnameinfo(ai->ai_addr, ai->ai_addrlen,
+		    host, sizeof(host),
+		    port, sizeof(port),
+		    NI_NUMERICHOST|NI_NUMERICSERV);
+	fprintf(stderr,"%s: %s:%s\n", prefix, host, port);
+    }
+}
 /*
  *----------------------------------------------------------------------
  *
@@ -1160,6 +1172,9 @@ Tcl_OpenTcpClient(
         return NULL;
     }
 
+    printaddrinfo(myaddrlist, "local");
+    printaddrinfo(addrlist, "remote");
+
     /*
      * Allocate a new TcpState for this socket.
      */
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 958e4ac..6afa094 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,6 +47,12 @@
 
 #include "tclWinInt.h"
 
+#if 1
+#define DEBUG(x) fprintf(stderr, ">>> %s(%d): %s<<<\n", __FUNCTION__, __LINE__, x)
+#else
+#define DEBUG(x)
+#endif
+
 /*
  * Which version of the winsock API do we want?
  */
@@ -76,7 +82,7 @@
 
 /* "sock" + a pointer in hex + \0 */
 #define SOCK_CHAN_LENGTH        (4 + sizeof(void *) * 2 + 1)
-#define SOCK_TEMPLATE           "sock%lx"
+#define SOCK_TEMPLATE           "sock%p"
 
 /*
  * The following variable is used to tell whether this module has been
@@ -156,6 +162,12 @@ struct SocketInfo {
     Tcl_TcpAcceptProc *acceptProc;
 				/* Proc to call on accept. */
     ClientData acceptProcData;	/* The data for the accept proc. */
+    struct addrinfo *addrlist;	/* Addresses to connect to. */
+    struct addrinfo *addr;	/* Iterator over addrlist. */
+    struct addrinfo *myaddrlist;/* Local address. */
+    struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
+    int status;                 /* Cache status of async socket. */
+    int cachedBlocking;         /* Cache blocking mode of async socket. */
     int lastError;		/* Error code from last message. */
     struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
@@ -214,9 +226,7 @@ static WNDCLASS windowClass;
  * Static functions defined in this file.
  */
 
-static SocketInfo *	CreateClientSocket(Tcl_Interp *interp, int port,
-			    const char *host, const char *myaddr,
-			    int myport, int async);
+static int		CreateClientSocket(Tcl_Interp *interp, SocketInfo *infoPtr);
 static void		InitSockets(void);
 static SocketInfo *	NewSocketInfo(SOCKET socket);
 static void		SocketExitHandler(ClientData clientData);
@@ -267,6 +277,22 @@ static const Tcl_ChannelType tcpChannelType = {
     TcpThreadActionProc,    /* thread action proc */
     NULL		    /* truncate */
 };
+void printaddrinfo(struct addrinfo *ai, char *prefix)
+{
+    char host[NI_MAXHOST], port[NI_MAXSERV];
+    getnameinfo(ai->ai_addr, ai->ai_addrlen,
+		host, sizeof(host),
+		port, sizeof(port),
+		NI_NUMERICHOST|NI_NUMERICSERV);
+    fprintf(stderr,"%s: [%s]:%s\n", prefix, host, port);
+}
+void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
+{
+    struct addrinfo *ai;
+    for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
+	printaddrinfo(ai, prefix);
+    }
+}
 
 /*
  *----------------------------------------------------------------------
@@ -699,6 +725,8 @@ SocketEventProc(
     address addr;
     int len;
 
+    DEBUG("xxx");
+
     if (!(flags & TCL_FILE_EVENTS)) {
 	return 0;
     }
@@ -841,20 +869,18 @@ SocketEventProc(
 		    (WPARAM) SELECT, (LPARAM) infoPtr);
 	}
     }
-    if (events & (FD_WRITE | FD_CONNECT)) {
+    if (events & FD_WRITE) {
 	mask |= TCL_WRITABLE;
-	if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) {
-	    /*
-	     * Connect errors should also fire the readable handler.
-	     */
-
-	    mask |= TCL_READABLE;
-	}
     }
-
+    if (events & FD_CONNECT) {
+	DEBUG("Calling CreateClientSocket...");
+	CreateClientSocket(NULL, infoPtr);
+    }
     if (mask) {
+	DEBUG("Calling Tcl_NotifyChannel...");
 	Tcl_NotifyChannel(infoPtr->channel, mask);
     }
+    DEBUG("returning...");
     return 1;
 }
 
@@ -944,6 +970,13 @@ TcpCloseProc(
 	}
     }
 
+    if (infoPtr->addrlist != NULL) {
+        freeaddrinfo(infoPtr->addrlist);
+    }
+    if (infoPtr->myaddrlist != NULL) {
+        freeaddrinfo(infoPtr->myaddrlist);
+    }
+
     /*
      * TIP #218. Removed the code removing the structure from the global
      * socket list. This is now done by the thread action callbacks, and only
@@ -1072,22 +1105,11 @@ AddSocketInfoFd(
  */
 
 static SocketInfo *
-NewSocketInfo(
-    SOCKET socket)
+NewSocketInfo(SOCKET socket)
 {
     SocketInfo *infoPtr = ckalloc(sizeof(SocketInfo));
 
-    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
-    infoPtr->channel = 0;
-    infoPtr->sockets = NULL;
-    infoPtr->flags = 0;
-    infoPtr->watchEvents = 0;
-    infoPtr->readyEvents = 0;
-    infoPtr->selectEvents = 0;
-    infoPtr->acceptEventCount = 0;
-    infoPtr->acceptProc = NULL;
-    infoPtr->acceptProcData = NULL;
-    infoPtr->lastError = 0;
+    memset(infoPtr, 0, sizeof(SocketInfo));
 
     /*
      * TIP #218. Removed the code inserting the new structure into the global
@@ -1095,8 +1117,6 @@ NewSocketInfo(
      * there.
      */
 
-    infoPtr->nextPtr = NULL;
-
     AddSocketInfoFd(infoPtr, socket);
 
     return infoPtr;
@@ -1107,193 +1127,189 @@ NewSocketInfo(
  *
  * CreateClientSocket --
  *
- *	This function opens a new client socket and initializes the
- *	SocketInfo structure.
+ *	This function opens a new socket in client mode.
  *
  * Results:
- *	Returns a new SocketInfo, or NULL with an error in interp.
+ *      TCL_OK, if the socket was successfully connected or an asynchronous
+ *      connection is in progress. If an error occurs, TCL_ERROR is returned
+ *      and an error message is left in interp.
  *
  * Side effects:
- *	None, except for allocation of memory.
+ *	Opens a socket.
+ *
+ * Remarks:
+ *	A single host name may resolve to more than one IP address, e.g. for
+ *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
+ *	sockets in the background for such hosts, this function can act as a
+ *	coroutine. On the first call, it sets up the control variables for the
+ *	two nested loops over the local and remote addresses. Once the first
+ *	connection attempt is in progress, it sets up itself as a writable
+ *	event handler for that socket, and returns. When the callback occurs,
+ *	control is transferred to the "reenter" label, right after the initial
+ *	return and the loops resume as if they had never been interrupted.
+ *	For syncronously connecting sockets, the loops work the usual way.
  *
  *----------------------------------------------------------------------
  */
 
-static SocketInfo *
+static int
 CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    int port,			/* Port number to open. */
-    const char *host,		/* Name of host on which to open port. */
-    const char *myaddr,		/* Optional client-side address */
-    int myport,			/* Optional client-side port */
-    int async)			/* If nonzero, connect client socket
-				 * asynchronously. */
+    SocketInfo *infoPtr)
 {
     u_long flag = 1;		/* Indicates nonblocking mode. */
-    int asyncConnect = 0;	/* Will be 1 if async connect is in
-				 * progress. */
-    unsigned short chosenport = 0;
-    struct addrinfo *addrlist = NULL, *addrPtr;
-				/* Socket address to connect to. */
-    struct addrinfo *myaddrlist = NULL, *myaddrPtr;
-				/* Socket address for our side. */
-    const char *errorMsg = NULL;
-    SOCKET sock = INVALID_SOCKET;
-    SocketInfo *infoPtr = NULL;	/* The returned value. */
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
+    int async_callback = (infoPtr->addr != NULL);
+    int connected = 0;
+    int async = infoPtr->flags & SOCKET_ASYNC_CONNECT;
 
-    if (!SocketsEnabled()) {
-	return NULL;
+    DEBUG(async_callback ? "subsequent" : "first");
+    DEBUG(async ? "async" : "sync");
+    if (async_callback) {
+        goto reenter;
     }
+    
+    for (infoPtr->addr = infoPtr->addrlist; infoPtr->addr != NULL;
+	 infoPtr->addr = infoPtr->addr->ai_next) {
+	
+        for (infoPtr->myaddr = infoPtr->myaddrlist; infoPtr->myaddr != NULL;
+	     infoPtr->myaddr = infoPtr->myaddr->ai_next) {
 
-    /*
-     * Construct the addresses for each end of the socket.
-     */
-
-    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0,
-	    &errorMsg)) {
-	goto error;
-    }
-    if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
-	    &errorMsg)) {
-	goto error;
-    }
+	    DEBUG("inner loop");
 
-    for (addrPtr = addrlist; addrPtr != NULL;
-	 addrPtr = addrPtr->ai_next) {
-	for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
-	     myaddrPtr = myaddrPtr->ai_next) {
 	    /*
 	     * No need to try combinations of local and remote addresses
 	     * of different families.
 	     */
 
-	    if (myaddrPtr->ai_family != addrPtr->ai_family) {
+	    if (infoPtr->myaddr->ai_family != infoPtr->addr->ai_family) {
+		DEBUG("family mismatch");
 		continue;
 	    }
 
-	    sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
-	    if (sock == INVALID_SOCKET) {
+	    DEBUG(infoPtr->myaddr->ai_family == AF_INET ? "IPv4" : "IPv6");
+	    printaddrinfo(infoPtr->myaddr, "~~ from");
+	    printaddrinfo(infoPtr->addr,   "~~   to");
+
+            /*
+             * Close the socket if it is still open from the last unsuccessful
+             * iteration.
+             */
+
+	    if (infoPtr->sockets->fd != INVALID_SOCKET) {
+		DEBUG("closesocket");
+		closesocket(infoPtr->sockets->fd);
+	    }
+
+	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
+	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
+		DEBUG("socket() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
 		continue;
 	    }
-
+	    
 	    /*
 	     * Win-NT has a misfeature that sockets are inherited in child
 	     * processes by default. Turn off the inherit bit.
 	     */
 
-	    SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
+	    SetHandleInformation((HANDLE) infoPtr->sockets->fd, HANDLE_FLAG_INHERIT, 0);
 
 	    /*
 	     * Set kernel space buffering
 	     */
 
-	    TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
+	    TclSockMinimumBuffers((void *) infoPtr->sockets->fd, TCP_BUFFER_SIZE);
 
 	    /*
 	     * Try to bind to a local port.
 	     */
 
-	    if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
-		== SOCKET_ERROR) {
+	    if (bind(infoPtr->sockets->fd, infoPtr->myaddr->ai_addr,
+			infoPtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
+		DEBUG("bind() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
-		goto looperror;
+		continue;
 	    }
 	    /*
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
 	     */
-	    if (async && ioctlsocket(sock, (long) FIONBIO, &flag)
+	    if (async && ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
 		== SOCKET_ERROR) {
+		DEBUG("FIONBIO");
 		TclWinConvertError((DWORD) WSAGetLastError());
-		goto looperror;
+		continue;
 	    }
 
 	    /*
 	     * Attempt to connect to the remote socket.
 	     */
 
-	    if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
-		== SOCKET_ERROR) {
+	    if (connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
+			    infoPtr->addr->ai_addrlen) == SOCKET_ERROR) {
 		DWORD error = (DWORD) WSAGetLastError();
-		if (error != WSAEWOULDBLOCK) {
+
+		DEBUG("connect()");
+		// fprintf(stderr,"error = %lu\n", error);
+		if (error == WSAEWOULDBLOCK) {
+		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		    DEBUG("WSAEWOULDBLOCK");
+		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+		    infoPtr->selectEvents |= FD_CONNECT;
+
+		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+				(LPARAM) infoPtr);
+		    return TCL_OK;
+		} else {
+		    DEBUG("ELSE");
 		    TclWinConvertError(error);
-		    goto looperror;
+		    continue;
 		}
-		
+	    reenter:
+		DEBUG("reenter");
+		fprintf(stderr, "lastError: %d\n", infoPtr->lastError);
 		/*
 		 * The connection is progressing in the background.
 		 */
-
-		asyncConnect = 1;
-	    }
-	    goto connected;
-	    
-	looperror:
-	    if (sock != INVALID_SOCKET) {
-		closesocket(sock);
-		sock = INVALID_SOCKET;
+		// infoPtr->selectEvents &= ~(FD_CONNECT);
+	    } else {
+		connected = 1;
+		goto connected;
 	    }
 	}
     }
     goto error;
+connected:
+    DEBUG("connected");
+    /*
+     * Set up the select mask for read/write events. If the connect
+     * attempt has not completed, include connect events.
+     */
+    
+    infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
 
-    connected:
-	/*
-	 * Add this socket to the global list of sockets.
-	 */
-
-	infoPtr = NewSocketInfo(sock);
-
-	/*
-	 * Set up the select mask for read/write events. If the connect
-	 * attempt has not completed, include connect events.
-	 */
-
-	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-	if (asyncConnect) {
-	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-	    infoPtr->selectEvents |= FD_CONNECT;
-	}
-
-  error:
-    if (addrlist != NULL) {
-	freeaddrinfo(addrlist);
-    }
-    if (myaddrlist != NULL) {
-	freeaddrinfo(myaddrlist);
-    }
-
+error:
     /*
      * Register for interest in events in the select mask. Note that this
      * automatically places the socket into non-blocking mode.
      */
 
-    if (infoPtr != NULL) {
-	ioctlsocket(sock, (long) FIONBIO, &flag);
+    if (connected) {
+	ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+
+	ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 		(LPARAM) infoPtr);
-
-	return infoPtr;
+	return TCL_OK;
     }
 
     if (interp != NULL) {
         Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"couldn't open socket: %s",
-		(errorMsg ? errorMsg : Tcl_PosixError(interp))));
+		"couldn't open socket: %s", Tcl_PosixError(interp)));
     }
 
-    if (sock != INVALID_SOCKET) {
-	closesocket(sock);
-    }
-    return NULL;
+    return TCL_ERROR;
 }
 
 /*
@@ -1390,18 +1406,57 @@ Tcl_OpenTcpClient(
 				 * asynchronously. */
 {
     SocketInfo *infoPtr;
-    char channelName[16 + TCL_INTEGER_SPACE];
+    const char *errorMsg = NULL;
+    struct addrinfo *addrlist = NULL;
+    struct addrinfo *myaddrlist = NULL;
+    char channelName[SOCK_CHAN_LENGTH];
 
     if (TclpHasSockets(interp) != TCL_OK) {
 	return NULL;
     }
 
     /*
-     * Create a new client socket and wrap it in a channel.
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
+     */
+
+    if (!SocketsEnabled()) {
+	return NULL;
+    }
+
+    /*
+     * Do the name lookups for the local and remote addresses.
      */
 
-    infoPtr = CreateClientSocket(interp, port, host, myaddr, myport, async);
-    if (infoPtr == NULL) {
+    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
+            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
+                    &errorMsg)) {
+        if (addrlist != NULL) {
+            freeaddrinfo(addrlist);
+        }
+        if (interp != NULL) {
+            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "couldn't open socket: %s", errorMsg));
+        }
+        return NULL;
+    }
+    printaddrinfolist(myaddrlist, "local");
+    printaddrinfolist(addrlist, "remote");
+
+    infoPtr = NewSocketInfo(INVALID_SOCKET);
+    infoPtr->addrlist = addrlist;
+    infoPtr->myaddrlist = myaddrlist;
+    if (async) {
+	infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+    }
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+    
+    if (CreateClientSocket(interp, infoPtr) != TCL_OK) {
+	TcpCloseProc(infoPtr, NULL);
 	return NULL;
     }
 
@@ -1444,7 +1499,7 @@ Tcl_MakeTcpClientChannel(
     ClientData sock)		/* The socket to wrap up into a channel. */
 {
     SocketInfo *infoPtr;
-    char channelName[16 + TCL_INTEGER_SPACE];
+    char channelName[SOCK_CHAN_LENGTH];
     ThreadSpecificData *tsdPtr;
 
     if (TclpHasSockets(NULL) != TCL_OK) {
@@ -1506,7 +1561,7 @@ Tcl_OpenTcpServer(
     unsigned short chosenport = 0;
     struct addrinfo *addrPtr;	/* Socket address to listen on. */
     SocketInfo *infoPtr = NULL;	/* The returned value. */
-    void *addrlist = NULL;
+    struct addrinfo *addrlist = NULL;
     char channelName[SOCK_CHAN_LENGTH];
     u_long flag = 1;		/* Indicates nonblocking mode. */
     const char *errorMsg = NULL;
@@ -1694,7 +1749,7 @@ TcpAccept(
     SocketInfo *newInfoPtr;
     SocketInfo *infoPtr = fds->infoPtr;
     int len = sizeof(addr);
-    char channelName[16 + TCL_INTEGER_SPACE];
+    char channelName[SOCK_CHAN_LENGTH];
     char host[NI_MAXHOST], port[NI_MAXSERV];
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
@@ -2512,10 +2567,12 @@ SocketProc(
 
     switch (message) {
     default:
+	    DEBUG("default");
 	return DefWindowProc(hwnd, message, wParam, lParam);
 	break;
 
     case WM_CREATE:
+	    DEBUG("CREATE");
 	/*
 	 * Store the initial tsdPtr, it's from a different thread, so it's not
 	 * directly accessible, but needed.
@@ -2531,10 +2588,12 @@ SocketProc(
 	break;
 
     case WM_DESTROY:
+	    DEBUG("DESTROY");
 	PostQuitMessage(0);
 	break;
 
     case SOCKET_MESSAGE:
+	    DEBUG("SOCKET_MESSAGE");
 	event = WSAGETSELECTEVENT(lParam);
 	error = WSAGETSELECTERROR(lParam);
 	socket = (SOCKET) wParam;
@@ -2549,6 +2608,11 @@ SocketProc(
 		infoPtr = infoPtr->nextPtr) {
 	    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 		if (fds->fd == socket) {
+		    if (event & FD_READ) 
+			DEBUG("|->FD_READ");
+		    if (event & FD_WRITE) 
+			DEBUG("|->FD_WRITE");
+
 		    /*
 		     * Update the socket state.
 		     *
@@ -2558,19 +2622,22 @@ SocketProc(
 		     */
 
 		    if (event & FD_CLOSE) {
+			DEBUG("FD_CLOSE");
 			infoPtr->acceptEventCount = 0;
 			infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
 		    } else if (event & FD_ACCEPT) {
-			infoPtr->acceptEventCount++;
+			DEBUG("FD_ACCEPT");
+			    infoPtr->acceptEventCount++;
 		    }
 
 		    if (event & FD_CONNECT) {
+			DEBUG("FD_CONNECT");
 			/*
 			 * The socket is now connected, clear the async connect
 			 * flag.
 			 */
 
-			infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+			//infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 
 			/*
 			 * Remember any error that occurred so we can report
@@ -2582,15 +2649,17 @@ SocketProc(
 			    infoPtr->lastError = Tcl_GetErrno();
 			}
 		    }
-
+#if 0
 		    if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
-			infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+			DEBUG("SOCKET_ASYNC_CONNECT");
+			// infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 			if (error != ERROR_SUCCESS) {
 			    TclWinConvertError((DWORD) error);
 			    infoPtr->lastError = Tcl_GetErrno();
 			}
 			infoPtr->readyEvents |= FD_WRITE;
 		    }
+#endif
 		    infoPtr->readyEvents |= event;
 
 		    /*
@@ -2607,10 +2676,12 @@ SocketProc(
 	break;
 
     case SOCKET_SELECT:
+	    DEBUG("SOCKET_SELECT");
 	infoPtr = (SocketInfo *) lParam;
 	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 	    infoPtr = (SocketInfo *) lParam;
 	    if (wParam == SELECT) {
+		DEBUG("SELECT");
 		WSAAsyncSelect(fds->fd, hwnd,
 			SOCKET_MESSAGE, infoPtr->selectEvents);
 	    } else {
@@ -2618,12 +2689,14 @@ SocketProc(
 		 * Clear the selection mask
 		 */
 
+		DEBUG("!SELECT");
 		WSAAsyncSelect(fds->fd, hwnd, 0, 0);
 	    }
 	}
 	break;
 
     case SOCKET_TERMINATE:
+	    DEBUG("SOCKET_TERMINATE");
 	DestroyWindow(hwnd);
 	break;
     }
-- 
cgit v0.12


From 4dd180a450af9fce8d8128ebc37dfe3aa3932c6e Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 28 Feb 2014 11:05:35 +0000
Subject: Make printf debugging switchable, because it affects 'make test'

---
 win/tclWinSock.c | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 6afa094..905297e 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,7 +47,8 @@
 
 #include "tclWinInt.h"
 
-#if 1
+//#define DEBUGGING
+#ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %s(%d): %s<<<\n", __FUNCTION__, __LINE__, x)
 #else
 #define DEBUG(x)
@@ -284,7 +285,9 @@ void printaddrinfo(struct addrinfo *ai, char *prefix)
 		host, sizeof(host),
 		port, sizeof(port),
 		NI_NUMERICHOST|NI_NUMERICSERV);
+#ifdef DEBUGGING
     fprintf(stderr,"%s: [%s]:%s\n", prefix, host, port);
+#endif
 }
 void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
 {
@@ -1250,7 +1253,9 @@ CreateClientSocket(
 		DWORD error = (DWORD) WSAGetLastError();
 
 		DEBUG("connect()");
+#ifdef DEBUGGING
 		// fprintf(stderr,"error = %lu\n", error);
+#endif
 		if (error == WSAEWOULDBLOCK) {
 		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		    DEBUG("WSAEWOULDBLOCK");
@@ -1268,7 +1273,9 @@ CreateClientSocket(
 		}
 	    reenter:
 		DEBUG("reenter");
+#ifdef DEBUGGING
 		fprintf(stderr, "lastError: %d\n", infoPtr->lastError);
+#endif
 		/*
 		 * The connection is progressing in the background.
 		 */
-- 
cgit v0.12


From d2d1d997780ab3a1651986fc9820fd4a75ea8e56 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 3 Mar 2014 15:57:56 +0000
Subject: WIP: async open event now passes to SocketEventProc() and connects
 but does not finalyze that (I guess).

---
 win/tclWinSock.c | 38 +++++++++++++++++++++++---------------
 1 file changed, 23 insertions(+), 15 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 905297e..ccae931 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -681,7 +681,10 @@ SocketCheckProc(
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
 	if ((infoPtr->readyEvents & infoPtr->watchEvents)
-		&& !(infoPtr->flags & SOCKET_PENDING)) {
+		&& !(infoPtr->flags & SOCKET_PENDING)
+		|| ( infoPtr->flags & SOCKET_ASYNC_CONNECT )
+		&& ( infoPtr->readyEvents & FD_CONNECT )
+	) {
 	    infoPtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
 	    evPtr->header.proc = SocketEventProc;
@@ -875,7 +878,7 @@ SocketEventProc(
     if (events & FD_WRITE) {
 	mask |= TCL_WRITABLE;
     }
-    if (events & FD_CONNECT) {
+    if (infoPtr->readyEvents & FD_CONNECT) {
 	DEBUG("Calling CreateClientSocket...");
 	CreateClientSocket(NULL, infoPtr);
     }
@@ -1236,12 +1239,24 @@ CreateClientSocket(
 	    /*
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
+	     * Activate notification for a connect.
 	     */
-	    if (async && ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
-		== SOCKET_ERROR) {
-		DEBUG("FIONBIO");
-		TclWinConvertError((DWORD) WSAGetLastError());
-		continue;
+	    if (async) {
+		if (ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
+		    == SOCKET_ERROR) {
+		    DEBUG("FIONBIO");
+		    TclWinConvertError((DWORD) WSAGetLastError());
+		    continue;
+		}
+		{
+		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+		    infoPtr->selectEvents |= FD_CONNECT;
+
+		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+				(LPARAM) infoPtr);
+		}
 	    }
 
 	    /*
@@ -1256,15 +1271,8 @@ CreateClientSocket(
 #ifdef DEBUGGING
 		// fprintf(stderr,"error = %lu\n", error);
 #endif
-		if (error == WSAEWOULDBLOCK) {
-		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		if (async && error == WSAEWOULDBLOCK) {
 		    DEBUG("WSAEWOULDBLOCK");
-		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-		    infoPtr->selectEvents |= FD_CONNECT;
-
-		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-				(LPARAM) infoPtr);
 		    return TCL_OK;
 		} else {
 		    DEBUG("ELSE");
-- 
cgit v0.12


From c5233a1a3eb0706c49c436bda255bbcdac5bf009 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 4 Mar 2014 07:54:18 +0000
Subject: Reverted move of WSAAsyncSelect before connect -> FD_Connect message
 does also fire if it exists on call.

---
 win/tclWinSock.c | 31 +++++++++++++------------------
 1 file changed, 13 insertions(+), 18 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index ccae931..dd893ac 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1239,24 +1239,12 @@ CreateClientSocket(
 	    /*
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
-	     * Activate notification for a connect.
 	     */
-	    if (async) {
-		if (ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
-		    == SOCKET_ERROR) {
-		    DEBUG("FIONBIO");
-		    TclWinConvertError((DWORD) WSAGetLastError());
-		    continue;
-		}
-		{
-		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-		    infoPtr->selectEvents |= FD_CONNECT;
-
-		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-				(LPARAM) infoPtr);
-		}
+	    if (async && ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
+		== SOCKET_ERROR) {
+		DEBUG("FIONBIO");
+		TclWinConvertError((DWORD) WSAGetLastError());
+		continue;
 	    }
 
 	    /*
@@ -1271,8 +1259,15 @@ CreateClientSocket(
 #ifdef DEBUGGING
 		// fprintf(stderr,"error = %lu\n", error);
 #endif
-		if (async && error == WSAEWOULDBLOCK) {
+		if (error == WSAEWOULDBLOCK) {
+		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		    DEBUG("WSAEWOULDBLOCK");
+		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+		    infoPtr->selectEvents |= FD_CONNECT;
+
+		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+				(LPARAM) infoPtr);
 		    return TCL_OK;
 		} else {
 		    DEBUG("ELSE");
-- 
cgit v0.12


From 312c80abf4c34b3313aae1c532e5621066e8bd1c Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 4 Mar 2014 18:54:48 +0000
Subject:   *  Use watchEvents only for read/write/close events of [chan
 event], don't mix with internal use of accept and connect events.   *  WIP:
 Refactor the tail of CreateClientSocket() to get notifications for completed
 async connects right.

---
 win/tclWinSock.c | 145 +++++++++++++++++++++++++++++++------------------------
 1 file changed, 82 insertions(+), 63 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index dd893ac..6620def 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,7 +47,7 @@
 
 #include "tclWinInt.h"
 
-//#define DEBUGGING
+#define DEBUGGING
 #ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %s(%d): %s<<<\n", __FUNCTION__, __LINE__, x)
 #else
@@ -629,11 +629,13 @@ SocketSetupProc(
     /*
      * Check to see if there is a ready socket.	 If so, poll.
      */
-
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
-	if (infoPtr->readyEvents & infoPtr->watchEvents) {
+	if (infoPtr->readyEvents &
+	    (infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT)
+	) {
+	    DEBUG("Tcl_SetMaxBlockTime");
 	    Tcl_SetMaxBlockTime(&blockTime);
 	    break;
 	}
@@ -667,6 +669,7 @@ SocketCheckProc(
     SocketEvent *evPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
+    DEBUG("A");
     if (!(flags & TCL_FILE_EVENTS)) {
 	return;
     }
@@ -680,10 +683,9 @@ SocketCheckProc(
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
-	if ((infoPtr->readyEvents & infoPtr->watchEvents)
-		&& !(infoPtr->flags & SOCKET_PENDING)
-		|| ( infoPtr->flags & SOCKET_ASYNC_CONNECT )
-		&& ( infoPtr->readyEvents & FD_CONNECT )
+	if ((infoPtr->readyEvents &
+		(infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT))
+	    && !(infoPtr->flags & SOCKET_PENDING)
 	) {
 	    infoPtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
@@ -731,8 +733,7 @@ SocketEventProc(
     address addr;
     int len;
 
-    DEBUG("xxx");
-
+    DEBUG("");
     if (!(flags & TCL_FILE_EVENTS)) {
 	return 0;
     }
@@ -760,10 +761,17 @@ SocketEventProc(
 
     infoPtr->flags &= ~SOCKET_PENDING;
 
+    if (infoPtr->readyEvents & FD_CONNECT) {
+	DEBUG("FD_CONNECT");
+	SetEvent(tsdPtr->socketListLock);
+	CreateClientSocket(NULL, infoPtr);
+	infoPtr->readyEvents &= ~(FD_CONNECT);
+	return 1;
+    }
+
     /*
      * Handle connection requests directly.
      */
-
     if (infoPtr->readyEvents & FD_ACCEPT) {
 	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 
@@ -845,6 +853,7 @@ SocketEventProc(
 
 	Tcl_Time blockTime = { 0, 0 };
 
+	DEBUG("FD_CLOSE");
 	Tcl_SetMaxBlockTime(&blockTime);
 	mask |= TCL_READABLE|TCL_WRITABLE;
     } else if (events & FD_READ) {
@@ -858,6 +867,7 @@ SocketEventProc(
 	 * readable, notify the channel driver, otherwise reset the async
 	 * select handler and keep waiting.
 	 */
+	DEBUG("FD_READ");
 
 	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
 		(WPARAM) UNSELECT, (LPARAM) infoPtr);
@@ -876,12 +886,9 @@ SocketEventProc(
 	}
     }
     if (events & FD_WRITE) {
+	DEBUG("FD_WRITE");
 	mask |= TCL_WRITABLE;
     }
-    if (infoPtr->readyEvents & FD_CONNECT) {
-	DEBUG("Calling CreateClientSocket...");
-	CreateClientSocket(NULL, infoPtr);
-    }
     if (mask) {
 	DEBUG("Calling Tcl_NotifyChannel...");
 	Tcl_NotifyChannel(infoPtr->channel, mask);
@@ -1164,14 +1171,17 @@ CreateClientSocket(
     SocketInfo *infoPtr)
 {
     u_long flag = 1;		/* Indicates nonblocking mode. */
-    int async_callback = (infoPtr->addr != NULL);
-    int connected = 0;
     int async = infoPtr->flags & SOCKET_ASYNC_CONNECT;
-
-    DEBUG(async_callback ? "subsequent" : "first");
+    int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
+    ThreadSpecificData *tsdPtr;
+    
     DEBUG(async ? "async" : "sync");
+
     if (async_callback) {
+	DEBUG("subsequent call");
         goto reenter;
+    } else {
+	DEBUG("first call");
     }
     
     for (infoPtr->addr = infoPtr->addrlist; infoPtr->addr != NULL;
@@ -1199,13 +1209,12 @@ CreateClientSocket(
             /*
              * Close the socket if it is still open from the last unsuccessful
              * iteration.
-             */
-
+             */	    
 	    if (infoPtr->sockets->fd != INVALID_SOCKET) {
 		DEBUG("closesocket");
 		closesocket(infoPtr->sockets->fd);
 	    }
-
+	    
 	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
 	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
 		DEBUG("socket() failed");
@@ -1254,7 +1263,7 @@ CreateClientSocket(
 	    if (connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
 			    infoPtr->addr->ai_addrlen) == SOCKET_ERROR) {
 		DWORD error = (DWORD) WSAGetLastError();
-
+		TclWinConvertError(error);
 		DEBUG("connect()");
 #ifdef DEBUGGING
 		// fprintf(stderr,"error = %lu\n", error);
@@ -1262,64 +1271,59 @@ CreateClientSocket(
 		if (error == WSAEWOULDBLOCK) {
 		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		    DEBUG("WSAEWOULDBLOCK");
-		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
 		    infoPtr->selectEvents |= FD_CONNECT;
 
 		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 				(LPARAM) infoPtr);
 		    return TCL_OK;
-		} else {
-		    DEBUG("ELSE");
-		    TclWinConvertError(error);
-		    continue;
+		reenter:
+		    Tcl_SetErrno(infoPtr->lastError);
+		    DEBUG("reenter");
+		    infoPtr->selectEvents &= ~(FD_CONNECT);
 		}
-	    reenter:
-		DEBUG("reenter");
+	    } else {
+		DWORD error = (DWORD) WSAGetLastError();
+		TclWinConvertError(error);
+	    }
 #ifdef DEBUGGING
-		fprintf(stderr, "lastError: %d\n", infoPtr->lastError);
+	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
 #endif
-		/*
-		 * The connection is progressing in the background.
-		 */
-		// infoPtr->selectEvents &= ~(FD_CONNECT);
-	    } else {
-		connected = 1;
-		goto connected;
+	    if (Tcl_GetErrno() == 0) {
+		goto out;
 	    }
 	}
     }
-    goto error;
-connected:
-    DEBUG("connected");
+
+out:
+    DEBUG("connected or finally failed");
+    if (Tcl_GetErrno() != 0 && interp != NULL) {
+	DEBUG("ERRNO");
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+				"couldn't open socket: %s", Tcl_PosixError(interp)));
+	}
+	return TCL_ERROR;
+    }
     /*
-     * Set up the select mask for read/write events. If the connect
-     * attempt has not completed, include connect events.
+     * Set up the select mask for read/write events.
      */
     
     infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-
-error:
+    
     /*
      * Register for interest in events in the select mask. Note that this
      * automatically places the socket into non-blocking mode.
      */
-
-    if (connected) {
-	ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
-	ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+    
+    tsdPtr = TclThreadDataKeyGet(&dataKey);
+    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 		(LPARAM) infoPtr);
-	return TCL_OK;
-    }
-
-    if (interp != NULL) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"couldn't open socket: %s", Tcl_PosixError(interp)));
+    if (async_callback) {
+	Tcl_NotifyChannel(infoPtr->channel, TCL_WRITABLE);
     }
-
-    return TCL_ERROR;
+    return TCL_OK;
 }
 
 /*
@@ -1348,7 +1352,6 @@ WaitForSocketEvent(
     int result = 1;
     int oldMode;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
     /*
      * Be sure to disable event servicing so we are truly modal.
      */
@@ -1464,7 +1467,7 @@ Tcl_OpenTcpClient(
     /*
      * Create a new client socket and wrap it in a channel.
      */
-    
+    DEBUG("");
     if (CreateClientSocket(interp, infoPtr) != TCL_OK) {
 	TcpCloseProc(infoPtr, NULL);
 	return NULL;
@@ -1702,7 +1705,6 @@ error:
 	 */
 	
 	infoPtr->selectEvents = FD_ACCEPT;
-	infoPtr->watchEvents |= FD_ACCEPT;
 	
 	/*
 	 * Register for interest in events in the select mask. Note that this
@@ -2289,6 +2291,9 @@ TcpGetOptionProc(
 	}
 	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 	    sock = fds->fd;
+#ifdef DEBUGGING
+	    fprintf(stderr, "sock == %d\n", sock);
+#endif
 	    size = sizeof(sockname);
 	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
 		int flags = reverseDNS;
@@ -2419,6 +2424,9 @@ TcpWatchProc(
 {
     SocketInfo *infoPtr = instanceData;
 
+    DEBUG((mask & TCL_READABLE) ? "+r":"-r");
+    DEBUG((mask & TCL_WRITABLE) ? "+w":"-w");
+
     /*
      * Update the watch events mask. Only if the socket is not a server
      * socket. [Bug 557878]
@@ -2427,10 +2435,10 @@ TcpWatchProc(
     if (!infoPtr->acceptProc) {
 	infoPtr->watchEvents = 0;
 	if (mask & TCL_READABLE) {
-	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
+	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE);
 	}
 	if (mask & TCL_WRITABLE) {
-	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
+	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE);
 	}
 
 	/*
@@ -2613,10 +2621,16 @@ SocketProc(
 	 * eventState flag.
 	 */
 
+	DEBUG("FOO");
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	DEBUG("BAR");
 	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 		infoPtr = infoPtr->nextPtr) {
 	    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+#ifdef DEBUGGING
+		fprintf(stderr,"socket = %d, fd=%d, event = %d, error = %d\n",
+			socket, fds->fd, event, error);
+#endif
 		if (fds->fd == socket) {
 		    if (event & FD_READ) 
 			DEBUG("|->FD_READ");
@@ -2692,6 +2706,11 @@ SocketProc(
 	    infoPtr = (SocketInfo *) lParam;
 	    if (wParam == SELECT) {
 		DEBUG("SELECT");
+		if (infoPtr->selectEvents & FD_READ) DEBUG("  READ");
+		if (infoPtr->selectEvents & FD_WRITE) DEBUG("  WRITE");
+		if (infoPtr->selectEvents & FD_CLOSE) DEBUG("  CLOSE");
+		if (infoPtr->selectEvents & FD_CONNECT) DEBUG("  CONNECT");
+		if (infoPtr->selectEvents & FD_ACCEPT) DEBUG("  ACCEPT");
 		WSAAsyncSelect(fds->fd, hwnd,
 			SOCKET_MESSAGE, infoPtr->selectEvents);
 	    } else {
-- 
cgit v0.12


From 91e8a8f60c91ad11df3a1c00d36184b9bc0c9947 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 5 Mar 2014 10:20:09 +0000
Subject: Next async connect try works. Reset error and move notifier before
 connect.

---
 win/tclWinSock.c | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 6620def..2da50f5 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1214,6 +1214,11 @@ CreateClientSocket(
 		DEBUG("closesocket");
 		closesocket(infoPtr->sockets->fd);
 	    }
+
+	    /*
+	     * Reset last error from last try
+	     */
+	    infoPtr->lastError = 0;
 	    
 	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
 	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
@@ -1249,11 +1254,13 @@ CreateClientSocket(
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
 	     */
-	    if (async && ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
-		== SOCKET_ERROR) {
-		DEBUG("FIONBIO");
-		TclWinConvertError((DWORD) WSAGetLastError());
-		continue;
+	    if (async) {
+		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		infoPtr->selectEvents |= FD_CONNECT;
+
+		ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+			    (LPARAM) infoPtr);
 	    }
 
 	    /*
@@ -1269,13 +1276,7 @@ CreateClientSocket(
 		// fprintf(stderr,"error = %lu\n", error);
 #endif
 		if (error == WSAEWOULDBLOCK) {
-		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		    DEBUG("WSAEWOULDBLOCK");
-		    infoPtr->selectEvents |= FD_CONNECT;
-
-		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-				(LPARAM) infoPtr);
 		    return TCL_OK;
 		reenter:
 		    Tcl_SetErrno(infoPtr->lastError);
-- 
cgit v0.12


From 60f72ecdaf9f585eb8210a95d43969c20ede5329 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Wed, 5 Mar 2014 13:09:22 +0000
Subject: Print out the value of infoPtr in DEBUG, so that coexisting sockets
 can be distinguished in the output.

---
 win/tclWinSock.c | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 2da50f5..64b2fc9 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -49,7 +49,8 @@
 
 #define DEBUGGING
 #ifdef DEBUGGING
-#define DEBUG(x) fprintf(stderr, ">>> %s(%d): %s<<<\n", __FUNCTION__, __LINE__, x)
+#define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
+			    infoPtr, __FUNCTION__, __LINE__, x)
 #else
 #define DEBUG(x)
 #endif
@@ -669,7 +670,6 @@ SocketCheckProc(
     SocketEvent *evPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    DEBUG("A");
     if (!(flags & TCL_FILE_EVENTS)) {
 	return;
     }
@@ -683,10 +683,12 @@ SocketCheckProc(
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
+    DEBUG("A");
 	if ((infoPtr->readyEvents &
 		(infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT))
 	    && !(infoPtr->flags & SOCKET_PENDING)
 	) {
+    DEBUG("B");
 	    infoPtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
 	    evPtr->header.proc = SocketEventProc;
@@ -1356,6 +1358,7 @@ WaitForSocketEvent(
     /*
      * Be sure to disable event servicing so we are truly modal.
      */
+    DEBUG("=============");
 
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
 
@@ -2586,12 +2589,10 @@ SocketProc(
 
     switch (message) {
     default:
-	    DEBUG("default");
 	return DefWindowProc(hwnd, message, wParam, lParam);
 	break;
 
     case WM_CREATE:
-	    DEBUG("CREATE");
 	/*
 	 * Store the initial tsdPtr, it's from a different thread, so it's not
 	 * directly accessible, but needed.
@@ -2607,12 +2608,10 @@ SocketProc(
 	break;
 
     case WM_DESTROY:
-	    DEBUG("DESTROY");
 	PostQuitMessage(0);
 	break;
 
     case SOCKET_MESSAGE:
-	    DEBUG("SOCKET_MESSAGE");
 	event = WSAGETSELECTEVENT(lParam);
 	error = WSAGETSELECTERROR(lParam);
 	socket = (SOCKET) wParam;
@@ -2668,7 +2667,6 @@ SocketProc(
 			 * Remember any error that occurred so we can report
 			 * connection failures.
 			 */
-
 			if (error != ERROR_SUCCESS) {
 			    TclWinConvertError((DWORD) error);
 			    infoPtr->lastError = Tcl_GetErrno();
-- 
cgit v0.12


From bf23be680c6a9233bd70707a05513b31b047d158 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Wed, 5 Mar 2014 13:12:13 +0000
Subject: avoid warnings about uninitialized infoPtr in DEBUG

---
 win/tclWinSock.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 64b2fc9..f06aad1 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -726,7 +726,7 @@ SocketEventProc(
     int flags)			/* Flags that indicate what events to handle,
 				 * such as TCL_FILE_EVENTS. */
 {
-    SocketInfo *infoPtr;
+    SocketInfo *infoPtr = NULL; /* DEBUG */
     SocketEvent *eventPtr = (SocketEvent *) evPtr;
     int mask = 0, events;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -2578,7 +2578,7 @@ SocketProc(
 {
     int event, error;
     SOCKET socket;
-    SocketInfo *infoPtr;
+    SocketInfo *infoPtr = NULL; /* DEBUG */
     TcpFdList *fds = NULL;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 #ifdef _WIN64
-- 
cgit v0.12


From 23801213cacd306b0bfddbdb51efcd15c88ed0f9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 5 Mar 2014 14:23:38 +0000
Subject: Merge repair to correct failing tests.

---
 generic/tclIO.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 139a05e..6e3f0cf 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5320,7 +5320,7 @@ ReadChars(
 	 * srcLen bytes, write no more than dstLimit bytes.
 	 */
 
-	int code = Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+	int code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
 		statePtr->inputEncodingFlags & (bufPtr->nextPtr
 		? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
 		dst, dstLimit, &srcRead, &dstDecoded, &numChars);
@@ -5441,7 +5441,7 @@ ReadChars(
 		statePtr->inputEncodingFlags = savedIEFlags;
 		statePtr->inputEncodingState = savedState;
 
-		Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+		Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
 		statePtr->inputEncodingFlags & (bufPtr->nextPtr
 		? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
 		buffer, TCL_UTF_MAX + 2, &read, &decoded, &count);
-- 
cgit v0.12


From f320ea76a37f8837d998a6400000d59b72d1e376 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Wed, 5 Mar 2014 14:40:27 +0000
Subject: Refactor the error handling logic around connect()

---
 win/tclWinSock.c | 37 +++++++++++++++++--------------------
 1 file changed, 17 insertions(+), 20 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f06aad1..d7b1b5b 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1176,6 +1176,7 @@ CreateClientSocket(
     int async = infoPtr->flags & SOCKET_ASYNC_CONNECT;
     int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
     ThreadSpecificData *tsdPtr;
+    DWORD error;
     
     DEBUG(async ? "async" : "sync");
 
@@ -1258,7 +1259,7 @@ CreateClientSocket(
 	     */
 	    if (async) {
 		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-		infoPtr->selectEvents |= FD_CONNECT;
+		infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE;
 
 		ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
@@ -1268,26 +1269,22 @@ CreateClientSocket(
 	    /*
 	     * Attempt to connect to the remote socket.
 	     */
-
-	    if (connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
-			    infoPtr->addr->ai_addrlen) == SOCKET_ERROR) {
-		DWORD error = (DWORD) WSAGetLastError();
-		TclWinConvertError(error);
-		DEBUG("connect()");
+	    
+	    DEBUG("connect()");
+	    connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
+		    infoPtr->addr->ai_addrlen);
+	    error = WSAGetLastError();
+	    TclWinConvertError(error);
 #ifdef DEBUGGING
-		// fprintf(stderr,"error = %lu\n", error);
+	    // fprintf(stderr,"error = %lu\n", error);
 #endif
-		if (error == WSAEWOULDBLOCK) {
-		    DEBUG("WSAEWOULDBLOCK");
-		    return TCL_OK;
-		reenter:
-		    Tcl_SetErrno(infoPtr->lastError);
-		    DEBUG("reenter");
-		    infoPtr->selectEvents &= ~(FD_CONNECT);
-		}
-	    } else {
-		DWORD error = (DWORD) WSAGetLastError();
-		TclWinConvertError(error);
+	    if (error == WSAEWOULDBLOCK) {
+		DEBUG("WSAEWOULDBLOCK");
+		return TCL_OK;
+	    reenter:
+		Tcl_SetErrno(infoPtr->lastError);
+		DEBUG("reenter");
+		infoPtr->selectEvents &= ~(FD_CONNECT);
 	    }
 #ifdef DEBUGGING
 	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
@@ -1311,7 +1308,7 @@ out:
     /*
      * Set up the select mask for read/write events.
      */
-    
+    DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
     infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
     
     /*
-- 
cgit v0.12


From 2910497fce32aefc629cfe738e7f2d5e0e941877 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 5 Mar 2014 15:15:43 +0000
Subject: "gets" blocked after async cannect: SOCKET_ASYNC_CONNECT was not
 cleared

---
 win/tclWinSock.c | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index d7b1b5b..162cbd4 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1259,7 +1259,7 @@ CreateClientSocket(
 	     */
 	    if (async) {
 		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-		infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE;
+		infoPtr->selectEvents |= FD_CONNECT;
 
 		ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
@@ -2653,18 +2653,18 @@ SocketProc(
 
 		    if (event & FD_CONNECT) {
 			DEBUG("FD_CONNECT");
-			/*
-			 * The socket is now connected, clear the async connect
-			 * flag.
-			 */
 
-			//infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-
-			/*
-			 * Remember any error that occurred so we can report
-			 * connection failures.
-			 */
-			if (error != ERROR_SUCCESS) {
+			if (error == ERROR_SUCCESS) {
+			    /*
+			     * The socket is now connected, clear the async connect
+			     * flag.
+			     */
+			    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+			} else {
+			    /*
+			     * Remember any error that occurred so we can report
+			     * connection failures.
+			     */
 			    TclWinConvertError((DWORD) error);
 			    infoPtr->lastError = Tcl_GetErrno();
 			}
-- 
cgit v0.12


From 9d31d410437d7e7fad1201c869e0a7c479daf693 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 5 Mar 2014 17:16:35 +0000
Subject: Adapt CopyAndTranslateBuffer() to changes in TranslateInputEOL().
 Notably no longer using the INPUT_NEED_NL flag.

---
 generic/tclIO.c | 117 +++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 77 insertions(+), 40 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6e3f0cf..013f8dd 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5914,7 +5914,7 @@ TranslateInputEOL(
 
 	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-	ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
+	ResetFlag(statePtr, INPUT_SAW_CR);
 	return 1;
     }
 
@@ -9046,7 +9046,6 @@ CopyAndTranslateBuffer(
 				 * in the current input buffer? */
     int copied;			/* How many characters were already copied
 				 * into the destination space? */
-    int toCopy;
 
     /*
      * If there is no input at all, return zero. The invariant is that either
@@ -9061,51 +9060,90 @@ CopyAndTranslateBuffer(
     bufPtr = statePtr->inQueueHead;
     bytesInBuffer = BytesLeft(bufPtr);
 
-    copied = 0;
-#if 0
-    if (statePtr->flags & INPUT_NEED_NL) {
+#if 1
+    copied = space;
+    if (bytesInBuffer <= copied) {
+	copied = bytesInBuffer;
+    }
+    if (copied == 0) {
+	return copied;
+    }
+    TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
+	    &copied, &bytesInBuffer);
+    bufPtr->nextRemoved += bytesInBuffer;
 
-	/*
-	 * An earlier call to TranslateInputEOL ended in the read of a \r .
-	 * Only the next read from the same channel can complete the
-	 * translation sequence to tell us what character we should read.
-	 */
+    /*
+     * If the current buffer is empty recycle it.
+     */
+
+    if (IsBufferEmpty(bufPtr)) {
+	statePtr->inQueueHead = bufPtr->nextPtr;
+	if (statePtr->inQueueHead == NULL) {
+	    statePtr->inQueueTail = NULL;
+	}
+	RecycleBuffer(statePtr, bufPtr, 0);
+    } else {
+
+	if (copied > 0) {
+	    return copied;
+	}
 
-	if (bytesInBuffer) {
-	    /* There's a next byte.  It will settle things. */
-	    ResetFlag(statePtr, INPUT_NEED_NL);
+	if (statePtr->inEofChar
+		&& RemovePoint(bufPtr)[0] == statePtr->inEofChar) {
+	    return 0;
+	}
 
-	    if (RemovePoint(bufPtr)[0] == '\n') {
-		bufPtr->nextRemoved++;
-		bytesInBuffer--;
-		*result++ = '\n';
-	    } else {
-		*result++ = '\r';
+	if (BytesLeft(bufPtr) == 1) {
+
+	    ChannelBuffer *nextPtr = bufPtr->nextPtr;
+
+	    if (nextPtr == NULL) {
+
+		if (statePtr->flags & CHANNEL_EOF) {
+		    *result = '\r';
+		    bufPtr->nextRemoved += 1;
+		    return 1;
+		}
+
+		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+		return 0;
 	    }
-	    copied++;
-	    space--;
-	} else if (statePtr->flags & CHANNEL_EOF) {
-	    /* There is no next byte, and there never will be (EOF). */
-	    ResetFlag(statePtr, INPUT_NEED_NL);
+
+	    nextPtr->nextRemoved -= 1;
+	    memcpy(RemovePoint(nextPtr), RemovePoint(bufPtr), 1);
+	    RecycleBuffer(statePtr, bufPtr, 0);
+	    statePtr->inQueueHead = nextPtr;
+	    return 0;
+	}
+
+	if (statePtr->inEofChar
+		&& RemovePoint(bufPtr)[1] == statePtr->inEofChar) {
 	    *result = '\r';
+	    bufPtr->nextRemoved += 1;
 	    return 1;
-	} else {
-	    /* There is no next byte.  Ask the caller to read more. */
-	    return 0;
 	}
+	/*
+	 * Buffer is not empty.  How can that be?
+	 * 0) We stopped early due to the value of "space".
+	 * 	=> copied > 0 and all is fine.
+	 * 1) We saw eof char and stopped the translation copy.
+	 *	=> if (copied > 0) or ((copied == 0) and @ eof char),
+	 *		return is fine.
+	 * 2) The buffer holds a \r while in CRLF translation, followed
+	 *    by either the end of the buffer, or the eof char.
+	 */
+
     }
-    toCopy = space;
-    if (bytesInBuffer <= toCopy) {
-	toCopy = bytesInBuffer;
-    }
-    if (toCopy == 0) {
-	return copied;
-    }
-    TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
-	    &toCopy, &bytesInBuffer);
-    bufPtr->nextRemoved += bytesInBuffer;
-    copied += toCopy;
+
+    /*
+     * Return the number of characters copied into the result buffer. This may
+     * be different from the number of bytes consumed, because of EOL
+     * translations.
+     */
+
+    return copied;
 #else
+    copied = 0;
     switch (statePtr->inputTranslation) {
     case TCL_TRANSLATE_LF:
 	if (bytesInBuffer == 0) {
@@ -9265,7 +9303,6 @@ CopyAndTranslateBuffer(
 	    }
 	}
     }
-#endif
 
     /*
      * If the current buffer is empty recycle it.
@@ -9286,6 +9323,7 @@ CopyAndTranslateBuffer(
      */
 
     return copied;
+#endif
 }
 
 /*
@@ -10726,7 +10764,6 @@ DumpFlags(
     ChanFlag('S', CHANNEL_STICKY_EOF);
     ChanFlag('B', CHANNEL_BLOCKED);
     ChanFlag('/', INPUT_SAW_CR);
-    ChanFlag('*', INPUT_NEED_NL);
     ChanFlag('D', CHANNEL_DEAD);
     ChanFlag('R', CHANNEL_RAW_MODE);
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-- 
cgit v0.12


From 94a4d6ac65eed79a3fe89a71d1c2a429793300bc Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 5 Mar 2014 19:41:51 +0000
Subject: Remove old dead code; silence compiler warnings; tidy up.

---
 generic/tclIO.c | 415 ++------------------------------------------------------
 generic/tclIO.h |   3 -
 2 files changed, 12 insertions(+), 406 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 013f8dd..821d111 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5252,33 +5252,25 @@ ReadChars(
 				 * UTF-8. On output, contains another guess
 				 * based on the data seen so far. */
 {
-    int toRead, factor, srcLen, dstNeeded, numBytes;
-    int srcRead, dstWrote, numChars, dstRead;
-    ChannelBuffer *bufPtr;
-    char *src, *dst;
-    Tcl_EncodingState oldState;
-    int encEndFlagSuppressed = 0;
     Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding
 	    : GetBinaryEncoding();
-
-    factor = *factorPtr;
-
-    bufPtr = statePtr->inQueueHead;
-    src = RemovePoint(bufPtr);
-    srcLen = BytesLeft(bufPtr);
-
-    toRead = charsToRead;
-    if ((unsigned)toRead > (unsigned)srcLen) {
-	toRead = srcLen;
-    }
+    Tcl_EncodingState savedState = statePtr->inputEncodingState;
+    ChannelBuffer *bufPtr = statePtr->inQueueHead;
+    int savedIEFlags = statePtr->inputEncodingFlags;
+    int savedFlags = statePtr->flags;
+    char *dst, *src = RemovePoint(bufPtr);
+    int dstLimit, numBytes, srcLen = BytesLeft(bufPtr);
+    int toRead = ((unsigned) charsToRead > srcLen) ? srcLen : charsToRead;
 
     /*
      * 'factor' is how much we guess that the bytes in the source buffer will
      * expand when converted to UTF-8 chars. This guess comes from analyzing
      * how many characters were produced by the previous pass.
      */
+    
+    int factor = *factorPtr;
+    int dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
 
-    dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
     (void) TclGetStringFromObj(objPtr, &numBytes);
     Tcl_AppendToObj(objPtr, NULL, dstNeeded);
     if (toRead == srcLen) {
@@ -5289,8 +5281,6 @@ ReadChars(
 	dst = TclGetString(objPtr) + numBytes;
     }
 
-#if 1
-
     /*
      * This routine is burdened with satisfying several constraints.
      * It cannot append more than 'charsToRead` chars onto objPtr.
@@ -5307,13 +5297,9 @@ ReadChars(
      * a consistent set of results.  This takes the shape of a loop.
      */
 
-    int dstLimit = dstNeeded + 1;
-    int savedFlags = statePtr->flags;
-    int savedIEFlags = statePtr->inputEncodingFlags;
-    Tcl_EncodingState savedState = statePtr->inputEncodingState;
-
+    dstLimit = dstNeeded + 1;
     while (1) {
-	int dstDecoded;
+	int dstDecoded, dstRead, dstWrote, srcRead, numChars;
 
 	/*
 	 * Perform the encoding transformation.  Read no more than
@@ -5555,200 +5541,6 @@ ReadChars(
 	Tcl_SetObjLength(objPtr, numBytes + dstWrote);
 	return numChars;
     }
-
-#else
-    /*
-     * [Bug 1462248]: The cause of the crash reported in this bug is this:
-     *
-     * - ReadChars, called with a single buffer, with a incomplete
-     *	 multi-byte character at the end (only the first byte of it).
-     * - Encoding translation fails, asks for more data
-     * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set.
-     * - ReadChar is called again, converts the first buffer, but due to TEE
-     *	 it does not check for incomplete multi-byte data, and the character
-     *	 just after the end of the first buffer is a valid completion of the
-     *	 multi-byte header in the actual buffer. The conversion reads more
-     *	 characters from the buffer then present. This causes nextRemoved to
-     *	 overshoot nextAdded and the next reads compute a negative srcLen,
-     *	 cause further translations to fail, causing copying of data into the
-     *	 next buffer using bad arguments, causing the mecpy for to eventually
-     *	 fail.
-     *
-     * In the end it is a memory access bug spiraling out of control if the
-     * conditions are _just so_. And ultimate cause is that TEE is given to a
-     * conversion where it should not. TEE signals that this is the last
-     * buffer. Except in our case it is not.
-     *
-     * My solution is to suppress TEE if the first buffer is not the last. We
-     * will eventually need it given that EOF has been reached, but not right
-     * now. This is what the new flag "endEncSuppressFlag" is for.
-     *
-     * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind the
-     * actual buffer has been fixed as well, and fixes the problem with the
-     * crash too, but this would still allow the generic layer to
-     * accidentially break a multi-byte sequence if the conditions are just
-     * right, because again the ExternalToUtf would be successful where it
-     * should not.
-     */
-
-    if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) &&
-	    (bufPtr->nextPtr != NULL)) {
-	/*
-	 * TEE is set for a buffer which is not the last. Squash it for now,
-	 * and restore it later, before yielding control to our caller.
-	 */
-
-	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
-	encEndFlagSuppressed = 1;
-    }
-
-    oldState = statePtr->inputEncodingState;
-    if (statePtr->flags & INPUT_NEED_NL) {
-	/*
-	 * We want a '\n' because the last character we saw was '\r'.
-	 */
-
-	ResetFlag(statePtr, INPUT_NEED_NL);
-	Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-		dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
-	if ((dstWrote > 0) && (*dst == '\n')) {
-	    /*
-	     * The next char was a '\n'. Consume it and produce a '\n'.
-	     */
-
-	    bufPtr->nextRemoved += srcRead;
-	} else {
-	    /*
-	     * The next char was not a '\n'. Produce a '\r'.
-	     */
-
-	    *dst = '\r';
-	}
-	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
-	Tcl_SetObjLength(objPtr, numBytes + 1);
-
-	if (encEndFlagSuppressed) {
-	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-	}
-	return 1;
-    }
-
-    Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
-	    dstNeeded + 1, &srcRead, &dstWrote, &numChars);
-
-    if (encEndFlagSuppressed) {
-	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-    }
-
-    if (srcRead == 0) {
-	/*
-	 * Not enough bytes in src buffer to make a complete char. Copy the
-	 * bytes to the next buffer to make a new contiguous string, then tell
-	 * the caller to fill the buffer with more bytes.
-	 */
-
-	ChannelBuffer *nextPtr;
-
-	nextPtr = bufPtr->nextPtr;
-	if (nextPtr == NULL) {
-	    if (srcLen > 0) {
-		/*
-		 * There isn't enough data in the buffers to complete the next
-		 * character, so we need to wait for more data before the next
-		 * file event can be delivered. [Bug 478856]
-		 *
-		 * The exception to this is if the input buffer was completely
-		 * empty before we tried to convert its contents. Nothing in,
-		 * nothing out, and no incomplete character data. The
-		 * conversion before the current one was complete.
-		 */
-
-		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
-	    }
-	    Tcl_SetObjLength(objPtr, numBytes);
-	    return -1;
-	}
-
-	/*
-	 * Space is made at the beginning of the buffer to copy the previous
-	 * unused bytes there. Check first if the buffer we are using actually
-	 * has enough space at its beginning for the data we are copying.
-	 * Because if not we will write over the buffer management
-	 * information, especially the 'nextPtr'.
-	 *
-	 * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used to
-	 * prevent exactly this situation. I.e. it should never happen.
-	 * Therefore it is ok to panic should it happen despite the
-	 * precautions.
-	 */
-
-	if (nextPtr->nextRemoved - srcLen < 0) {
-	    Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
-	}
-
-	nextPtr->nextRemoved -= srcLen;
-	memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
-	RecycleBuffer(statePtr, bufPtr, 0);
-	statePtr->inQueueHead = nextPtr;
-	Tcl_SetObjLength(objPtr, numBytes);
-	return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
-    }
-
-    dstRead = dstWrote;
-    if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
-	/*
-	 * Hit EOF char. How many bytes of src correspond to where the EOF was
-	 * located in dst? Run the conversion again with an output buffer just
-	 * big enough to hold the data so we can get the correct value for
-	 * srcRead.
-	 */
-
-	if (dstWrote == 0) {
-	    Tcl_SetObjLength(objPtr, numBytes);
-	    return -1;
-	}
-	statePtr->inputEncodingState = oldState;
-	Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-		dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
-	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
-    }
-
-    /*
-     * The number of characters that we got may be less than the number that
-     * we started with because "\r\n" sequences may have been turned into just
-     * '\n' in dst.
-     */
-
-    numChars -= (dstRead - dstWrote);
-
-    if ((unsigned) numChars > (unsigned) toRead) {
-	/*
-	 * Got too many chars.
-	 */
-
-	const char *eof;
-
-	eof = Tcl_UtfAtIndex(dst, toRead);
-	statePtr->inputEncodingState = oldState;
-	Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-		dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
-	dstRead = dstWrote;
-	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
-	numChars -= (dstRead - dstWrote);
-    }
-    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
-
-    bufPtr->nextRemoved += srcRead;
-    if (dstWrote > srcRead + 1) {
-	*factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
-    }
-    Tcl_SetObjLength(objPtr, numBytes + dstWrote);
-    return numChars;
-#endif
 }
 
 /*
@@ -9060,7 +8852,6 @@ CopyAndTranslateBuffer(
     bufPtr = statePtr->inQueueHead;
     bytesInBuffer = BytesLeft(bufPtr);
 
-#if 1
     copied = space;
     if (bytesInBuffer <= copied) {
 	copied = bytesInBuffer;
@@ -9142,188 +8933,6 @@ CopyAndTranslateBuffer(
      */
 
     return copied;
-#else
-    copied = 0;
-    switch (statePtr->inputTranslation) {
-    case TCL_TRANSLATE_LF:
-	if (bytesInBuffer == 0) {
-	    return 0;
-	}
-
-	/*
-	 * Copy the current chunk into the result buffer.
-	 */
-
-	if (bytesInBuffer < space) {
-	    space = bytesInBuffer;
-	}
-	memcpy(result, RemovePoint(bufPtr), (size_t) space);
-	bufPtr->nextRemoved += space;
-	copied = space;
-	break;
-    case TCL_TRANSLATE_CR: {
-	char *end;
-
-	if (bytesInBuffer == 0) {
-	    return 0;
-	}
-
-	/*
-	 * Copy the current chunk into the result buffer, then replace all \r
-	 * with \n.
-	 */
-
-	if (bytesInBuffer < space) {
-	    space = bytesInBuffer;
-	}
-	memcpy(result, RemovePoint(bufPtr), (size_t) space);
-	bufPtr->nextRemoved += space;
-	copied = space;
-
-	for (end = result + copied; result < end; result++) {
-	    if (*result == '\r') {
-		*result = '\n';
-	    }
-	}
-	break;
-    }
-    case TCL_TRANSLATE_CRLF: {
-	char *src, *end, *dst;
-	int curByte;
-
-	/*
-	 * If there is a held-back "\r" at EOF, produce it now.
-	 */
-
-	if (bytesInBuffer == 0) {
-	    if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
-		    (INPUT_SAW_CR | CHANNEL_EOF)) {
-		result[0] = '\r';
-		ResetFlag(statePtr, INPUT_SAW_CR);
-		return 1;
-	    }
-	    return 0;
-	}
-
-	/*
-	 * Copy the current chunk and replace "\r\n" with "\n" (but not
-	 * standalone "\r"!).
-	 */
-
-	if (bytesInBuffer < space) {
-	    space = bytesInBuffer;
-	}
-	memcpy(result, RemovePoint(bufPtr), (size_t) space);
-	bufPtr->nextRemoved += space;
-	copied = space;
-
-	end = result + copied;
-	dst = result;
-	for (src = result; src < end; src++) {
-	    curByte = *src;
-	    if (curByte == '\n') {
-		ResetFlag(statePtr, INPUT_SAW_CR);
-	    } else if (statePtr->flags & INPUT_SAW_CR) {
-		ResetFlag(statePtr, INPUT_SAW_CR);
-		*dst = '\r';
-		dst++;
-	    }
-	    if (curByte == '\r') {
-		SetFlag(statePtr, INPUT_SAW_CR);
-	    } else {
-		*dst = (char) curByte;
-		dst++;
-	    }
-	}
-	copied = dst - result;
-	break;
-    }
-    case TCL_TRANSLATE_AUTO: {
-	char *src, *end, *dst;
-	int curByte;
-
-	if (bytesInBuffer == 0) {
-	    return 0;
-	}
-
-	/*
-	 * Loop over the current buffer, converting "\r" and "\r\n" to "\n".
-	 */
-
-	if (bytesInBuffer < space) {
-	    space = bytesInBuffer;
-	}
-	memcpy(result, RemovePoint(bufPtr), (size_t) space);
-	bufPtr->nextRemoved += space;
-	copied = space;
-
-	end = result + copied;
-	dst = result;
-	for (src = result; src < end; src++) {
-	    curByte = *src;
-	    if (curByte == '\r') {
-		SetFlag(statePtr, INPUT_SAW_CR);
-		*dst = '\n';
-		dst++;
-	    } else {
-		if ((curByte != '\n') || !(statePtr->flags & INPUT_SAW_CR)) {
-		    *dst = (char) curByte;
-		    dst++;
-		}
-		ResetFlag(statePtr, INPUT_SAW_CR);
-	    }
-	}
-	copied = dst - result;
-	break;
-    }
-    default:
-	Tcl_Panic("unknown eol translation mode");
-    }
-
-    /*
-     * If an in-stream EOF character is set for this channel, check that the
-     * input we copied so far does not contain the EOF char. If it does, copy
-     * only up to and excluding that character.
-     */
-
-    if (statePtr->inEofChar != 0) {
-	int i;
-
-	for (i = 0; i < copied; i++) {
-	    if (result[i] == (char) statePtr->inEofChar) {
-		/*
-		 * Set sticky EOF so that no further input is presented to the
-		 * caller.
-		 */
-
-		SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
-		statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-		copied = i;
-		break;
-	    }
-	}
-    }
-
-    /*
-     * If the current buffer is empty recycle it.
-     */
-
-    if (IsBufferEmpty(bufPtr)) {
-	statePtr->inQueueHead = bufPtr->nextPtr;
-	if (statePtr->inQueueHead == NULL) {
-	    statePtr->inQueueTail = NULL;
-	}
-	RecycleBuffer(statePtr, bufPtr, 0);
-    }
-
-    /*
-     * Return the number of characters copied into the result buffer. This may
-     * be different from the number of bytes consumed, because of EOL
-     * translations.
-     */
-
-    return copied;
-#endif
 }
 
 /*
diff --git a/generic/tclIO.h b/generic/tclIO.h
index ebf2ef7..a57d4c5 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -252,9 +252,6 @@ typedef struct ChannelState {
 #define INPUT_SAW_CR		(1<<12)	/* Channel is in CRLF eol input
 					 * translation mode and the last byte
 					 * seen was a "\r". */
-#define INPUT_NEED_NL		(1<<15)	/* Saw a '\r' at end of last buffer,
-					 * and there should be a '\n' at
-					 * beginning of next buffer. */
 #define CHANNEL_DEAD		(1<<13)	/* The channel has been closed by the
 					 * exit handler (on exit) but not
 					 * deallocated. When any IO operation
-- 
cgit v0.12


From 3d0e0863c3cb661e0e0b03a84f6227bc3b5a0d20 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Thu, 6 Mar 2014 10:37:13 +0000
Subject: Terminate async connect synchronously by any blocking operation

---
 win/tclWinSock.c | 116 +++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 104 insertions(+), 12 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 162cbd4..263ef9a 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,7 +47,7 @@
 
 #include "tclWinInt.h"
 
-#define DEBUGGING
+//#define DEBUGGING
 #ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
 			    infoPtr, __FUNCTION__, __LINE__, x)
@@ -207,6 +207,9 @@ typedef struct {
 #define SOCKET_ASYNC_CONNECT	(1<<2)	/* This socket uses async connect. */
 #define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
 					 * socket */
+#define SOCKET_REENTER_PENDING	(1<<4)	/* The reentering after a received
+					 * FD_CONNECT to CreateClientSocket
+					 * is pending */
 
 typedef struct {
     HWND hwnd;			/* Handle to window for socket messages. */
@@ -236,6 +239,7 @@ static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
 			    LPARAM lParam);
 static int		SocketsEnabled(void);
 static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
+static int		WaitForAsyncConnect(SocketInfo *infoPtr, int *errorCodePtr);
 static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
 			    int *errorCodePtr);
 static DWORD WINAPI	SocketThread(LPVOID arg);
@@ -763,11 +767,12 @@ SocketEventProc(
 
     infoPtr->flags &= ~SOCKET_PENDING;
 
-    if (infoPtr->readyEvents & FD_CONNECT) {
+    /* Continue async connect if pending and ready */
+    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
+	    && (infoPtr->readyEvents & FD_CONNECT) ) {
 	DEBUG("FD_CONNECT");
 	SetEvent(tsdPtr->socketListLock);
 	CreateClientSocket(NULL, infoPtr);
-	infoPtr->readyEvents &= ~(FD_CONNECT);
 	return 1;
     }
 
@@ -1173,15 +1178,22 @@ CreateClientSocket(
     SocketInfo *infoPtr)
 {
     u_long flag = 1;		/* Indicates nonblocking mode. */
-    int async = infoPtr->flags & SOCKET_ASYNC_CONNECT;
+    /*
+     * We are started with async connect and the connect notification
+     * was not jet received
+     */
+    int async_connect = infoPtr->flags & SOCKET_ASYNC_CONNECT;
+    /* We were called by the event procedure and continue our loop */
     int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
     ThreadSpecificData *tsdPtr;
     DWORD error;
     
-    DEBUG(async ? "async" : "sync");
+    DEBUG(async_connect ? "async connect" : "sync connect");
 
     if (async_callback) {
 	DEBUG("subsequent call");
+	/* Clear this pending reenter case */
+	infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
         goto reenter;
     } else {
 	DEBUG("first call");
@@ -1257,7 +1269,7 @@ CreateClientSocket(
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
 	     */
-	    if (async) {
+	    if (async_connect) {
 		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		infoPtr->selectEvents |= FD_CONNECT;
 
@@ -1280,6 +1292,8 @@ CreateClientSocket(
 #endif
 	    if (error == WSAEWOULDBLOCK) {
 		DEBUG("WSAEWOULDBLOCK");
+		/* Jump out and remember that we want to get back in */
+		infoPtr->flags |= SOCKET_REENTER_PENDING;
 		return TCL_OK;
 	    reenter:
 		Tcl_SetErrno(infoPtr->lastError);
@@ -1299,6 +1313,8 @@ out:
     DEBUG("connected or finally failed");
     if (Tcl_GetErrno() != 0 && interp != NULL) {
 	DEBUG("ERRNO");
+        /* Clear async flag so if a read is done it does not block */
+        infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 				"couldn't open socket: %s", Tcl_PosixError(interp)));
@@ -1329,6 +1345,82 @@ out:
 /*
  *----------------------------------------------------------------------
  *
+ * WaitForAsyncConnect --
+ *
+ *	Terminate an asyncroneous connect syncroneously.
+ *	This routine should only be called if flag ASYNC_CONNECT is set.
+ *
+ * Results:
+ *	Returns 1 on success or 0 on failure, with an error code in
+ *	errorCodePtr.
+ *
+ * Side effects:
+ *	Processes socket events off the system queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForAsyncConnect(
+    SocketInfo *infoPtr,	/* Information about this socket. */
+    int *errorCodePtr)		/* Where to store errors? */
+{
+    int result = 1;
+    int oldMode;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    /*
+     * A non blocking socket waiting for an asyncronous connect
+     * returns directly an error
+     */
+    if (infoPtr->flags & SOCKET_ASYNC) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    return 0;
+	}
+
+    /*
+     * Be sure to disable event servicing so we are truly modal.
+     */
+
+    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
+
+    /*
+     * Disable async connect as we continue now synchoneously
+     */
+
+    /* ToDo: need thread protection * */
+    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
+    /*
+     * Reset WSAAsyncSelect so we have a fresh set of events pending.
+     */
+
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
+	    (LPARAM) infoPtr);
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+	    (LPARAM) infoPtr);
+
+    while (1) {
+	/* Check for connect event */
+	if (infoPtr->readyEvents & FD_CONNECT) {
+	    /* continue async connect syncroneously */
+	    result = CreateClientSocket(NULL, infoPtr);
+	    (void) Tcl_SetServiceMode(oldMode);
+	    /* Todo: find adequate error code */
+	    *errorCodePtr = EFAULT;
+	    return (result == TCL_OK);
+	}
+
+	/*
+	 * Wait until something happens.
+	 */
+
+	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * WaitForSocketEvent --
  *
  *	Waits until one of the specified events occurs on a socket.
@@ -1865,11 +1957,11 @@ TcpInputProc(
     }
 
     /*
-     * Check to see if the socket is connected before trying to read.
+     * Check if there is an async connect to terminate
      */
 
-    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
-	    && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
+    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
+	    && !WaitForAsyncConnect(infoPtr, errorCodePtr)) {
 	return -1;
     }
 
@@ -1993,11 +2085,11 @@ TcpOutputProc(
     }
 
     /*
-     * Check to see if the socket is connected before trying to write.
+     * Check if there is an async connect to terminate
      */
 
-    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
-	    && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
+    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
+	    && !WaitForAsyncConnect(infoPtr, errorCodePtr)) {
 	return -1;
     }
 
-- 
cgit v0.12


From a59f5c70234be1134e3752519daa601c3c850365 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 6 Mar 2014 15:51:06 +0000
Subject: Variable "rawStart" serves no purpose.

---
 generic/tclIO.c | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 821d111..b0d0e32 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4464,7 +4464,7 @@ FilterInputBytes(
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
     ChannelBuffer *bufPtr;
-    char *raw, *rawStart, *dst;
+    char *raw, *dst;
     int offset, toRead, dstNeeded, spaceLeft, result, rawLen;
     Tcl_Obj *objPtr;
 #define ENCODING_LINESIZE 20	/* Lower bound on how many bytes to convert at
@@ -4521,8 +4521,7 @@ FilterInputBytes(
      * string rep if we need more space.
      */
 
-    rawStart = RemovePoint(bufPtr);
-    raw = rawStart;
+    raw = RemovePoint(bufPtr);
     rawLen = BytesLeft(bufPtr);
 
     dst = *gsPtr->dstPtr;
-- 
cgit v0.12


From e53f96cbd13df27c822ebe8cc9a5e215f70b800f Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Thu, 6 Mar 2014 18:21:40 +0000
Subject: More debug to chase different fd in struct than in callback

---
 tests/socket.test |  6 ++++
 win/tclWinSock.c  | 93 ++++++++++++++++++++++++-------------------------------
 2 files changed, 46 insertions(+), 53 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 51219e6..74c44ce 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1855,12 +1855,15 @@ test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] bef
     -constraints [list socket supported_inet supported_inet6] \
     -setup {
         proc accept {s a p} {
+            global s
             puts $s bye
             close $s
+            set s ok
         }
         set server [socket -server accept -myaddr 127.0.0.1 0]
         set port [lindex [fconfigure $server -sockname] 2]
         set x ""
+        set s ""
     } \
     -body {
         set client [socket -async localhost $port]
@@ -1869,6 +1872,9 @@ test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] bef
             lappend x [fconfigure $client -error]
             update
         }
+        # This test blocked, as gets waits for the accept which did
+        # not run due to missing vwait
+        vwait sok
         lappend x [gets $client]
     } \
     -cleanup {
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 263ef9a..0533ecd 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,7 +47,7 @@
 
 #include "tclWinInt.h"
 
-//#define DEBUGGING
+#define DEBUGGING
 #ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
 			    infoPtr, __FUNCTION__, __LINE__, x)
@@ -768,12 +768,14 @@ SocketEventProc(
     infoPtr->flags &= ~SOCKET_PENDING;
 
     /* Continue async connect if pending and ready */
-    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && (infoPtr->readyEvents & FD_CONNECT) ) {
+    if ( infoPtr->readyEvents & FD_CONNECT ) {
+	infoPtr->readyEvents &= ~(FD_CONNECT);
 	DEBUG("FD_CONNECT");
-	SetEvent(tsdPtr->socketListLock);
-	CreateClientSocket(NULL, infoPtr);
-	return 1;
+        if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
+	    SetEvent(tsdPtr->socketListLock);
+	    CreateClientSocket(NULL, infoPtr);
+	    return 1;
+	}
     }
 
     /*
@@ -1192,8 +1194,6 @@ CreateClientSocket(
 
     if (async_callback) {
 	DEBUG("subsequent call");
-	/* Clear this pending reenter case */
-	infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
         goto reenter;
     } else {
 	DEBUG("first call");
@@ -1242,6 +1242,9 @@ CreateClientSocket(
 		continue;
 	    }
 	    
+#ifdef DEBUGGING
+	    fprintf(stderr, "Client socket %d created\n", infoPtr->sockets->fd);
+#endif
 	    /*
 	     * Win-NT has a misfeature that sockets are inherited in child
 	     * processes by default. Turn off the inherit bit.
@@ -1287,12 +1290,11 @@ CreateClientSocket(
 		    infoPtr->addr->ai_addrlen);
 	    error = WSAGetLastError();
 	    TclWinConvertError(error);
-#ifdef DEBUGGING
-	    // fprintf(stderr,"error = %lu\n", error);
-#endif
-	    if (error == WSAEWOULDBLOCK) {
+	    if (async_connect && error == WSAEWOULDBLOCK) {
 		DEBUG("WSAEWOULDBLOCK");
-		/* Jump out and remember that we want to get back in */
+		/*
+		 * Activate FD_CONNECT notification and reenter jump
+		 */
 		infoPtr->flags |= SOCKET_REENTER_PENDING;
 		return TCL_OK;
 	    reenter:
@@ -1300,6 +1302,11 @@ CreateClientSocket(
 		DEBUG("reenter");
 		infoPtr->selectEvents &= ~(FD_CONNECT);
 	    }
+	    /*
+	     * Clear the reenter flag also for the (hypothetic) case
+	     * that connect did succeed emidiately
+	     */
+	    infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
 #ifdef DEBUGGING
 	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
 #endif
@@ -1311,10 +1318,10 @@ CreateClientSocket(
 
 out:
     DEBUG("connected or finally failed");
+    /* Clear async flag (not really necessary, not used any more) */
+    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
     if (Tcl_GetErrno() != 0 && interp != NULL) {
 	DEBUG("ERRNO");
-        /* Clear async flag so if a read is done it does not block */
-        infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 				"couldn't open socket: %s", Tcl_PosixError(interp)));
@@ -1373,9 +1380,9 @@ WaitForAsyncConnect(
      * returns directly an error
      */
     if (infoPtr->flags & SOCKET_ASYNC) {
-	    *errorCodePtr = EWOULDBLOCK;
-	    return 0;
-	}
+	*errorCodePtr = EWOULDBLOCK;
+	return 0;
+    }
 
     /*
      * Be sure to disable event servicing so we are truly modal.
@@ -1387,21 +1394,15 @@ WaitForAsyncConnect(
      * Disable async connect as we continue now synchoneously
      */
 
-    /* ToDo: need thread protection * */
+    /* ToDo: need thread protection? */
     infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 
-    /*
-     * Reset WSAAsyncSelect so we have a fresh set of events pending.
-     */
-
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
-	    (LPARAM) infoPtr);
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-	    (LPARAM) infoPtr);
-
     while (1) {
 	/* Check for connect event */
 	if (infoPtr->readyEvents & FD_CONNECT) {
+	    /* Consume the connect event */
+	    /* ToDo: eventual signaling ? */
+	    infoPtr->readyEvents &= ~(FD_CONNECT);
 	    /* continue async connect syncroneously */
 	    result = CreateClientSocket(NULL, infoPtr);
 	    (void) Tcl_SetServiceMode(oldMode);
@@ -2745,39 +2746,23 @@ SocketProc(
 
 		    if (event & FD_CONNECT) {
 			DEBUG("FD_CONNECT");
-
-			if (error == ERROR_SUCCESS) {
-			    /*
-			     * The socket is now connected, clear the async connect
-			     * flag.
-			     */
-			    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-			} else {
-			    /*
-			     * Remember any error that occurred so we can report
-			     * connection failures.
-			     */
-			    TclWinConvertError((DWORD) error);
-			    infoPtr->lastError = Tcl_GetErrno();
-			}
-		    }
-#if 0
-		    if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
-			DEBUG("SOCKET_ASYNC_CONNECT");
-			// infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+			/*
+			 * Remember any error that occurred so we can report
+			 * connection failures.
+			 */
 			if (error != ERROR_SUCCESS) {
 			    TclWinConvertError((DWORD) error);
 			    infoPtr->lastError = Tcl_GetErrno();
 			}
-			infoPtr->readyEvents |= FD_WRITE;
 		    }
-#endif
+		    /*
+		     * Inform main thread about signaled events
+		     */
 		    infoPtr->readyEvents |= event;
 
 		    /*
 		     * Wake up the Main Thread.
 		     */
-
 		    SetEvent(tsdPtr->readyEvent);
 		    Tcl_ThreadAlert(tsdPtr->threadId);
 		    break;
@@ -2788,10 +2773,12 @@ SocketProc(
 	break;
 
     case SOCKET_SELECT:
-	    DEBUG("SOCKET_SELECT");
+	DEBUG("SOCKET_SELECT");
 	infoPtr = (SocketInfo *) lParam;
 	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
-	    infoPtr = (SocketInfo *) lParam;
+#ifdef DEBUGGING
+	    fprintf(stderr,"loop over fd = %d\n",fds->fd);
+#endif
 	    if (wParam == SELECT) {
 		DEBUG("SELECT");
 		if (infoPtr->selectEvents & FD_READ) DEBUG("  READ");
-- 
cgit v0.12


From bc91d5aa1ef2be26a0f1a6d3de3fb05724964afe Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 7 Mar 2014 07:40:30 +0000
Subject: Still incomplete info structure in event proc: try to protect with
 locks (unsuccesful). Probably locks in accept socket creation missing.

---
 win/tclWinSock.c | 63 +++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 51 insertions(+), 12 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 0533ecd..62d4073 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1151,6 +1151,12 @@ NewSocketInfo(SOCKET socket)
  *
  *	This function opens a new socket in client mode.
  *
+ *	This might be called in 3 circumstances:
+ *	-   By a regular socket command
+ *	-   By the event handler to continue an asynchroneous connect
+ *	-   By a blocking socket function (gets/puts) to terminate the
+ *	    connect synchroneously
+ *
  * Results:
  *      TCL_OK, if the socket was successfully connected or an asynchronous
  *      connection is in progress. If an error occurs, TCL_ERROR is returned
@@ -1179,6 +1185,7 @@ CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
     SocketInfo *infoPtr)
 {
+    DWORD error;
     u_long flag = 1;		/* Indicates nonblocking mode. */
     /*
      * We are started with async connect and the connect notification
@@ -1187,8 +1194,7 @@ CreateClientSocket(
     int async_connect = infoPtr->flags & SOCKET_ASYNC_CONNECT;
     /* We were called by the event procedure and continue our loop */
     int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
-    ThreadSpecificData *tsdPtr;
-    DWORD error;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
     
     DEBUG(async_connect ? "async connect" : "sync connect");
 
@@ -1230,12 +1236,20 @@ CreateClientSocket(
 		closesocket(infoPtr->sockets->fd);
 	    }
 
+	    /* get infoPtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
 	    /*
 	     * Reset last error from last try
 	     */
 	    infoPtr->lastError = 0;
 	    
 	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
+	    
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
+
+	    /* continue on socket creation error */
 	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
 		DEBUG("socket() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
@@ -1273,12 +1287,21 @@ CreateClientSocket(
 	     * be done in the background.
 	     */
 	    if (async_connect) {
-		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		/* get infoPtr lock */
+		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
+		/* Now get connect events */
 		infoPtr->selectEvents |= FD_CONNECT;
 
-		ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		/* Free list lock */
+		SetEvent(tsdPtr->socketListLock);
+
+		// ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 			    (LPARAM) infoPtr);
+	    } else {
+		/* Free list lock */
+		SetEvent(tsdPtr->socketListLock);
 	    }
 
 	    /*
@@ -1300,7 +1323,11 @@ CreateClientSocket(
 	    reenter:
 		Tcl_SetErrno(infoPtr->lastError);
 		DEBUG("reenter");
+		/* get infoPtr lock */
+		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 		infoPtr->selectEvents &= ~(FD_CONNECT);
+		/* Free list lock */
+		SetEvent(tsdPtr->socketListLock);
 	    }
 	    /*
 	     * Clear the reenter flag also for the (hypothetic) case
@@ -1390,27 +1417,39 @@ WaitForAsyncConnect(
 
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
 
-    /*
-     * Disable async connect as we continue now synchoneously
-     */
-
-    /* ToDo: need thread protection? */
-    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-
     while (1) {
+	
+	/* get infoPtr lock */
+        WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	
 	/* Check for connect event */
 	if (infoPtr->readyEvents & FD_CONNECT) {
+
 	    /* Consume the connect event */
-	    /* ToDo: eventual signaling ? */
 	    infoPtr->readyEvents &= ~(FD_CONNECT);
+
+	    /*
+	     * Disable async connect as we continue now synchoneously
+	     */
+	    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
+            /* Free list lock */
+            SetEvent(tsdPtr->socketListLock);
+
 	    /* continue async connect syncroneously */
 	    result = CreateClientSocket(NULL, infoPtr);
+
+	    /* Restore event service mode */
 	    (void) Tcl_SetServiceMode(oldMode);
+
 	    /* Todo: find adequate error code */
 	    *errorCodePtr = EFAULT;
 	    return (result == TCL_OK);
 	}
 
+        /* Free list lock */
+        SetEvent(tsdPtr->socketListLock);
+
 	/*
 	 * Wait until something happens.
 	 */
-- 
cgit v0.12


From a895183137cb5e741f92353116465a9e27c432e4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 7 Mar 2014 19:43:16 +0000
Subject: Simplify the input eof char scan.  Update some comments.

---
 generic/tclIO.c | 64 +++++++++++++++++++++++++++++----------------------------
 1 file changed, 33 insertions(+), 31 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b0d0e32..03aac32 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5244,7 +5244,11 @@ ReadChars(
 				 * is larger than the number of characters
 				 * available in the first buffer, only the
 				 * characters from the first buffer are
-				 * returned. */
+				 * returned. The execption is when there is
+				 * not any complete character in the first
+				 * buffer.  In that case, a recursive call
+				 * effectively obtains chars from the
+				 * second buffer. */
     int *factorPtr)		/* On input, contains a guess of how many
 				 * bytes need to be allocated to hold the
 				 * result of converting N source bytes to
@@ -5259,6 +5263,15 @@ ReadChars(
     int savedFlags = statePtr->flags;
     char *dst, *src = RemovePoint(bufPtr);
     int dstLimit, numBytes, srcLen = BytesLeft(bufPtr);
+
+    /*
+     * One src byte can yield at most one character.  So when the
+     * number of src bytes we plan to read is less than the limit on
+     * character count to be read, clearly we will remain within that
+     * limit, and we can use the value of "srcLen" as a tighter limit
+     * for sizing receiving buffers.
+     */
+
     int toRead = ((unsigned) charsToRead > srcLen) ? srcLen : charsToRead;
 
     /*
@@ -5569,43 +5582,32 @@ TranslateInputEOL(
 				 * characters. */
     const char *srcStart,	/* Source characters. */
     int *dstLenPtr,		/* On entry, the maximum length of output
-				 * buffer in bytes; must be <= *srcLenPtr. On
-				 * exit, the number of bytes actually used in
-				 * output buffer. */
+				 * buffer in bytes. On exit, the number of
+				 * bytes actually used in output buffer. */
     int *srcLenPtr)		/* On entry, the length of source buffer. On
 				 * exit, the number of bytes read from the
 				 * source buffer. */
 {
-    int dstLen, srcLen, inEofChar;
-    const char *eof;
+    const char *eof = NULL;
+    int dstLen = *dstLenPtr;
+    int srcLen = *srcLenPtr;
+    int inEofChar = statePtr->inEofChar;
 
-    dstLen = *dstLenPtr;
-
-    eof = NULL;
-    inEofChar = statePtr->inEofChar;
     if (inEofChar != '\0') {
 	/*
-	 * Find EOF in translated buffer then compress out the EOL. The source
-	 * buffer may be much longer than the destination buffer - we only
-	 * want to return EOF if the EOF has been copied to the destination
-	 * buffer.
+	 * Make sure we do not read past any logical end of channel input
+	 * created by the presence of the input eof char.
 	 */
 
-	const char *src, *srcMax;
-
-	srcMax = srcStart + *srcLenPtr;
-	for (src = srcStart; src < srcMax; src++) {
-	    if (*src == inEofChar) {
-		eof = src;
-		srcLen = src - srcStart;
-		if (srcLen < dstLen) {
-		    dstLen = srcLen;
-		}
-		*srcLenPtr = srcLen;
-		break;
-	    }
+	if ((eof = memchr(srcStart, inEofChar, srcLen))) {
+	    srcLen = eof - srcStart;
 	}
     }
+
+    if (dstLen > srcLen) {
+	dstLen = srcLen;
+    }
+
     switch (statePtr->inputTranslation) {
     case TCL_TRANSLATE_LF:
 	if (dstStart != srcStart) {
@@ -5635,7 +5637,7 @@ TranslateInputEOL(
 	dst = dstStart;
 	src = srcStart;
 	srcEnd = srcStart + dstLen;
-	srcMax = srcStart + *srcLenPtr;
+	srcMax = srcStart + srcLen;
 
 	for ( ; src < srcEnd; ) {
 	    if (*src == '\r') {
@@ -5663,7 +5665,7 @@ TranslateInputEOL(
 	dst = dstStart;
 	src = srcStart;
 	srcEnd = srcStart + dstLen;
-	srcMax = srcStart + *srcLenPtr;
+	srcMax = srcStart + srcLen;
 
 	if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
 	    if (*src == '\n') {
@@ -5692,9 +5694,10 @@ TranslateInputEOL(
 	break;
     }
     default:
-	return 0;
+	Tcl_Panic("unknown input translation %d", statePtr->inputTranslation);
     }
     *dstLenPtr = dstLen;
+    *srcLenPtr = srcLen;
 
     if ((eof != NULL) && (srcStart + srcLen >= eof)) {
 	/*
@@ -5709,7 +5712,6 @@ TranslateInputEOL(
 	return 1;
     }
 
-    *srcLenPtr = srcLen;
     return 0;
 }
 
-- 
cgit v0.12


From 83f5493faa96da87b5327be1f49e432f5a870879 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 7 Mar 2014 20:15:12 +0000
Subject: TranslateInputEOL() callers no longer need assert dstLen <= srcLen.

---
 generic/tclIO.c | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 03aac32..d23ca03 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5330,7 +5330,8 @@ ReadChars(
 	 * Capture the number of bytes actually consumed in dstRead.
 	 */
 
-	dstWrote = dstRead = dstDecoded;
+	dstWrote = dstLimit;
+	dstRead = dstDecoded;
 	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
 
 	if (dstRead < dstDecoded) {
@@ -8852,14 +8853,11 @@ CopyAndTranslateBuffer(
     }
     bufPtr = statePtr->inQueueHead;
     bytesInBuffer = BytesLeft(bufPtr);
+    if (bytesInBuffer == 0) {
+	return 0;
+    }
 
     copied = space;
-    if (bytesInBuffer <= copied) {
-	copied = bytesInBuffer;
-    }
-    if (copied == 0) {
-	return copied;
-    }
     TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
 	    &copied, &bytesInBuffer);
     bufPtr->nextRemoved += bytesInBuffer;
-- 
cgit v0.12


From 85ef4165965dd5e25ccfb0e01ac2d1cf4b3df7aa Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 9 Mar 2014 21:55:51 +0000
Subject: Mark io-35.18b test as knownBug

---
 tests/io.test | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/tests/io.test b/tests/io.test
index 64c878d..4791280 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4701,7 +4701,7 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
     close $f
     list $c $l $e
 } {21 8 1}
-test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} {
+test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr
@@ -4714,8 +4714,8 @@ test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {8 8 1 13}
-test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} {
+} -result {8 8 1 13}
+test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar \x1a
@@ -4728,8 +4728,8 @@ test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {9 8 1 13}
-test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} {
+} -result {9 8 1 13}
+test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -constraints knownBug -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar \x1a
@@ -4742,8 +4742,8 @@ test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {2 1 1 13}
-test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} {
+} -result {2 1 1 13}
+test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr
@@ -4756,8 +4756,8 @@ test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {1 1 1 13}
-test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} {
+} -result {1 1 1 13}
+test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar {}
@@ -4771,7 +4771,7 @@ test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $c $l $e [scan [string index $in end] %c]
-} {17 8 1 13}
+} -result {17 8 1 13}
 
 # Test Tcl_InputBlocked
 
-- 
cgit v0.12


From 62268820f73d797eebfc2a66ed3fa856c27daeb7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 03:09:03 +0000
Subject: TranslateInputEOL doesn't need to return anything.  No caller cares.
 Other optimizations and simplifications.

---
 generic/tclIO.c | 79 +++++++++++++++++++++++++++++++--------------------------
 1 file changed, 43 insertions(+), 36 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index d23ca03..6dfdd03 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -214,7 +214,7 @@ static int		StackSetBlockMode(Channel *chanPtr, int mode);
 static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
 			    int mode);
 static void		StopCopy(CopyState *csPtr);
-static int		TranslateInputEOL(ChannelState *statePtr, char *dst,
+static void		TranslateInputEOL(ChannelState *statePtr, char *dst,
 			    const char *src, int *dstLenPtr, int *srcLenPtr);
 static void		UpdateInterest(Channel *chanPtr);
 static int		Write(Channel *chanPtr, const char *src,
@@ -5574,7 +5574,7 @@ ReadChars(
  *---------------------------------------------------------------------------
  */
 
-static int
+static void 
 TranslateInputEOL(
     ChannelState *statePtr,	/* Channel being read, for EOL translation and
 				 * EOF character. */
@@ -5594,6 +5594,29 @@ TranslateInputEOL(
     int srcLen = *srcLenPtr;
     int inEofChar = statePtr->inEofChar;
 
+    /*
+     * Depending on the translation mode in use, there's no need
+     * to scan more srcLen bytes at srcStart than can possibly transform
+     * to dstLen bytes.  This keeps the scan for eof char below from
+     * being pointlessly long.
+     */
+
+    switch (statePtr->inputTranslation) {
+    case TCL_TRANSLATE_LF:
+    case TCL_TRANSLATE_CR:
+	if (srcLen > dstLen) {
+	/* In these modes, each src byte become a dst byte. */
+	    srcLen = dstLen;
+	}
+	break;
+    default:
+	/* In other modes, at most 2 src bytes become a dst byte. */
+	if (srcLen > 2 * dstLen) {
+	    srcLen = 2 * dstLen;
+	}
+	break;
+    }
+
     if (inEofChar != '\0') {
 	/*
 	 * Make sure we do not read past any logical end of channel input
@@ -5605,36 +5628,29 @@ TranslateInputEOL(
 	}
     }
 
-    if (dstLen > srcLen) {
-	dstLen = srcLen;
-    }
-
     switch (statePtr->inputTranslation) {
     case TCL_TRANSLATE_LF:
+    case TCL_TRANSLATE_CR:
 	if (dstStart != srcStart) {
-	    memcpy(dstStart, srcStart, (size_t) dstLen);
+	    memcpy(dstStart, srcStart, (size_t) srcLen);
 	}
-	srcLen = dstLen;
-	break;
-    case TCL_TRANSLATE_CR: {
-	char *dst, *dstEnd;
+	if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+	    char *dst = dstStart;
+	    char *dstEnd = dstStart + srcLen;
 
-	if (dstStart != srcStart) {
-	    memcpy(dstStart, srcStart, (size_t) dstLen);
-	}
-	dstEnd = dstStart + dstLen;
-	for (dst = dstStart; dst < dstEnd; dst++) {
-	    if (*dst == '\r') {
-		*dst = '\n';
+	    while ((dst = memchr(dst, '\r', dstEnd - dst))) {
+		*dst++ = '\n';
 	    }
 	}
-	srcLen = dstLen;
+	dstLen = srcLen;
 	break;
-    }
     case TCL_TRANSLATE_CRLF: {
 	char *dst;
 	const char *src, *srcEnd, *srcMax;
 
+    if (dstLen > srcLen) {
+	dstLen = srcLen;
+    }
 	dst = dstStart;
 	src = srcStart;
 	srcEnd = srcStart + dstLen;
@@ -5660,29 +5676,23 @@ TranslateInputEOL(
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
-	char *dst;
-	const char *src, *srcEnd, *srcMax;
+	const char *srcEnd = srcStart + srcLen;
+	const char *dstEnd = dstStart + dstLen;
+	const char *src = srcStart;
+	char *dst = dstStart;
 
-	dst = dstStart;
-	src = srcStart;
-	srcEnd = srcStart + dstLen;
-	srcMax = srcStart + srcLen;
-
-	if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
 	    if (*src == '\n') {
 		src++;
 	    }
 	    ResetFlag(statePtr, INPUT_SAW_CR);
 	}
-	for ( ; src < srcEnd; ) {
+	for ( ; dst < dstEnd && src < srcEnd; ) {
 	    if (*src == '\r') {
 		src++;
-		if (src >= srcMax) {
+		if (src == srcEnd) {
 		    SetFlag(statePtr, INPUT_SAW_CR);
 		} else if (*src == '\n') {
-		    if (srcEnd < srcMax) {
-			srcEnd++;
-		    }
 		    src++;
 		}
 		*dst++ = '\n';
@@ -5710,10 +5720,7 @@ TranslateInputEOL(
 	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	ResetFlag(statePtr, INPUT_SAW_CR);
-	return 1;
     }
-
-    return 0;
 }
 
 /*
-- 
cgit v0.12


From 3c84887dc4fac9f47f2c1b5521c6d889ab6f9dc1 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Mon, 10 Mar 2014 12:08:44 +0000
Subject:   *  tclUnixSock.c: Fix WaitForConnect() for client sockets that have
 to try more than one address.   *  socket.test: Extend and improve tests for
 [socket -async]   *  socket.test: Add latency measuring and calculation for
 Windows.

---
 tests/socket.test  | 199 +++++++++++++++++++++++++++++++++++++++++++++++------
 unix/tclUnixSock.c |  20 +++---
 2 files changed, 190 insertions(+), 29 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 74c44ce..bfe6990 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -86,8 +86,21 @@ puts $s2 test1; gets $s1
 puts $s2 test2; gets $s1
 close $s1; close $s2
 set t2 [clock milliseconds]
-set latency [expr {($t2-$t1)*2}]; # doubled as a safety margin
-unset t1 t2 s1 s2 server
+set lat1 [expr {($t2-$t1)*2}]; # doubled as a safety margin
+
+# Test the latency of failed connection attempts over the loopback
+# interface. They can take more than a second under Windowos and requres
+# additional [after]s in some tests that are not needed on systems that fail
+# immediately.
+set t1 [clock milliseconds]
+catch {socket 127.0.0.1 [randport]}
+set t2 [clock milliseconds]
+set lat2 [expr {($t2-$t1)*2}]
+
+# Use the maximum of the two latency calculations, but at least 100ms
+set latency [expr {$lat1 > $lat2 ? $lat1 : $lat2}]
+set latency [expr {$latency > 100 ? $latency : 100}]
+unset t1 t2 s1 s2 lat1 lat2 server
 
 # If remoteServerIP or remoteServerPort are not set, check in the environment
 # variables for externally set values.
@@ -1723,7 +1736,7 @@ catch {close $commandSocket}
 catch {close $remoteProcChan}
 }
 unset ::tcl::unsupported::socketAF
-test socket-14.0 {[socket -async] when server only listens on IPv4} \
+test socket-14.0.0 {[socket -async] when server only listens on IPv4} \
     -constraints [list socket supported_any localhost_v4] \
     -setup {
         proc accept {s a p} {
@@ -1736,7 +1749,29 @@ test socket-14.0 {[socket -async] when server only listens on IPv4} \
         set port [lindex [fconfigure $server -sockname] 2]
     } -body {
         set client [socket -async localhost $port]
-        set after [after 1000 {set x [fconfigure $client -error]}]
+        set after [after $latency {set x [fconfigure $client -error]}]
+        vwait x
+        set x
+    } -cleanup {
+        after cancel $after
+        close $server
+        close $client
+        unset x
+    } -result ok
+test socket-14.0.1 {[socket -async] when server only listens on IPv6} \
+    -constraints [list socket supported_any localhost_v4] \
+    -setup {
+        proc accept {s a p} {
+            global x
+            puts $s bye
+            close $s
+            set x ok
+        }
+        set server [socket -server accept -myaddr ::1 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+    } -body {
+        set client [socket -async localhost $port]
+        set after [after $latency {set x [fconfigure $client -error]}]
         vwait x
         set x
     } -cleanup {
@@ -1763,7 +1798,7 @@ test socket-14.1 {[socket -async] fileevent while still connecting} \
             lappend x [fconfigure $client -error]
 	    fileevent $client writable {}
         }
-        set after [after 1000 {lappend x timeout}]
+        set after [after $latency {lappend x timeout}]
         while {[llength $x] < 2 && "timeout" ni $x} {
             vwait x
         }
@@ -1781,7 +1816,7 @@ test socket-14.2 {[socket -async] fileevent connection refused} \
 	    regexp {[^:]*: (.*)} $client -> x
 	} else {
             fileevent $client writable {set x [fconfigure $client -error]}
-            set after [after 1000 {set x timeout}]
+            set after [after $latency {set x timeout}]
             vwait x
 	    after cancel $after
             if {$x eq "timeout"} {
@@ -1806,7 +1841,7 @@ test socket-14.3 {[socket -async] when server only listens on IPv6} \
         set port [lindex [fconfigure $server -sockname] 2]
     } -body {
         set client [socket -async localhost $port]
-        set after [after 1000 {set x [fconfigure $client -error]}]
+        set after [after $latency {set x [fconfigure $client -error]}]
         vwait x
         set x
     } -cleanup {
@@ -1832,7 +1867,7 @@ test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
             fileevent $client writable {}
         }
         fileevent $client readable {lappend x [gets $client]}
-        set after [after 1000 {lappend x timeout}]
+        set after [after $latency {lappend x timeout}]
         while {[llength $x] < 2 && "timeout" ni $x} {
             vwait x
         }
@@ -1851,38 +1886,162 @@ test socket-14.5 {[socket -async] which fails before any connect() can be made}
     } \
     -returnCodes 1 \
     -result {couldn't open socket: cannot assign requested address}
-test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] before the socket is connected} \
+test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} \
     -constraints [list socket supported_inet supported_inet6] \
     -setup {
         proc accept {s a p} {
-            global s
+            global x
             puts $s bye
             close $s
-            set s ok
+            set x ok
         }
         set server [socket -server accept -myaddr 127.0.0.1 0]
         set port [lindex [fconfigure $server -sockname] 2]
         set x ""
-        set s ""
     } \
     -body {
         set client [socket -async localhost $port]
-        foreach _ {1 2} {
-            lappend x [lindex [fconfigure $client -sockname] 0]
-            lappend x [fconfigure $client -error]
+        for {set i 0} {$i < 50} {incr i } {
             update
+            if {$x ne ""} {
+                lappend x [gets $client]
+                break
+            }
+            after 100
         }
-        # This test blocked, as gets waits for the accept which did
-        # not run due to missing vwait
-        vwait sok
-        lappend x [gets $client]
+        set x
     } \
     -cleanup {
         close $server
         close $client
         unset x
     } \
-    -result [list ::1 "connection refused" 127.0.0.1 "" bye]
+    -result {ok bye}
+test socket-14.6.1 {[socket -async] with no event loop and server listening on IPv6} \
+    -constraints [list socket supported_inet supported_inet6] \
+    -setup {
+        proc accept {s a p} {
+            global x
+            puts $s bye
+            close $s
+            set x ok
+        }
+        set server [socket -server accept -myaddr ::1 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+        set x ""
+    } \
+    -body {
+        set client [socket -async localhost $port]
+        for {set i 0} {$i < 50} {incr i } {
+            update
+            if {$x ne ""} {
+                lappend x [gets $client]
+                break
+            }
+            after 100
+        }
+        set x
+    } \
+    -cleanup {
+        close $server
+        close $client
+        unset x
+    } \
+    -result {ok bye}
+test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr 127.0.0.1 0]
+            proc accept {s h p} {puts $s ok; close $s; set ::x 1}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        gets $sock
+    } -cleanup {
+        # make sure the server exits
+        catch {socket 127.0.0.1 $port}
+        close $sock
+        close $fd
+    } -result {ok}
+test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr ::1 0]
+            proc accept {s h p} {puts $s ok; close $s; set ::x 1}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        gets $sock
+    } -cleanup {
+        # make sure the server exits
+        catch {socket ::1 $port}
+        close $sock
+        close $fd
+    } -result {ok}
+test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr 127.0.0.1 0]
+            proc accept {s h p} {puts $s ok; close $s; set ::x 1}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        fconfigure $sock -blocking 0
+        for {set i 0} {$i < 50} {incr i } {
+            if {[set x [gets $sock]] ne ""} break
+            after 200
+        }
+        set x
+    } -cleanup {
+        # make sure the server exits
+        catch {socket 127.0.0.1 $port}
+        close $sock
+        close $fd
+    } -result {ok}
+test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IPv6} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr ::1 0]
+            proc accept {s h p} {puts $s ok; close $s; set ::x 1}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        fconfigure $sock -blocking 0
+        for {set i 0} {$i < 50} {incr i } {
+            if {[set x [gets $sock]] ne ""} break
+            after 200
+        }
+        set x
+    } -cleanup {
+        # make sure the server exits
+        catch {socket ::1 $port}
+        close $sock
+        close $fd
+    } -result {ok}
 
 ::tcltest::cleanupTests
 flush stdout
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index c866903..41d729e 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -163,6 +163,8 @@ static TclInitProcessGlobalValueProc InitializeHostName;
 static ProcessGlobalValue hostName =
 	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
 
+#if 0
+/* printf debugging */
 void printaddrinfo(struct addrinfo *addrlist, char *prefix)
 {
     char host[NI_MAXHOST], port[NI_MAXSERV];
@@ -175,6 +177,7 @@ void printaddrinfo(struct addrinfo *addrlist, char *prefix)
 	fprintf(stderr,"%s: %s:%s\n", prefix, host, port);
     }
 }
+#endif
 /*
  *----------------------------------------------------------------------
  *
@@ -409,18 +412,20 @@ WaitForConnect(
 	    timeOut = 0;
 	} else {
 	    timeOut = -1;
+	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
 	}
 	errno = 0;
 	state = TclUnixWaitForFile(statePtr->fds.fd,
 		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-	if (state & TCL_EXCEPTION) {
-	    return -1;
-	}
-	if (state & TCL_WRITABLE) {
-	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
-	} else if (timeOut == 0) {
+        CreateClientSocket(NULL, statePtr);
+        if (statePtr->flags & TCP_ASYNC_CONNECT) {
+            /* We are still in progress, so ignore the result of the last
+             * attempt */
 	    *errorCodePtr = errno = EWOULDBLOCK;
 	    return -1;
+        }
+	if (state & TCL_EXCEPTION) {
+	    return -1;
 	}
     }
     return 0;
@@ -1172,9 +1177,6 @@ Tcl_OpenTcpClient(
         return NULL;
     }
 
-    printaddrinfo(myaddrlist, "local");
-    printaddrinfo(addrlist, "remote");
-
     /*
      * Allocate a new TcpState for this socket.
      */
-- 
cgit v0.12


From 18bf8d8c83fcdf19f769fb12de0c53931f640f81 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 10 Mar 2014 14:36:38 +0000
Subject: Workaround if FD_CONNECT notification comes before socket list
 registration in TcpThreadActionProc

---
 win/tclWinSock.c | 264 ++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 184 insertions(+), 80 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 62d4073..a3a770f 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,8 +47,8 @@
 
 #include "tclWinInt.h"
 
-#define DEBUGGING
-#ifdef DEBUGGING
+//#define DEBUGGING
+//#ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
 			    infoPtr, __FUNCTION__, __LINE__, x)
 #else
@@ -220,6 +220,10 @@ typedef struct {
 				 * socketThread has been initialized and has
 				 * started. */
     HANDLE socketListLock;	/* Win32 Event to lock the socketList */
+    SocketInfo *pendingSocketInfo;
+				/* This socket is opened but not jet in the
+				 * list. This value is also checked by
+				 * the event structure. */
     SocketInfo *socketList;	/* Every open socket in this thread has an
 				 * entry on this list. */
 } ThreadSpecificData;
@@ -239,9 +243,10 @@ static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
 			    LPARAM lParam);
 static int		SocketsEnabled(void);
 static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
-static int		WaitForAsyncConnect(SocketInfo *infoPtr, int *errorCodePtr);
+static int		WaitForConnect(SocketInfo *infoPtr, int *errorCodePtr);
 static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
 			    int *errorCodePtr);
+static int		FindFDInList(SocketInfo *infoPtr, SOCKET socket);
 static DWORD WINAPI	SocketThread(LPVOID arg);
 static void		TcpThreadActionProc(ClientData instanceData,
 			    int action);
@@ -398,6 +403,7 @@ InitSockets(void)
      */
 
     tsdPtr = TCL_TSD_INIT(&dataKey);
+    tsdPtr->pendingSocketInfo = NULL;
     tsdPtr->socketList = NULL;
     tsdPtr->hwnd       = NULL;
     tsdPtr->threadId   = Tcl_GetCurrentThread();
@@ -687,12 +693,12 @@ SocketCheckProc(
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
-    DEBUG("A");
+	DEBUG("Socket loop");
 	if ((infoPtr->readyEvents &
 		(infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT))
 	    && !(infoPtr->flags & SOCKET_PENDING)
 	) {
-    DEBUG("B");
+	    DEBUG("Event found");
 	    infoPtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
 	    evPtr->header.proc = SocketEventProc;
@@ -1283,25 +1289,49 @@ CreateClientSocket(
 		continue;
 	    }
 	    /*
-	     * Set the socket into nonblocking mode if the connect should
-	     * be done in the background.
+	     * For asyncroneous connect set the socket in nonblocking mode
+	     * and activate connect notification
 	     */
 	    if (async_connect) {
+		SocketInfo *infoPtr2;
+		int in_socket_list = 0;
 		/* get infoPtr lock */
 		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
-		/* Now get connect events */
-		infoPtr->selectEvents |= FD_CONNECT;
+		/*
+		 * Check if my infoPtr is already in the tsdPtr->socketList
+		 * It is set after this call by TcpThreadActionProc and is set
+		 * on a second round.
+		 *
+		 * If not, we buffer my infoPtr in the tsd memory so it is not
+		 * lost by the event procedure
+		 */
 
-		/* Free list lock */
+		for (infoPtr2 = tsdPtr->socketList; infoPtr2 != NULL;
+			infoPtr2 = infoPtr->nextPtr) {
+		    if (infoPtr2 == infoPtr) {
+			in_socket_list = 1;
+			break;
+		    }
+		}
+		if (!in_socket_list) {
+		    tsdPtr->pendingSocketInfo = infoPtr;
+		}
+		/*
+		 * Set connect mask to connect events
+		 * This is activated by a SOCKET_SELECT message to the notifier
+		 * thread.
+		 */
+		infoPtr->selectEvents |= FD_CONNECT;
+		
+		/*
+		 * Free list lock
+		 */
 		SetEvent(tsdPtr->socketListLock);
 
-		// ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+    		/* activate accept notification */
 		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-			    (LPARAM) infoPtr);
-	    } else {
-		/* Free list lock */
-		SetEvent(tsdPtr->socketListLock);
+			(LPARAM) infoPtr);
 	    }
 
 	    /*
@@ -1311,29 +1341,41 @@ CreateClientSocket(
 	    DEBUG("connect()");
 	    connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
 		    infoPtr->addr->ai_addrlen);
+
 	    error = WSAGetLastError();
 	    TclWinConvertError(error);
+
 	    if (async_connect && error == WSAEWOULDBLOCK) {
+		/*
+		 * Asynchroneous connect
+		 */
 		DEBUG("WSAEWOULDBLOCK");
+
+
 		/*
-		 * Activate FD_CONNECT notification and reenter jump
+		 * Remember that we jump back behind this next round
 		 */
 		infoPtr->flags |= SOCKET_REENTER_PENDING;
 		return TCL_OK;
+
 	    reenter:
-		Tcl_SetErrno(infoPtr->lastError);
 		DEBUG("reenter");
+		/*
+		 * Re-entry point for async connect after connect event or
+		 * blocking operation
+		 *
+		 * Clear the reenter flag
+		 */
+		infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
 		/* get infoPtr lock */
 		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+		/* Get signaled connect error */
+		Tcl_SetErrno(infoPtr->lastError);
+		/* Clear eventual connect flag */
 		infoPtr->selectEvents &= ~(FD_CONNECT);
 		/* Free list lock */
 		SetEvent(tsdPtr->socketListLock);
 	    }
-	    /*
-	     * Clear the reenter flag also for the (hypothetic) case
-	     * that connect did succeed emidiately
-	     */
-	    infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
 #ifdef DEBUGGING
 	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
 #endif
@@ -1379,13 +1421,13 @@ out:
 /*
  *----------------------------------------------------------------------
  *
- * WaitForAsyncConnect --
+ * WaitForConnect --
  *
  *	Terminate an asyncroneous connect syncroneously.
  *	This routine should only be called if flag ASYNC_CONNECT is set.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with an error code in
+ *	Returns -1 on success or 0 on failure, with an error code in
  *	errorCodePtr.
  *
  * Side effects:
@@ -1395,11 +1437,11 @@ out:
  */
 
 static int
-WaitForAsyncConnect(
+WaitForConnect(
     SocketInfo *infoPtr,	/* Information about this socket. */
     int *errorCodePtr)		/* Where to store errors? */
 {
-    int result = 1;
+    int result;
     int oldMode;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
     /*
@@ -2001,7 +2043,7 @@ TcpInputProc(
      */
 
     if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForAsyncConnect(infoPtr, errorCodePtr)) {
+	    && !WaitForConnect(infoPtr, errorCodePtr)) {
 	return -1;
     }
 
@@ -2129,7 +2171,7 @@ TcpOutputProc(
      */
 
     if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForAsyncConnect(infoPtr, errorCodePtr)) {
+	    && !WaitForConnect(infoPtr, errorCodePtr)) {
 	return -1;
     }
 
@@ -2708,6 +2750,7 @@ SocketProc(
     int event, error;
     SOCKET socket;
     SocketInfo *infoPtr = NULL; /* DEBUG */
+    int info_found = 0;
     TcpFdList *fds = NULL;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 #ifdef _WIN64
@@ -2745,68 +2788,88 @@ SocketProc(
 	error = WSAGETSELECTERROR(lParam);
 	socket = (SOCKET) wParam;
 
+        #ifdef DEBUGGING
+	fprintf(stderr,"event = %d, error=%d\n",event,error);
+	#endif
+	if (event & FD_READ) DEBUG("READ Event");
+	if (event & FD_WRITE) DEBUG("WRITE Event");
+	if (event & FD_CLOSE) DEBUG("CLOSE Event");
+	if (event & FD_CONNECT)
+	    DEBUG("CONNECT Event");
+	if (event & FD_ACCEPT) DEBUG("ACCEPT Event");
+
+	DEBUG("Get list lock");
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
 	/*
 	 * Find the specified socket on the socket list and update its
 	 * eventState flag.
 	 */
 
-	DEBUG("FOO");
-	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	DEBUG("BAR");
 	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 		infoPtr = infoPtr->nextPtr) {
-	    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
-#ifdef DEBUGGING
-		fprintf(stderr,"socket = %d, fd=%d, event = %d, error = %d\n",
-			socket, fds->fd, event, error);
-#endif
-		if (fds->fd == socket) {
-		    if (event & FD_READ) 
-			DEBUG("|->FD_READ");
-		    if (event & FD_WRITE) 
-			DEBUG("|->FD_WRITE");
-
-		    /*
-		     * Update the socket state.
-		     *
-		     * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
-		     * happens, then clear the FD_ACCEPT count. Otherwise,
-		     * increment the count if the current event is an FD_ACCEPT.
-		     */
-
-		    if (event & FD_CLOSE) {
-			DEBUG("FD_CLOSE");
-			infoPtr->acceptEventCount = 0;
-			infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
-		    } else if (event & FD_ACCEPT) {
-			DEBUG("FD_ACCEPT");
-			    infoPtr->acceptEventCount++;
-		    }
+    	    DEBUG("Cur InfoPtr");
+    	    if ( FindFDInList(infoPtr,socket) ) {
+    		info_found = 1;
+    		DEBUG("InfoPtr found");
+    		break;
+    	    }
+    	}
+    	/*
+    	 * Check if there is a pending info structure not jet in the
+    	 * list
+    	 */
+    	if ( !info_found
+    		&& tsdPtr->pendingSocketInfo != NULL
+    		&& FindFDInList(tsdPtr->pendingSocketInfo,socket) ) {
+    	    infoPtr = tsdPtr->pendingSocketInfo;
+    	    DEBUG("Pending InfoPtr found");
+    	    info_found = 1;
+    	}
+    	if (info_found) {
+	    if (event & FD_READ) 
+		DEBUG("|->FD_READ");
+	    if (event & FD_WRITE) 
+		DEBUG("|->FD_WRITE");
 
-		    if (event & FD_CONNECT) {
-			DEBUG("FD_CONNECT");
-			/*
-			 * Remember any error that occurred so we can report
-			 * connection failures.
-			 */
-			if (error != ERROR_SUCCESS) {
-			    TclWinConvertError((DWORD) error);
-			    infoPtr->lastError = Tcl_GetErrno();
-			}
-		    }
-		    /*
-		     * Inform main thread about signaled events
-		     */
-		    infoPtr->readyEvents |= event;
-
-		    /*
-		     * Wake up the Main Thread.
-		     */
-		    SetEvent(tsdPtr->readyEvent);
-		    Tcl_ThreadAlert(tsdPtr->threadId);
-		    break;
+	    /*
+	     * Update the socket state.
+	     *
+	     * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
+	     * happens, then clear the FD_ACCEPT count. Otherwise,
+	     * increment the count if the current event is an FD_ACCEPT.
+	     */
+
+	    if (event & FD_CLOSE) {
+		DEBUG("FD_CLOSE");
+		infoPtr->acceptEventCount = 0;
+		infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+	    } else if (event & FD_ACCEPT) {
+		DEBUG("FD_ACCEPT");
+		    infoPtr->acceptEventCount++;
+	    }
+
+	    if (event & FD_CONNECT) {
+		DEBUG("FD_CONNECT");
+		/*
+		 * Remember any error that occurred so we can report
+		 * connection failures.
+		 */
+		if (error != ERROR_SUCCESS) {
+		    TclWinConvertError((DWORD) error);
+		    infoPtr->lastError = Tcl_GetErrno();
 		}
 	    }
+	    /*
+	     * Inform main thread about signaled events
+	     */
+	    infoPtr->readyEvents |= event;
+
+	    /*
+	     * Wake up the Main Thread.
+	     */
+	    SetEvent(tsdPtr->readyEvent);
+	    Tcl_ThreadAlert(tsdPtr->threadId);
 	}
 	SetEvent(tsdPtr->socketListLock);
 	break;
@@ -2850,6 +2913,39 @@ SocketProc(
 /*
  *----------------------------------------------------------------------
  *
+ * FindFDInList --
+ *
+ *	Return true, if the given file descriptior is contained in the
+ *	file descriptor list.
+ *
+ * Results:
+ *	true if found.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FindFDInList(
+    SocketInfo *infoPtr,
+    SOCKET socket)
+{
+    TcpFdList *fds;
+    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+        #ifdef DEBUGGING
+	fprintf(stderr,"socket = %d, fd=%d",socket,fds);
+	#endif
+	if (fds->fd == socket) {
+	    return 1;
+	}
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_GetHostName --
  *
  *	Returns the name of the local host.
@@ -3064,8 +3160,15 @@ TcpThreadActionProc(
 	tsdPtr = TCL_TSD_INIT(&dataKey);
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	DEBUG("Inserting pointer to list");
 	infoPtr->nextPtr = tsdPtr->socketList;
 	tsdPtr->socketList = infoPtr;
+	
+	if (infoPtr == tsdPtr->pendingSocketInfo) {
+	    DEBUG("Clearing temporary info pointer");
+	    tsdPtr->pendingSocketInfo = NULL;
+	}
+	
 	SetEvent(tsdPtr->socketListLock);
 
 	notifyCmd = SELECT;
@@ -3081,6 +3184,7 @@ TcpThreadActionProc(
 	 */
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	DEBUG("Removing pointer from list");
 	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
 		nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
 	    if ((*nextPtrPtr) == infoPtr) {
-- 
cgit v0.12


From c6c9538be56e14eb89700fa1ca1903d246a756c0 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 10 Mar 2014 15:22:56 +0000
Subject: Also continue async connect without event loop if gets/puts is called
 (test socket-14.8.*)

---
 win/tclWinSock.c | 56 ++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 34 insertions(+), 22 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index a3a770f..e689830 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -48,7 +48,7 @@
 #include "tclWinInt.h"
 
 //#define DEBUGGING
-//#ifdef DEBUGGING
+#ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
 			    infoPtr, __FUNCTION__, __LINE__, x)
 #else
@@ -201,7 +201,7 @@ typedef struct {
  * structure.
  */
 
-#define SOCKET_ASYNC		(1<<0)	/* The socket is in blocking mode. */
+#define TCP_ASYNC_SOCKET	(1<<0)	/* The socket is in blocking mode. */
 #define SOCKET_EOF		(1<<1)	/* A zero read happened on the
 					 * socket. */
 #define SOCKET_ASYNC_CONNECT	(1<<2)	/* This socket uses async connect. */
@@ -937,9 +937,9 @@ TcpBlockProc(
     SocketInfo *infoPtr = instanceData;
 
     if (mode == TCL_MODE_NONBLOCKING) {
-	infoPtr->flags |= SOCKET_ASYNC;
+	infoPtr->flags |= TCP_ASYNC_SOCKET;
     } else {
-	infoPtr->flags &= ~(SOCKET_ASYNC);
+	infoPtr->flags &= ~(TCP_ASYNC_SOCKET);
     }
     return 0;
 }
@@ -1389,7 +1389,7 @@ out:
     DEBUG("connected or finally failed");
     /* Clear async flag (not really necessary, not used any more) */
     infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-    if (Tcl_GetErrno() != 0 && interp != NULL) {
+    if ( Tcl_GetErrno() != 0 ) {
 	DEBUG("ERRNO");
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -1427,7 +1427,7 @@ out:
  *	This routine should only be called if flag ASYNC_CONNECT is set.
  *
  * Results:
- *	Returns -1 on success or 0 on failure, with an error code in
+ *	Returns 1 on success or 0 on failure, with an error code in
  *	errorCodePtr.
  *
  * Side effects:
@@ -1444,14 +1444,6 @@ WaitForConnect(
     int result;
     int oldMode;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-    /*
-     * A non blocking socket waiting for an asyncronous connect
-     * returns directly an error
-     */
-    if (infoPtr->flags & SOCKET_ASYNC) {
-	*errorCodePtr = EWOULDBLOCK;
-	return 0;
-    }
 
     /*
      * Be sure to disable event servicing so we are truly modal.
@@ -1471,28 +1463,48 @@ WaitForConnect(
 	    infoPtr->readyEvents &= ~(FD_CONNECT);
 
 	    /*
-	     * Disable async connect as we continue now synchoneously
+	     * For blocking sockets disable async connect
+	     * as we continue now synchoneously
 	     */
-	    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+	    if (! ( infoPtr->flags & TCP_ASYNC_SOCKET ) ) {
+		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+	    }
 
             /* Free list lock */
             SetEvent(tsdPtr->socketListLock);
 
-	    /* continue async connect syncroneously */
+	    /* continue connect */
 	    result = CreateClientSocket(NULL, infoPtr);
 
 	    /* Restore event service mode */
 	    (void) Tcl_SetServiceMode(oldMode);
 
-	    /* Todo: find adequate error code */
+	    /* Succesfully connected or async connect restarted */
+	    if (result == TCL_OK) {
+		if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
+		    *errorCodePtr = EWOULDBLOCK;
+		    return 0;
+		}
+		return 1;
+	    }
+	    /* error case */
 	    *errorCodePtr = EFAULT;
-	    return (result == TCL_OK);
+	    return 1;
 	}
 
         /* Free list lock */
         SetEvent(tsdPtr->socketListLock);
 
 	/*
+	 * A non blocking socket waiting for an asyncronous connect
+	 * returns directly an error
+	 */
+	if ( infoPtr->flags & TCP_ASYNC_SOCKET ) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    return 0;
+	}
+
+	/*
 	 * Wait until something happens.
 	 */
 
@@ -1549,7 +1561,7 @@ WaitForSocketEvent(
 	    break;
 	} else if (infoPtr->readyEvents & events) {
 	    break;
-	} else if (infoPtr->flags & SOCKET_ASYNC) {
+	} else if (infoPtr->flags & TCP_ASYNC_SOCKET) {
 	    *errorCodePtr = EWOULDBLOCK;
 	    result = 0;
 	    break;
@@ -2101,7 +2113,7 @@ TcpInputProc(
 	 * Check for error condition or underflow in non-blocking case.
 	 */
 
-	if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
+	if ((infoPtr->flags & TCP_ASYNC_SOCKET) || (error != WSAEWOULDBLOCK)) {
 	    TclWinConvertError(error);
 	    *errorCodePtr = Tcl_GetErrno();
 	    bytesRead = -1;
@@ -2205,7 +2217,7 @@ TcpOutputProc(
 	error = WSAGetLastError();
 	if (error == WSAEWOULDBLOCK) {
 	    infoPtr->readyEvents &= ~(FD_WRITE);
-	    if (infoPtr->flags & SOCKET_ASYNC) {
+	    if (infoPtr->flags & TCP_ASYNC_SOCKET) {
 		*errorCodePtr = EWOULDBLOCK;
 		bytesWritten = -1;
 		break;
-- 
cgit v0.12


From ad589d66e2f1ec13f0ba2c482bd70547aaec8fba Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 10 Mar 2014 15:38:21 +0000
Subject: Fire write fileevent if async connect fails finally (test
 socket-14.2)

---
 win/tclWinSock.c | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index e689830..01a0f6f 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1395,6 +1395,12 @@ out:
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 				"couldn't open socket: %s", Tcl_PosixError(interp)));
 	}
+	/*
+	 * In the final error case inform fileevent that we failed
+	 */
+	if (async_callback) {
+	    Tcl_NotifyChannel(infoPtr->channel, TCL_WRITABLE);
+	}
 	return TCL_ERROR;
     }
     /*
@@ -1423,8 +1429,11 @@ out:
  *
  * WaitForConnect --
  *
- *	Terminate an asyncroneous connect syncroneously.
- *	This routine should only be called if flag ASYNC_CONNECT is set.
+ *	Process an asyncroneous connect by gets/puts commands.
+ *	For blocking calls, terminate connect synchroneously.
+ *	For non blocking calls, do one asynchroneous step if possible.
+ *	This routine should only be called if flag SOCKET_REENTER_PENDING
+ *	is set.
  *
  * Results:
  *	Returns 1 on success or 0 on failure, with an error code in
@@ -1432,6 +1441,7 @@ out:
  *
  * Side effects:
  *	Processes socket events off the system queue.
+ *	May process asynchroneous connect.
  *
  *----------------------------------------------------------------------
  */
-- 
cgit v0.12


From 138267abe275e454e892fe55ad5f3e16fd032278 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 10 Mar 2014 16:59:09 +0000
Subject: Additional security for wrong pointer

---
 win/tclWinSock.c | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 01a0f6f..d8b9129 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1379,6 +1379,12 @@ CreateClientSocket(
 #ifdef DEBUGGING
 	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
 #endif
+	    /*
+	     * Clear the tsd socket list pointer if we did not wait for
+	     * the FD_CONNECT asyncroneously
+	     */
+	    tsdPtr->pendingSocketInfo = NULL;
+	    
 	    if (Tcl_GetErrno() == 0) {
 		goto out;
 	    }
-- 
cgit v0.12


From 091096d315755aa89f28bd063b426e16a4c16e51 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 17:58:32 +0000
Subject: Bring CRLF translation in parallel with others.

---
 generic/tclIO.c | 20 +++++++-------------
 tests/io.test   | 14 ++++++++++++++
 2 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6dfdd03..2971838 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5645,21 +5645,15 @@ TranslateInputEOL(
 	dstLen = srcLen;
 	break;
     case TCL_TRANSLATE_CRLF: {
-	char *dst;
-	const char *src, *srcEnd, *srcMax;
-
-    if (dstLen > srcLen) {
-	dstLen = srcLen;
-    }
-	dst = dstStart;
-	src = srcStart;
-	srcEnd = srcStart + dstLen;
-	srcMax = srcStart + srcLen;
+	const char *srcEnd = srcStart + srcLen;
+	const char *dstEnd = dstStart + dstLen;
+	const char *src = srcStart;
+	char *dst = dstStart;
 
-	for ( ; src < srcEnd; ) {
+	for ( ; dst < dstEnd && src < srcEnd; ) {
 	    if (*src == '\r') {
 		src++;
-		if (src >= srcMax) {
+		if (src == srcEnd) {
 		    src--;
 		    break;
 		} else if (*src == '\n') {
@@ -5710,7 +5704,7 @@ TranslateInputEOL(
     *dstLenPtr = dstLen;
     *srcLenPtr = srcLen;
 
-    if ((eof != NULL) && (srcStart + srcLen >= eof)) {
+    if (srcStart + srcLen == eof) {
 	/*
 	 * EOF character was seen in EOL translated range. Leave current file
 	 * position pointing at the EOF character, but don't store the EOF
diff --git a/tests/io.test b/tests/io.test
index c325809..e3fff32 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6858,6 +6858,20 @@ test io-52.14 {coverage of -translation crlf} {
     close $out
     file size $path(test2)
 } 29
+test io-52.14.1 {coverage of -translation crlf} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8 -translation crlf
+    set out [open $path(test2) w]
+    fcopy $in $out -size 2
+    close $in
+    close $out
+    file size $path(test2)
+} 2
 test io-52.15 {coverage of -translation crlf} {
     file delete $path(test1) $path(test2)
     set out [open $path(test1) wb]
-- 
cgit v0.12


From 4964ea0ff919aca3e872155d323cd72868cb93f3 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Mon, 10 Mar 2014 18:11:08 +0000
Subject: WaitForConnect may only call back to CreateClientSocket when the
 socket is writable or something. When it does so for a pending socket, it is
 falsely assumed to have succeeded and a subsequent read/write operation will
 fail.

---
 tests/socket.test  | 4 ++--
 unix/tclUnixSock.c | 4 +++-
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index bfe6990..a21bb8d 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -2006,7 +2006,7 @@ test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IP
         set sock [socket -async localhost $port]
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
-            if {[set x [gets $sock]] ne ""} break
+            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
             after 200
         }
         set x
@@ -2032,7 +2032,7 @@ test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IP
         set sock [socket -async localhost $port]
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
-            if {[set x [gets $sock]] ne ""} break
+            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
             after 200
         }
         set x
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 41d729e..6e84ed5 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -417,7 +417,9 @@ WaitForConnect(
 	errno = 0;
 	state = TclUnixWaitForFile(statePtr->fds.fd,
 		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-        CreateClientSocket(NULL, statePtr);
+        if (state != 0) {
+            CreateClientSocket(NULL, statePtr);
+        }
         if (statePtr->flags & TCP_ASYNC_CONNECT) {
             /* We are still in progress, so ignore the result of the last
              * attempt */
-- 
cgit v0.12


From dd5ac1c6419faed6fedef71a19409cb52335353c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 19:00:19 +0000
Subject: Rewrite CRLF translation to use more system calls.

---
 generic/tclIO.c | 46 ++++++++++++++++++++++++++++------------------
 1 file changed, 28 insertions(+), 18 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2971838..1070f0a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5645,28 +5645,38 @@ TranslateInputEOL(
 	dstLen = srcLen;
 	break;
     case TCL_TRANSLATE_CRLF: {
-	const char *srcEnd = srcStart + srcLen;
-	const char *dstEnd = dstStart + dstLen;
-	const char *src = srcStart;
+	const char *crFound, *src = srcStart;
 	char *dst = dstStart;
-
-	for ( ; dst < dstEnd && src < srcEnd; ) {
-	    if (*src == '\r') {
-		src++;
-		if (src == srcEnd) {
-		    src--;
-		    break;
-		} else if (*src == '\n') {
-		    *dst++ = *src++;
-		} else {
-		    *dst++ = '\r';
-		}
+	int lesser = (dstLen < srcLen) ? dstLen : srcLen;
+
+	while ((crFound = memchr(src, '\r', lesser))) {
+	    int numBytes = crFound - src;
+	    memmove(dst, src, numBytes);
+
+	    dst += numBytes;
+	    src += numBytes;
+	    dstLen -= numBytes;
+	    srcLen -= numBytes;
+	    if (srcLen == 1) {
+		/* valid src bytes end in \r */
+		lesser = 0;
+		break;
+	    }
+	    if (src[1] == '\n') {
+		*dst++ = '\n';
+		srcLen -= 2;
+		src += 2;
 	    } else {
-		*dst++ = *src++;
+		*dst++ = '\r';
+		srcLen--;
+		src++;
 	    }
+	    dstLen++;
+	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
 	}
-	srcLen = src - srcStart;
-	dstLen = dst - dstStart;
+	memmove(dst, src, lesser);
+	srcLen = src + lesser - srcStart;
+	dstLen = dst + lesser - dstStart;
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
-- 
cgit v0.12


From ea4c5e97e3d2d2751578fa19df54d98988aa46f4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 19:29:54 +0000
Subject: Test for the bug I just committed.

---
 tests/io.test | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/tests/io.test b/tests/io.test
index e3fff32..1bc3799 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6872,6 +6872,20 @@ test io-52.14.1 {coverage of -translation crlf} {
     close $out
     file size $path(test2)
 } 2
+test io-52.14.2 {coverage of -translation crlf} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -translation crlf
+    set out [open $path(test2) w]
+    fcopy $in $out -size 9
+    close $in
+    close $out
+    file size $path(test2)
+} 9
 test io-52.15 {coverage of -translation crlf} {
     file delete $path(test1) $path(test2)
     set out [open $path(test1) wb]
-- 
cgit v0.12


From d539d0925f6d60f1334d053247c8f3112e8de938 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 19:30:22 +0000
Subject: .... and then the bug fix.

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 1070f0a..6194637 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5671,7 +5671,7 @@ TranslateInputEOL(
 		srcLen--;
 		src++;
 	    }
-	    dstLen++;
+	    dstLen--;
 	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
 	}
 	memmove(dst, src, lesser);
-- 
cgit v0.12


From 507194e18d3ee09110002c002daa35eea2b249fd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 11 Mar 2014 03:38:55 +0000
Subject: Trial rewrite of AUTO input translation.

---
 generic/tclIO.c | 35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6194637..8d8e30f 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5680,6 +5680,40 @@ TranslateInputEOL(
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
+#if 1
+	const char *crFound, *src = srcStart;
+	char *dst = dstStart;
+	int lesser;
+
+	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
+	    if (*src == '\n') {
+		src++;
+		srcLen--;
+	    }
+	    ResetFlag(statePtr, INPUT_SAW_CR);
+	}
+	lesser = (dstLen < srcLen) ? dstLen : srcLen;
+	while ((crFound = memchr(src, '\r', lesser))) {
+	    int numBytes = crFound - src;
+	    memmove(dst, src, numBytes);
+
+	    dst[numBytes] = '\n';
+	    dst += numBytes + 1;
+	    dstLen -= numBytes + 1;
+	    src += numBytes + 1;
+	    srcLen -= numBytes + 1;
+	    if (srcLen == 0) {
+		SetFlag(statePtr, INPUT_SAW_CR);
+	    } else if (*src == '\n') {
+		src++;
+		srcLen--;
+	    }
+	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
+	}
+	memmove(dst, src, lesser);
+	srcLen = src + lesser - srcStart;
+	dstLen = dst + lesser - dstStart;
+#else
 	const char *srcEnd = srcStart + srcLen;
 	const char *dstEnd = dstStart + dstLen;
 	const char *src = srcStart;
@@ -5706,6 +5740,7 @@ TranslateInputEOL(
 	}
 	srcLen = src - srcStart;
 	dstLen = dst - dstStart;
+#endif
 	break;
     }
     default:
-- 
cgit v0.12


From ad739fa25ae937cd6dc5435db43f36c310d3a738 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 11 Mar 2014 13:35:37 +0000
Subject: No [fconfigure -error] error in connect process; gets after failed
 async connect returns connect error

---
 win/tclWinSock.c | 29 +++++++++++++++++++----------
 1 file changed, 19 insertions(+), 10 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index d8b9129..33eddd5 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1249,6 +1249,7 @@ CreateClientSocket(
 	     * Reset last error from last try
 	     */
 	    infoPtr->lastError = 0;
+	    Tcl_SetErrno(0);
 	    
 	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
 	    
@@ -1504,8 +1505,8 @@ WaitForConnect(
 		return 1;
 	    }
 	    /* error case */
-	    *errorCodePtr = EFAULT;
-	    return 1;
+	    *errorCodePtr = Tcl_GetErrno();
+	    return 0;
 	}
 
         /* Free list lock */
@@ -2417,15 +2418,23 @@ TcpGetOptionProc(
 
     if ((len > 1) && (optionName[1] == 'e') &&
 	    (strncmp(optionName, "-error", len) == 0)) {
-	int optlen;
 	DWORD err;
-	int ret;
-
-	optlen = sizeof(int);
-	ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
-		(char *)&err, &optlen);
-	if (ret == SOCKET_ERROR) {
-	    err = WSAGetLastError();
+	/*
+	 * Check if an asyncroneous connect is running
+	 * and return ok
+	 */
+	if (infoPtr->flags & SOCKET_REENTER_PENDING) {
+	    err = 0;
+	} else {
+	    int optlen;
+	    int ret;
+
+	    optlen = sizeof(int);
+	    ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
+		    (char *)&err, &optlen);
+	    if (ret == SOCKET_ERROR) {
+		err = WSAGetLastError();
+	    }
 	}
 	if (err) {
 	    TclWinConvertError(err);
-- 
cgit v0.12


From 63b89595467a04db5b8a034eab47617e86ab6606 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 11 Mar 2014 16:51:38 +0000
Subject: Compress code for better single screen viewing.

---
 generic/tclIO.c | 55 ++++++++-----------------------------------------------
 1 file changed, 8 insertions(+), 47 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 8d8e30f..b4f1c0c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5653,10 +5653,8 @@ TranslateInputEOL(
 	    int numBytes = crFound - src;
 	    memmove(dst, src, numBytes);
 
-	    dst += numBytes;
-	    src += numBytes;
-	    dstLen -= numBytes;
-	    srcLen -= numBytes;
+	    dst += numBytes; dstLen -= numBytes;
+	    src += numBytes; srcLen -= numBytes;
 	    if (srcLen == 1) {
 		/* valid src bytes end in \r */
 		lesser = 0;
@@ -5664,12 +5662,10 @@ TranslateInputEOL(
 	    }
 	    if (src[1] == '\n') {
 		*dst++ = '\n';
-		srcLen -= 2;
-		src += 2;
+		src += 2; srcLen -= 2;
 	    } else {
 		*dst++ = '\r';
-		srcLen--;
-		src++;
+		src++; srcLen--;
 	    }
 	    dstLen--;
 	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
@@ -5680,16 +5676,12 @@ TranslateInputEOL(
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
-#if 1
 	const char *crFound, *src = srcStart;
 	char *dst = dstStart;
 	int lesser;
 
 	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
-	    if (*src == '\n') {
-		src++;
-		srcLen--;
-	    }
+	    if (*src == '\n') { src++; srcLen--; }
 	    ResetFlag(statePtr, INPUT_SAW_CR);
 	}
 	lesser = (dstLen < srcLen) ? dstLen : srcLen;
@@ -5698,49 +5690,18 @@ TranslateInputEOL(
 	    memmove(dst, src, numBytes);
 
 	    dst[numBytes] = '\n';
-	    dst += numBytes + 1;
-	    dstLen -= numBytes + 1;
-	    src += numBytes + 1;
-	    srcLen -= numBytes + 1;
+	    dst += numBytes + 1; dstLen -= numBytes + 1;
+	    src += numBytes + 1; srcLen -= numBytes + 1;
 	    if (srcLen == 0) {
 		SetFlag(statePtr, INPUT_SAW_CR);
 	    } else if (*src == '\n') {
-		src++;
-		srcLen--;
+		src++; srcLen--;
 	    }
 	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
 	}
 	memmove(dst, src, lesser);
 	srcLen = src + lesser - srcStart;
 	dstLen = dst + lesser - dstStart;
-#else
-	const char *srcEnd = srcStart + srcLen;
-	const char *dstEnd = dstStart + dstLen;
-	const char *src = srcStart;
-	char *dst = dstStart;
-
-	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
-	    if (*src == '\n') {
-		src++;
-	    }
-	    ResetFlag(statePtr, INPUT_SAW_CR);
-	}
-	for ( ; dst < dstEnd && src < srcEnd; ) {
-	    if (*src == '\r') {
-		src++;
-		if (src == srcEnd) {
-		    SetFlag(statePtr, INPUT_SAW_CR);
-		} else if (*src == '\n') {
-		    src++;
-		}
-		*dst++ = '\n';
-	    } else {
-		*dst++ = *src++;
-	    }
-	}
-	srcLen = src - srcStart;
-	dstLen = dst - dstStart;
-#endif
 	break;
     }
     default:
-- 
cgit v0.12


From 8baf8e577ab51fc28a14b48622dbbba82c33ac24 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 11 Mar 2014 17:34:54 +0000
Subject:   *  Hide transient errors of the internal iterations of [socket
 -async] from the script level.   *  More tests for corner cases.

---
 tests/socket.test  | 160 +++++++++++++++++++++++++++++++++++++++++++++++++++--
 unix/tclUnixSock.c |  75 ++++++++++++-------------
 2 files changed, 189 insertions(+), 46 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index a21bb8d..6b072c2 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1759,7 +1759,7 @@ test socket-14.0.0 {[socket -async] when server only listens on IPv4} \
         unset x
     } -result ok
 test socket-14.0.1 {[socket -async] when server only listens on IPv6} \
-    -constraints [list socket supported_any localhost_v4] \
+    -constraints [list socket supported_any localhost_v6] \
     -setup {
         proc accept {s a p} {
             global x
@@ -1962,13 +1962,13 @@ test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4}
         set port [gets $fd]
     } -body {
         set sock [socket -async localhost $port]
-        gets $sock
+        list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error]
     } -cleanup {
         # make sure the server exits
         catch {socket 127.0.0.1 $port}
         close $sock
         close $fd
-    } -result {ok}
+    } -result {{} ok {}}
 test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} \
     -constraints {socket supported_inet supported_inet6} \
     -setup {
@@ -1983,13 +1983,22 @@ test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6}
         set port [gets $fd]
     } -body {
         set sock [socket -async localhost $port]
-        gets $sock
+        list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error]
     } -cleanup {
         # make sure the server exits
         catch {socket ::1 $port}
         close $sock
         close $fd
-    } -result {ok}
+    } -result {{} ok {}}
+test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set sock [socket -async localhost [randport]]
+        catch {gets $sock} x
+        list $x [fconfigure $sock -error]
+    } -cleanup {
+        close $sock
+    } -match glob -result {{error reading "sock*": socket is not connected} {connection refused}}
 test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \
     -constraints {socket supported_inet supported_inet6} \
     -setup {
@@ -2007,6 +2016,7 @@ test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IP
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
+            update
             after 200
         }
         set x
@@ -2033,6 +2043,7 @@ test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IP
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
+            update
             after 200
         }
         set x
@@ -2042,6 +2053,145 @@ test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IP
         close $sock
         close $fd
     } -result {ok}
+test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set sock [socket -async localhost [randport]]
+        fconfigure $sock -blocking 0
+        for {set i 0} {$i < 50} {incr i } {
+            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
+            update
+            after 200
+        }
+        fconfigure $sock -error
+    } -cleanup {
+        close $sock
+    } -match glob -result {connection refused}
+test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr 127.0.0.1 0]
+            proc accept {s h p} {set ::x $s}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+            puts [gets $x]
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        puts $sock ok
+        flush $sock
+        list [fconfigure $sock -error] [gets $fd]
+    } -cleanup {
+        # make sure the server exits
+        catch {socket 127.0.0.1 $port}
+        close $sock
+        close $fd
+    } -result {{} ok}
+test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr ::1 0]
+            proc accept {s h p} {set ::x $s}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+            puts [gets $x]
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        puts $sock ok
+        flush $sock
+        list [fconfigure $sock -error] [gets $fd]
+    } -cleanup {
+        # make sure the server exits
+        catch {socket ::1 $port}
+        close $sock
+        close $fd
+    } -result {{} ok}
+test socket-14.10.0 {pending [socket -async] and blocking [puts], server is IPv4} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr 127.0.0.1 0]
+            proc accept {s h p} {set ::x $s}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+            puts [gets $x]
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        flush $sock
+        fileevent $fd readable {set x 1}
+        vwait x
+        list [fconfigure $sock -error] [gets $fd]
+    } -cleanup {
+        # make sure the server exits
+        catch {socket 127.0.0.1 $port}
+        close $sock
+        close $fd
+    } -result {{} ok}
+test socket-14.10.1 {pending [socket -async] and blocking [puts], server is IPv6} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr ::1 0]
+            proc accept {s h p} {set ::x $s}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+            puts [gets $x]
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        flush $sock
+        fileevent $fd readable {set x 1}
+        vwait x
+        list [fconfigure $sock -error] [gets $fd]
+    } -cleanup {
+        # make sure the server exits
+        catch {socket ::1 $port}
+        close $sock
+        close $fd
+    } -result {{} ok}
+test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set sock [socket -async localhost [randport]]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        fileevent $sock writable {set x 1}
+        vwait x
+        close $sock
+    } -cleanup {
+    } -result {broken pipe} -returnCodes 1
+test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set sock [socket -async localhost [randport]]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        flush $sock
+        fileevent $sock writable {set x 1}
+        vwait x
+        close $sock
+    } -cleanup {
+    } -result {broken pipe} -returnCodes 1
 
 ::tcltest::cleanupTests
 flush stdout
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 6e84ed5..8336bdb 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -73,7 +73,7 @@ struct TcpState {
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int filehandlers;           /* Caches FileHandlers that get set up while
                                  * an async socket is not yet connected. */
-    int status;                 /* Cache status of async socket. */
+    int error;                  /* Cache SO_ERROR of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
 };
 
@@ -417,7 +417,7 @@ WaitForConnect(
 	errno = 0;
 	state = TclUnixWaitForFile(statePtr->fds.fd,
 		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-        if (state != 0) {
+        if (timeOut == -1 && state != 0) {
             CreateClientSocket(NULL, statePtr);
         }
         if (statePtr->flags & TCP_ASYNC_CONNECT) {
@@ -522,6 +522,7 @@ TcpOutputProc(
 	return -1;
     }
     written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0);
+
     if (written > -1) {
 	return written;
     }
@@ -752,24 +753,22 @@ TcpGetOptionProc(
     if ((len > 1) && (optionName[1] == 'e') &&
 	    (strncmp(optionName, "-error", len) == 0)) {
 	socklen_t optlen = sizeof(int);
-	int err, ret;
 
-        if (statePtr->status == 0) {
-            ret = getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
-                            (char *) &err, &optlen);
-            if (statePtr->flags & TCP_ASYNC_CONNECT) {
-                statePtr->status = err;
-            }
-            if (ret < 0) {
-                err = errno;
-            }
+        if (statePtr->flags & TCP_ASYNC_CONNECT) {
+            /* Suppress errors as long as we are not done */
+            errno = 0;
+        } else if (statePtr->error != 0) {
+            errno = statePtr->error;
+            statePtr->error = 0;
         } else {
-            err = statePtr->status;
-            statePtr->status = 0;
+            int err;
+            getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
+                    (char *) &err, &optlen);
+            errno = err;
+        }
+        if (errno != 0) {
+	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), -1);
         }
-	if (err != 0) {
-	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(err), -1);
-	}
 	return TCL_OK;
     }
 
@@ -982,7 +981,7 @@ CreateClientSocket(
 {
     socklen_t optlen;
     int async_callback = (state->addr != NULL);
-    int status;
+    int ret = -1, error;
     int async = state->flags & TCP_ASYNC_CONNECT;
 
     if (async_callback) {
@@ -991,8 +990,6 @@ CreateClientSocket(
 
     for (state->addr = state->addrlist; state->addr != NULL;
             state->addr = state->addr->ai_next) {
-	status = -1;
-
         for (state->myaddr = state->myaddrlist; state->myaddr != NULL;
                 state->myaddr = state->myaddr->ai_next) {
             int reuseaddr;
@@ -1014,6 +1011,7 @@ CreateClientSocket(
             if (state->fds.fd >= 0) {
 		close(state->fds.fd);
 		state->fds.fd = -1;
+                errno = 0;
 	    }
 
 	    state->fds.fd = socket(state->addr->ai_family, SOCK_STREAM, 0);
@@ -1035,19 +1033,18 @@ CreateClientSocket(
 	    TclSockMinimumBuffers(INT2PTR(state->fds.fd), SOCKET_BUFSIZE);
     
 	    if (async) {
-		status = TclUnixSetBlockingMode(state->fds.fd,
-                        TCL_MODE_NONBLOCKING);
-		if (status < 0) {
+                ret = TclUnixSetBlockingMode(state->fds.fd,TCL_MODE_NONBLOCKING);
+                if (ret < 0) {
                     continue;
-		}
-	    }
+                }
+            }
 
             reuseaddr = 1;
             (void) setsockopt(state->fds.fd, SOL_SOCKET, SO_REUSEADDR,
                     (char *) &reuseaddr, sizeof(reuseaddr));
-            status = bind(state->fds.fd, state->myaddr->ai_addr,
+            ret = bind(state->fds.fd, state->myaddr->ai_addr,
                     state->myaddr->ai_addrlen);
-            if (status < 0) {
+            if (ret < 0) {
                 continue;
             }
 
@@ -1058,9 +1055,10 @@ CreateClientSocket(
 	     * in being informed when the connect completes.
 	     */
 	    
-	    status = connect(state->fds.fd, state->addr->ai_addr,
-                    state->addr->ai_addrlen);
-	    if (status < 0 && errno == EINPROGRESS) {
+	    ret = connect(state->fds.fd, state->addr->ai_addr,
+                        state->addr->ai_addrlen);
+            error = errno;
+	    if (ret < 0 && errno == EINPROGRESS) {
                 Tcl_CreateFileHandler(state->fds.fd,
                         TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, state);
                 return TCL_OK;
@@ -1077,23 +1075,18 @@ CreateClientSocket(
 
                 optlen = sizeof(int);
 
-                if (state->status == 0) {
-                    getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
-                            (char *) &status, &optlen);
-                    state->status = status;
-                } else {
-                    status = state->status;
-                    state->status = 0;
-                }
+                getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
+                        (char *) &error, &optlen);
+                errno = error;
             }
-	    if (status == 0) {
+	    if (ret == 0 || errno == 0) {
 		goto out;
 	    }
 	}
     }
 
 out:
-
+    state->error = errno;
     CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT);
     if (async_callback) {
         /*
@@ -1113,7 +1106,7 @@ out:
          */
 
         Tcl_NotifyChannel(state->channel, TCL_WRITABLE);
-    } else if (status != 0) {
+    } else if (ret != 0) {
         /*
          * Failure for either a synchronous connection, or an async one that
          * failed before it could enter background mode, e.g. because an
-- 
cgit v0.12


From f52bc4c0b11afcb0144f828bd128be56202099a6 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 14 Mar 2014 09:12:13 +0000
Subject: Async connect terminates: fire fileevent by setting readyEvent,
 propage commit fail message to [fconfigure -error]

---
 win/tclWinSock.c | 162 +++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 110 insertions(+), 52 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 33eddd5..0ea8f04 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -170,7 +170,8 @@ struct SocketInfo {
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int status;                 /* Cache status of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
-    int lastError;		/* Error code from last message. */
+    int lastError;		/* Error code from notifier thread. */
+    int connectError;		/* Error code from failed async connect. */
     struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
 };
@@ -243,7 +244,8 @@ static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
 			    LPARAM lParam);
 static int		SocketsEnabled(void);
 static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
-static int		WaitForConnect(SocketInfo *infoPtr, int *errorCodePtr);
+static int		WaitForConnect(SocketInfo *infoPtr, int *errorCodePtr,
+			    int terminate_connect);
 static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
 			    int *errorCodePtr);
 static int		FindFDInList(SocketInfo *infoPtr, SOCKET socket);
@@ -778,9 +780,13 @@ SocketEventProc(
 	infoPtr->readyEvents &= ~(FD_CONNECT);
 	DEBUG("FD_CONNECT");
         if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
+	    /* free list lock */
 	    SetEvent(tsdPtr->socketListLock);
-	    CreateClientSocket(NULL, infoPtr);
-	    return 1;
+	    /* Do one connect step */
+	    if (TCL_OK != CreateClientSocket(NULL, infoPtr) ) {
+		/* On final fail save error for fconfigure -error */
+		infoPtr->connectError = Tcl_GetErrno();
+	    }
 	}
     }
 
@@ -1393,41 +1399,65 @@ CreateClientSocket(
     }
 
 out:
+    /*
+     * Socket connected or connection failed
+     */
     DEBUG("connected or finally failed");
     /* Clear async flag (not really necessary, not used any more) */
     infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-    if ( Tcl_GetErrno() != 0 ) {
+
+    /*
+     * Final connect failure
+     */
+
+    if ( Tcl_GetErrno() == 0 ) {
+	/*
+	 * Succesfully connected
+	 */
+	/*
+	 * Set up the select mask for read/write events.
+	 */
+	DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
+	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
+        
+	/*
+	 * Register for interest in events in the select mask. Note that this
+	 * automatically places the socket into non-blocking mode.
+	 */
+        
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		    (LPARAM) infoPtr);
+    } else {
+	/*
+	 * Connect failed
+	 */
 	DEBUG("ERRNO");
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-				"couldn't open socket: %s", Tcl_PosixError(interp)));
-	}
+
 	/*
-	 * In the final error case inform fileevent that we failed
+	 * For async connect schedule a writable event to report the fail.
 	 */
 	if (async_callback) {
-	    Tcl_NotifyChannel(infoPtr->channel, TCL_WRITABLE);
+	    /*
+	     * Set up the select mask for read/write events.
+	     */
+	    DEBUG("selectEvents = FD_WRITE for fail writable");    
+	    infoPtr->selectEvents = FD_WRITE;
+	    /* get infoPtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	    /* Clear eventual connect flag */
+	    infoPtr->readyEvents |= FD_WRITE;
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
+	}
+	/*
+	 * Error message on syncroneous connect
+	 */
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "couldn't open socket: %s", Tcl_PosixError(interp)));
 	}
 	return TCL_ERROR;
     }
-    /*
-     * Set up the select mask for read/write events.
-     */
-    DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
-    infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-    
-    /*
-     * Register for interest in events in the select mask. Note that this
-     * automatically places the socket into non-blocking mode.
-     */
-    
-    tsdPtr = TclThreadDataKeyGet(&dataKey);
-    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-		(LPARAM) infoPtr);
-    if (async_callback) {
-	Tcl_NotifyChannel(infoPtr->channel, TCL_WRITABLE);
-    }
     return TCL_OK;
 }
 
@@ -1436,15 +1466,20 @@ out:
  *
  * WaitForConnect --
  *
- *	Process an asyncroneous connect by gets/puts commands.
- *	For blocking calls, terminate connect synchroneously.
- *	For non blocking calls, do one asynchroneous step if possible.
+ *	Process an asyncroneous connect by other commands (gets... ).
+ *	Do one connect step if pending as if the event loop would run.
+ *
+ *	Blocking commands may call in with terminate_connect to terminate
+ *	the syncroneous connect syncroneously.
+ *
  *	This routine should only be called if flag SOCKET_REENTER_PENDING
  *	is set.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with an error code in
+ *	Returns 1 on success or 0 on failure, with a possix error code in
  *	errorCodePtr.
+ *	If the connect is not terminated, errorCode is set to EWOULDBLOCK
+ *	and 0 is returned.
  *
  * Side effects:
  *	Processes socket events off the system queue.
@@ -1456,7 +1491,8 @@ out:
 static int
 WaitForConnect(
     SocketInfo *infoPtr,	/* Information about this socket. */
-    int *errorCodePtr)		/* Where to store errors? */
+    int *errorCodePtr,		/* Where to store errors? */
+    int terminate_connect)	/* Should the connect be terminated? */
 {
     int result;
     int oldMode;
@@ -1483,7 +1519,7 @@ WaitForConnect(
 	     * For blocking sockets disable async connect
 	     * as we continue now synchoneously
 	     */
-	    if (! ( infoPtr->flags & TCP_ASYNC_SOCKET ) ) {
+	    if ( terminate_connect ) {
 		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 	    }
 
@@ -1516,7 +1552,7 @@ WaitForConnect(
 	 * A non blocking socket waiting for an asyncronous connect
 	 * returns directly an error
 	 */
-	if ( infoPtr->flags & TCP_ASYNC_SOCKET ) {
+	if ( ! terminate_connect ) {
 	    *errorCodePtr = EWOULDBLOCK;
 	    return 0;
 	}
@@ -2068,11 +2104,14 @@ TcpInputProc(
     }
 
     /*
-     * Check if there is an async connect to terminate
+     * Check if there is an async connect running.
+     * For blocking sockets terminate connect, otherwise do one step.
+     * For a non blocking socket return EWOULDBLOCK if connect not terminated
      */
 
     if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForConnect(infoPtr, errorCodePtr)) {
+	    && !WaitForConnect(infoPtr, errorCodePtr,
+		! ( infoPtr->flags & TCP_ASYNC_SOCKET ))) {
 	return -1;
     }
 
@@ -2196,11 +2235,14 @@ TcpOutputProc(
     }
 
     /*
-     * Check if there is an async connect to terminate
+     * Check if there is an async connect running.
+     * For blocking sockets terminate connect, otherwise do one step.
+     * For a non blocking socket return EWOULDBLOCK if connect not terminated
      */
 
     if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForConnect(infoPtr, errorCodePtr)) {
+	    && !WaitForConnect(infoPtr, errorCodePtr,
+		! ( infoPtr->flags & TCP_ASYNC_SOCKET ))) {
 	return -1;
     }
 
@@ -2418,28 +2460,44 @@ TcpGetOptionProc(
 
     if ((len > 1) && (optionName[1] == 'e') &&
 	    (strncmp(optionName, "-error", len) == 0)) {
-	DWORD err;
-	/*
-	 * Check if an asyncroneous connect is running
-	 * and return ok
-	 */
-	if (infoPtr->flags & SOCKET_REENTER_PENDING) {
-	    err = 0;
+
+	if ( (infoPtr->flags & SOCKET_REENTER_PENDING) ) {
+
+	    /*
+	     * Asyncroneous connect is running.
+	     * Process it one step without blocking.
+	     * Return its error or nothing if connect not
+	     * terminated.
+	     */
+
+	    int errorCode;
+	    if (!WaitForConnect(infoPtr, &errorCode, 0)
+		    && errorCode != EWOULDBLOCK) {
+		/* connect terminated with error */
+		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
+	    }
+	} else if (infoPtr->connectError != 0) {
+	    /*
+	     * An async connect error was not jet reported.
+	     */
+	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(infoPtr->connectError), -1);
+	    infoPtr->connectError = 0;
 	} else {
 	    int optlen;
 	    int ret;
+    	    DWORD err;
 
 	    optlen = sizeof(int);
 	    ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
 		    (char *)&err, &optlen);
 	    if (ret == SOCKET_ERROR) {
 		err = WSAGetLastError();
+		if (err) {
+		    TclWinConvertError(err);
+		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
+		}
 	    }
 	}
-	if (err) {
-	    TclWinConvertError(err);
-	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
-	}
 	return TCL_OK;
     }
 
@@ -2971,7 +3029,7 @@ FindFDInList(
     TcpFdList *fds;
     for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
         #ifdef DEBUGGING
-	fprintf(stderr,"socket = %d, fd=%d",socket,fds);
+	fprintf(stderr,"socket = %d, fd=%d\n",socket,fds);
 	#endif
 	if (fds->fd == socket) {
 	    return 1;
-- 
cgit v0.12


From 7dc014d8e0a311dd0298724157b449414392b33d Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 14 Mar 2014 10:59:48 +0000
Subject: Remove writable shortcut and errorneous workaround to get [connect
 -async] fail error to [fconfigure -error]

---
 win/tclWinSock.c | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 0ea8f04..d9b9789 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -170,8 +170,7 @@ struct SocketInfo {
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int status;                 /* Cache status of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
-    int lastError;		/* Error code from notifier thread. */
-    int connectError;		/* Error code from failed async connect. */
+    int lastError;		/* Error code from last message. */
     struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
 };
@@ -780,13 +779,9 @@ SocketEventProc(
 	infoPtr->readyEvents &= ~(FD_CONNECT);
 	DEBUG("FD_CONNECT");
         if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
-	    /* free list lock */
 	    SetEvent(tsdPtr->socketListLock);
-	    /* Do one connect step */
-	    if (TCL_OK != CreateClientSocket(NULL, infoPtr) ) {
-		/* On final fail save error for fconfigure -error */
-		infoPtr->connectError = Tcl_GetErrno();
-	    }
+	    CreateClientSocket(NULL, infoPtr);
+	    return 1;
 	}
     }
 
@@ -2476,26 +2471,31 @@ TcpGetOptionProc(
 		/* connect terminated with error */
 		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
 	    }
-	} else if (infoPtr->connectError != 0) {
-	    /*
-	     * An async connect error was not jet reported.
-	     */
-	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(infoPtr->connectError), -1);
-	    infoPtr->connectError = 0;
+
 	} else {
 	    int optlen;
 	    int ret;
     	    DWORD err;
 
+	    /*
+	     * Populater the err Variable with a possix error
+	     */
 	    optlen = sizeof(int);
 	    ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
 		    (char *)&err, &optlen);
+	    /*
+	     * The error was not returned directly but should be
+	     * taken from WSA
+	     */
 	    if (ret == SOCKET_ERROR) {
 		err = WSAGetLastError();
-		if (err) {
-		    TclWinConvertError(err);
-		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
-		}
+	    }
+	    /*
+	     * Return error message
+	     */
+	    if (err) {
+		TclWinConvertError(err);
+		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
 	    }
 	}
 	return TCL_OK;
-- 
cgit v0.12


From c02f2ee223615fe5b82e63c097199e34d0803814 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 14 Mar 2014 14:26:22 +0000
Subject:   *  More test improvements for async sockets.   *  Advance async
 connections whenever the channel is touched (e.g. by [chan configure]).   * 
 Add a noblock argument to WaitForConnect(), so that advancing async
 connections from [chan configure] doesn't block even on a blocking socket.

---
 tests/socket.test  | 45 ++++++++++++++++++++++++++-------------------
 unix/tclUnixSock.c | 28 +++++++++++++++++++++-------
 2 files changed, 47 insertions(+), 26 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 6b072c2..61660cd 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -95,7 +95,7 @@ set lat1 [expr {($t2-$t1)*2}]; # doubled as a safety margin
 set t1 [clock milliseconds]
 catch {socket 127.0.0.1 [randport]}
 set t2 [clock milliseconds]
-set lat2 [expr {($t2-$t1)*2}]
+set lat2 [expr {($t2-$t1)*3}]
 
 # Use the maximum of the two latency calculations, but at least 100ms
 set latency [expr {$lat1 > $lat2 ? $lat1 : $lat2}]
@@ -1812,22 +1812,17 @@ test socket-14.1 {[socket -async] fileevent while still connecting} \
 test socket-14.2 {[socket -async] fileevent connection refused} \
     -constraints [list socket supported_any] \
     -body {
-        if {[catch {socket -async localhost [randport]} client]} {
-	    regexp {[^:]*: (.*)} $client -> x
-	} else {
-            fileevent $client writable {set x [fconfigure $client -error]}
-            set after [after $latency {set x timeout}]
-            vwait x
-	    after cancel $after
-            if {$x eq "timeout"} {
-                append x ": [fconfigure $client -error]"
-            }
-	    close $client
-	}
-        set x
+        set client [socket -async localhost [randport]]
+        fileevent $client writable {set x ok}
+        set after [after $latency {set x timeout}]
+        vwait x
+        after cancel $after
+        lappend x [fconfigure $client -error]
     } -cleanup {
-        unset x
-    } -result "connection refused"
+        after cancel $after
+        close $client
+        unset x after client
+    } -result {ok {connection refused}}
 test socket-14.3 {[socket -async] when server only listens on IPv6} \
     -constraints [list socket supported_any localhost_v6] \
     -setup {
@@ -2016,7 +2011,6 @@ test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IP
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
-            update
             after 200
         }
         set x
@@ -2043,7 +2037,6 @@ test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IP
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
-            update
             after 200
         }
         set x
@@ -2060,7 +2053,6 @@ test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener}
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
-            update
             after 200
         }
         fconfigure $sock -error
@@ -2191,7 +2183,22 @@ test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, f
         vwait x
         close $sock
     } -cleanup {
+        unset x
     } -result {broken pipe} -returnCodes 1
+test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set s [socket -async localhost [randport]]
+        for {set i 0} {$i < 50} {incr i} {
+            set x [fconfigure $s -error]
+            if {$x != ""} break
+            after 200
+        }
+        set x
+    } -cleanup {
+        close $s
+        unset x s
+    } -result {connection refused}
 
 ::tcltest::cleanupTests
 flush stdout
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 8336bdb..b26d707 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -128,7 +128,8 @@ static int		TcpInputProc(ClientData instanceData, char *buf,
 static int		TcpOutputProc(ClientData instanceData,
 			    const char *buf, int toWrite, int *errorCode);
 static void		TcpWatchProc(ClientData instanceData, int mask);
-static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
+static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr,
+			    int noblock);
 
 /*
  * This structure describes the channel type structure for TCP socket
@@ -385,7 +386,8 @@ TcpBlockModeProc(
  *
  *	Wait for a connection on an asynchronously opened socket to be
  *	completed.  In nonblocking mode, just test if the connection
- *	has completed without blocking.
+ *	has completed without blocking. The noblock parameter allows to
+ *	enforce nonblocking behaviour even on sockets in blocking mode.
  *
  * Results:
  * 	0 if the connection has completed, -1 if still in progress
@@ -397,7 +399,8 @@ TcpBlockModeProc(
 static int
 WaitForConnect(
     TcpState *statePtr,		/* State of the socket. */
-    int *errorCodePtr)		/* Where to store errors? */
+    int *errorCodePtr,		/* Where to store errors? */
+    int noblock)		/* Don't wait, even for sockets in blocking mode */
 {
     int timeOut;		/* How long to wait. */
     int state;			/* Of calling TclWaitForFile. */
@@ -408,7 +411,7 @@ WaitForConnect(
      */
 
     if (statePtr->flags & TCP_ASYNC_CONNECT) {
-	if (statePtr->flags & TCP_ASYNC_SOCKET) {
+	if (noblock || statePtr->flags & TCP_ASYNC_SOCKET) {
 	    timeOut = 0;
 	} else {
 	    timeOut = -1;
@@ -417,7 +420,7 @@ WaitForConnect(
 	errno = 0;
 	state = TclUnixWaitForFile(statePtr->fds.fd,
 		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-        if (timeOut == -1 && state != 0) {
+        if (state != 0) {
             CreateClientSocket(NULL, statePtr);
         }
         if (statePtr->flags & TCP_ASYNC_CONNECT) {
@@ -468,7 +471,7 @@ TcpInputProc(
     int bytesRead;
 
     *errorCodePtr = 0;
-    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
+    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
 	return -1;
     }
     bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0);
@@ -518,7 +521,7 @@ TcpOutputProc(
     int written;
 
     *errorCodePtr = 0;
-    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
+    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
 	return -1;
     }
     written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0);
@@ -745,6 +748,9 @@ TcpGetOptionProc(
 {
     TcpState *statePtr = instanceData;
     size_t len = 0;
+    int errorCode;
+
+    WaitForConnect(statePtr, &errorCode, 1);
 
     if (optionName != NULL) {
 	len = strlen(optionName);
@@ -772,6 +778,14 @@ TcpGetOptionProc(
 	return TCL_OK;
     }
 
+    if ((len > 1) && (optionName[1] == 'c') &&
+	    (strncmp(optionName, "-connecting", len) == 0)) {
+
+        Tcl_DStringAppend(dsPtr,
+                        (statePtr->flags & TCP_ASYNC_CONNECT) ? "1" : "0", -1);
+        return TCL_OK;
+    }
+
     if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
 	    (strncmp(optionName, "-peername", len) == 0))) {
         address peername;
-- 
cgit v0.12


From cf759170c20c57b8dd8dad33a78c8e1273b99cf2 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 14 Mar 2014 16:59:25 +0000
Subject: file tclWinSock.c reorganized to minimize diff to tclUnixSock.c. No
 functional change

---
 win/tclWinSock.c | 3675 +++++++++++++++++++++++++++---------------------------
 1 file changed, 1859 insertions(+), 1816 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index d9b9789..f65ea46 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -9,6 +9,9 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
  * -----------------------------------------------------------------------
+ * The order and naming of functions in this file should minimize
+ * the file diff to tclUnixSock.c.
+ * -----------------------------------------------------------------------
  *
  * General information on how this module works.
  *
@@ -50,7 +53,7 @@
 //#define DEBUGGING
 #ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
-			    infoPtr, __FUNCTION__, __LINE__, x)
+			    statePtr, __FUNCTION__, __LINE__, x)
 #else
 #define DEBUG(x)
 #endif
@@ -82,6 +85,15 @@
 #undef getsockopt
 #undef setsockopt
 
+/*
+ * Helper macros to make parts of this file clearer. The macros do exactly
+ * what they say on the tin. :-) They also only ever refer to their arguments
+ * once, and so can be used without regard to side effects.
+ */
+
+#define SET_BITS(var, bits)	((var) |= (bits))
+#define CLEAR_BITS(var, bits)	((var) &= ~(bits))
+
 /* "sock" + a pointer in hex + \0 */
 #define SOCK_CHAN_LENGTH        (4 + sizeof(void *) * 2 + 1)
 #define SOCK_TEMPLATE           "sock%p"
@@ -97,15 +109,6 @@ static const TCHAR classname[] = TEXT("TclSocket");
 TCL_DECLARE_MUTEX(socketMutex)
 
 /*
- * The following variable holds the network name of this host.
- */
-
-static TclInitProcessGlobalValueProc InitializeHostName;
-static ProcessGlobalValue hostName = {
-    0, 0, NULL, NULL, InitializeHostName, NULL, NULL
-};
-
-/*
  * The following defines declare the messages used on socket windows.
  */
 
@@ -131,20 +134,19 @@ typedef union {
 #define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL
 #endif
 
-typedef struct SocketInfo SocketInfo;
+/*
+ * This structure describes per-instance state of a tcp based channel.
+ */
+
+typedef struct TcpState TcpState;
 
 typedef struct TcpFdList {
-    SocketInfo *infoPtr;
+    TcpState *statePtr;
     SOCKET fd;
     struct TcpFdList *next;
 } TcpFdList;
 
-/*
- * The following structure is used to store the data associated with each
- * socket.
- */
-
-struct SocketInfo {
+struct TcpState {
     Tcl_Channel channel;	/* Channel associated with this socket. */
     struct TcpFdList *sockets;	/* Windows SOCKET handle. */
     int flags;			/* Bit field comprised of the flags described
@@ -154,28 +156,55 @@ struct SocketInfo {
 				 * indicate which events are interesting. */
     int readyEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
-				 * indicate which events have occurred. */
+				 * indicate which events have occurred.
+				 * Set by notifier thread, access must be
+				 * protected by semaphore */
     int selectEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are currently being
 				 * selected. */
     int acceptEventCount;	/* Count of the current number of FD_ACCEPTs
-				 * that have arrived and not yet processed. */
+				 * that have arrived and not yet processed.
+				 * Set by notifier thread, access must be
+				 * protected by semaphore */
     Tcl_TcpAcceptProc *acceptProc;
 				/* Proc to call on accept. */
     ClientData acceptProcData;	/* The data for the accept proc. */
+
+    /*
+     * Only needed for client sockets
+     */
+
     struct addrinfo *addrlist;	/* Addresses to connect to. */
     struct addrinfo *addr;	/* Iterator over addrlist. */
     struct addrinfo *myaddrlist;/* Local address. */
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int status;                 /* Cache status of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
-    int lastError;		/* Error code from last message. */
-    struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
+    int lastError;		/* Error code from last message.
+				 * Set by notifier thread, access must be
+				 * protected by semaphore */
+    struct TcpState *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
 };
 
 /*
+ * These bits may be ORed together into the "flags" field of a TcpState
+ * structure.
+ */
+
+#define TCP_ASYNC_SOCKET	(1<<0)	/* Asynchronous socket. */
+#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */
+#define SOCKET_EOF		(1<<2)	/* A zero read happened on the
+					 * socket. */
+#define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
+					 * socket */
+#define SOCKET_REENTER_PENDING	(1<<4)	/* CreateClientSocket was called to
+					 * process an async connect. This
+					 * flag indicates that reentry is
+					 * still pending */
+
+/*
  * The following structure is what is added to the Tcl event queue when a
  * socket event occurs.
  */
@@ -184,8 +213,8 @@ typedef struct {
     Tcl_Event header;		/* Information that is standard for all
 				 * events. */
     SOCKET socket;		/* Socket descriptor that is ready. Used to
-				 * find the SocketInfo structure for the file
-				 * (can't point directly to the SocketInfo
+				 * find the TcpState structure for the file
+				 * (can't point directly to the TcpState
 				 * structure because it could go away while
 				 * the event is queued). */
 } SocketEvent;
@@ -196,20 +225,6 @@ typedef struct {
 
 #define TCP_BUFFER_SIZE 4096
 
-/*
- * The following macros may be used to set the flags field of a SocketInfo
- * structure.
- */
-
-#define TCP_ASYNC_SOCKET	(1<<0)	/* The socket is in blocking mode. */
-#define SOCKET_EOF		(1<<1)	/* A zero read happened on the
-					 * socket. */
-#define SOCKET_ASYNC_CONNECT	(1<<2)	/* This socket uses async connect. */
-#define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
-					 * socket */
-#define SOCKET_REENTER_PENDING	(1<<4)	/* The reentering after a received
-					 * FD_CONNECT to CreateClientSocket
-					 * is pending */
 
 typedef struct {
     HWND hwnd;			/* Handle to window for socket messages. */
@@ -220,11 +235,11 @@ typedef struct {
 				 * socketThread has been initialized and has
 				 * started. */
     HANDLE socketListLock;	/* Win32 Event to lock the socketList */
-    SocketInfo *pendingSocketInfo;
+    TcpState *pendingTcpState;
 				/* This socket is opened but not jet in the
 				 * list. This value is also checked by
 				 * the event structure. */
-    SocketInfo *socketList;	/* Every open socket in this thread has an
+    TcpState *socketList;	/* Every open socket in this thread has an
 				 * entry on this list. */
 } ThreadSpecificData;
 
@@ -232,22 +247,24 @@ static Tcl_ThreadDataKey dataKey;
 static WNDCLASS windowClass;
 
 /*
- * Static functions defined in this file.
+ * Static routines for this file:
  */
 
-static int		CreateClientSocket(Tcl_Interp *interp, SocketInfo *infoPtr);
+static int		CreateClientSocket(Tcl_Interp *interp,
+			    TcpState *state);
 static void		InitSockets(void);
-static SocketInfo *	NewSocketInfo(SOCKET socket);
+static TcpState *	NewSocketInfo(SOCKET socket);
 static void		SocketExitHandler(ClientData clientData);
 static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
 			    LPARAM lParam);
 static int		SocketsEnabled(void);
 static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
-static int		WaitForConnect(SocketInfo *infoPtr, int *errorCodePtr,
+static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr,
 			    int terminate_connect);
-static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
+static int		WaitForSocketEvent(TcpState *statePtr, int events,
 			    int *errorCodePtr);
-static int		FindFDInList(SocketInfo *infoPtr, SOCKET socket);
+static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
+static int		FindFDInList(TcpState *statePtr, SOCKET socket);
 static DWORD WINAPI	SocketThread(LPVOID arg);
 static void		TcpThreadActionProc(ClientData instanceData,
 			    int action);
@@ -255,7 +272,7 @@ static void		TcpThreadActionProc(ClientData instanceData,
 static Tcl_EventCheckProc	SocketCheckProc;
 static Tcl_EventProc		SocketEventProc;
 static Tcl_EventSetupProc	SocketSetupProc;
-static Tcl_DriverBlockModeProc	TcpBlockProc;
+static Tcl_DriverBlockModeProc	TcpBlockModeProc;
 static Tcl_DriverCloseProc	TcpCloseProc;
 static Tcl_DriverClose2Proc	TcpClose2Proc;
 static Tcl_DriverSetOptionProc	TcpSetOptionProc;
@@ -267,28 +284,37 @@ static Tcl_DriverGetHandleProc	TcpGetHandleProc;
 
 /*
  * This structure describes the channel type structure for TCP socket
- * based IO.
+ * based IO:
  */
 
 static const Tcl_ChannelType tcpChannelType = {
-    "tcp",		    /* Type name. */
-    TCL_CHANNEL_VERSION_5,  /* v5 channel */
-    TcpCloseProc,	    /* Close proc. */
-    TcpInputProc,	    /* Input proc. */
-    TcpOutputProc,	    /* Output proc. */
-    NULL,		    /* Seek proc. */
-    TcpSetOptionProc,	    /* Set option proc. */
-    TcpGetOptionProc,	    /* Get option proc. */
-    TcpWatchProc,	    /* Set up notifier to watch this channel. */
-    TcpGetHandleProc,	    /* Get an OS handle from channel. */
-    TcpClose2Proc,	    /* Close2proc. */
-    TcpBlockProc,	    /* Set socket into (non-)blocking mode. */
-    NULL,		    /* flush proc. */
-    NULL,		    /* handler proc. */
-    NULL,		    /* wide seek proc */
-    TcpThreadActionProc,    /* thread action proc */
-    NULL		    /* truncate */
+    "tcp",			/* Type name. */
+    TCL_CHANNEL_VERSION_5,	/* v5 channel */
+    TcpCloseProc,		/* Close proc. */
+    TcpInputProc,		/* Input proc. */
+    TcpOutputProc,		/* Output proc. */
+    NULL,			/* Seek proc. */
+    TcpSetOptionProc,		/* Set option proc. */
+    TcpGetOptionProc,		/* Get option proc. */
+    TcpWatchProc,		/* Initialize notifier. */
+    TcpGetHandleProc,		/* Get OS handles out of channel. */
+    TcpClose2Proc,		/* Close2 proc. */
+    TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
+    NULL,			/* flush proc. */
+    NULL,			/* handler proc. */
+    NULL,			/* wide seek proc. */
+    TcpThreadActionProc,	/* thread action proc. */
+    NULL			/* truncate proc. */
 };
+
+/*
+ * The following variable holds the network name of this host.
+ */
+
+static TclInitProcessGlobalValueProc InitializeHostName;
+static ProcessGlobalValue hostName =
+	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
+
 void printaddrinfo(struct addrinfo *ai, char *prefix)
 {
     char host[NI_MAXHOST], port[NI_MAXSERV];
@@ -311,202 +337,125 @@ void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
 /*
  *----------------------------------------------------------------------
  *
- * InitSockets --
- *
- *	Initialize the socket module.  If winsock startup is successful,
- *	registers the event window for the socket notifier code.
+ * InitializeHostName --
  *
- *	Assumes socketMutex is held.
+ *	This routine sets the process global value of the name of the local
+ *	host on which the process is running.
  *
  * Results:
  *	None.
  *
- * Side effects:
- *	Initializes winsock, registers a new window class and creates a
- *	window for use in asynchronous socket notification.
- *
  *----------------------------------------------------------------------
  */
 
-static void
-InitSockets(void)
+void
+InitializeHostName(
+    char **valuePtr,
+    int *lengthPtr,
+    Tcl_Encoding *encodingPtr)
 {
-    DWORD id, err;
-    WSADATA wsaData;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
-    if (!initialized) {
-	initialized = 1;
-	TclCreateLateExitHandler(SocketExitHandler, NULL);
+    TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
+    DWORD length = MAX_COMPUTERNAME_LENGTH + 1;
+    Tcl_DString ds;
 
+    if (GetComputerName(tbuf, &length) != 0) {
 	/*
-	 * Create the async notification window with a new class. We must
-	 * create a new class to avoid a Windows 95 bug that causes us to get
-	 * the wrong message number for socket events if the message window is
-	 * a subclass of a static control.
+	 * Convert string from native to UTF then change to lowercase.
 	 */
 
-	windowClass.style = 0;
-	windowClass.cbClsExtra = 0;
-	windowClass.cbWndExtra = 0;
-	windowClass.hInstance = TclWinGetTclInstance();
-	windowClass.hbrBackground = NULL;
-	windowClass.lpszMenuName = NULL;
-	windowClass.lpszClassName = classname;
-	windowClass.lpfnWndProc = SocketProc;
-	windowClass.hIcon = NULL;
-	windowClass.hCursor = NULL;
-
-	if (!RegisterClass(&windowClass)) {
-	    TclWinConvertError(GetLastError());
-	    goto initFailure;
-	}
-
-	/*
-	 * Initialize the winsock library and check the interface version
-	 * actually loaded. We only ask for the 1.1 interface and do require
-	 * that it not be less than 1.1.
-	 */
+	Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds));
 
-	err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR),
-		&wsaData);
-	if (err != 0) {
-	    TclWinConvertError(err);
-	    goto initFailure;
-	}
+    } else {
+	Tcl_DStringInit(&ds);
+	if (TclpHasSockets(NULL) == TCL_OK) {
+	    /*
+	     * The buffer size of 256 is recommended by the MSDN page that
+	     * documents gethostname() as being always adequate.
+	     */
 
-	/*
-	 * Note the byte positions ae swapped for the comparison, so that
-	 * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). We
-	 * want the comparison to be 0x0200 < 0x0101.
-	 */
+	    Tcl_DString inDs;
 
-	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
-		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
-	    TclWinConvertError(WSAVERNOTSUPPORTED);
-	    WSACleanup();
-	    goto initFailure;
+	    Tcl_DStringInit(&inDs);
+	    Tcl_DStringSetLength(&inDs, 256);
+	    if (gethostname(Tcl_DStringValue(&inDs),
+		    Tcl_DStringLength(&inDs)) == 0) {
+		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
+			&ds);
+	    }
+	    Tcl_DStringFree(&inDs);
 	}
     }
 
-    /*
-     * Check for per-thread initialization.
-     */
-
-    if (tsdPtr != NULL) {
-	return;
-    }
-
-    /*
-     * OK, this thread has never done anything with sockets before.  Construct
-     * a worker thread to handle asynchronous events related to sockets
-     * assigned to _this_ thread.
-     */
-
-    tsdPtr = TCL_TSD_INIT(&dataKey);
-    tsdPtr->pendingSocketInfo = NULL;
-    tsdPtr->socketList = NULL;
-    tsdPtr->hwnd       = NULL;
-    tsdPtr->threadId   = Tcl_GetCurrentThread();
-    tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
-    if (tsdPtr->readyEvent == NULL) {
-	goto initFailure;
-    }
-    tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
-    if (tsdPtr->socketListLock == NULL) {
-	goto initFailure;
-    }
-    tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0,
-	    &id);
-    if (tsdPtr->socketThread == NULL) {
-	goto initFailure;
-    }
-
-    SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
-
-    /*
-     * Wait for the thread to signal when the window has been created and if
-     * it is ready to go.
-     */
-
-    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
-
-    if (tsdPtr->hwnd == NULL) {
-	goto initFailure;	/* Trouble creating the window. */
-    }
-
-    Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
-    return;
-
-  initFailure:
-    TclpFinalizeSockets();
-    initialized = -1;
-    return;
+    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
+    *lengthPtr = Tcl_DStringLength(&ds);
+    *valuePtr = ckalloc((*lengthPtr) + 1);
+    memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
+    Tcl_DStringFree(&ds);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * SocketsEnabled --
+ * Tcl_GetHostName --
  *
- *	Check that the WinSock was successfully initialized.
+ *	Returns the name of the local host.
  *
  * Results:
- *	1 if it is.
+ *	A string containing the network name for this machine, or an empty
+ *	string if we can't figure out the name. The caller must not modify or
+ *	free this string.
  *
  * Side effects:
- *	None.
+ *	Caches the name to return for future calls.
  *
  *----------------------------------------------------------------------
  */
 
-    /* ARGSUSED */
-static int
-SocketsEnabled(void)
+const char *
+Tcl_GetHostName(void)
 {
-    int enabled;
-
-    Tcl_MutexLock(&socketMutex);
-    enabled = (initialized == 1);
-    Tcl_MutexUnlock(&socketMutex);
-    return enabled;
+    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- * SocketExitHandler --
+ * TclpHasSockets --
  *
- *	Callback invoked during exit clean up to delete the socket
- *	communication window and to release the WinSock DLL.
+ *	This function determines whether sockets are available on the current
+ *	system and returns an error in interp if they are not. Note that
+ *	interp may be NULL.
  *
  * Results:
- *	None.
+ *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
+ *	error in interp (if non-NULL).
  *
  * Side effects:
- *	None.
+ *	If not already prepared, initializes the TSD structure and socket
+ *	message handling thread associated to the calling thread for the
+ *	subsystem of the driver.
  *
  *----------------------------------------------------------------------
  */
 
-    /* ARGSUSED */
-static void
-SocketExitHandler(
-    ClientData clientData)		/* Not used. */
+int
+TclpHasSockets(
+    Tcl_Interp *interp)		/* Where to write an error message if sockets
+				 * are not present, or NULL if no such message
+				 * is to be written. */
 {
     Tcl_MutexLock(&socketMutex);
-
-    /*
-     * Make sure the socket event handling window is cleaned-up for, at
-     * most, this thread.
-     */
-
-    TclpFinalizeSockets();
-    UnregisterClass(classname, TclWinGetTclInstance());
-    WSACleanup();
-    initialized = 0;
+    InitSockets();
     Tcl_MutexUnlock(&socketMutex);
+
+    if (SocketsEnabled()) {
+	return TCL_OK;
+    }
+    if (interp != NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"sockets are not available on this system", -1));
+    }
+    return TCL_ERROR;
 }
 
 /*
@@ -570,379 +519,400 @@ TclpFinalizeSockets(void)
 /*
  *----------------------------------------------------------------------
  *
- * TclpHasSockets --
+ * TcpBlockModeProc --
  *
- *	This function determines whether sockets are available on the current
- *	system and returns an error in interp if they are not. Note that
- *	interp may be NULL.
+ *	This function is invoked by the generic IO level to set blocking and
+ *	nonblocking mode on a TCP socket based channel.
  *
  * Results:
- *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
- *	error in interp (if non-NULL).
+ *	0 if successful, errno when failed.
  *
  * Side effects:
- *	If not already prepared, initializes the TSD structure and socket
- *	message handling thread associated to the calling thread for the
- *	subsystem of the driver.
+ *	Sets the device into blocking or nonblocking mode.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclpHasSockets(
-    Tcl_Interp *interp)		/* Where to write an error message if sockets
-				 * are not present, or NULL if no such message
-				 * is to be written. */
+	/* ARGSUSED */
+static int
+TcpBlockModeProc(
+    ClientData instanceData,	/* Socket state. */
+    int mode)			/* The mode to set. Can be one of
+				 * TCL_MODE_BLOCKING or
+				 * TCL_MODE_NONBLOCKING. */
 {
-    Tcl_MutexLock(&socketMutex);
-    InitSockets();
-    Tcl_MutexUnlock(&socketMutex);
+    TcpState *statePtr = instanceData;
 
-    if (SocketsEnabled()) {
-	return TCL_OK;
-    }
-    if (interp != NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"sockets are not available on this system", -1));
+    if (mode == TCL_MODE_NONBLOCKING) {
+	statePtr->flags |= TCP_ASYNC_SOCKET;
+    } else {
+	statePtr->flags &= ~(TCP_ASYNC_SOCKET);
     }
-    return TCL_ERROR;
+    return 0;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * SocketSetupProc --
+ * WaitForConnect --
  *
- *	This function is invoked before Tcl_DoOneEvent blocks waiting for an
- *	event.
+ *	Process an asyncroneous connect by other commands (gets... ).
+ *	Do one connect step if pending as if the event loop would run.
+ *
+ *	Blocking commands may call in with terminate_connect to terminate
+ *	the syncroneous connect syncroneously.
+ *
+ *	Ok is directly returned if no async connect is running.
  *
  * Results:
- *	None.
+ *	Returns 1 on success or 0 on failure, with a possix error code in
+ *	errorCodePtr.
+ *	If the connect is not terminated, errorCode is set to EWOULDBLOCK
+ *	and 0 is returned.
  *
  * Side effects:
- *	Adjusts the block time if needed.
+ *	Processes socket events off the system queue.
+ *	May process asynchroneous connect.
  *
  *----------------------------------------------------------------------
  */
 
-void
-SocketSetupProc(
-    ClientData data,		/* Not used. */
-    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+static int
+WaitForConnect(
+    TcpState *statePtr,		/* State of the socket. */
+    int *errorCodePtr,		/* Where to store errors? */
+    int terminate_connect)	/* Should the connect be terminated? */
 {
-    SocketInfo *infoPtr;
-    Tcl_Time blockTime = { 0, 0 };
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    if (!(flags & TCL_FILE_EVENTS)) {
-	return;
-    }
+    int result;
+    int oldMode;
+    ThreadSpecificData *tsdPtr;
 
     /*
-     * Check to see if there is a ready socket.	 If so, poll.
+     * Check if an async connect is running. If not return ok
+     */
+    if ( !(statePtr->flags & SOCKET_REENTER_PENDING) )
+	return 1;
+    
+    /*
+     * Be sure to disable event servicing so we are truly modal.
      */
-    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
-	    infoPtr = infoPtr->nextPtr) {
-	if (infoPtr->readyEvents &
-	    (infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT)
-	) {
-	    DEBUG("Tcl_SetMaxBlockTime");
-	    Tcl_SetMaxBlockTime(&blockTime);
-	    break;
-	}
-    }
-    SetEvent(tsdPtr->socketListLock);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketCheckProc --
- *
- *	This function is called by Tcl_DoOneEvent to check the socket event
- *	source for events.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	May queue an event.
- *
- *----------------------------------------------------------------------
- */
 
-static void
-SocketCheckProc(
-    ClientData data,		/* Not used. */
-    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
-{
-    SocketInfo *infoPtr;
-    SocketEvent *evPtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
 
-    if (!(flags & TCL_FILE_EVENTS)) {
-	return;
-    }
+    while (1) {
 
-    /*
-     * Queue events for any ready sockets that don't already have events
-     * queued (caused by persistent states that won't generate WinSock
-     * events).
-     */
+	/* get statePtr lock */
+        tsdPtr = TclThreadDataKeyGet(&dataKey);
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	
+	/* Check for connect event */
+	if (statePtr->readyEvents & FD_CONNECT) {
 
-    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
-	    infoPtr = infoPtr->nextPtr) {
-	DEBUG("Socket loop");
-	if ((infoPtr->readyEvents &
-		(infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT))
-	    && !(infoPtr->flags & SOCKET_PENDING)
-	) {
-	    DEBUG("Event found");
-	    infoPtr->flags |= SOCKET_PENDING;
-	    evPtr = ckalloc(sizeof(SocketEvent));
-	    evPtr->header.proc = SocketEventProc;
-	    evPtr->socket = infoPtr->sockets->fd;
-	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+	    /* Consume the connect event */
+	    statePtr->readyEvents &= ~(FD_CONNECT);
+
+	    /*
+	     * For blocking sockets disable async connect
+	     * as we continue now synchoneously
+	     */
+	    if ( terminate_connect ) {
+		statePtr->flags &= ~(TCP_ASYNC_CONNECT);
+	    }
+
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
+
+	    /* continue connect */
+	    result = CreateClientSocket(NULL, statePtr);
+
+	    /* Restore event service mode */
+	    (void) Tcl_SetServiceMode(oldMode);
+
+	    /* Succesfully connected or async connect restarted */
+	    if (result == TCL_OK) {
+		if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
+		    *errorCodePtr = EWOULDBLOCK;
+		    return 0;
+		}
+		return 1;
+	    }
+	    /* error case */
+	    *errorCodePtr = Tcl_GetErrno();
+	    return 0;
+	}
+
+        /* Free list lock */
+        SetEvent(tsdPtr->socketListLock);
+
+	/*
+	 * A non blocking socket waiting for an asyncronous connect
+	 * returns directly an error
+	 */
+	if ( ! terminate_connect ) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    return 0;
 	}
+
+	/*
+	 * Wait until something happens.
+	 */
+
+	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
     }
-    SetEvent(tsdPtr->socketListLock);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * SocketEventProc --
+ * TcpInputProc --
  *
- *	This function is called by Tcl_ServiceEvent when a socket event
- *	reaches the front of the event queue. This function is responsible for
- *	notifying the generic channel code.
+ *	This function is invoked by the generic IO level to read input from a
+ *	TCP socket based channel.
  *
  * Results:
- *	Returns 1 if the event was handled, meaning it should be removed from
- *	the queue. Returns 0 if the event was not handled, meaning it should
- *	stay on the queue. The only time the event isn't handled is if the
- *	TCL_FILE_EVENTS flag bit isn't set.
+ *	The number of bytes read is returned or -1 on error. An output
+ *	argument contains the POSIX error code on error, or zero if no error
+ *	occurred.
  *
  * Side effects:
- *	Whatever the channel callback functions do.
+ *	Reads input from the input device of the channel.
  *
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 static int
-SocketEventProc(
-    Tcl_Event *evPtr,		/* Event to service. */
-    int flags)			/* Flags that indicate what events to handle,
-				 * such as TCL_FILE_EVENTS. */
+TcpInputProc(
+    ClientData instanceData,	/* Socket state. */
+    char *buf,			/* Where to store data read. */
+    int bufSize,		/* How much space is available in the
+				 * buffer? */
+    int *errorCodePtr)		/* Where to store error code. */
 {
-    SocketInfo *infoPtr = NULL; /* DEBUG */
-    SocketEvent *eventPtr = (SocketEvent *) evPtr;
-    int mask = 0, events;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    TcpFdList *fds;
-    SOCKET newSocket;
-    address addr;
-    int len;
+    TcpState *statePtr = instanceData;
+    int bytesRead;
+    DWORD error;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
-    DEBUG("");
-    if (!(flags & TCL_FILE_EVENTS)) {
-	return 0;
-    }
+    *errorCodePtr = 0;
 
     /*
-     * Find the specified socket on the socket list.
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
      */
 
-    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
-	    infoPtr = infoPtr->nextPtr) {
-	if (infoPtr->sockets->fd == eventPtr->socket) {
-	    break;
-	}
+    if (!SocketsEnabled()) {
+	*errorCodePtr = EFAULT;
+	return -1;
     }
 
     /*
-     * Discard events that have gone stale.
+     * First check to see if EOF was already detected, to prevent calling the
+     * socket stack after the first time EOF is detected.
      */
 
-    if (!infoPtr) {
-        SetEvent(tsdPtr->socketListLock);
-	return 1;
+    if (statePtr->flags & SOCKET_EOF) {
+	return 0;
     }
 
-    infoPtr->flags &= ~SOCKET_PENDING;
+    /*
+     * Check if there is an async connect running.
+     * For blocking sockets terminate connect, otherwise do one step.
+     * For a non blocking socket return EWOULDBLOCK if connect not terminated
+     */
 
-    /* Continue async connect if pending and ready */
-    if ( infoPtr->readyEvents & FD_CONNECT ) {
-	infoPtr->readyEvents &= ~(FD_CONNECT);
-	DEBUG("FD_CONNECT");
-        if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
-	    SetEvent(tsdPtr->socketListLock);
-	    CreateClientSocket(NULL, infoPtr);
-	    return 1;
-	}
+    if ( !WaitForConnect(statePtr, errorCodePtr,
+	    ! ( statePtr->flags & TCP_ASYNC_SOCKET ))) {
+	return -1;
     }
 
     /*
-     * Handle connection requests directly.
+     * No EOF, and it is connected, so try to read more from the socket. Note
+     * that we clear the FD_READ bit because read events are level triggered
+     * so a new event will be generated if there is still data available to be
+     * read. We have to simulate blocking behavior here since we are always
+     * using non-blocking sockets.
      */
-    if (infoPtr->readyEvents & FD_ACCEPT) {
-	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 
-	    /*
-	    * Accept the incoming connection request.
-	    */
-	    len = sizeof(address);
+    while (1) {
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+		(WPARAM) UNSELECT, (LPARAM) statePtr);
+	/* single fd operation: this proc is only called for a connected socket. */
+	bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0);
+	statePtr->readyEvents &= ~(FD_READ);
 
-	    newSocket = accept(fds->fd, &(addr.sa), &len);
+	/*
+	 * Check for end-of-file condition or successful read.
+	 */
 
-	    /* On Tcl server sockets with multiple OS fds we loop over the fds trying
-	     * an accept() on each, so we expect INVALID_SOCKET.  There are also other
-	     * network stack conditions that can result in FD_ACCEPT but a subsequent
-	     * failure on accept() by the time we get around to it.
-	     * Access to sockets (acceptEventCount, readyEvents) in socketList
-	     * is still protected by the lock (prevents reintroduction of 
-	     * SF Tcl Bug 3056775.
-	     */
+	if (bytesRead == 0) {
+	    statePtr->flags |= SOCKET_EOF;
+	}
+	if (bytesRead != SOCKET_ERROR) {
+	    break;
+	}
 
-	    if (newSocket == INVALID_SOCKET) {
-		/* int err = WSAGetLastError(); */
-		continue;
-	    }
-
-	    /*
-	     * It is possible that more than one FD_ACCEPT has been sent, so an extra
-	     * count must be kept. Decrement the count, and reset the readyEvent bit
-	     * if the count is no longer > 0.
-	     */
-	    infoPtr->acceptEventCount--;
-
-	    if (infoPtr->acceptEventCount <= 0) {
-		infoPtr->readyEvents &= ~(FD_ACCEPT);
-	    }
-
-	    SetEvent(tsdPtr->socketListLock);
-
-	    /* Caution: TcpAccept() has the side-effect of evaluating the server
-	     * accept script (via AcceptCallbackProc() in tclIOCmd.c), which can
-	     * close the server socket and invalidate infoPtr and fds.
-	     * If TcpAccept() accepts a socket we must return immediately and let
-	     * SocketCheckProc queue additional FD_ACCEPT events.
-	     */
-	    TcpAccept(fds, newSocket, addr);
-	    return 1;
-	}
-
-	/* Loop terminated with no sockets accepted; clear the ready mask so 
-	 * we can detect the next connection request. Note that connection 
-	 * requests are level triggered, so if there is a request already 
-	 * pending, a new event will be generated.
+	/*
+	 * If an error occurs after the FD_CLOSE has arrived, then ignore the
+	 * error and report an EOF.
 	 */
-	infoPtr->acceptEventCount = 0;
-	infoPtr->readyEvents &= ~(FD_ACCEPT);
-
-	SetEvent(tsdPtr->socketListLock);
-	return 1;
-    }
-
-    SetEvent(tsdPtr->socketListLock);
 
-    /*
-     * Mask off unwanted events and compute the read/write mask so we can
-     * notify the channel.
-     */
+	if (statePtr->readyEvents & FD_CLOSE) {
+	    statePtr->flags |= SOCKET_EOF;
+	    bytesRead = 0;
+	    break;
+	}
 
-    events = infoPtr->readyEvents & infoPtr->watchEvents;
+	error = WSAGetLastError();
 
-    if (events & FD_CLOSE) {
 	/*
-	 * If the socket was closed and the channel is still interested in
-	 * read events, then we need to ensure that we keep polling for this
-	 * event until someone does something with the channel. Note that we
-	 * do this before calling Tcl_NotifyChannel so we don't have to watch
-	 * out for the channel being deleted out from under us. This may cause
-	 * a redundant trip through the event loop, but it's simpler than
-	 * trying to do unwind protection.
+	 * If an RST comes, then ignore the error and report an EOF just like
+	 * on unix.
 	 */
 
-	Tcl_Time blockTime = { 0, 0 };
-
-	DEBUG("FD_CLOSE");
-	Tcl_SetMaxBlockTime(&blockTime);
-	mask |= TCL_READABLE|TCL_WRITABLE;
-    } else if (events & FD_READ) {
-	fd_set readFds;
-	struct timeval timeout;
+	if (error == WSAECONNRESET) {
+	    statePtr->flags |= SOCKET_EOF;
+	    bytesRead = 0;
+	    break;
+	}
 
 	/*
-	 * We must check to see if data is really available, since someone
-	 * could have consumed the data in the meantime. Turn off async
-	 * notification so select will work correctly. If the socket is still
-	 * readable, notify the channel driver, otherwise reset the async
-	 * select handler and keep waiting.
+	 * Check for error condition or underflow in non-blocking case.
 	 */
-	DEBUG("FD_READ");
 
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) infoPtr);
+	if ((statePtr->flags & TCP_ASYNC_SOCKET) || (error != WSAEWOULDBLOCK)) {
+	    TclWinConvertError(error);
+	    *errorCodePtr = Tcl_GetErrno();
+	    bytesRead = -1;
+	    break;
+	}
 
-	FD_ZERO(&readFds);
-	FD_SET(infoPtr->sockets->fd, &readFds);
-	timeout.tv_usec = 0;
-	timeout.tv_sec = 0;
+	/*
+	 * In the blocking case, wait until the file becomes readable or
+	 * closed and try again.
+	 */
 
-	if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
-	    mask |= TCL_READABLE;
-	} else {
-	    infoPtr->readyEvents &= ~(FD_READ);
-	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		    (WPARAM) SELECT, (LPARAM) infoPtr);
+	if (!WaitForSocketEvent(statePtr, FD_READ|FD_CLOSE, errorCodePtr)) {
+	    bytesRead = -1;
+	    break;
 	}
     }
-    if (events & FD_WRITE) {
-	DEBUG("FD_WRITE");
-	mask |= TCL_WRITABLE;
-    }
-    if (mask) {
-	DEBUG("Calling Tcl_NotifyChannel...");
-	Tcl_NotifyChannel(infoPtr->channel, mask);
-    }
-    DEBUG("returning...");
-    return 1;
+
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+
+    return bytesRead;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpBlockProc --
+ * TcpOutputProc --
  *
- *	Sets a socket into blocking or non-blocking mode.
+ *	This function is called by the generic IO level to write data to a
+ *	socket based channel.
  *
  * Results:
- *	0 if successful, errno if there was an error.
+ *	The number of bytes written or -1 on failure.
  *
  * Side effects:
- *	None.
+ *	Produces output on the socket.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TcpBlockProc(
-    ClientData instanceData,	/* The socket to block/un-block. */
-    int mode)			/* TCL_MODE_BLOCKING or
-				 * TCL_MODE_NONBLOCKING. */
+TcpOutputProc(
+    ClientData instanceData,	/* Socket state. */
+    const char *buf,		/* The data buffer. */
+    int toWrite,		/* How many bytes to write? */
+    int *errorCodePtr)		/* Where to store error code. */
 {
-    SocketInfo *infoPtr = instanceData;
+    TcpState *statePtr = instanceData;
+    int written;
+    DWORD error;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
-    if (mode == TCL_MODE_NONBLOCKING) {
-	infoPtr->flags |= TCP_ASYNC_SOCKET;
-    } else {
-	infoPtr->flags &= ~(TCP_ASYNC_SOCKET);
+    *errorCodePtr = 0;
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
+     */
+
+    if (!SocketsEnabled()) {
+	*errorCodePtr = EFAULT;
+	return -1;
     }
-    return 0;
+
+    /*
+     * Check if there is an async connect running.
+     * For blocking sockets terminate connect, otherwise do one step.
+     * For a non blocking socket return EWOULDBLOCK if connect not terminated
+     */
+
+    if ( !WaitForConnect(statePtr, errorCodePtr,
+	    ! ( statePtr->flags & TCP_ASYNC_SOCKET ))) {
+	return -1;
+    }
+
+    while (1) {
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+		(WPARAM) UNSELECT, (LPARAM) statePtr);
+
+	/* single fd operation: this proc is only called for a connected socket. */
+	written = send(statePtr->sockets->fd, buf, toWrite, 0);
+	if (written != SOCKET_ERROR) {
+	    /*
+	     * Since Windows won't generate a new write event until we hit an
+	     * overflow condition, we need to force the event loop to poll
+	     * until the condition changes.
+	     */
+
+	    if (statePtr->watchEvents & FD_WRITE) {
+		Tcl_Time blockTime = { 0, 0 };
+		Tcl_SetMaxBlockTime(&blockTime);
+	    }
+	    break;
+	}
+
+	/*
+	 * Check for error condition or overflow. In the event of overflow, we
+	 * need to clear the FD_WRITE flag so we can detect the next writable
+	 * event. Note that Windows only sends a new writable event after a
+	 * send fails with WSAEWOULDBLOCK.
+	 */
+
+	error = WSAGetLastError();
+	if (error == WSAEWOULDBLOCK) {
+	    statePtr->readyEvents &= ~(FD_WRITE);
+	    if (statePtr->flags & TCP_ASYNC_SOCKET) {
+		*errorCodePtr = EWOULDBLOCK;
+		written = -1;
+		break;
+	    }
+	} else {
+	    TclWinConvertError(error);
+	    *errorCodePtr = Tcl_GetErrno();
+	    written = -1;
+	    break;
+	}
+
+	/*
+	 * In the blocking case, wait until the file becomes writable or
+	 * closed and try again.
+	 */
+
+	if (!WaitForSocketEvent(statePtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
+	    written = -1;
+	    break;
+	}
+    }
+
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+
+    return written;
 }
 
 /*
@@ -969,7 +939,7 @@ TcpCloseProc(
     ClientData instanceData,	/* The socket to close. */
     Tcl_Interp *interp)		/* Unused. */
 {
-    SocketInfo *infoPtr = instanceData;
+    TcpState *statePtr = instanceData;
     /* TIP #218 */
     int errorCode = 0;
     /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
@@ -987,9 +957,9 @@ TcpCloseProc(
 	 * background.
 	 */
 
-	while ( infoPtr->sockets != NULL ) {
-	    TcpFdList *thisfd = infoPtr->sockets;
-	    infoPtr->sockets = thisfd->next;
+	while ( statePtr->sockets != NULL ) {
+	    TcpFdList *thisfd = statePtr->sockets;
+	    statePtr->sockets = thisfd->next;
 
 	    if (closesocket(thisfd->fd) == SOCKET_ERROR) {
 		TclWinConvertError((DWORD) WSAGetLastError());
@@ -999,11 +969,11 @@ TcpCloseProc(
 	}
     }
 
-    if (infoPtr->addrlist != NULL) {
-        freeaddrinfo(infoPtr->addrlist);
+    if (statePtr->addrlist != NULL) {
+        freeaddrinfo(statePtr->addrlist);
     }
-    if (infoPtr->myaddrlist != NULL) {
-        freeaddrinfo(infoPtr->myaddrlist);
+    if (statePtr->myaddrlist != NULL) {
+        freeaddrinfo(statePtr->myaddrlist);
     }
 
     /*
@@ -1013,7 +983,7 @@ TcpCloseProc(
      * fear of damaging the list.
      */
 
-    ckfree(infoPtr);
+    ckfree(statePtr);
     return errorCode;
 }
 
@@ -1040,14 +1010,15 @@ TcpClose2Proc(
     Tcl_Interp *interp,		/* For error reporting. */
     int flags)			/* Flags that indicate which side to close. */
 {
-    SocketInfo *infoPtr = instanceData;
-    int errorCode = 0, sd;
+    TcpState *statePtr = instanceData;
+    int errorCode = 0;
+    int sd;
 
     /*
      * Shutdown the OS socket handle.
      */
 
-    switch (flags) {
+    switch(flags) {
     case TCL_CLOSE_READ:
 	sd = SD_RECEIVE;
 	break;
@@ -1057,14 +1028,14 @@ TcpClose2Proc(
     default:
 	if (interp) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "Socket close2proc called bidirectionally", -1));
+		    "socket close2proc called bidirectionally", -1));
 	}
 	return TCL_ERROR;
     }
 
     /* single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or
      * TCL_WRITABLE so this should never be called for a server socket. */
-    if (shutdown(infoPtr->sockets->fd, sd) == SOCKET_ERROR) {
+    if (shutdown(statePtr->sockets->fd, sd) == SOCKET_ERROR) {
 	TclWinConvertError((DWORD) WSAGetLastError());
 	errorCode = Tcl_GetErrno();
     }
@@ -1075,745 +1046,799 @@ TcpClose2Proc(
 /*
  *----------------------------------------------------------------------
  *
- * AddSocketInfoFd --
+ * TcpSetOptionProc --
  *
- *	This function adds a SOCKET file descriptor to the 'sockets' linked 
- *	list of a SocketInfo structure.
+ *	Sets Tcp channel specific options.
  *
  * Results:
- *	None.
+ *	None, unless an error happens.
  *
  * Side effects:
- *	None, except for allocation of memory.
+ *	Changes attributes of the socket at the system level.
  *
  *----------------------------------------------------------------------
  */
 
-static void
-AddSocketInfoFd(
-    SocketInfo *infoPtr, 
-    SOCKET socket)
+static int
+TcpSetOptionProc(
+    ClientData instanceData,	/* Socket state. */
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    const char *optionName,	/* Name of the option to set. */
+    const char *value)		/* New value for option. */
 {
-    TcpFdList *fds = infoPtr->sockets;
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+    TcpState *statePtr = instanceData;
+    SOCKET sock;
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
 
-    if ( fds == NULL ) {
-	/* Add the first FD */
-	infoPtr->sockets = ckalloc(sizeof(TcpFdList));
-	fds = infoPtr->sockets;
-    } else {
-	/* Find end of list and append FD */
-	while ( fds->next != NULL ) {
-	    fds = fds->next;
+    /*
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
+     */
+
+    if (!SocketsEnabled()) {
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "winsock is not initialized", -1));
 	}
-    
-	fds->next = ckalloc(sizeof(TcpFdList));
-	fds = fds->next;
+	return TCL_ERROR;
     }
 
-    /* Populate new FD */
-    fds->fd = socket;
-    fds->infoPtr = infoPtr;
-    fds->next = NULL;
-}
-
-    
-/*
- *----------------------------------------------------------------------
- *
- * NewSocketInfo --
- *
- *	This function allocates and initializes a new SocketInfo structure.
- *
- * Results:
- *	Returns a newly allocated SocketInfo.
- *
- * Side effects:
- *	None, except for allocation of memory.
- *
- *----------------------------------------------------------------------
- */
-
-static SocketInfo *
-NewSocketInfo(SOCKET socket)
-{
-    SocketInfo *infoPtr = ckalloc(sizeof(SocketInfo));
-
-    memset(infoPtr, 0, sizeof(SocketInfo));
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+    #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list"
+    sock = statePtr->sockets->fd;
 
-    /*
-     * TIP #218. Removed the code inserting the new structure into the global
-     * list. This is now handled in the thread action callbacks, and only
-     * there.
-     */
+    if (!strcasecmp(optionName, "-keepalive")) {
+	BOOL val = FALSE;
+	int boolVar, rtn;
 
-    AddSocketInfoFd(infoPtr, socket);
+	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (boolVar) {
+	    val = TRUE;
+	}
+	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
+		(const char *) &val, sizeof(BOOL));
+	if (rtn != 0) {
+	    TclWinConvertError(WSAGetLastError());
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't set socket option: %s",
+			Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    } else if (!strcasecmp(optionName, "-nagle")) {
+	BOOL val = FALSE;
+	int boolVar, rtn;
+
+	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!boolVar) {
+	    val = TRUE;
+	}
+	rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
+		(const char *) &val, sizeof(BOOL));
+	if (rtn != 0) {
+	    TclWinConvertError(WSAGetLastError());
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't set socket option: %s",
+			Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
 
-    return infoPtr;
+    return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
+#else
+    return Tcl_BadChannelOption(interp, optionName, "");
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CreateClientSocket --
+ * TcpGetOptionProc --
  *
- *	This function opens a new socket in client mode.
+ *	Computes an option value for a TCP socket based channel, or a list of
+ *	all options and their values.
  *
- *	This might be called in 3 circumstances:
- *	-   By a regular socket command
- *	-   By the event handler to continue an asynchroneous connect
- *	-   By a blocking socket function (gets/puts) to terminate the
- *	    connect synchroneously
+ *	Note: This code is based on code contributed by John Haxby.
  *
  * Results:
- *      TCL_OK, if the socket was successfully connected or an asynchronous
- *      connection is in progress. If an error occurs, TCL_ERROR is returned
- *      and an error message is left in interp.
+ *	A standard Tcl result. The value of the specified option or a list of
+ *	all options and their values is returned in the supplied DString. Sets
+ *	Error message if needed.
  *
  * Side effects:
- *	Opens a socket.
- *
- * Remarks:
- *	A single host name may resolve to more than one IP address, e.g. for
- *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
- *	sockets in the background for such hosts, this function can act as a
- *	coroutine. On the first call, it sets up the control variables for the
- *	two nested loops over the local and remote addresses. Once the first
- *	connection attempt is in progress, it sets up itself as a writable
- *	event handler for that socket, and returns. When the callback occurs,
- *	control is transferred to the "reenter" label, right after the initial
- *	return and the loops resume as if they had never been interrupted.
- *	For syncronously connecting sockets, the loops work the usual way.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-CreateClientSocket(
-    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    SocketInfo *infoPtr)
+TcpGetOptionProc(
+    ClientData instanceData,	/* Socket state. */
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    const char *optionName,	/* Name of the option to retrieve the value
+				 * for, or NULL to get all options and their
+				 * values. */
+    Tcl_DString *dsPtr)		/* Where to store the computed value;
+				 * initialized by caller. */
 {
-    DWORD error;
-    u_long flag = 1;		/* Indicates nonblocking mode. */
+    TcpState *statePtr = instanceData;
+    char host[NI_MAXHOST], port[NI_MAXSERV];
+    SOCKET sock;
+    size_t len = 0;
+    int reverseDNS = 0;
+#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
+
     /*
-     * We are started with async connect and the connect notification
-     * was not jet received
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
      */
-    int async_connect = infoPtr->flags & SOCKET_ASYNC_CONNECT;
-    /* We were called by the event procedure and continue our loop */
-    int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-    
-    DEBUG(async_connect ? "async connect" : "sync connect");
 
-    if (async_callback) {
-	DEBUG("subsequent call");
-        goto reenter;
-    } else {
-	DEBUG("first call");
+    if (!SocketsEnabled()) {
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "winsock is not initialized", -1));
+	}
+	return TCL_ERROR;
     }
-    
-    for (infoPtr->addr = infoPtr->addrlist; infoPtr->addr != NULL;
-	 infoPtr->addr = infoPtr->addr->ai_next) {
-	
-        for (infoPtr->myaddr = infoPtr->myaddrlist; infoPtr->myaddr != NULL;
-	     infoPtr->myaddr = infoPtr->myaddr->ai_next) {
-
-	    DEBUG("inner loop");
-
-	    /*
-	     * No need to try combinations of local and remote addresses
-	     * of different families.
-	     */
-
-	    if (infoPtr->myaddr->ai_family != infoPtr->addr->ai_family) {
-		DEBUG("family mismatch");
-		continue;
-	    }
 
-	    DEBUG(infoPtr->myaddr->ai_family == AF_INET ? "IPv4" : "IPv6");
-	    printaddrinfo(infoPtr->myaddr, "~~ from");
-	    printaddrinfo(infoPtr->addr,   "~~   to");
+    sock = statePtr->sockets->fd;
+    if (optionName != NULL) {
+	len = strlen(optionName);
+    }
 
-            /*
-             * Close the socket if it is still open from the last unsuccessful
-             * iteration.
-             */	    
-	    if (infoPtr->sockets->fd != INVALID_SOCKET) {
-		DEBUG("closesocket");
-		closesocket(infoPtr->sockets->fd);
-	    }
+    if ((len > 1) && (optionName[1] == 'e') &&
+	    (strncmp(optionName, "-error", len) == 0)) {
 
-	    /* get infoPtr lock */
-	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	if ( (statePtr->flags & SOCKET_REENTER_PENDING) ) {
 
 	    /*
-	     * Reset last error from last try
+	     * Asyncroneous connect is running.
+	     * Process it one step without blocking.
+	     * Return its error or nothing if connect not
+	     * terminated.
 	     */
-	    infoPtr->lastError = 0;
-	    Tcl_SetErrno(0);
-	    
-	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
-	    
-	    /* Free list lock */
-	    SetEvent(tsdPtr->socketListLock);
 
-	    /* continue on socket creation error */
-	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
-		DEBUG("socket() failed");
-		TclWinConvertError((DWORD) WSAGetLastError());
-		continue;
+	    int errorCode;
+	    if (!WaitForConnect(statePtr, &errorCode, 0)
+		    && errorCode != EWOULDBLOCK) {
+		/* connect terminated with error */
+		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
 	    }
-	    
-#ifdef DEBUGGING
-	    fprintf(stderr, "Client socket %d created\n", infoPtr->sockets->fd);
-#endif
-	    /*
-	     * Win-NT has a misfeature that sockets are inherited in child
-	     * processes by default. Turn off the inherit bit.
-	     */
 
-	    SetHandleInformation((HANDLE) infoPtr->sockets->fd, HANDLE_FLAG_INHERIT, 0);
+	} else {
+	    int optlen;
+	    int ret;
+    	    DWORD err;
 
 	    /*
-	     * Set kernel space buffering
+	     * Populater the err Variable with a possix error
 	     */
-
-	    TclSockMinimumBuffers((void *) infoPtr->sockets->fd, TCP_BUFFER_SIZE);
-
+	    optlen = sizeof(int);
+	    ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
+		    (char *)&err, &optlen);
 	    /*
-	     * Try to bind to a local port.
+	     * The error was not returned directly but should be
+	     * taken from WSA
 	     */
-
-	    if (bind(infoPtr->sockets->fd, infoPtr->myaddr->ai_addr,
-			infoPtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
-		DEBUG("bind() failed");
-		TclWinConvertError((DWORD) WSAGetLastError());
-		continue;
+	    if (ret == SOCKET_ERROR) {
+		err = WSAGetLastError();
 	    }
 	    /*
-	     * For asyncroneous connect set the socket in nonblocking mode
-	     * and activate connect notification
+	     * Return error message
 	     */
-	    if (async_connect) {
-		SocketInfo *infoPtr2;
-		int in_socket_list = 0;
-		/* get infoPtr lock */
-		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	    if (err) {
+		TclWinConvertError(err);
+		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
+	    }
+	}
+	return TCL_OK;
+    }
 
-		/*
-		 * Check if my infoPtr is already in the tsdPtr->socketList
-		 * It is set after this call by TcpThreadActionProc and is set
-		 * on a second round.
-		 *
-		 * If not, we buffer my infoPtr in the tsd memory so it is not
-		 * lost by the event procedure
-		 */
+    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
+	reverseDNS = NI_NUMERICHOST;
+    }
 
-		for (infoPtr2 = tsdPtr->socketList; infoPtr2 != NULL;
-			infoPtr2 = infoPtr->nextPtr) {
-		    if (infoPtr2 == infoPtr) {
-			in_socket_list = 1;
-			break;
-		    }
-		}
-		if (!in_socket_list) {
-		    tsdPtr->pendingSocketInfo = infoPtr;
-		}
-		/*
-		 * Set connect mask to connect events
-		 * This is activated by a SOCKET_SELECT message to the notifier
-		 * thread.
-		 */
-		infoPtr->selectEvents |= FD_CONNECT;
-		
-		/*
-		 * Free list lock
-		 */
-		SetEvent(tsdPtr->socketListLock);
+    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
+	    (strncmp(optionName, "-peername", len) == 0))) {
+	address peername;
+	socklen_t size = sizeof(peername);
 
-    		/* activate accept notification */
-		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-			(LPARAM) infoPtr);
+	if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
+	    if (len == 0) {
+		Tcl_DStringAppendElement(dsPtr, "-peername");
+		Tcl_DStringStartSublist(dsPtr);
 	    }
 
+	    getnameinfo(&(peername.sa), size, host, sizeof(host),
+		    NULL, 0, NI_NUMERICHOST);
+	    Tcl_DStringAppendElement(dsPtr, host);
+	    getnameinfo(&(peername.sa), size, host, sizeof(host),
+		    port, sizeof(port), reverseDNS | NI_NUMERICSERV);
+	    Tcl_DStringAppendElement(dsPtr, host);
+	    Tcl_DStringAppendElement(dsPtr, port);
+	    if (len == 0) {
+		Tcl_DStringEndSublist(dsPtr);
+	    } else {
+		return TCL_OK;
+	    }
+	} else {
 	    /*
-	     * Attempt to connect to the remote socket.
+	     * getpeername failed - but if we were asked for all the options
+	     * (len==0), don't flag an error at that point because it could be
+	     * an fconfigure request on a server socket (such sockets have no
+	     * peer). {Copied from unix/tclUnixChan.c}
 	     */
-	    
-	    DEBUG("connect()");
-	    connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
-		    infoPtr->addr->ai_addrlen);
-
-	    error = WSAGetLastError();
-	    TclWinConvertError(error);
 
-	    if (async_connect && error == WSAEWOULDBLOCK) {
-		/*
-		 * Asynchroneous connect
-		 */
-		DEBUG("WSAEWOULDBLOCK");
+	    if (len) {
+		TclWinConvertError((DWORD) WSAGetLastError());
+		if (interp) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "can't get peername: %s",
+			    Tcl_PosixError(interp)));
+		}
+		return TCL_ERROR;
+	    }
+	}
+    }
 
+    if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
+	    (strncmp(optionName, "-sockname", len) == 0))) {
+	TcpFdList *fds;
+	address sockname;
+	socklen_t size;
+	int found = 0;
 
-		/*
-		 * Remember that we jump back behind this next round
-		 */
-		infoPtr->flags |= SOCKET_REENTER_PENDING;
-		return TCL_OK;
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-sockname");
+	    Tcl_DStringStartSublist(dsPtr);
+	}
+	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
+	    sock = fds->fd;
+#ifdef DEBUGGING
+	    fprintf(stderr, "sock == %d\n", sock);
+#endif
+	    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);
 
-	    reenter:
-		DEBUG("reenter");
 		/*
-		 * Re-entry point for async connect after connect event or
-		 * blocking operation
-		 *
-		 * Clear the reenter flag
+		 * We don't want to resolve INADDR_ANY and sin6addr_any; they
+		 * can sometimes cause problems (and never have a name).
 		 */
-		infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
-		/* get infoPtr lock */
-		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-		/* Get signaled connect error */
-		Tcl_SetErrno(infoPtr->lastError);
-		/* Clear eventual connect flag */
-		infoPtr->selectEvents &= ~(FD_CONNECT);
-		/* Free list lock */
-		SetEvent(tsdPtr->socketListLock);
+		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);
 	    }
-#ifdef DEBUGGING
-	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
-#endif
-	    /*
-	     * Clear the tsd socket list pointer if we did not wait for
-	     * the FD_CONNECT asyncroneously
-	     */
-	    tsdPtr->pendingSocketInfo = NULL;
-	    
-	    if (Tcl_GetErrno() == 0) {
-		goto out;
+	}
+	if (found) {
+	    if (len == 0) {
+		Tcl_DStringEndSublist(dsPtr);
+	    } else {
+		return TCL_OK;
 	    }
+	} else {
+	    if (interp) {
+		TclWinConvertError((DWORD) WSAGetLastError());
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"can't get sockname: %s", Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
 	}
     }
 
-out:
-    /*
-     * Socket connected or connection failed
-     */
-    DEBUG("connected or finally failed");
-    /* Clear async flag (not really necessary, not used any more) */
-    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+    if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
+	int optlen;
+	BOOL opt = FALSE;
 
-    /*
-     * Final connect failure
-     */
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
+	}
+	optlen = sizeof(BOOL);
+	getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
+	if (opt) {
+	    Tcl_DStringAppendElement(dsPtr, "1");
+	} else {
+	    Tcl_DStringAppendElement(dsPtr, "0");
+	}
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
 
-    if ( Tcl_GetErrno() == 0 ) {
-	/*
-	 * Succesfully connected
-	 */
-	/*
-	 * Set up the select mask for read/write events.
-	 */
-	DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
-	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-        
-	/*
-	 * Register for interest in events in the select mask. Note that this
-	 * automatically places the socket into non-blocking mode.
-	 */
-        
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-		    (LPARAM) infoPtr);
-    } else {
-	/*
-	 * Connect failed
-	 */
-	DEBUG("ERRNO");
+    if (len == 0 || !strncmp(optionName, "-nagle", len)) {
+	int optlen;
+	BOOL opt = FALSE;
 
-	/*
-	 * For async connect schedule a writable event to report the fail.
-	 */
-	if (async_callback) {
-	    /*
-	     * Set up the select mask for read/write events.
-	     */
-	    DEBUG("selectEvents = FD_WRITE for fail writable");    
-	    infoPtr->selectEvents = FD_WRITE;
-	    /* get infoPtr lock */
-	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	    /* Clear eventual connect flag */
-	    infoPtr->readyEvents |= FD_WRITE;
-	    /* Free list lock */
-	    SetEvent(tsdPtr->socketListLock);
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-nagle");
 	}
-	/*
-	 * Error message on syncroneous connect
-	 */
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "couldn't open socket: %s", Tcl_PosixError(interp)));
+	optlen = sizeof(BOOL);
+	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
+	if (opt) {
+	    Tcl_DStringAppendElement(dsPtr, "0");
+	} else {
+	    Tcl_DStringAppendElement(dsPtr, "1");
 	}
-	return TCL_ERROR;
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+
+    if (len > 0) {
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+	return Tcl_BadChannelOption(interp, optionName,
+		"peername sockname keepalive nagle");
+#else
+	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
     }
+
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * WaitForConnect --
- *
- *	Process an asyncroneous connect by other commands (gets... ).
- *	Do one connect step if pending as if the event loop would run.
- *
- *	Blocking commands may call in with terminate_connect to terminate
- *	the syncroneous connect syncroneously.
+ * TcpWatchProc --
  *
- *	This routine should only be called if flag SOCKET_REENTER_PENDING
- *	is set.
+ *	Informs the channel driver of the events that the generic channel code
+ *	wishes to receive on this socket.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with a possix error code in
- *	errorCodePtr.
- *	If the connect is not terminated, errorCode is set to EWOULDBLOCK
- *	and 0 is returned.
+ *	None.
  *
  * Side effects:
- *	Processes socket events off the system queue.
- *	May process asynchroneous connect.
+ *	May cause the notifier to poll if any of the specified conditions are
+ *	already true.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-WaitForConnect(
-    SocketInfo *infoPtr,	/* Information about this socket. */
-    int *errorCodePtr,		/* Where to store errors? */
-    int terminate_connect)	/* Should the connect be terminated? */
+static void
+TcpWatchProc(
+    ClientData instanceData,	/* The socket state. */
+    int mask)			/* Events of interest; an OR-ed combination of
+				 * TCL_READABLE, TCL_WRITABLE and
+				 * TCL_EXCEPTION. */
 {
-    int result;
-    int oldMode;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    TcpState *statePtr = instanceData;
+
+    DEBUG((mask & TCL_READABLE) ? "+r":"-r");
+    DEBUG((mask & TCL_WRITABLE) ? "+w":"-w");
 
     /*
-     * Be sure to disable event servicing so we are truly modal.
+     * Update the watch events mask. Only if the socket is not a server
+     * socket. [Bug 557878]
      */
 
-    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
-
-    while (1) {
-	
-	/* get infoPtr lock */
-        WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	
-	/* Check for connect event */
-	if (infoPtr->readyEvents & FD_CONNECT) {
-
-	    /* Consume the connect event */
-	    infoPtr->readyEvents &= ~(FD_CONNECT);
-
-	    /*
-	     * For blocking sockets disable async connect
-	     * as we continue now synchoneously
-	     */
-	    if ( terminate_connect ) {
-		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-	    }
-
-            /* Free list lock */
-            SetEvent(tsdPtr->socketListLock);
+    if (!statePtr->acceptProc) {
+	statePtr->watchEvents = 0;
+	if (mask & TCL_READABLE) {
+	    statePtr->watchEvents |= (FD_READ|FD_CLOSE);
+	}
+	if (mask & TCL_WRITABLE) {
+	    statePtr->watchEvents |= (FD_WRITE|FD_CLOSE);
+	}
 
-	    /* continue connect */
-	    result = CreateClientSocket(NULL, infoPtr);
+	/*
+	 * If there are any conditions already set, then tell the notifier to
+	 * poll rather than block.
+	 */
 
-	    /* Restore event service mode */
-	    (void) Tcl_SetServiceMode(oldMode);
+	if (statePtr->readyEvents & statePtr->watchEvents) {
+	    Tcl_Time blockTime = { 0, 0 };
 
-	    /* Succesfully connected or async connect restarted */
-	    if (result == TCL_OK) {
-		if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
-		    *errorCodePtr = EWOULDBLOCK;
-		    return 0;
-		}
-		return 1;
-	    }
-	    /* error case */
-	    *errorCodePtr = Tcl_GetErrno();
-	    return 0;
-	}
-
-        /* Free list lock */
-        SetEvent(tsdPtr->socketListLock);
-
-	/*
-	 * A non blocking socket waiting for an asyncronous connect
-	 * returns directly an error
-	 */
-	if ( ! terminate_connect ) {
-	    *errorCodePtr = EWOULDBLOCK;
-	    return 0;
+	    Tcl_SetMaxBlockTime(&blockTime);
 	}
-
-	/*
-	 * Wait until something happens.
-	 */
-
-	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * WaitForSocketEvent --
+ * TcpGetHandleProc --
  *
- *	Waits until one of the specified events occurs on a socket.
+ *	Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
+ *	TCP socket based channel.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with an error code in
- *	errorCodePtr.
+ *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
+ *	handle for the specified direction.
  *
  * Side effects:
- *	Processes socket events off the system queue.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 static int
-WaitForSocketEvent(
-    SocketInfo *infoPtr,	/* Information about this socket. */
-    int events,			/* Events to look for. */
-    int *errorCodePtr)		/* Where to store errors? */
+TcpGetHandleProc(
+    ClientData instanceData,	/* The socket state. */
+    int direction,		/* Not used. */
+    ClientData *handlePtr)	/* Where to store the handle. */
 {
-    int result = 1;
-    int oldMode;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-    /*
-     * Be sure to disable event servicing so we are truly modal.
-     */
-    DEBUG("=============");
-
-    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
-
-    /*
-     * Reset WSAAsyncSelect so we have a fresh set of events pending.
-     */
-
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
-	    (LPARAM) infoPtr);
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-	    (LPARAM) infoPtr);
-
-    while (1) {
-	if (infoPtr->lastError) {
-	    *errorCodePtr = infoPtr->lastError;
-	    result = 0;
-	    break;
-	} else if (infoPtr->readyEvents & events) {
-	    break;
-	} else if (infoPtr->flags & TCP_ASYNC_SOCKET) {
-	    *errorCodePtr = EWOULDBLOCK;
-	    result = 0;
-	    break;
-	}
+    TcpState *statePtr = instanceData;
 
-	/*
-	 * Wait until something happens.
-	 */
+    *handlePtr = INT2PTR(statePtr->sockets->fd);
+    return TCL_OK;
+}
 
-	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
-    }
 
-    (void) Tcl_SetServiceMode(oldMode);
-    return result;
-}
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_OpenTcpClient --
+ * CreateClientSocket --
  *
- *	Opens a TCP client socket and creates a channel around it.
+ *	This function opens a new socket in client mode.
+ *
+ *	This might be called in 3 circumstances:
+ *	-   By a regular socket command
+ *	-   By the event handler to continue an asynchroneous connect
+ *	-   By a blocking socket function (gets/puts) to terminate the
+ *	    connect synchroneously
  *
  * Results:
- *	The channel or NULL if failed. An error message is returned in the
- *	interpreter on failure.
+ *      TCL_OK, if the socket was successfully connected or an asynchronous
+ *      connection is in progress. If an error occurs, TCL_ERROR is returned
+ *      and an error message is left in interp.
  *
  * Side effects:
- *	Opens a client socket and creates a new channel.
+ *	Opens a socket.
+ *
+ * Remarks:
+ *	A single host name may resolve to more than one IP address, e.g. for
+ *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
+ *	sockets in the background for such hosts, this function can act as a
+ *	coroutine. On the first call, it sets up the control variables for the
+ *	two nested loops over the local and remote addresses. Once the first
+ *	connection attempt is in progress, it sets up itself as a writable
+ *	event handler for that socket, and returns. When the callback occurs,
+ *	control is transferred to the "reenter" label, right after the initial
+ *	return and the loops resume as if they had never been interrupted.
+ *	For syncronously connecting sockets, the loops work the usual way.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Channel
-Tcl_OpenTcpClient(
+static int
+CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    int port,			/* Port number to open. */
-    const char *host,		/* Host on which to open port. */
-    const char *myaddr,		/* Client-side address */
-    int myport,			/* Client-side port */
-    int async)			/* If nonzero, should connect client socket
-				 * asynchronously. */
+    TcpState *statePtr)
 {
-    SocketInfo *infoPtr;
-    const char *errorMsg = NULL;
-    struct addrinfo *addrlist = NULL;
-    struct addrinfo *myaddrlist = NULL;
-    char channelName[SOCK_CHAN_LENGTH];
-
-    if (TclpHasSockets(interp) != TCL_OK) {
-	return NULL;
-    }
-
+    DWORD error;
+    u_long flag = 1;		/* Indicates nonblocking mode. */
     /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
+     * We are started with async connect and the connect notification
+     * was not jet received
      */
+    int async_connect = statePtr->flags & TCP_ASYNC_CONNECT;
+    /* We were called by the event procedure and continue our loop */
+    int async_callback = statePtr->sockets->fd != INVALID_SOCKET;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    
+    DEBUG(async_connect ? "async connect" : "sync connect");
 
-    if (!SocketsEnabled()) {
-	return NULL;
+    if (async_callback) {
+	DEBUG("subsequent call");
+        goto reenter;
+    } else {
+	DEBUG("first call");
     }
+    
+    for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
+	 statePtr->addr = statePtr->addr->ai_next) {
+	
+        for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL;
+	     statePtr->myaddr = statePtr->myaddr->ai_next) {
 
-    /*
-     * Do the name lookups for the local and remote addresses.
-     */
+	    DEBUG("inner loop");
 
-    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
-            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
-                    &errorMsg)) {
-        if (addrlist != NULL) {
-            freeaddrinfo(addrlist);
-        }
-        if (interp != NULL) {
-            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                    "couldn't open socket: %s", errorMsg));
-        }
-        return NULL;
-    }
-    printaddrinfolist(myaddrlist, "local");
-    printaddrinfolist(addrlist, "remote");
+	    /*
+	     * No need to try combinations of local and remote addresses
+	     * of different families.
+	     */
 
-    infoPtr = NewSocketInfo(INVALID_SOCKET);
-    infoPtr->addrlist = addrlist;
-    infoPtr->myaddrlist = myaddrlist;
-    if (async) {
-	infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-    }
+	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
+		DEBUG("family mismatch");
+		continue;
+	    }
 
-    /*
-     * Create a new client socket and wrap it in a channel.
-     */
-    DEBUG("");
-    if (CreateClientSocket(interp, infoPtr) != TCL_OK) {
-	TcpCloseProc(infoPtr, NULL);
-	return NULL;
-    }
+	    DEBUG(statePtr->myaddr->ai_family == AF_INET ? "IPv4" : "IPv6");
+	    printaddrinfo(statePtr->myaddr, "~~ from");
+	    printaddrinfo(statePtr->addr,   "~~   to");
 
-    sprintf(channelName, SOCK_TEMPLATE, infoPtr);
+            /*
+             * Close the socket if it is still open from the last unsuccessful
+             * iteration.
+             */	    
+	    if (statePtr->sockets->fd != INVALID_SOCKET) {
+		DEBUG("closesocket");
+		closesocket(statePtr->sockets->fd);
+	    }
 
-    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
-	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
-    if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
-	    "-translation", "auto crlf")) {
-	Tcl_Close(NULL, infoPtr->channel);
-	return NULL;
-    } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
-	    "-eofchar", "")) {
-	Tcl_Close(NULL, infoPtr->channel);
-	return NULL;
-    }
-    return infoPtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_MakeTcpClientChannel --
- *
- *	Creates a Tcl_Channel from an existing client TCP socket.
- *
- * Results:
- *	The Tcl_Channel wrapped around the preexisting TCP socket.
- *
- * Side effects:
- *	None.
- *
- * NOTE: Code contributed by Mark Diekhans (markd@grizzly.com)
- *
- *----------------------------------------------------------------------
- */
+	    /* get statePtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
-Tcl_Channel
-Tcl_MakeTcpClientChannel(
-    ClientData sock)		/* The socket to wrap up into a channel. */
-{
-    SocketInfo *infoPtr;
-    char channelName[SOCK_CHAN_LENGTH];
-    ThreadSpecificData *tsdPtr;
+	    /*
+	     * Reset last error from last try
+	     */
+	    statePtr->lastError = 0;
+	    Tcl_SetErrno(0);
+	    
+	    statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, SOCK_STREAM, 0);
+	    
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
 
-    if (TclpHasSockets(NULL) != TCL_OK) {
-	return NULL;
-    }
+	    /* continue on socket creation error */
+	    if (statePtr->sockets->fd == INVALID_SOCKET) {
+		DEBUG("socket() failed");
+		TclWinConvertError((DWORD) WSAGetLastError());
+		continue;
+	    }
+	    
+#ifdef DEBUGGING
+	    fprintf(stderr, "Client socket %d created\n", statePtr->sockets->fd);
+#endif
+	    /*
+	     * Win-NT has a misfeature that sockets are inherited in child
+	     * processes by default. Turn off the inherit bit.
+	     */
 
-    tsdPtr = TclThreadDataKeyGet(&dataKey);
+	    SetHandleInformation((HANDLE) statePtr->sockets->fd, HANDLE_FLAG_INHERIT, 0);
 
-    /*
-     * Set kernel space buffering and non-blocking.
-     */
+	    /*
+	     * Set kernel space buffering
+	     */
 
-    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
+	    TclSockMinimumBuffers((void *) statePtr->sockets->fd, TCP_BUFFER_SIZE);
 
-    infoPtr = NewSocketInfo((SOCKET) sock);
+	    /*
+	     * Try to bind to a local port.
+	     */
 
-    /*
-     * Start watching for read/write events on the socket.
-     */
+	    if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
+			statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
+		DEBUG("bind() failed");
+		TclWinConvertError((DWORD) WSAGetLastError());
+		continue;
+	    }
+	    /*
+	     * For asyncroneous connect set the socket in nonblocking mode
+	     * and activate connect notification
+	     */
+	    if (async_connect) {
+		TcpState *statePtr2;
+		int in_socket_list = 0;
+		/* get statePtr lock */
+		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
-    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
+		/*
+		 * Check if my statePtr is already in the tsdPtr->socketList
+		 * It is set after this call by TcpThreadActionProc and is set
+		 * on a second round.
+		 *
+		 * If not, we buffer my statePtr in the tsd memory so it is not
+		 * lost by the event procedure
+		 */
+
+		for (statePtr2 = tsdPtr->socketList; statePtr2 != NULL;
+			statePtr2 = statePtr->nextPtr) {
+		    if (statePtr2 == statePtr) {
+			in_socket_list = 1;
+			break;
+		    }
+		}
+		if (!in_socket_list) {
+		    tsdPtr->pendingTcpState = statePtr;
+		}
+		/*
+		 * Set connect mask to connect events
+		 * This is activated by a SOCKET_SELECT message to the notifier
+		 * thread.
+		 */
+		statePtr->selectEvents |= FD_CONNECT;
+		
+		/*
+		 * Free list lock
+		 */
+		SetEvent(tsdPtr->socketListLock);
+
+    		/* activate accept notification */
+		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+			(LPARAM) statePtr);
+	    }
+
+	    /*
+	     * Attempt to connect to the remote socket.
+	     */
+	    
+	    DEBUG("connect()");
+	    connect(statePtr->sockets->fd, statePtr->addr->ai_addr,
+		    statePtr->addr->ai_addrlen);
+
+	    error = WSAGetLastError();
+	    TclWinConvertError(error);
+
+	    if (async_connect && error == WSAEWOULDBLOCK) {
+		/*
+		 * Asynchroneous connect
+		 */
+		DEBUG("WSAEWOULDBLOCK");
+
+
+		/*
+		 * Remember that we jump back behind this next round
+		 */
+		statePtr->flags |= SOCKET_REENTER_PENDING;
+		return TCL_OK;
+
+	    reenter:
+		DEBUG("reenter");
+		/*
+		 * Re-entry point for async connect after connect event or
+		 * blocking operation
+		 *
+		 * Clear the reenter flag
+		 */
+		statePtr->flags &= ~(SOCKET_REENTER_PENDING);
+		/* get statePtr lock */
+		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+		/* Get signaled connect error */
+		Tcl_SetErrno(statePtr->lastError);
+		/* Clear eventual connect flag */
+		statePtr->selectEvents &= ~(FD_CONNECT);
+		/* Free list lock */
+		SetEvent(tsdPtr->socketListLock);
+	    }
+#ifdef DEBUGGING
+	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
+#endif
+	    /*
+	     * Clear the tsd socket list pointer if we did not wait for
+	     * the FD_CONNECT asyncroneously
+	     */
+	    tsdPtr->pendingTcpState = NULL;
+	    
+	    if (Tcl_GetErrno() == 0) {
+		goto out;
+	    }
+	}
+    }
+
+out:
+    /*
+     * Socket connected or connection failed
+     */
+    DEBUG("connected or finally failed");
+    /* Clear async flag (not really necessary, not used any more) */
+    statePtr->flags &= ~(TCP_ASYNC_CONNECT);
+
+    /*
+     * Final connect failure
+     */
+
+    if ( Tcl_GetErrno() == 0 ) {
+	/*
+	 * Succesfully connected
+	 */
+	/*
+	 * Set up the select mask for read/write events.
+	 */
+	DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
+	statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
+        
+	/*
+	 * Register for interest in events in the select mask. Note that this
+	 * automatically places the socket into non-blocking mode.
+	 */
+        
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		    (LPARAM) statePtr);
+    } else {
+	/*
+	 * Connect failed
+	 */
+	DEBUG("ERRNO");
 
-    sprintf(channelName, SOCK_TEMPLATE, infoPtr);
-    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
-	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
-    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
-    return infoPtr->channel;
+	/*
+	 * For async connect schedule a writable event to report the fail.
+	 */
+	if (async_callback) {
+	    /*
+	     * Set up the select mask for read/write events.
+	     */
+	    DEBUG("selectEvents = FD_WRITE for fail writable");    
+	    statePtr->selectEvents = FD_WRITE;
+	    /* get statePtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	    /* Clear eventual connect flag */
+	    statePtr->readyEvents |= FD_WRITE;
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
+	}
+	/*
+	 * Error message on syncroneous connect
+	 */
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "couldn't open socket: %s", Tcl_PosixError(interp)));
+	}
+	return TCL_ERROR;
+    }
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_OpenTcpServer --
+ * Tcl_OpenTcpClient --
  *
- *	Opens a TCP server socket and creates a channel around it.
+ *	Opens a TCP client socket and creates a channel around it.
  *
  * Results:
  *	The channel or NULL if failed. An error message is returned in the
  *	interpreter on failure.
  *
  * Side effects:
- *	Opens a server socket and creates a new channel.
+ *	Opens a client socket and creates a new channel.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Channel
-Tcl_OpenTcpServer(
-    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
+Tcl_OpenTcpClient(
+    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
     int port,			/* Port number to open. */
-    const char *host,		/* Name of local host. */
-    Tcl_TcpAcceptProc *acceptProc,
-				/* Callback for accepting connections from new
-				 * clients. */
-    ClientData acceptProcData)	/* Data for the callback. */
+    const char *host,		/* Host on which to open port. */
+    const char *myaddr,		/* Client-side address */
+    int myport,			/* Client-side port */
+    int async)			/* If nonzero, attempt to do an asynchronous
+				 * connect. Otherwise we do a blocking
+				 * connect. */
 {
-    SOCKET sock = INVALID_SOCKET;
-    unsigned short chosenport = 0;
-    struct addrinfo *addrPtr;	/* Socket address to listen on. */
-    SocketInfo *infoPtr = NULL;	/* The returned value. */
-    struct addrinfo *addrlist = NULL;
-    char channelName[SOCK_CHAN_LENGTH];
-    u_long flag = 1;		/* Indicates nonblocking mode. */
+    TcpState *statePtr;
     const char *errorMsg = NULL;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
+    char channelName[SOCK_CHAN_LENGTH];
 
     if (TclpHasSockets(interp) != TCL_OK) {
 	return NULL;
@@ -1830,116 +1855,270 @@ Tcl_OpenTcpServer(
     }
 
     /*
-     * Construct the addresses for each end of the socket.
+     * Do the name lookups for the local and remote addresses.
      */
 
-    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 1, &errorMsg)) {
-	goto error;
+    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
+            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
+                    &errorMsg)) {
+        if (addrlist != NULL) {
+            freeaddrinfo(addrlist);
+        }
+        if (interp != NULL) {
+            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "couldn't open socket: %s", errorMsg));
+        }
+        return NULL;
     }
+    printaddrinfolist(myaddrlist, "local");
+    printaddrinfolist(addrlist, "remote");
 
-    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
-	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
-                addrPtr->ai_protocol);
-	if (sock == INVALID_SOCKET) {
-	    TclWinConvertError((DWORD) WSAGetLastError());
-	    continue;
-	}
-	
-	/*
-	 * Win-NT has a misfeature that sockets are inherited in child
-	 * processes by default. Turn off the inherit bit.
-	 */
-	
-	SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
-	
-	/*
-	 * Set kernel space buffering
-	 */
-	
-	TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
-	
-	/*
-	 * Make sure we use the same port when opening two server sockets
-	 * for IPv4 and IPv6.
-	 *
-	 * As sockaddr_in6 uses the same offset and size for the port
-	 * member as sockaddr_in, we can handle both through the IPv4 API.
-	 */
-	
-	if (port == 0 && chosenport != 0) {
-	    ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
-		htons(chosenport);
-	}
-	
-	/*
-	 * Bind to the specified port. Note that we must not call
-	 * setsockopt with SO_REUSEADDR because Microsoft allows addresses
-	 * to be reused even if they are still in use.
-	 *
-	 * Bind should not be affected by the socket having already been
-	 * set into nonblocking mode. If there is trouble, this is one
-	 * place to look for bugs.
-	 */
-	
-	if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
-	    == SOCKET_ERROR) {
-	    TclWinConvertError((DWORD) WSAGetLastError());
-	    closesocket(sock);
-	    continue;
-	}
-	if (port == 0 && chosenport == 0) {
-	    address sockname;
-	    socklen_t namelen = sizeof(sockname);
-	    
-	    /*
-	     * Synchronize port numbers when binding to port 0 of multiple
-	     * addresses.
-	     */
-	    
-	    if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
-		chosenport = ntohs(sockname.sa4.sin_port);
-	    }
-	}
-	
-	/*
-	 * Set the maximum number of pending connect requests to the max
-	 * value allowed on each platform (Win32 and Win32s may be
-	 * different, and there may be differences between TCP/IP stacks).
-	 */
-	
-	if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
-	    TclWinConvertError((DWORD) WSAGetLastError());
-	    closesocket(sock);
-	    continue;
-	}
-	
-	if (infoPtr == NULL) {
-	    /*
-	     * Add this socket to the global list of sockets.
-	     */
-	    infoPtr = NewSocketInfo(sock);
-	} else {
-	    AddSocketInfoFd( infoPtr, sock );
-	}
+    statePtr = NewSocketInfo(INVALID_SOCKET);
+    statePtr->addrlist = addrlist;
+    statePtr->myaddrlist = myaddrlist;
+    if (async) {
+	statePtr->flags |= TCP_ASYNC_CONNECT;
     }
 
-error:
-     if (addrlist != NULL) {
-	freeaddrinfo(addrlist);
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+    DEBUG("");
+    if (CreateClientSocket(interp, statePtr) != TCL_OK) {
+	TcpCloseProc(statePtr, NULL);
+	return NULL;
+    }
+
+    sprintf(channelName, SOCK_TEMPLATE, statePtr);
+
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+	    statePtr, (TCL_READABLE | TCL_WRITABLE));
+    if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
+	    "-translation", "auto crlf")) {
+	Tcl_Close(NULL, statePtr->channel);
+	return NULL;
+    } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
+	    "-eofchar", "")) {
+	Tcl_Close(NULL, statePtr->channel);
+	return NULL;
+    }
+    return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeTcpClientChannel --
+ *
+ *	Creates a Tcl_Channel from an existing client TCP socket.
+ *
+ * Results:
+ *	The Tcl_Channel wrapped around the preexisting TCP socket.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeTcpClientChannel(
+    ClientData sock)		/* The socket to wrap up into a channel. */
+{
+    TcpState *statePtr;
+    char channelName[SOCK_CHAN_LENGTH];
+    ThreadSpecificData *tsdPtr;
+
+    if (TclpHasSockets(NULL) != TCL_OK) {
+	return NULL;
+    }
+
+    tsdPtr = TclThreadDataKeyGet(&dataKey);
+
+    /*
+     * Set kernel space buffering and non-blocking.
+     */
+
+    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
+
+    statePtr = NewSocketInfo((SOCKET) sock);
+
+    /*
+     * Start watching for read/write events on the socket.
+     */
+
+    statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+
+    sprintf(channelName, SOCK_TEMPLATE, statePtr);
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+	    statePtr, (TCL_READABLE | TCL_WRITABLE));
+    Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
+    return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpServer --
+ *
+ *	Opens a TCP server socket and creates a channel around it.
+ *
+ * Results:
+ *	The channel or NULL if failed. If an error occurred, an error message
+ *	is left in the interp's result if interp is not NULL.
+ *
+ * Side effects:
+ *	Opens a server socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpServer(
+    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
+    int port,			/* Port number to open. */
+    const char *myHost,		/* Name of local host. */
+    Tcl_TcpAcceptProc *acceptProc,
+				/* Callback for accepting connections from new
+				 * clients. */
+    ClientData acceptProcData)	/* Data for the callback. */
+{
+    SOCKET sock = INVALID_SOCKET;
+    unsigned short chosenport = 0;
+    struct addrinfo *addrlist = NULL;
+    struct addrinfo *addrPtr;	/* Socket address to listen on. */
+    TcpState *statePtr = NULL;	/* The returned value. */
+    char channelName[SOCK_CHAN_LENGTH];
+    u_long flag = 1;		/* Indicates nonblocking mode. */
+    const char *errorMsg = NULL;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+
+    if (TclpHasSockets(interp) != TCL_OK) {
+	return NULL;
+    }
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
+     */
+
+    if (!SocketsEnabled()) {
+	return NULL;
+    }
+
+    /*
+     * Construct the addresses for each end of the socket.
+     */
+
+    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
+	goto error;
+    }
+
+    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
+	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
+                addrPtr->ai_protocol);
+	if (sock == INVALID_SOCKET) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    continue;
+	}
+	
+	/*
+	 * Win-NT has a misfeature that sockets are inherited in child
+	 * processes by default. Turn off the inherit bit.
+	 */
+	
+	SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
+	
+	/*
+	 * Set kernel space buffering
+	 */
+	
+	TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
+	
+	/*
+	 * Make sure we use the same port when opening two server sockets
+	 * for IPv4 and IPv6.
+	 *
+	 * As sockaddr_in6 uses the same offset and size for the port
+	 * member as sockaddr_in, we can handle both through the IPv4 API.
+	 */
+	
+	if (port == 0 && chosenport != 0) {
+	    ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
+		htons(chosenport);
+	}
+	
+	/*
+	 * Bind to the specified port. Note that we must not call
+	 * setsockopt with SO_REUSEADDR because Microsoft allows addresses
+	 * to be reused even if they are still in use.
+	 *
+	 * Bind should not be affected by the socket having already been
+	 * set into nonblocking mode. If there is trouble, this is one
+	 * place to look for bugs.
+	 */
+	
+	if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+	    == SOCKET_ERROR) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    closesocket(sock);
+	    continue;
+	}
+	if (port == 0 && chosenport == 0) {
+	    address sockname;
+	    socklen_t namelen = sizeof(sockname);
+	    
+	    /*
+	     * Synchronize port numbers when binding to port 0 of multiple
+	     * addresses.
+	     */
+	    
+	    if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
+		chosenport = ntohs(sockname.sa4.sin_port);
+	    }
+	}
+	
+	/*
+	 * Set the maximum number of pending connect requests to the max
+	 * value allowed on each platform (Win32 and Win32s may be
+	 * different, and there may be differences between TCP/IP stacks).
+	 */
+	
+	if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    closesocket(sock);
+	    continue;
+	}
+	
+	if (statePtr == NULL) {
+	    /*
+	     * Add this socket to the global list of sockets.
+	     */
+	    statePtr = NewSocketInfo(sock);
+	} else {
+	    AddSocketInfoFd( statePtr, sock );
+	}
+    }
+
+error:
+    if (addrlist != NULL) {
+	freeaddrinfo(addrlist);
     }
 
-    if (infoPtr != NULL) {
+    if (statePtr != NULL) {
 
-	infoPtr->acceptProc = acceptProc;
-	infoPtr->acceptProcData = acceptProcData;
-	sprintf(channelName, SOCK_TEMPLATE, infoPtr);
-	infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
-					    infoPtr, 0);	
+	statePtr->acceptProc = acceptProc;
+	statePtr->acceptProcData = acceptProcData;
+	sprintf(channelName, SOCK_TEMPLATE, statePtr);
+	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+		statePtr, 0);
 	/*
 	 * Set up the select mask for connection request events.
 	 */
 	
-	infoPtr->selectEvents = FD_ACCEPT;
+	statePtr->selectEvents = FD_ACCEPT;
 	
 	/*
 	 * Register for interest in events in the select mask. Note that this
@@ -1948,13 +2127,13 @@ error:
 
 	ioctlsocket(sock, (long) FIONBIO, &flag);
 	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-		    (LPARAM) infoPtr);
-	if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
+		    (LPARAM) statePtr);
+	if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
 	    == TCL_ERROR) {
-	    Tcl_Close(NULL, infoPtr->channel);
+	    Tcl_Close(NULL, statePtr->channel);
 	    return NULL;
 	}
-	return infoPtr->channel;
+	return statePtr->channel;
     }
 
     if (interp != NULL) {
@@ -1973,28 +2152,27 @@ error:
  *----------------------------------------------------------------------
  *
  * TcpAccept --
- *
- *	Creates a channel for a newly accepted socket connection. This is 
- *	called by SocketEventProc and it in turns calls the registered 
- *	accept function.
+ *	Accept a TCP socket connection.	 This is called by the event loop.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Invokes the accept proc which may invoke arbitrary Tcl code.
+ *	Creates a new connection socket. Calls the registered callback for the
+ *	connection acceptance mechanism.
  *
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 static void
 TcpAccept(
     TcpFdList *fds,	/* Server socket that accepted newSocket. */
     SOCKET newSocket,   /* Newly accepted socket. */
     address addr)       /* Address of new socket. */
 {
-    SocketInfo *newInfoPtr;
-    SocketInfo *infoPtr = fds->infoPtr;
+    TcpState *newInfoPtr;
+    TcpState *statePtr = fds->statePtr;
     int len = sizeof(addr);
     char channelName[SOCK_CHAN_LENGTH];
     char host[NI_MAXHOST], port[NI_MAXSERV];
@@ -2039,10 +2217,10 @@ TcpAccept(
      * Invoke the accept callback function.
      */
 
-    if (infoPtr->acceptProc != NULL) {
+    if (statePtr->acceptProc != NULL) {
 	getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port),
                     NI_NUMERICHOST|NI_NUMERICSERV);
-	infoPtr->acceptProc(infoPtr->acceptProcData, newInfoPtr->channel,
+	statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel,
 			    host, atoi(port));
     }
 }
@@ -2050,707 +2228,652 @@ TcpAccept(
 /*
  *----------------------------------------------------------------------
  *
- * TcpInputProc --
+ * InitSockets --
  *
- *	This function is called by the generic IO level to read data from a
- *	socket based channel.
+ *	Initialize the socket module.  If winsock startup is successful,
+ *	registers the event window for the socket notifier code.
+ *
+ *	Assumes socketMutex is held.
  *
  * Results:
- *	The number of bytes read or -1 on error.
+ *	None.
  *
  * Side effects:
- *	Consumes input from the socket.
+ *	Initializes winsock, registers a new window class and creates a
+ *	window for use in asynchronous socket notification.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-TcpInputProc(
-    ClientData instanceData,	/* The socket state. */
-    char *buf,			/* Where to store data. */
-    int toRead,			/* Maximum number of bytes to read. */
-    int *errorCodePtr)		/* Where to store error codes. */
+static void
+InitSockets(void)
 {
-    SocketInfo *infoPtr = instanceData;
-    int bytesRead;
-    DWORD error;
+    DWORD id, err;
+    WSADATA wsaData;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
-    *errorCodePtr = 0;
+    if (!initialized) {
+	initialized = 1;
+	TclCreateLateExitHandler(SocketExitHandler, NULL);
 
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
+	/*
+	 * Create the async notification window with a new class. We must
+	 * create a new class to avoid a Windows 95 bug that causes us to get
+	 * the wrong message number for socket events if the message window is
+	 * a subclass of a static control.
+	 */
 
-    if (!SocketsEnabled()) {
-	*errorCodePtr = EFAULT;
-	return -1;
-    }
+	windowClass.style = 0;
+	windowClass.cbClsExtra = 0;
+	windowClass.cbWndExtra = 0;
+	windowClass.hInstance = TclWinGetTclInstance();
+	windowClass.hbrBackground = NULL;
+	windowClass.lpszMenuName = NULL;
+	windowClass.lpszClassName = classname;
+	windowClass.lpfnWndProc = SocketProc;
+	windowClass.hIcon = NULL;
+	windowClass.hCursor = NULL;
 
-    /*
-     * First check to see if EOF was already detected, to prevent calling the
-     * socket stack after the first time EOF is detected.
-     */
-
-    if (infoPtr->flags & SOCKET_EOF) {
-	return 0;
-    }
-
-    /*
-     * Check if there is an async connect running.
-     * For blocking sockets terminate connect, otherwise do one step.
-     * For a non blocking socket return EWOULDBLOCK if connect not terminated
-     */
-
-    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForConnect(infoPtr, errorCodePtr,
-		! ( infoPtr->flags & TCP_ASYNC_SOCKET ))) {
-	return -1;
-    }
-
-    /*
-     * No EOF, and it is connected, so try to read more from the socket. Note
-     * that we clear the FD_READ bit because read events are level triggered
-     * so a new event will be generated if there is still data available to be
-     * read. We have to simulate blocking behavior here since we are always
-     * using non-blocking sockets.
-     */
-
-    while (1) {
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) infoPtr);
-	/* single fd operation: this proc is only called for a connected socket. */
-	bytesRead = recv(infoPtr->sockets->fd, buf, toRead, 0);
-	infoPtr->readyEvents &= ~(FD_READ);
+	if (!RegisterClass(&windowClass)) {
+	    TclWinConvertError(GetLastError());
+	    goto initFailure;
+	}
 
 	/*
-	 * Check for end-of-file condition or successful read.
+	 * Initialize the winsock library and check the interface version
+	 * actually loaded. We only ask for the 1.1 interface and do require
+	 * that it not be less than 1.1.
 	 */
 
-	if (bytesRead == 0) {
-	    infoPtr->flags |= SOCKET_EOF;
-	}
-	if (bytesRead != SOCKET_ERROR) {
-	    break;
+	err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR),
+		&wsaData);
+	if (err != 0) {
+	    TclWinConvertError(err);
+	    goto initFailure;
 	}
 
 	/*
-	 * If an error occurs after the FD_CLOSE has arrived, then ignore the
-	 * error and report an EOF.
+	 * Note the byte positions ae swapped for the comparison, so that
+	 * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). We
+	 * want the comparison to be 0x0200 < 0x0101.
 	 */
 
-	if (infoPtr->readyEvents & FD_CLOSE) {
-	    infoPtr->flags |= SOCKET_EOF;
-	    bytesRead = 0;
-	    break;
+	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
+		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
+	    TclWinConvertError(WSAVERNOTSUPPORTED);
+	    WSACleanup();
+	    goto initFailure;
 	}
+    }
 
-	error = WSAGetLastError();
+    /*
+     * Check for per-thread initialization.
+     */
 
-	/*
-	 * If an RST comes, then ignore the error and report an EOF just like
-	 * on unix.
-	 */
+    if (tsdPtr != NULL) {
+	return;
+    }
 
-	if (error == WSAECONNRESET) {
-	    infoPtr->flags |= SOCKET_EOF;
-	    bytesRead = 0;
-	    break;
-	}
+    /*
+     * OK, this thread has never done anything with sockets before.  Construct
+     * a worker thread to handle asynchronous events related to sockets
+     * assigned to _this_ thread.
+     */
 
-	/*
-	 * Check for error condition or underflow in non-blocking case.
-	 */
+    tsdPtr = TCL_TSD_INIT(&dataKey);
+    tsdPtr->pendingTcpState = NULL;
+    tsdPtr->socketList = NULL;
+    tsdPtr->hwnd       = NULL;
+    tsdPtr->threadId   = Tcl_GetCurrentThread();
+    tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+    if (tsdPtr->readyEvent == NULL) {
+	goto initFailure;
+    }
+    tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
+    if (tsdPtr->socketListLock == NULL) {
+	goto initFailure;
+    }
+    tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0,
+	    &id);
+    if (tsdPtr->socketThread == NULL) {
+	goto initFailure;
+    }
 
-	if ((infoPtr->flags & TCP_ASYNC_SOCKET) || (error != WSAEWOULDBLOCK)) {
-	    TclWinConvertError(error);
-	    *errorCodePtr = Tcl_GetErrno();
-	    bytesRead = -1;
-	    break;
-	}
+    SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
 
-	/*
-	 * In the blocking case, wait until the file becomes readable or
-	 * closed and try again.
-	 */
+    /*
+     * Wait for the thread to signal when the window has been created and if
+     * it is ready to go.
+     */
 
-	if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
-	    bytesRead = -1;
-	    break;
-	}
+    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+
+    if (tsdPtr->hwnd == NULL) {
+	goto initFailure;	/* Trouble creating the window. */
     }
 
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
+    Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
+    return;
 
-    return bytesRead;
+  initFailure:
+    TclpFinalizeSockets();
+    initialized = -1;
+    return;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpOutputProc --
+ * SocketsEnabled --
  *
- *	This function is called by the generic IO level to write data to a
- *	socket based channel.
+ *	Check that the WinSock was successfully initialized.
  *
  * Results:
- *	The number of bytes written or -1 on failure.
+ *	1 if it is.
  *
  * Side effects:
- *	Produces output on the socket.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
+    /* ARGSUSED */
 static int
-TcpOutputProc(
-    ClientData instanceData,	/* The socket state. */
-    const char *buf,		/* Where to get data. */
-    int toWrite,		/* Maximum number of bytes to write. */
-    int *errorCodePtr)		/* Where to store error codes. */
+SocketsEnabled(void)
 {
-    SocketInfo *infoPtr = instanceData;
-    int bytesWritten;
-    DWORD error;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    int enabled;
 
-    *errorCodePtr = 0;
+    Tcl_MutexLock(&socketMutex);
+    enabled = (initialized == 1);
+    Tcl_MutexUnlock(&socketMutex);
+    return enabled;
+}
 
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketExitHandler --
+ *
+ *	Callback invoked during exit clean up to delete the socket
+ *	communication window and to release the WinSock DLL.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    if (!SocketsEnabled()) {
-	*errorCodePtr = EFAULT;
-	return -1;
-    }
+    /* ARGSUSED */
+static void
+SocketExitHandler(
+    ClientData clientData)		/* Not used. */
+{
+    Tcl_MutexLock(&socketMutex);
 
     /*
-     * Check if there is an async connect running.
-     * For blocking sockets terminate connect, otherwise do one step.
-     * For a non blocking socket return EWOULDBLOCK if connect not terminated
+     * Make sure the socket event handling window is cleaned-up for, at
+     * most, this thread.
      */
 
-    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForConnect(infoPtr, errorCodePtr,
-		! ( infoPtr->flags & TCP_ASYNC_SOCKET ))) {
-	return -1;
-    }
-
-    while (1) {
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) infoPtr);
-
-	/* single fd operation: this proc is only called for a connected socket. */
-	bytesWritten = send(infoPtr->sockets->fd, buf, toWrite, 0);
-	if (bytesWritten != SOCKET_ERROR) {
-	    /*
-	     * Since Windows won't generate a new write event until we hit an
-	     * overflow condition, we need to force the event loop to poll
-	     * until the condition changes.
-	     */
-
-	    if (infoPtr->watchEvents & FD_WRITE) {
-		Tcl_Time blockTime = { 0, 0 };
-		Tcl_SetMaxBlockTime(&blockTime);
-	    }
-	    break;
-	}
-
-	/*
-	 * Check for error condition or overflow. In the event of overflow, we
-	 * need to clear the FD_WRITE flag so we can detect the next writable
-	 * event. Note that Windows only sends a new writable event after a
-	 * send fails with WSAEWOULDBLOCK.
-	 */
-
-	error = WSAGetLastError();
-	if (error == WSAEWOULDBLOCK) {
-	    infoPtr->readyEvents &= ~(FD_WRITE);
-	    if (infoPtr->flags & TCP_ASYNC_SOCKET) {
-		*errorCodePtr = EWOULDBLOCK;
-		bytesWritten = -1;
-		break;
-	    }
-	} else {
-	    TclWinConvertError(error);
-	    *errorCodePtr = Tcl_GetErrno();
-	    bytesWritten = -1;
-	    break;
-	}
-
-	/*
-	 * In the blocking case, wait until the file becomes writable or
-	 * closed and try again.
-	 */
-
-	if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
-	    bytesWritten = -1;
-	    break;
-	}
-    }
-
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
-
-    return bytesWritten;
+    TclpFinalizeSockets();
+    UnregisterClass(classname, TclWinGetTclInstance());
+    WSACleanup();
+    initialized = 0;
+    Tcl_MutexUnlock(&socketMutex);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpSetOptionProc --
+ * SocketSetupProc --
  *
- *	Sets Tcp channel specific options.
+ *	This function is invoked before Tcl_DoOneEvent blocks waiting for an
+ *	event.
  *
  * Results:
- *	None, unless an error happens.
+ *	None.
  *
  * Side effects:
- *	Changes attributes of the socket at the system level.
+ *	Adjusts the block time if needed.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-TcpSetOptionProc(
-    ClientData instanceData,	/* Socket state. */
-    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
-    const char *optionName,	/* Name of the option to set. */
-    const char *value)		/* New value for option. */
+void
+SocketSetupProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 {
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-    SocketInfo *infoPtr = instanceData;
-    SOCKET sock;
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+    TcpState *statePtr;
+    Tcl_Time blockTime = { 0, 0 };
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
 
     /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
+     * Check to see if there is a ready socket.	 If so, poll.
      */
-
-    if (!SocketsEnabled()) {
-	if (interp) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "winsock is not initialized", -1));
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+    for (statePtr = tsdPtr->socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	if (statePtr->readyEvents &
+	    (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
+	) {
+	    DEBUG("Tcl_SetMaxBlockTime");
+	    Tcl_SetMaxBlockTime(&blockTime);
+	    break;
 	}
-	return TCL_ERROR;
     }
+    SetEvent(tsdPtr->socketListLock);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketCheckProc --
+ *
+ *	This function is called by Tcl_DoOneEvent to check the socket event
+ *	source for events.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
 
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-    #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat infoPtr->sockets as single fd or list"
-    sock = infoPtr->sockets->fd;
+static void
+SocketCheckProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    TcpState *statePtr;
+    SocketEvent *evPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    if (!strcasecmp(optionName, "-keepalive")) {
-	BOOL val = FALSE;
-	int boolVar, rtn;
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
 
-	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (boolVar) {
-	    val = TRUE;
-	}
-	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
-		(const char *) &val, sizeof(BOOL));
-	if (rtn != 0) {
-	    TclWinConvertError(WSAGetLastError());
-	    if (interp) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"couldn't set socket option: %s",
-			Tcl_PosixError(interp)));
-	    }
-	    return TCL_ERROR;
-	}
-	return TCL_OK;
-    } else if (!strcasecmp(optionName, "-nagle")) {
-	BOOL val = FALSE;
-	int boolVar, rtn;
+    /*
+     * Queue events for any ready sockets that don't already have events
+     * queued (caused by persistent states that won't generate WinSock
+     * events).
+     */
 
-	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (!boolVar) {
-	    val = TRUE;
-	}
-	rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
-		(const char *) &val, sizeof(BOOL));
-	if (rtn != 0) {
-	    TclWinConvertError(WSAGetLastError());
-	    if (interp) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"couldn't set socket option: %s",
-			Tcl_PosixError(interp)));
-	    }
-	    return TCL_ERROR;
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+    for (statePtr = tsdPtr->socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	DEBUG("Socket loop");
+	if ((statePtr->readyEvents &
+		(statePtr->watchEvents | FD_CONNECT | FD_ACCEPT))
+	    && !(statePtr->flags & SOCKET_PENDING)
+	) {
+	    DEBUG("Event found");
+	    statePtr->flags |= SOCKET_PENDING;
+	    evPtr = ckalloc(sizeof(SocketEvent));
+	    evPtr->header.proc = SocketEventProc;
+	    evPtr->socket = statePtr->sockets->fd;
+	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
 	}
-	return TCL_OK;
     }
-
-    return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
-#else
-    return Tcl_BadChannelOption(interp, optionName, "");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+    SetEvent(tsdPtr->socketListLock);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpGetOptionProc --
- *
- *	Computes an option value for a TCP socket based channel, or a list of
- *	all options and their values.
+ * SocketEventProc --
  *
- *	Note: This code is based on code contributed by John Haxby.
+ *	This function is called by Tcl_ServiceEvent when a socket event
+ *	reaches the front of the event queue. This function is responsible for
+ *	notifying the generic channel code.
  *
  * Results:
- *	A standard Tcl result. The value of the specified option or a list of
- *	all options and their values is returned in the supplied DString.
+ *	Returns 1 if the event was handled, meaning it should be removed from
+ *	the queue. Returns 0 if the event was not handled, meaning it should
+ *	stay on the queue. The only time the event isn't handled is if the
+ *	TCL_FILE_EVENTS flag bit isn't set.
  *
  * Side effects:
- *	None.
+ *	Whatever the channel callback functions do.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TcpGetOptionProc(
-    ClientData instanceData,	/* Socket state. */
-    Tcl_Interp *interp,		/* For error reporting - can be NULL */
-    const char *optionName,	/* Name of the option to retrieve the value
-				 * for, or NULL to get all options and their
-				 * values. */
-    Tcl_DString *dsPtr)		/* Where to store the computed value;
-				 * initialized by caller. */
+SocketEventProc(
+    Tcl_Event *evPtr,		/* Event to service. */
+    int flags)			/* Flags that indicate what events to handle,
+				 * such as TCL_FILE_EVENTS. */
 {
-    SocketInfo *infoPtr = instanceData;
-    char host[NI_MAXHOST], port[NI_MAXSERV];
-    SOCKET sock;
-    size_t len = 0;
-    int reverseDNS = 0;
-#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
+    TcpState *statePtr = NULL; /* DEBUG */
+    SocketEvent *eventPtr = (SocketEvent *) evPtr;
+    int mask = 0, events;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    TcpFdList *fds;
+    SOCKET newSocket;
+    address addr;
+    int len;
+
+    DEBUG("");
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return 0;
+    }
 
     /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
+     * Find the specified socket on the socket list.
      */
 
-    if (!SocketsEnabled()) {
-	if (interp) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "winsock is not initialized", -1));
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+    for (statePtr = tsdPtr->socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	if (statePtr->sockets->fd == eventPtr->socket) {
+	    break;
 	}
-	return TCL_ERROR;
-    }
-
-    sock = infoPtr->sockets->fd;
-    if (optionName != NULL) {
-	len = strlen(optionName);
     }
 
-    if ((len > 1) && (optionName[1] == 'e') &&
-	    (strncmp(optionName, "-error", len) == 0)) {
+    /*
+     * Discard events that have gone stale.
+     */
 
-	if ( (infoPtr->flags & SOCKET_REENTER_PENDING) ) {
+    if (!statePtr) {
+        SetEvent(tsdPtr->socketListLock);
+	return 1;
+    }
 
-	    /*
-	     * Asyncroneous connect is running.
-	     * Process it one step without blocking.
-	     * Return its error or nothing if connect not
-	     * terminated.
-	     */
+    statePtr->flags &= ~SOCKET_PENDING;
 
-	    int errorCode;
-	    if (!WaitForConnect(infoPtr, &errorCode, 0)
-		    && errorCode != EWOULDBLOCK) {
-		/* connect terminated with error */
-		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
-	    }
+    /* Continue async connect if pending and ready */
+    if ( statePtr->readyEvents & FD_CONNECT ) {
+	statePtr->readyEvents &= ~(FD_CONNECT);
+	DEBUG("FD_CONNECT");
+        if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
+	    SetEvent(tsdPtr->socketListLock);
+	    CreateClientSocket(NULL, statePtr);
+	    return 1;
+	}
+    }
 
-	} else {
-	    int optlen;
-	    int ret;
-    	    DWORD err;
+    /*
+     * Handle connection requests directly.
+     */
+    if (statePtr->readyEvents & FD_ACCEPT) {
+	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
 
 	    /*
-	     * Populater the err Variable with a possix error
-	     */
-	    optlen = sizeof(int);
-	    ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
-		    (char *)&err, &optlen);
-	    /*
-	     * The error was not returned directly but should be
-	     * taken from WSA
-	     */
-	    if (ret == SOCKET_ERROR) {
-		err = WSAGetLastError();
-	    }
-	    /*
-	     * Return error message
-	     */
-	    if (err) {
-		TclWinConvertError(err);
-		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
-	    }
-	}
-	return TCL_OK;
-    }
+	    * Accept the incoming connection request.
+	    */
+	    len = sizeof(address);
 
-    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
-	reverseDNS = NI_NUMERICHOST;
-    }
+	    newSocket = accept(fds->fd, &(addr.sa), &len);
 
-    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
-	    (strncmp(optionName, "-peername", len) == 0))) {
-	address peername;
-	socklen_t size = sizeof(peername);
+	    /* On Tcl server sockets with multiple OS fds we loop over the fds trying
+	     * an accept() on each, so we expect INVALID_SOCKET.  There are also other
+	     * network stack conditions that can result in FD_ACCEPT but a subsequent
+	     * failure on accept() by the time we get around to it.
+	     * Access to sockets (acceptEventCount, readyEvents) in socketList
+	     * is still protected by the lock (prevents reintroduction of 
+	     * SF Tcl Bug 3056775.
+	     */
 
-	if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
-	    if (len == 0) {
-		Tcl_DStringAppendElement(dsPtr, "-peername");
-		Tcl_DStringStartSublist(dsPtr);
+	    if (newSocket == INVALID_SOCKET) {
+		/* int err = WSAGetLastError(); */
+		continue;
 	    }
 
-	    getnameinfo(&(peername.sa), size, host, sizeof(host),
-		    NULL, 0, NI_NUMERICHOST);
-	    Tcl_DStringAppendElement(dsPtr, host);
-	    getnameinfo(&(peername.sa), size, host, sizeof(host),
-		    port, sizeof(port), reverseDNS | NI_NUMERICSERV);
-	    Tcl_DStringAppendElement(dsPtr, host);
-	    Tcl_DStringAppendElement(dsPtr, port);
-	    if (len == 0) {
-		Tcl_DStringEndSublist(dsPtr);
-	    } else {
-		return TCL_OK;
-	    }
-	} else {
 	    /*
-	     * getpeername failed - but if we were asked for all the options
-	     * (len==0), don't flag an error at that point because it could be
-	     * an fconfigure request on a server socket (such sockets have no
-	     * peer). {Copied from unix/tclUnixChan.c}
+	     * It is possible that more than one FD_ACCEPT has been sent, so an extra
+	     * count must be kept. Decrement the count, and reset the readyEvent bit
+	     * if the count is no longer > 0.
 	     */
+	    statePtr->acceptEventCount--;
 
-	    if (len) {
-		TclWinConvertError((DWORD) WSAGetLastError());
-		if (interp) {
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "can't get peername: %s",
-			    Tcl_PosixError(interp)));
-		}
-		return TCL_ERROR;
+	    if (statePtr->acceptEventCount <= 0) {
+		statePtr->readyEvents &= ~(FD_ACCEPT);
 	    }
-	}
-    }
 
-    if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
-	    (strncmp(optionName, "-sockname", len) == 0))) {
-	TcpFdList *fds;
-	address sockname;
-	socklen_t size;
-	int found = 0;
+	    SetEvent(tsdPtr->socketListLock);
 
-	if (len == 0) {
-	    Tcl_DStringAppendElement(dsPtr, "-sockname");
-	    Tcl_DStringStartSublist(dsPtr);
+	    /* Caution: TcpAccept() has the side-effect of evaluating the server
+	     * accept script (via AcceptCallbackProc() in tclIOCmd.c), which can
+	     * close the server socket and invalidate statePtr and fds.
+	     * If TcpAccept() accepts a socket we must return immediately and let
+	     * SocketCheckProc queue additional FD_ACCEPT events.
+	     */
+	    TcpAccept(fds, newSocket, addr);
+	    return 1;
 	}
-	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
-	    sock = fds->fd;
-#ifdef DEBUGGING
-	    fprintf(stderr, "sock == %d\n", sock);
-#endif
-	    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);
+	/* Loop terminated with no sockets accepted; clear the ready mask so 
+	 * we can detect the next connection request. Note that connection 
+	 * requests are level triggered, so if there is a request already 
+	 * pending, a new event will be generated.
+	 */
+	statePtr->acceptEventCount = 0;
+	statePtr->readyEvents &= ~(FD_ACCEPT);
 
-		/*
-		 * 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);
-	    }
-	}
-	if (found) {
-	    if (len == 0) {
-		Tcl_DStringEndSublist(dsPtr);
-	    } else {
-		return TCL_OK;
-	    }
-	} else {
-	    if (interp) {
-		TclWinConvertError((DWORD) WSAGetLastError());
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"can't get sockname: %s", Tcl_PosixError(interp)));
-	    }
-	    return TCL_ERROR;
-	}
+	SetEvent(tsdPtr->socketListLock);
+	return 1;
     }
 
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-    if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
-	int optlen;
-	BOOL opt = FALSE;
+    SetEvent(tsdPtr->socketListLock);
 
-	if (len == 0) {
-	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
-	}
-	optlen = sizeof(BOOL);
-	getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
-	if (opt) {
-	    Tcl_DStringAppendElement(dsPtr, "1");
-	} else {
-	    Tcl_DStringAppendElement(dsPtr, "0");
-	}
-	if (len > 0) {
-	    return TCL_OK;
-	}
-    }
+    /*
+     * Mask off unwanted events and compute the read/write mask so we can
+     * notify the channel.
+     */
+
+    events = statePtr->readyEvents & statePtr->watchEvents;
+
+    if (events & FD_CLOSE) {
+	/*
+	 * If the socket was closed and the channel is still interested in
+	 * read events, then we need to ensure that we keep polling for this
+	 * event until someone does something with the channel. Note that we
+	 * do this before calling Tcl_NotifyChannel so we don't have to watch
+	 * out for the channel being deleted out from under us. This may cause
+	 * a redundant trip through the event loop, but it's simpler than
+	 * trying to do unwind protection.
+	 */
+
+	Tcl_Time blockTime = { 0, 0 };
+
+	DEBUG("FD_CLOSE");
+	Tcl_SetMaxBlockTime(&blockTime);
+	mask |= TCL_READABLE|TCL_WRITABLE;
+    } else if (events & FD_READ) {
+	fd_set readFds;
+	struct timeval timeout;
 
-    if (len == 0 || !strncmp(optionName, "-nagle", len)) {
-	int optlen;
-	BOOL opt = FALSE;
+	/*
+	 * We must check to see if data is really available, since someone
+	 * could have consumed the data in the meantime. Turn off async
+	 * notification so select will work correctly. If the socket is still
+	 * readable, notify the channel driver, otherwise reset the async
+	 * select handler and keep waiting.
+	 */
+	DEBUG("FD_READ");
 
-	if (len == 0) {
-	    Tcl_DStringAppendElement(dsPtr, "-nagle");
-	}
-	optlen = sizeof(BOOL);
-	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
-	if (opt) {
-	    Tcl_DStringAppendElement(dsPtr, "0");
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+		(WPARAM) UNSELECT, (LPARAM) statePtr);
+
+	FD_ZERO(&readFds);
+	FD_SET(statePtr->sockets->fd, &readFds);
+	timeout.tv_usec = 0;
+	timeout.tv_sec = 0;
+
+	if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
+	    mask |= TCL_READABLE;
 	} else {
-	    Tcl_DStringAppendElement(dsPtr, "1");
-	}
-	if (len > 0) {
-	    return TCL_OK;
+	    statePtr->readyEvents &= ~(FD_READ);
+	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+		    (WPARAM) SELECT, (LPARAM) statePtr);
 	}
     }
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
-
-    if (len > 0) {
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-	return Tcl_BadChannelOption(interp, optionName,
-		"peername sockname keepalive nagle");
-#else
-	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+    if (events & FD_WRITE) {
+	DEBUG("FD_WRITE");
+	mask |= TCL_WRITABLE;
     }
-
-    return TCL_OK;
+    if (mask) {
+	DEBUG("Calling Tcl_NotifyChannel...");
+	Tcl_NotifyChannel(statePtr->channel, mask);
+    }
+    DEBUG("returning...");
+    return 1;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpWatchProc --
+ * AddSocketInfoFd --
  *
- *	Informs the channel driver of the events that the generic channel code
- *	wishes to receive on this socket.
+ *	This function adds a SOCKET file descriptor to the 'sockets' linked 
+ *	list of a TcpState structure.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	May cause the notifier to poll if any of the specified conditions are
- *	already true.
+ *	None, except for allocation of memory.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-TcpWatchProc(
-    ClientData instanceData,	/* The socket state. */
-    int mask)			/* Events of interest; an OR-ed combination of
-				 * TCL_READABLE, TCL_WRITABLE and
-				 * TCL_EXCEPTION. */
+AddSocketInfoFd(
+    TcpState *statePtr, 
+    SOCKET socket)
 {
-    SocketInfo *infoPtr = instanceData;
+    TcpFdList *fds = statePtr->sockets;
 
-    DEBUG((mask & TCL_READABLE) ? "+r":"-r");
-    DEBUG((mask & TCL_WRITABLE) ? "+w":"-w");
+    if ( fds == NULL ) {
+	/* Add the first FD */
+	statePtr->sockets = ckalloc(sizeof(TcpFdList));
+	fds = statePtr->sockets;
+    } else {
+	/* Find end of list and append FD */
+	while ( fds->next != NULL ) {
+	    fds = fds->next;
+	}
+    
+	fds->next = ckalloc(sizeof(TcpFdList));
+	fds = fds->next;
+    }
 
-    /*
-     * Update the watch events mask. Only if the socket is not a server
-     * socket. [Bug 557878]
-     */
+    /* Populate new FD */
+    fds->fd = socket;
+    fds->statePtr = statePtr;
+    fds->next = NULL;
+}
 
-    if (!infoPtr->acceptProc) {
-	infoPtr->watchEvents = 0;
-	if (mask & TCL_READABLE) {
-	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE);
-	}
-	if (mask & TCL_WRITABLE) {
-	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE);
-	}
+    
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewSocketInfo --
+ *
+ *	This function allocates and initializes a new TcpState structure.
+ *
+ * Results:
+ *	Returns a newly allocated TcpState.
+ *
+ * Side effects:
+ *	None, except for allocation of memory.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	/*
-	 * If there are any conditions already set, then tell the notifier to
-	 * poll rather than block.
-	 */
+static TcpState *
+NewSocketInfo(SOCKET socket)
+{
+    TcpState *statePtr = ckalloc(sizeof(TcpState));
 
-	if (infoPtr->readyEvents & infoPtr->watchEvents) {
-	    Tcl_Time blockTime = { 0, 0 };
+    memset(statePtr, 0, sizeof(TcpState));
 
-	    Tcl_SetMaxBlockTime(&blockTime);
-	}
-    }
+    /*
+     * TIP #218. Removed the code inserting the new structure into the global
+     * list. This is now handled in the thread action callbacks, and only
+     * there.
+     */
+
+    AddSocketInfoFd(statePtr, socket);
+
+    return statePtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpGetProc --
+ * WaitForSocketEvent --
  *
- *	Called from Tcl_GetChannelHandle to retrieve an OS handle from inside
- *	a TCP socket based channel.
+ *	Waits until one of the specified events occurs on a socket.
  *
  * Results:
- *	Returns TCL_OK with the socket in handlePtr.
+ *	Returns 1 on success or 0 on failure, with an error code in
+ *	errorCodePtr.
  *
  * Side effects:
- *	None.
+ *	Processes socket events off the system queue.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TcpGetHandleProc(
-    ClientData instanceData,	/* The socket state. */
-    int direction,		/* Not used. */
-    ClientData *handlePtr)	/* Where to store the handle. */
+WaitForSocketEvent(
+    TcpState *statePtr,	/* Information about this socket. */
+    int events,			/* Events to look for. */
+    int *errorCodePtr)		/* Where to store errors? */
 {
-    SocketInfo *statePtr = instanceData;
+    int result = 1;
+    int oldMode;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    /*
+     * Be sure to disable event servicing so we are truly modal.
+     */
+    DEBUG("=============");
 
-    *handlePtr = INT2PTR(statePtr->sockets->fd);
-    return TCL_OK;
+    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
+
+    /*
+     * Reset WSAAsyncSelect so we have a fresh set of events pending.
+     */
+
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
+	    (LPARAM) statePtr);
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+	    (LPARAM) statePtr);
+
+    while (1) {
+	if (statePtr->lastError) {
+	    *errorCodePtr = statePtr->lastError;
+	    result = 0;
+	    break;
+	} else if (statePtr->readyEvents & events) {
+	    break;
+	} else if (statePtr->flags & TCP_ASYNC_SOCKET) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    result = 0;
+	    break;
+	}
+
+	/*
+	 * Wait until something happens.
+	 */
+
+	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+    }
+
+    (void) Tcl_SetServiceMode(oldMode);
+    return result;
 }
 
 /*
@@ -2844,7 +2967,7 @@ SocketProc(
 {
     int event, error;
     SOCKET socket;
-    SocketInfo *infoPtr = NULL; /* DEBUG */
+    TcpState *statePtr = NULL; /* DEBUG */
     int info_found = 0;
     TcpFdList *fds = NULL;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
@@ -2901,27 +3024,27 @@ SocketProc(
 	 * eventState flag.
 	 */
 
-	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
-		infoPtr = infoPtr->nextPtr) {
-    	    DEBUG("Cur InfoPtr");
-    	    if ( FindFDInList(infoPtr,socket) ) {
-    		info_found = 1;
-    		DEBUG("InfoPtr found");
-    		break;
-    	    }
-    	}
-    	/*
-    	 * Check if there is a pending info structure not jet in the
-    	 * list
-    	 */
-    	if ( !info_found
-    		&& tsdPtr->pendingSocketInfo != NULL
-    		&& FindFDInList(tsdPtr->pendingSocketInfo,socket) ) {
-    	    infoPtr = tsdPtr->pendingSocketInfo;
-    	    DEBUG("Pending InfoPtr found");
-    	    info_found = 1;
-    	}
-    	if (info_found) {
+	for (statePtr = tsdPtr->socketList; statePtr != NULL;
+		statePtr = statePtr->nextPtr) {
+	    DEBUG("Cur InfoPtr");
+	    if ( FindFDInList(statePtr,socket) ) {
+		info_found = 1;
+		DEBUG("InfoPtr found");
+		break;
+	    }
+	}
+	/*
+	 * Check if there is a pending info structure not jet in the
+	 * list
+	 */
+	if ( !info_found
+		&& tsdPtr->pendingTcpState != NULL
+		&& FindFDInList(tsdPtr->pendingTcpState,socket) ) {
+	    statePtr = tsdPtr->pendingTcpState;
+	    DEBUG("Pending InfoPtr found");
+	    info_found = 1;
+	}
+	if (info_found) {
 	    if (event & FD_READ) 
 		DEBUG("|->FD_READ");
 	    if (event & FD_WRITE) 
@@ -2937,11 +3060,11 @@ SocketProc(
 
 	    if (event & FD_CLOSE) {
 		DEBUG("FD_CLOSE");
-		infoPtr->acceptEventCount = 0;
-		infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+		statePtr->acceptEventCount = 0;
+		statePtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
 	    } else if (event & FD_ACCEPT) {
 		DEBUG("FD_ACCEPT");
-		    infoPtr->acceptEventCount++;
+		    statePtr->acceptEventCount++;
 	    }
 
 	    if (event & FD_CONNECT) {
@@ -2952,13 +3075,13 @@ SocketProc(
 		 */
 		if (error != ERROR_SUCCESS) {
 		    TclWinConvertError((DWORD) error);
-		    infoPtr->lastError = Tcl_GetErrno();
+		    statePtr->lastError = Tcl_GetErrno();
 		}
 	    }
 	    /*
 	     * Inform main thread about signaled events
 	     */
-	    infoPtr->readyEvents |= event;
+	    statePtr->readyEvents |= event;
 
 	    /*
 	     * Wake up the Main Thread.
@@ -2971,20 +3094,20 @@ SocketProc(
 
     case SOCKET_SELECT:
 	DEBUG("SOCKET_SELECT");
-	infoPtr = (SocketInfo *) lParam;
-	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+	statePtr = (TcpState *) lParam;
+	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
 #ifdef DEBUGGING
 	    fprintf(stderr,"loop over fd = %d\n",fds->fd);
 #endif
 	    if (wParam == SELECT) {
 		DEBUG("SELECT");
-		if (infoPtr->selectEvents & FD_READ) DEBUG("  READ");
-		if (infoPtr->selectEvents & FD_WRITE) DEBUG("  WRITE");
-		if (infoPtr->selectEvents & FD_CLOSE) DEBUG("  CLOSE");
-		if (infoPtr->selectEvents & FD_CONNECT) DEBUG("  CONNECT");
-		if (infoPtr->selectEvents & FD_ACCEPT) DEBUG("  ACCEPT");
+		if (statePtr->selectEvents & FD_READ) DEBUG("  READ");
+		if (statePtr->selectEvents & FD_WRITE) DEBUG("  WRITE");
+		if (statePtr->selectEvents & FD_CLOSE) DEBUG("  CLOSE");
+		if (statePtr->selectEvents & FD_CONNECT) DEBUG("  CONNECT");
+		if (statePtr->selectEvents & FD_ACCEPT) DEBUG("  ACCEPT");
 		WSAAsyncSelect(fds->fd, hwnd,
-			SOCKET_MESSAGE, infoPtr->selectEvents);
+			SOCKET_MESSAGE, statePtr->selectEvents);
 	    } else {
 		/*
 		 * Clear the selection mask
@@ -3023,11 +3146,11 @@ SocketProc(
 
 static int
 FindFDInList(
-    SocketInfo *infoPtr,
+    TcpState *statePtr,
     SOCKET socket)
 {
     TcpFdList *fds;
-    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+    for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
         #ifdef DEBUGGING
 	fprintf(stderr,"socket = %d, fd=%d\n",socket,fds);
 	#endif
@@ -3041,88 +3164,6 @@ FindFDInList(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GetHostName --
- *
- *	Returns the name of the local host.
- *
- * Results:
- *	A string containing the network name for this machine. The caller must
- *	not modify or free this string.
- *
- * Side effects:
- *	Caches the name to return for future calls.
- *
- *----------------------------------------------------------------------
- */
-
-const char *
-Tcl_GetHostName(void)
-{
-    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InitializeHostName --
- *
- *	This routine sets the process global value of the name of the local
- *	host on which the process is running.
- *
- * Results:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-InitializeHostName(
-    char **valuePtr,
-    int *lengthPtr,
-    Tcl_Encoding *encodingPtr)
-{
-    TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
-    DWORD length = MAX_COMPUTERNAME_LENGTH + 1;
-    Tcl_DString ds;
-
-    if (GetComputerName(tbuf, &length) != 0) {
-	/*
-	 * Convert string from native to UTF then change to lowercase.
-	 */
-
-	Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds));
-
-    } else {
-	Tcl_DStringInit(&ds);
-	if (TclpHasSockets(NULL) == TCL_OK) {
-	    /*
-	     * The buffer size of 256 is recommended by the MSDN page that
-	     * documents gethostname() as being always adequate.
-	     */
-
-	    Tcl_DString inDs;
-
-	    Tcl_DStringInit(&inDs);
-	    Tcl_DStringSetLength(&inDs, 256);
-	    if (gethostname(Tcl_DStringValue(&inDs),
-		    Tcl_DStringLength(&inDs)) == 0) {
-		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
-			&ds);
-	    }
-	    Tcl_DStringFree(&inDs);
-	}
-    }
-
-    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
-    *lengthPtr = Tcl_DStringLength(&ds);
-    *valuePtr = ckalloc((*lengthPtr) + 1);
-    memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
-    Tcl_DStringFree(&ds);
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclWinGetSockOpt, et al. --
  *
  *	These functions are wrappers that let us bind the WinSock API
@@ -3239,7 +3280,7 @@ TcpThreadActionProc(
     int action)
 {
     ThreadSpecificData *tsdPtr;
-    SocketInfo *infoPtr = instanceData;
+    TcpState *statePtr = instanceData;
     int notifyCmd;
 
     if (action == TCL_CHANNEL_THREAD_INSERT) {
@@ -3256,19 +3297,19 @@ TcpThreadActionProc(
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 	DEBUG("Inserting pointer to list");
-	infoPtr->nextPtr = tsdPtr->socketList;
-	tsdPtr->socketList = infoPtr;
+	statePtr->nextPtr = tsdPtr->socketList;
+	tsdPtr->socketList = statePtr;
 	
-	if (infoPtr == tsdPtr->pendingSocketInfo) {
+	if (statePtr == tsdPtr->pendingTcpState) {
 	    DEBUG("Clearing temporary info pointer");
-	    tsdPtr->pendingSocketInfo = NULL;
+	    tsdPtr->pendingTcpState = NULL;
 	}
 	
 	SetEvent(tsdPtr->socketListLock);
 
 	notifyCmd = SELECT;
     } else {
-	SocketInfo **nextPtrPtr;
+	TcpState **nextPtrPtr;
 	int removed = 0;
 
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -3282,8 +3323,8 @@ TcpThreadActionProc(
 	DEBUG("Removing pointer from list");
 	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
 		nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
-	    if ((*nextPtrPtr) == infoPtr) {
-		(*nextPtrPtr) = infoPtr->nextPtr;
+	    if ((*nextPtrPtr) == statePtr) {
+		(*nextPtrPtr) = statePtr->nextPtr;
 		removed = 1;
 		break;
 	    }
@@ -3309,7 +3350,7 @@ TcpThreadActionProc(
      */
 
     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-	    (WPARAM) notifyCmd, (LPARAM) infoPtr);
+	    (WPARAM) notifyCmd, (LPARAM) statePtr);
 }
 
 /*
@@ -3317,5 +3358,7 @@ TcpThreadActionProc(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
  * End:
  */
-- 
cgit v0.12


From 19de01829d8d5c466d392806d3b327ee49e20d58 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 14 Mar 2014 17:01:33 +0000
Subject: WaitForConnection like tclUnixSock.c, new option [fconfigure
 -connecting]

---
 win/tclWinSock.c | 76 +++++++++++++++++++++++++-------------------------------
 1 file changed, 34 insertions(+), 42 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f65ea46..3d41bd3 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -260,7 +260,7 @@ static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
 static int		SocketsEnabled(void);
 static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
 static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr,
-			    int terminate_connect);
+			    int noblock);
 static int		WaitForSocketEvent(TcpState *statePtr, int events,
 			    int *errorCodePtr);
 static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
@@ -556,19 +556,14 @@ TcpBlockModeProc(
  *
  * WaitForConnect --
  *
- *	Process an asyncroneous connect by other commands (gets... ).
- *	Do one connect step if pending as if the event loop would run.
- *
- *	Blocking commands may call in with terminate_connect to terminate
- *	the syncroneous connect syncroneously.
- *
- *	Ok is directly returned if no async connect is running.
+ *	Wait for a connection on an asynchronously opened socket to be
+ *	completed.  In nonblocking mode, just test if the connection
+ *	has completed without blocking. The noblock parameter allows to
+ *	enforce nonblocking behaviour even on sockets in blocking mode.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with a possix error code in
- *	errorCodePtr.
- *	If the connect is not terminated, errorCode is set to EWOULDBLOCK
- *	and 0 is returned.
+ * 	0 if the connection has completed, -1 if still in progress
+ * 	or there is an error.
  *
  * Side effects:
  *	Processes socket events off the system queue.
@@ -581,7 +576,7 @@ static int
 WaitForConnect(
     TcpState *statePtr,		/* State of the socket. */
     int *errorCodePtr,		/* Where to store errors? */
-    int terminate_connect)	/* Should the connect be terminated? */
+    int noblock)		/* Don't wait, even for sockets in blocking mode */
 {
     int result;
     int oldMode;
@@ -591,7 +586,7 @@ WaitForConnect(
      * Check if an async connect is running. If not return ok
      */
     if ( !(statePtr->flags & SOCKET_REENTER_PENDING) )
-	return 1;
+	return 0;
     
     /*
      * Be sure to disable event servicing so we are truly modal.
@@ -615,8 +610,8 @@ WaitForConnect(
 	     * For blocking sockets disable async connect
 	     * as we continue now synchoneously
 	     */
-	    if ( terminate_connect ) {
-		statePtr->flags &= ~(TCP_ASYNC_CONNECT);
+	    if ( !(noblock || (statePtr->flags & TCP_ASYNC_SOCKET)) ) {
+		CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
 	    }
 
 	    /* Free list lock */
@@ -632,13 +627,13 @@ WaitForConnect(
 	    if (result == TCL_OK) {
 		if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
 		    *errorCodePtr = EWOULDBLOCK;
-		    return 0;
+		    return -1;
 		}
-		return 1;
+		return 0;
 	    }
 	    /* error case */
 	    *errorCodePtr = Tcl_GetErrno();
-	    return 0;
+	    return -1;
 	}
 
         /* Free list lock */
@@ -648,9 +643,9 @@ WaitForConnect(
 	 * A non blocking socket waiting for an asyncronous connect
 	 * returns directly an error
 	 */
-	if ( ! terminate_connect ) {
+	if ( noblock || (statePtr->flags & TCP_ASYNC_SOCKET) ) {
 	    *errorCodePtr = EWOULDBLOCK;
-	    return 0;
+	    return -1;
 	}
 
 	/*
@@ -722,8 +717,7 @@ TcpInputProc(
      * For a non blocking socket return EWOULDBLOCK if connect not terminated
      */
 
-    if ( !WaitForConnect(statePtr, errorCodePtr,
-	    ! ( statePtr->flags & TCP_ASYNC_SOCKET ))) {
+    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
 	return -1;
     }
 
@@ -852,8 +846,7 @@ TcpOutputProc(
      * For a non blocking socket return EWOULDBLOCK if connect not terminated
      */
 
-    if ( !WaitForConnect(statePtr, errorCodePtr,
-	    ! ( statePtr->flags & TCP_ASYNC_SOCKET ))) {
+    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
 	return -1;
     }
 
@@ -1176,6 +1169,7 @@ TcpGetOptionProc(
     char host[NI_MAXHOST], port[NI_MAXSERV];
     SOCKET sock;
     size_t len = 0;
+    int errorCode;
     int reverseDNS = 0;
 #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
 
@@ -1193,6 +1187,9 @@ TcpGetOptionProc(
 	return TCL_ERROR;
     }
 
+    /* Go one step in async connect */
+    WaitForConnect(statePtr, &errorCode, 1);
+
     sock = statePtr->sockets->fd;
     if (optionName != NULL) {
 	len = strlen(optionName);
@@ -1201,23 +1198,10 @@ TcpGetOptionProc(
     if ((len > 1) && (optionName[1] == 'e') &&
 	    (strncmp(optionName, "-error", len) == 0)) {
 
-	if ( (statePtr->flags & SOCKET_REENTER_PENDING) ) {
-
-	    /*
-	     * Asyncroneous connect is running.
-	     * Process it one step without blocking.
-	     * Return its error or nothing if connect not
-	     * terminated.
-	     */
-
-	    int errorCode;
-	    if (!WaitForConnect(statePtr, &errorCode, 0)
-		    && errorCode != EWOULDBLOCK) {
-		/* connect terminated with error */
-		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
-	    }
-
-	} else {
+	/*
+	* Do not return any errors if async connect is running
+	*/
+	if (! (statePtr->flags & SOCKET_REENTER_PENDING) ) {
 	    int optlen;
 	    int ret;
     	    DWORD err;
@@ -1246,6 +1230,14 @@ TcpGetOptionProc(
 	return TCL_OK;
     }
 
+    if ((len > 1) && (optionName[1] == 'c') &&
+	    (strncmp(optionName, "-connecting", len) == 0)) {
+
+        Tcl_DStringAppend(dsPtr,
+                        (statePtr->flags & SOCKET_REENTER_PENDING) ? "1" : "0", -1);
+        return TCL_OK;
+    }
+
     if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
 	reverseDNS = NI_NUMERICHOST;
     }
-- 
cgit v0.12


From b16e407595d059711eecc4f8a0a62a18294edff0 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 17 Mar 2014 17:56:47 +0000
Subject: Remove long dead "BAD_BLOCKING" support code so it no longer confuses
 people reading/editing this code.

---
 generic/tclIO.c | 133 +++++---------------------------------------------------
 generic/tclIO.h |  23 ----------
 2 files changed, 10 insertions(+), 146 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b4f1c0c..0f894e4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4873,42 +4873,18 @@ Tcl_ReadRaw(
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
 
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
 	    /*
-	     * [Bug 943274]. Better emulation of non-blocking channels for
-	     * channels without BlockModeProc, by keeping track of true
-	     * fileevents generated by the OS == Data waiting and reading if
-	     * and only if we are sure to have data.
+	     * Now go to the driver to get as much as is possible to
+	     * fill the remaining request. Do all the error handling by
+	     * ourselves. The code was stolen from 'GetInput' and
+	     * slightly adapted (different return value here).
+	     *
+	     * The case of 'bytesToRead == 0' at this point cannot
+	     * happen.
 	     */
 
-	    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-		    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-		    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
-		/*
-		 * We bypass the driver; it would block as no data is
-		 * available.
-		 */
-
-		nread = -1;
-		result = EWOULDBLOCK;
-	    } else {
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
-		/*
-		 * Now go to the driver to get as much as is possible to fill
-		 * the remaining request. Do all the error handling by
-		 * ourselves. The code was stolen from 'GetInput' and slightly
-		 * adapted (different return value here).
-		 *
-		 * The case of 'bytesToRead == 0' at this point cannot happen.
-		 */
-
-		nread = ChanRead(chanPtr, bufPtr + copied,
-			bytesToRead - copied, &result);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	    }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
+	    nread = ChanRead(chanPtr, bufPtr + copied,
+		    bytesToRead - copied, &result);
 
 	    if (nread > 0) {
 		/*
@@ -4921,18 +4897,6 @@ Tcl_ReadRaw(
 		if (nread < (bytesToRead - copied)) {
 		    SetFlag(statePtr, CHANNEL_BLOCKED);
 		}
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-		if (nread <= (bytesToRead - copied)) {
-		    /*
-		     * [Bug 943274] We have read the available data, clear
-		     * flag.
-		     */
-
-		    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
-		}
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
 	    } else if (nread == 0) {
 		SetFlag(statePtr, CHANNEL_EOF);
 		statePtr->inputEncodingFlags |= TCL_ENCODING_END;
@@ -6041,32 +6005,7 @@ GetInput(
 	return 0;
     }
 
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    /*
-     * [SF Tcl Bug 943274]. Better emulation of non-blocking channels for
-     * channels without BlockModeProc, by keeping track of true fileevents
-     * generated by the OS == Data waiting and reading if and only if we are
-     * sure to have data.
-     */
-
-    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
-	/*
-	 * Bypass the driver, it would block, as no data is available
-	 */
-
-	nread = -1;
-	result = EWOULDBLOCK;
-    } else {
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
-	nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
+    nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
     if (nread > 0) {
 	bufPtr->nextAdded += nread;
 
@@ -6080,18 +6019,6 @@ GetInput(
 	if (nread < toRead) {
 	    SetFlag(statePtr, CHANNEL_BLOCKED);
 	}
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	if (nread <= toRead) {
-	    /*
-	     * [SF Tcl Bug 943274] We have read the available data, clear
-	     * flag.
-	     */
-
-	    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
-	}
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
     } else if (nread == 0) {
 	SetFlag(statePtr, CHANNEL_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
@@ -7548,21 +7475,6 @@ Tcl_NotifyChannel(
     Channel *upChanPtr;
     const Tcl_ChannelType *upTypePtr;
 
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    /*
-     * [SF Tcl Bug 943274] For a non-blocking channel without blockmodeproc we
-     * keep track of actual input coming from the OS so that we can do a
-     * credible imitation of non-blocking behaviour.
-     */
-
-    if ((mask & TCL_READABLE) &&
-	    (statePtr->flags & CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !(statePtr->flags & CHANNEL_TIMER_FEV)) {
-	SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
-    }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
     /*
      * In contrast to the other API functions this procedure walks towards the
      * top of a stack and not down from it.
@@ -7797,29 +7709,8 @@ ChannelTimerProc(
 	 */
 
 	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	/*
-	 * Set the TIMER flag to notify the higher levels that the driver
-	 * might have no data for us. We do this only if we are in
-	 * non-blocking mode and the driver has no BlockModeProc because only
-	 * then we really don't know if the driver will block or not. A
-	 * similar test is done in "PeekAhead".
-	 */
-
-	if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
-	    SetFlag(statePtr, CHANNEL_TIMER_FEV);
-	}
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
 	Tcl_Preserve(statePtr);
 	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	ResetFlag(statePtr, CHANNEL_TIMER_FEV);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
 	Tcl_Release(statePtr);
     } else {
 	statePtr->timer = NULL;
@@ -10381,10 +10272,6 @@ DumpFlags(
     ChanFlag('/', INPUT_SAW_CR);
     ChanFlag('D', CHANNEL_DEAD);
     ChanFlag('R', CHANNEL_RAW_MODE);
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    ChanFlag('T', CHANNEL_TIMER_FEV);
-    ChanFlag('H', CHANNEL_HAS_MORE_DATA);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
     ChanFlag('x', CHANNEL_INCLOSE);
 
     buf[i] ='\0';
diff --git a/generic/tclIO.h b/generic/tclIO.h
index a57d4c5..59754cf 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -271,29 +271,6 @@ typedef struct ChannelState {
 					 * changes. */
 #define CHANNEL_RAW_MODE	(1<<16)	/* When set, notes that the Raw API is
 					 * being used. */
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-#define CHANNEL_TIMER_FEV	(1<<17)	/* When set the event we are notified
-					 * by is a fileevent generated by a
-					 * timer. We don't know if the driver
-					 * has more data and should not try to
-					 * read from it. If the system needs
-					 * more than is in the buffers out
-					 * read routines will simulate a short
-					 * read (0 characters read) */
-#define CHANNEL_HAS_MORE_DATA   (1<<18) /* Set by NotifyChannel for a channel
-					 * if and only if the channel is
-					 * configured non-blocking, the driver
-					 * for said channel has no
-					 * blockmodeproc, and data has arrived
-					 * for reading at the OS level). A
-					 * GetInput will pass reading from the
-					 * driver if the channel is
-					 * non-blocking, without blockmode
-					 * proc and the flag has not been set.
-					 * A read will be performed if the
-					 * flag is set. This will reset the
-					 * flag as well. */
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
 #define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
 					 * Its structures are still live and
-- 
cgit v0.12


From 69b5edf8708c05f4abdb039c64ea28932478b400 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 19 Mar 2014 20:32:37 +0000
Subject: Complete rewrite of DoRead().

---
 generic/tclIO.c | 288 ++++++++++++++++++++++++++------------------------------
 1 file changed, 132 insertions(+), 156 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0f894e4..2d22942 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -11,6 +11,7 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
+#undef NDEBUG
 #include "tclInt.h"
 #include "tclIO.h"
 #include <assert.h>
@@ -173,8 +174,6 @@ static void		CleanupChannelHandlers(Tcl_Interp *interp,
 static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
 			    int errorCode);
 static void		CommonGetsCleanup(Channel *chanPtr);
-static int		CopyAndTranslateBuffer(ChannelState *statePtr,
-			    char *result, int space);
 static int		CopyBuffer(Channel *chanPtr, char *result, int space);
 static int		CopyData(CopyState *csPtr, int mask);
 static void		CopyEventProc(ClientData clientData, int mask);
@@ -188,7 +187,7 @@ static int		DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
 static void		DiscardInputQueued(ChannelState *statePtr,
 			    int discardSavedBuffers);
 static void		DiscardOutputQueued(ChannelState *chanPtr);
-static int		DoRead(Channel *chanPtr, char *srcPtr, int slen);
+static int		DoRead(Channel *chanPtr, char *dst, int bytesToRead);
 static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
 			    int appendFlag);
 static int		FilterInputBytes(Channel *chanPtr,
@@ -5363,7 +5362,7 @@ ReadChars(
 	     *	  record \r or \n yet.
 	     */
 
-	    assert(dstRead + 1 == dstDecoded);
+//	    assert(dstRead + 1 == dstDecoded);
 	    assert(dst[dstRead] == '\r');
 	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
 
@@ -5384,7 +5383,7 @@ ReadChars(
 
 	    assert(dstWrote == 0);
 	    assert(dstRead == 0);
-	    assert(dstDecoded == 1);
+//	    assert(dstDecoded == 1);
 
 	    /*
 	     * We decoded only the bare cr, and we cannot read a
@@ -5882,6 +5881,9 @@ DiscardInputQueued(
  *
  *	Reads input data from a device into a channel buffer.
  *
+ *	IMPORTANT!  This routine is only called on a chanPtr argument
+ *	that is the top channel of a stack!
+ *
  * Results:
  *	The return value is the Posix error code if an error occurred while
  *	reading from the file, or 0 otherwise.
@@ -8633,13 +8635,24 @@ CopyData(
  *
  * DoRead --
  *
- *	Reads a given number of bytes from a channel.
+ *	Stores up to "bytesToRead" bytes in memory pointed to by "dst".
+ *	These bytes come from reading the channel "chanPtr" and 
+ *	performing the configured translations.
  *
  *	No encoding conversions are applied to the bytes being read.
  *
  * Results:
- *	The number of characters read, or -1 on error. Use Tcl_GetErrno() to
- *	retrieve the error code for the error that occurred.
+ *	The number of bytes actually stored (<= bytesToRead),
+ * 	or -1 if there is an error in reading the channel.  Use
+ * 	Tcl_GetErrno() to retrieve the error code for the error
+ *	that occurred.
+ *
+ *	The number of bytes stored can be less than the number
+ * 	requested when
+ *	  - EOF is reached on the channel; or
+ *	  - the channel is non-blocking, and we've read all we can
+ *	    without blocking.
+ *	  - a channel reading error occurs (and we return -1)
  *
  * Side effects:
  *	May cause input to be buffered.
@@ -8650,186 +8663,149 @@ CopyData(
 static int
 DoRead(
     Channel *chanPtr,		/* The channel from which to read. */
-    char *bufPtr,		/* Where to store input read. */
-    int toRead)			/* Maximum number of bytes to read. */
+    char *dst,		/* Where to store input read. */
+    int bytesToRead)		/* Maximum number of bytes to read. */
 {
     ChannelState *statePtr = chanPtr->state;
-				/* State info for channel */
-    int copied;			/* How many characters were copied into the
-				 * result string? */
-    int copiedNow;		/* How many characters were copied from the
-				 * current input buffer? */
-    int result;			/* Of calling GetInput. */
+    char *p = dst;
 
-    /*
-     * If we have not encountered a sticky EOF, clear the EOF bit. Either way
-     * clear the BLOCKED bit. We want to discover these anew during each
-     * operation.
-     */
+    while (bytesToRead) {
+	/*
+	 * Each pass through the loop is intended to process up to 
+	 * one channel buffer.
+	 * 
+	 * First, if there is no full buffer, we attempt to 
+	 * create and/or fill one.
+	 */
 
-    if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
-	ResetFlag(statePtr, CHANNEL_EOF);
-    }
-    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+	ChannelBuffer *bufPtr = statePtr->inQueueHead;
 
-    for (copied = 0; copied < toRead; copied += copiedNow) {
-	copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
-		toRead - copied);
-	if (copiedNow == 0) {
-	    if (statePtr->flags & CHANNEL_EOF) {
-		goto done;
-	    }
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
-		    goto done;
-		}
-		ResetFlag(statePtr, CHANNEL_BLOCKED);
+	if (statePtr->flags & CHANNEL_EOF
+		&& (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
+	    break;
+	}
+
+	while (bufPtr == NULL || !IsBufferFull(bufPtr)) {
+	    int code;
+
+	    ResetFlag(statePtr, CHANNEL_BLOCKED);
+	moreData:
+	    code = GetInput(chanPtr);
+	    bufPtr = statePtr->inQueueHead;
+	    if (statePtr->flags & (CHANNEL_EOF|CHANNEL_BLOCKED)) {
+		/* Further reads cannot do any more */
+		break;
 	    }
-	    result = GetInput(chanPtr);
-	    if (result != 0) {
-		if (result != EAGAIN) {
-		    copied = -1;
-		}
-		goto done;
+	    
+	    if (code) {
+		/* Read error */
+		UpdateInterest(chanPtr);
+		return -1;
 	    }
 	}
-    }
 
-    ResetFlag(statePtr, CHANNEL_BLOCKED);
+	/* Here we know bufPtr != NULL */
+	int bytesRead = BytesLeft(bufPtr);
+	int bytesWritten = bytesToRead;
 
-    /*
-     * Update the notifier state so we don't block while there is still data
-     * in the buffers.
-     */
+	if (bytesRead == 0 && statePtr->flags & CHANNEL_NONBLOCKING
+		&& statePtr->flags & CHANNEL_BLOCKED) {
+	    break;
+	}
 
-  done:
-    UpdateInterest(chanPtr);
-    return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CopyAndTranslateBuffer --
- *
- *	Copy at most one buffer of input to the result space, doing eol
- *	translations according to mode in effect currently.
- *
- * Results:
- *	Number of bytes stored in the result buffer (as opposed to the number
- *	of bytes read from the channel). May return zero if no input is
- *	available to be translated.
- *
- * Side effects:
- *	Consumes buffered input. May deallocate one buffer.
- *
- *----------------------------------------------------------------------
- */
+	TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
+		&bytesWritten, &bytesRead);
+	bufPtr->nextRemoved += bytesRead;
+	p += bytesWritten;
+	bytesToRead -= bytesWritten;
 
-static int
-CopyAndTranslateBuffer(
-    ChannelState *statePtr,	/* Channel state from which to read input. */
-    char *result,		/* Where to store the copied input. */
-    int space)			/* How many bytes are available in result to
-				 * store the copied input? */
-{
-    ChannelBuffer *bufPtr;	/* The buffer from which to copy bytes. */
-    int bytesInBuffer;		/* How many bytes are available to be copied
-				 * in the current input buffer? */
-    int copied;			/* How many characters were already copied
-				 * into the destination space? */
+	if (!IsBufferEmpty(bufPtr)) {
+	    /*
+	     * Buffer is not empty.  How can that be?
+	     *
+	     * 0) We stopped early because we got all the bytes
+	     *    we were seeking.  That's fine.
+	     */
 
-    /*
-     * If there is no input at all, return zero. The invariant is that either
-     * there is no buffer in the queue, or if the first buffer is empty, it is
-     * also the last buffer (and thus there is no input in the queue). Note
-     * also that if the buffer is empty, we leave it in the queue.
-     */
+	    if (bytesToRead == 0) {
+		UpdateInterest(chanPtr);
+		break;
+	    }
 
-    if (statePtr->inQueueHead == NULL) {
-	return 0;
-    }
-    bufPtr = statePtr->inQueueHead;
-    bytesInBuffer = BytesLeft(bufPtr);
-    if (bytesInBuffer == 0) {
-	return 0;
-    }
+	    /*
+	     * 1) We're @EOF because we saw eof char.
+	     */
 
-    copied = space;
-    TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
-	    &copied, &bytesInBuffer);
-    bufPtr->nextRemoved += bytesInBuffer;
+	    if (statePtr->inEofChar
+		    && RemovePoint(bufPtr)[0] == statePtr->inEofChar) {
+		UpdateInterest(chanPtr);
+		break;
+	    }
 
-    /*
-     * If the current buffer is empty recycle it.
-     */
+	    /*
+	     * 2) The buffer holds a \r while in CRLF translation, followed
+	     *    by either the end of the buffer, or the eof char.
+	     */
 
-    if (IsBufferEmpty(bufPtr)) {
-	statePtr->inQueueHead = bufPtr->nextPtr;
-	if (statePtr->inQueueHead == NULL) {
-	    statePtr->inQueueTail = NULL;
-	}
-	RecycleBuffer(statePtr, bufPtr, 0);
-    } else {
+	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
+	    assert(RemovePoint(bufPtr)[0] == '\r');
 
-	if (copied > 0) {
-	    return copied;
-	}
+	    if (BytesLeft(bufPtr) > 1) {
 
-	if (statePtr->inEofChar
-		&& RemovePoint(bufPtr)[0] == statePtr->inEofChar) {
-	    return 0;
-	}
+		/* TODO: shift this to TIEOL */
+		assert(statePtr->inEofChar);
+		assert(RemovePoint(bufPtr)[1] == statePtr->inEofChar);
 
-	if (BytesLeft(bufPtr) == 1) {
+		bufPtr->nextRemoved++;
+		*p++ = '\r';
+		bytesToRead--;
+		UpdateInterest(chanPtr);
+		break;
+	    }
 
-	    ChannelBuffer *nextPtr = bufPtr->nextPtr;
+	    assert(BytesLeft(bufPtr) == 1);
 
-	    if (nextPtr == NULL) {
+	    if (bufPtr->nextPtr == NULL) {
+		/* There's no more buffered data.... */
 
 		if (statePtr->flags & CHANNEL_EOF) {
-		    *result = '\r';
-		    bufPtr->nextRemoved += 1;
-		    return 1;
-		}
+		    /* ...and there never will be. */
 
-		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
-		return 0;
+		    *p++ = '\r';
+		    bytesToRead--;
+		    bufPtr->nextRemoved++;
+		} else if (statePtr->flags & CHANNEL_BLOCKED) {
+		    /* ...and we cannot get more now. */
+		    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+		    UpdateInterest(chanPtr);
+		    break;
+		} else {
+		    /* ... so we need to get some. */
+		    goto moreData;
+		}
 	    }
 
-	    nextPtr->nextRemoved -= 1;
-	    memcpy(RemovePoint(nextPtr), RemovePoint(bufPtr), 1);
-	    RecycleBuffer(statePtr, bufPtr, 0);
-	    statePtr->inQueueHead = nextPtr;
-	    return 0;
-	}
+	    if (bufPtr->nextPtr) {
+		/* There's a next buffer.  Shift orphan \r to it. */
 
-	if (statePtr->inEofChar
-		&& RemovePoint(bufPtr)[1] == statePtr->inEofChar) {
-	    *result = '\r';
-	    bufPtr->nextRemoved += 1;
-	    return 1;
+		ChannelBuffer *nextPtr = bufPtr->nextPtr;
+
+		nextPtr->nextRemoved -= 1;
+		RemovePoint(nextPtr)[0] = '\r';
+		bufPtr->nextRemoved++;
+	    }
 	}
-	/*
-	 * Buffer is not empty.  How can that be?
-	 * 0) We stopped early due to the value of "space".
-	 * 	=> copied > 0 and all is fine.
-	 * 1) We saw eof char and stopped the translation copy.
-	 *	=> if (copied > 0) or ((copied == 0) and @ eof char),
-	 *		return is fine.
-	 * 2) The buffer holds a \r while in CRLF translation, followed
-	 *    by either the end of the buffer, or the eof char.
-	 */
 
+	if (IsBufferEmpty(bufPtr)) {
+	    statePtr->inQueueHead = bufPtr->nextPtr;
+	    if (statePtr->inQueueHead == NULL) {
+		statePtr->inQueueTail = NULL;
+	    }
+	    RecycleBuffer(statePtr, bufPtr, 0);
+	}
     }
 
-    /*
-     * Return the number of characters copied into the result buffer. This may
-     * be different from the number of bytes consumed, because of EOL
-     * translations.
-     */
-
-    return copied;
+    return (int)(p - dst);
 }
 
 /*
-- 
cgit v0.12


From a174107efac416856e4183ea90821edac8c266b2 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 19 Mar 2014 21:43:31 +0000
Subject: Let TranslateInputEOL handle the "\r$eofChar" sequence in CRLF mode.

---
 generic/tclIO.c | 44 +++++++++++++++++---------------------------
 1 file changed, 17 insertions(+), 27 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2d22942..267b659 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5362,7 +5362,7 @@ ReadChars(
 	     *	  record \r or \n yet.
 	     */
 
-//	    assert(dstRead + 1 == dstDecoded);
+	    assert(dstRead + 1 == dstDecoded);
 	    assert(dst[dstRead] == '\r');
 	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
 
@@ -5383,7 +5383,7 @@ ReadChars(
 
 	    assert(dstWrote == 0);
 	    assert(dstRead == 0);
-//	    assert(dstDecoded == 1);
+	    assert(dstDecoded == 1);
 
 	    /*
 	     * We decoded only the bare cr, and we cannot read a
@@ -5620,10 +5620,14 @@ TranslateInputEOL(
 	    src += numBytes; srcLen -= numBytes;
 	    if (srcLen == 1) {
 		/* valid src bytes end in \r */
-		lesser = 0;
-		break;
-	    }
-	    if (src[1] == '\n') {
+		if (eof) {
+		    *dst++ = '\r';
+		    src++; srcLen--;
+		} else {
+		    lesser = 0;
+		    break;
+		}
+	    } else if (src[1] == '\n') {
 		*dst++ = '\n';
 		src += 2; srcLen -= 2;
 	    } else {
@@ -8708,11 +8712,6 @@ DoRead(
 	int bytesRead = BytesLeft(bufPtr);
 	int bytesWritten = bytesToRead;
 
-	if (bytesRead == 0 && statePtr->flags & CHANNEL_NONBLOCKING
-		&& statePtr->flags & CHANNEL_BLOCKED) {
-	    break;
-	}
-
 	TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
 		&bytesWritten, &bytesRead);
 	bufPtr->nextRemoved += bytesRead;
@@ -8743,26 +8742,12 @@ DoRead(
 	    }
 
 	    /*
-	     * 2) The buffer holds a \r while in CRLF translation, followed
-	     *    by either the end of the buffer, or the eof char.
+	     * 2) The buffer holds a \r while in CRLF translation,
+	     *    followed by the end of the buffer.
 	     */
 
 	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
 	    assert(RemovePoint(bufPtr)[0] == '\r');
-
-	    if (BytesLeft(bufPtr) > 1) {
-
-		/* TODO: shift this to TIEOL */
-		assert(statePtr->inEofChar);
-		assert(RemovePoint(bufPtr)[1] == statePtr->inEofChar);
-
-		bufPtr->nextRemoved++;
-		*p++ = '\r';
-		bytesToRead--;
-		UpdateInterest(chanPtr);
-		break;
-	    }
-
 	    assert(BytesLeft(bufPtr) == 1);
 
 	    if (bufPtr->nextPtr == NULL) {
@@ -8803,6 +8788,11 @@ DoRead(
 	    }
 	    RecycleBuffer(statePtr, bufPtr, 0);
 	}
+
+	if (statePtr->flags & CHANNEL_NONBLOCKING
+		&& statePtr->flags & CHANNEL_BLOCKED) {
+	    break;
+	}
     }
 
     return (int)(p - dst);
-- 
cgit v0.12


From afc78cdb50eea22471934dad252ce914c1bf492b Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 20 Mar 2014 09:22:29 +0000
Subject: Proposed fix for [2f7cbd01c3].

---
 unix/configure | 24 ++++++++++--------------
 unix/tcl.m4    | 24 ++++++++++--------------
 2 files changed, 20 insertions(+), 28 deletions(-)

diff --git a/unix/configure b/unix/configure
index 6800fe2..55127c2 100755
--- a/unix/configure
+++ b/unix/configure
@@ -7639,15 +7639,6 @@ fi
 
 fi
 
-	    case $system in
-	    FreeBSD-3.*)
-	    	# FreeBSD-3 doesn't handle version numbers with dots.
-	    	UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
-	    	SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
-	    	TCL_LIB_VERSIONS_OK=nodots
-		;;
-	    esac
-	    ;;
 	FreeBSD-*)
 	    # This configuration from FreeBSD Ports.
 	    SHLIB_CFLAGS="-fPIC"
@@ -7672,11 +7663,16 @@ fi
 		LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
 fi
 
-	    # Version numbers are dot-stripped by system policy.
-	    TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
-	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
-	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1'
-	    TCL_LIB_VERSIONS_OK=nodots
+	    case $system in
+	    FreeBSD-3.*)
+		# Version numbers are dot-stripped by system policy.
+		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
+		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
+		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
+		TCL_LIB_VERSIONS_OK=nodots
+		;;
+	    esac
+	    ;;
 	    ;;
 	Darwin-*)
 	    CFLAGS_OPTIMIZE="-Os"
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index c57111b..afe20dc 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1550,15 +1550,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 		CFLAGS="$CFLAGS -pthread"
 	    	LDFLAGS="$LDFLAGS -pthread"
 	    ])
-	    case $system in
-	    FreeBSD-3.*)
-	    	# FreeBSD-3 doesn't handle version numbers with dots.
-	    	UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
-	    	SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
-	    	TCL_LIB_VERSIONS_OK=nodots
-		;;
-	    esac
-	    ;;
 	FreeBSD-*)
 	    # This configuration from FreeBSD Ports.
 	    SHLIB_CFLAGS="-fPIC"
@@ -1577,11 +1568,16 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 		LIBS=`echo $LIBS | sed s/-pthread//`
 		CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
 		LDFLAGS="$LDFLAGS $PTHREAD_LIBS"])
-	    # Version numbers are dot-stripped by system policy.
-	    TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
-	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
-	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1'
-	    TCL_LIB_VERSIONS_OK=nodots
+	    case $system in
+	    FreeBSD-3.*)
+		# Version numbers are dot-stripped by system policy.
+		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
+		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
+		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
+		TCL_LIB_VERSIONS_OK=nodots
+		;;
+	    esac
+	    ;;
 	    ;;
 	Darwin-*)
 	    CFLAGS_OPTIMIZE="-Os"
-- 
cgit v0.12


From eae6f97866efd02f09d961bf695047a3b47ac961 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Mar 2014 16:31:11 +0000
Subject: Use assertions about the pushback buffers to simplify their handling.
 Mark several things left TODO.  Some tidying.

---
 generic/tclIO.c | 60 +++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 37 insertions(+), 23 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 267b659..b423bcc 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -6,6 +6,7 @@
  *
  * Copyright (c) 1998-2000 Ajuba Solutions
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Contributions from Don Porter, NIST, 2014. (not subject to US copyright)
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -1679,17 +1680,17 @@ Tcl_StackChannel(
      */
 
     if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
+
 	/*
-	 * Remark: It is possible that the channel buffers contain data from
-	 * some earlier push-backs.
+	 * When statePtr->inQueueHead is not NULL, we know
+	 * prevChanPtr->inQueueHead must be NULL.
 	 */
 
-	statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
-	prevChanPtr->inQueueHead = statePtr->inQueueHead;
+	assert(prevChanPtr->inQueueHead == NULL);
+	assert(prevChanPtr->inQueueTail == NULL);
 
-	if (prevChanPtr->inQueueTail == NULL) {
-	    prevChanPtr->inQueueTail = statePtr->inQueueTail;
-	}
+	prevChanPtr->inQueueHead = statePtr->inQueueHead;
+	prevChanPtr->inQueueTail = statePtr->inQueueTail;
 
 	statePtr->inQueueHead = NULL;
 	statePtr->inQueueTail = NULL;
@@ -2254,6 +2255,7 @@ RecycleBuffer(
     }
 
     /*
+     * TODO
      * Only save buffers which are at least as big as the requested buffersize
      * for the channel. This is to honor dynamic changes of the buffersize
      * made by the user.
@@ -3696,9 +3698,7 @@ Write(
 		&statePtr->outputEncodingState, dst,
 		dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
 
-	    if (srcRead != nlLen) {
-		Tcl_Panic("Can This Happen?");
-	    }
+	    assert (srcRead == nlLen);
 
 	    bufPtr->nextAdded += dstWrote;
 	    src++;
@@ -4837,6 +4837,7 @@ Tcl_ReadRaw(
     int nread, result, copied, copiedNow;
 
     /*
+     * TODO VERIFY
      * The check below does too much because it will reject a call to this
      * function with a channel which is part of an 'fcopy'. But we have to
      * allow this here or else the chaining in the transformation drivers will
@@ -5925,16 +5926,11 @@ GetInput(
      * channel in the stack and use them. They can be the result of a
      * transformation which went away without reading all the information
      * placed in the area when it was stacked.
-     *
-     * Two possibilities for the state: No buffers in it, or a single empty
-     * buffer. In the latter case we can recycle it now.
      */
 
     if (chanPtr->inQueueHead != NULL) {
-	if (statePtr->inQueueHead != NULL) {
-	    RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
-	    statePtr->inQueueHead = NULL;
-	}
+
+	assert(statePtr->inQueueHead == NULL);
 
 	statePtr->inQueueHead = chanPtr->inQueueHead;
 	statePtr->inQueueTail = chanPtr->inQueueTail;
@@ -5962,6 +5958,7 @@ GetInput(
 	statePtr->saveInBufPtr = NULL;
 
 	/*
+	 * TODO
 	 * Check the actual buffersize against the requested buffersize.
 	 * Buffers which are smaller than requested are squashed. This is done
 	 * to honor dynamic changes of the buffersize made by the user.
@@ -5979,6 +5976,7 @@ GetInput(
 	bufPtr->nextPtr = NULL;
 
 	/*
+	 * TODO
 	 * SF #427196: Use the actual size of the buffer to determine the
 	 * number of bytes to read from the channel and not the size for new
 	 * buffers. They can be different if the buffersize was changed
@@ -6003,6 +6001,7 @@ GetInput(
     }
 
     /*
+     * TODO 
      * If EOF is set, we should avoid calling the driver because on some
      * platforms it is impossible to read from a device after EOF.
      */
@@ -6524,6 +6523,7 @@ CheckChannelErrors(
 
     if (direction == TCL_READABLE) {
 	/*
+	 * TODO
 	 * If we have not encountered a sticky EOF, clear the EOF bit (sticky
 	 * EOF is set if we have seen the input eofChar, to prevent reading
 	 * beyond the eofChar). Also, always clear the BLOCKED bit. We want to
@@ -6739,6 +6739,7 @@ Tcl_SetChannelBufferSize(
     ChannelState *statePtr;	/* State of real channel structure. */
 
     /*
+     * TODO
      * Clip the buffer size to force it into the [1,1M] range
      */
 
@@ -7375,6 +7376,7 @@ Tcl_SetChannelOption(
     }
 
     /*
+     * TODO
      * If bufsize changes, need to get rid of old utility buffer.
      */
 
@@ -8677,18 +8679,23 @@ DoRead(
 	/*
 	 * Each pass through the loop is intended to process up to 
 	 * one channel buffer.
-	 * 
-	 * First, if there is no full buffer, we attempt to 
-	 * create and/or fill one.
 	 */
 
+	int bytesRead, bytesWritten;
 	ChannelBuffer *bufPtr = statePtr->inQueueHead;
 
+	/*
+	 * When there's no buffered data to read, and we're at EOF,
+	 * escape to the caller.
+	 */
+
 	if (statePtr->flags & CHANNEL_EOF
 		&& (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
 	    break;
 	}
 
+	/* If there is no full buffer, attempt to create and/or fill one. */
+
 	while (bufPtr == NULL || !IsBufferFull(bufPtr)) {
 	    int code;
 
@@ -8696,6 +8703,9 @@ DoRead(
 	moreData:
 	    code = GetInput(chanPtr);
 	    bufPtr = statePtr->inQueueHead;
+
+	    assert (bufPtr != NULL);
+
 	    if (statePtr->flags & (CHANNEL_EOF|CHANNEL_BLOCKED)) {
 		/* Further reads cannot do any more */
 		break;
@@ -8706,11 +8716,14 @@ DoRead(
 		UpdateInterest(chanPtr);
 		return -1;
 	    }
+
+	    assert (IsBufferFull(bufPtr));
 	}
 
-	/* Here we know bufPtr != NULL */
-	int bytesRead = BytesLeft(bufPtr);
-	int bytesWritten = bytesToRead;
+	assert (bufPtr != NULL);
+
+	bytesRead = BytesLeft(bufPtr);
+	bytesWritten = bytesToRead;
 
 	TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
 		&bytesWritten, &bytesRead);
@@ -10155,6 +10168,7 @@ SetChannelFromAny(
     }
     if (objPtr->typePtr == &chanObjType) {
 	/*
+	 * TODO: TAINT Flag and dup'd channel values?
 	 * The channel is valid until any call to DetachChannel occurs.
 	 * Ensure consistency checks are done.
 	 */
-- 
cgit v0.12


From 8c3da02c3e41f1b7e029ed7633e250646fe7ec82 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Mar 2014 19:25:11 +0000
Subject: Stop routine clearing of CHANNEL_EOF.  Only clear when there's a
 reason (seek, eofchar change, ungets).  Otherwise, once you hit EOF you stay
 there.

---
 generic/tclIO.c | 24 ++++++------------------
 1 file changed, 6 insertions(+), 18 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b423bcc..1a56811 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4837,7 +4837,6 @@ Tcl_ReadRaw(
     int nread, result, copied, copiedNow;
 
     /*
-     * TODO VERIFY
      * The check below does too much because it will reject a call to this
      * function with a channel which is part of an 'fcopy'. But we have to
      * allow this here or else the chaining in the transformation drivers will
@@ -5742,16 +5741,11 @@ Tcl_Ungets(
     statePtr->flags = flags;
 
     /*
-     * If we have encountered a sticky EOF, just punt without storing (sticky
-     * EOF is set if we have seen the input eofChar, to prevent reading beyond
-     * the eofChar). Otherwise, clear the EOF flags, and clear the BLOCKED
-     * bit. We want to discover these conditions anew in each operation.
+     * Clear the EOF flags, and clear the BLOCKED bit.
      */
 
-    if (statePtr->flags & CHANNEL_STICKY_EOF) {
-	goto done;
-    }
-    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
+    ResetFlag(statePtr,
+	    CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
 
     bufPtr = AllocChannelBuffer(len);
     memcpy(InsertPoint(bufPtr), str, (size_t) len);
@@ -6001,7 +5995,7 @@ GetInput(
     }
 
     /*
-     * TODO 
+     * TODO - consider escape before buffer alloc
      * If EOF is set, we should avoid calling the driver because on some
      * platforms it is impossible to read from a device after EOF.
      */
@@ -6523,16 +6517,10 @@ CheckChannelErrors(
 
     if (direction == TCL_READABLE) {
 	/*
-	 * TODO
-	 * If we have not encountered a sticky EOF, clear the EOF bit (sticky
-	 * EOF is set if we have seen the input eofChar, to prevent reading
-	 * beyond the eofChar). Also, always clear the BLOCKED bit. We want to
-	 * discover these conditions anew in each operation.
+	 * Clear the BLOCKED bit. We want to discover this condition
+	 * anew in each operation.
 	 */
 
-	if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
-	    ResetFlag(statePtr, CHANNEL_EOF);
-	}
 	ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
     }
 
-- 
cgit v0.12


From 60a84571795909d2b51dff06349107716ae3ab6d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Mar 2014 20:18:20 +0000
Subject: Don't allow buffer recycling to prevent or delay buffersize
 shrinkage.

---
 generic/tclIO.c | 68 ++++++++++++++++++++++++---------------------------------
 1 file changed, 28 insertions(+), 40 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 1a56811..e7653f6 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2255,13 +2255,12 @@ RecycleBuffer(
     }
 
     /*
-     * TODO
-     * Only save buffers which are at least as big as the requested buffersize
-     * for the channel. This is to honor dynamic changes of the buffersize
+     * Only save buffers which have the requested buffersize for the
+     * channel. This is to honor dynamic changes of the buffersize
      * made by the user.
      */
 
-    if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
+    if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) {
 	ckfree((char *) bufPtr);
 	return;
     }
@@ -5952,14 +5951,13 @@ GetInput(
 	statePtr->saveInBufPtr = NULL;
 
 	/*
-	 * TODO
 	 * Check the actual buffersize against the requested buffersize.
-	 * Buffers which are smaller than requested are squashed. This is done
+	 * Saved buffers of the wrong size are squashed. This is done
 	 * to honor dynamic changes of the buffersize made by the user.
 	 */
 
 	if ((bufPtr != NULL)
-		&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
+		&& (bufPtr->bufLength - BUFFER_PADDING != statePtr->bufSize)) {
 	    ckfree((char *) bufPtr);
 	    bufPtr = NULL;
 	}
@@ -5969,22 +5967,8 @@ GetInput(
 	}
 	bufPtr->nextPtr = NULL;
 
-	/*
-	 * TODO
-	 * SF #427196: Use the actual size of the buffer to determine the
-	 * number of bytes to read from the channel and not the size for new
-	 * buffers. They can be different if the buffersize was changed
-	 * between reads.
-	 *
-	 * Note: This affects performance negatively if the buffersize was
-	 * extended but this small buffer is reused for all subsequent reads.
-	 * The system never uses buffers with the requested bigger size in
-	 * that case. An adjunct patch could try and delete all unused buffers
-	 * it encounters and which are smaller than the formally requested
-	 * buffersize.
-	 */
-
 	toRead = SpaceLeft(bufPtr);
+	assert(toRead == statePtr->bufSize);
 
 	if (statePtr->inQueueTail == NULL) {
 	    statePtr->inQueueHead = bufPtr;
@@ -6727,7 +6711,6 @@ Tcl_SetChannelBufferSize(
     ChannelState *statePtr;	/* State of real channel structure. */
 
     /*
-     * TODO
      * Clip the buffer size to force it into the [1,1M] range
      */
 
@@ -6738,7 +6721,27 @@ Tcl_SetChannelBufferSize(
     }
 
     statePtr = ((Channel *) chan)->state;
+
+    if (statePtr->bufSize == sz) {
+	return;
+    }
     statePtr->bufSize = sz;
+
+    /*
+     * If bufsize changes, need to get rid of old utility buffer.
+     */
+
+    if (statePtr->saveInBufPtr != NULL) {
+	RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
+	statePtr->saveInBufPtr = NULL;
+    }
+    if ((statePtr->inQueueHead != NULL)
+	    && (statePtr->inQueueHead->nextPtr == NULL)
+	    && IsBufferEmpty(statePtr->inQueueHead)) {
+	RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
+	statePtr->inQueueHead = NULL;
+	statePtr->inQueueTail = NULL;
+    }
 }
 
 /*
@@ -7172,6 +7175,7 @@ Tcl_SetChannelOption(
 	    return TCL_ERROR;
 	}
 	Tcl_SetChannelBufferSize(chan, newBufferSize);
+	return TCL_OK;
     } else if (HaveOpt(2, "-encoding")) {
 	Tcl_Encoding encoding;
 
@@ -7202,6 +7206,7 @@ Tcl_SetChannelOption(
 	statePtr->outputEncodingFlags = TCL_ENCODING_START;
 	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
 	UpdateInterest(chanPtr);
+	return TCL_OK;
     } else if (HaveOpt(2, "-eofchar")) {
 	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
 	    return TCL_ERROR;
@@ -7363,23 +7368,6 @@ Tcl_SetChannelOption(
 	return Tcl_BadChannelOption(interp, optionName, NULL);
     }
 
-    /*
-     * TODO
-     * If bufsize changes, need to get rid of old utility buffer.
-     */
-
-    if (statePtr->saveInBufPtr != NULL) {
-	RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
-	statePtr->saveInBufPtr = NULL;
-    }
-    if ((statePtr->inQueueHead != NULL)
-	    && (statePtr->inQueueHead->nextPtr == NULL)
-	    && IsBufferEmpty(statePtr->inQueueHead)) {
-	RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
-	statePtr->inQueueHead = NULL;
-	statePtr->inQueueTail = NULL;
-    }
-
     return TCL_OK;
 }
 
-- 
cgit v0.12


From 72ae8dccf119510f1b175a9a2243a87069cef308 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 17:11:32 +0000
Subject: Added comments raising questions about possible updates to channel
 drivers on Windows.

---
 win/tclWinChan.c    | 4 ++++
 win/tclWinConsole.c | 7 +++++++
 win/tclWinPipe.c    | 6 ++++++
 3 files changed, 17 insertions(+)

diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index c63aaa7..48acacb 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -662,6 +662,10 @@ FileInputProc(
     *errorCode = 0;
 
     /*
+     * TODO: This comment appears to be out of date.  We *do* have a
+     * console driver, over in tclWinConsole.c.  After some Windows
+     * developer confirms, this comment should be revised.
+     *
      * Note that we will block on reads from a console buffer until a full
      * line has been entered. The only way I know of to get around this is to
      * write a console driver. We should probably do this at some point, but
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 0ec22c5..6630083 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -756,6 +756,13 @@ ConsoleInputProc(
 
     if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize,
 	    &count) == TRUE) {
+	/*
+	 * TODO: This potentially writes beyond the limits specified
+	 * by the caller.  In practice this is harmless, since all writes
+	 * are into ChannelBuffers, and those have padding, but still
+	 * ought to remove this, unless some Windows wizard can give
+	 * a reason not to.  
+	 */
 	buf[count] = '\0';
 	return count;
     }
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 77fc776..a9eec6d 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -82,6 +82,12 @@ static ProcInfo *procList;
 #define PIPE_EXTRABYTE	(1<<3)	/* The reader thread has consumed one byte. */
 
 /*
+ * TODO: It appears the whole EXTRABYTE machinery is in place to support
+ * outdated Win 95 systems.  If this can be confirmed, much code can be
+ * deleted.
+ */
+
+/*
  * This structure describes per-instance data for a pipe based channel.
  */
 
-- 
cgit v0.12


From ce028f5b60d1cf34a689f2781b9ac15280d09eb2 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Sat, 22 Mar 2014 16:14:26 +0000
Subject: Bug [336441ed59]: Buffer infoPtr between socket creation and
 insertion into info structure in thread local memory. Backported fix from
 commit [65b320b464] from branch "bug-[13d3af3ad5]".

---
 win/tclWinSock.c | 213 ++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 140 insertions(+), 73 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 9fa01c9..f0b210e 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -167,6 +167,10 @@ typedef struct {
 				 * socketThread has been initialized and has
 				 * started. */
     HANDLE socketListLock;	/* Win32 Event to lock the socketList */
+    SocketInfo *pendingSocketInfo;
+				/* This socket is opened but not jet in the
+				 * list. This value is also checked by
+				 * the event structure. */
     SocketInfo *socketList;	/* Every open socket in this thread has an
 				 * entry on this list. */
 } ThreadSpecificData;
@@ -329,6 +333,7 @@ InitSockets(void)
 
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
+	tsdPtr->pendingSocketInfo = NULL;
 	tsdPtr->socketList = NULL;
 	tsdPtr->hwnd       = NULL;
 	tsdPtr->threadId   = Tcl_GetCurrentThread();
@@ -923,12 +928,10 @@ CreateSocket(
 				 * asynchronously. */
 {
     u_long flag = 1;		/* Indicates nonblocking mode. */
-    int asyncConnect = 0;	/* Will be 1 if async connect is in
-				 * progress. */
     SOCKADDR_IN sockaddr;	/* Socket address */
     SOCKADDR_IN mysockaddr;	/* Socket address for client */
     SOCKET sock = INVALID_SOCKET;
-    SocketInfo *infoPtr;	/* The returned value. */
+    SocketInfo *infoPtr=NULL;	/* The returned value. */
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 	    TclThreadDataKeyGet(&dataKey);
 
@@ -1007,6 +1010,15 @@ CreateSocket(
 	infoPtr->selectEvents = FD_ACCEPT;
 	infoPtr->watchEvents |= FD_ACCEPT;
 
+	/*
+	 * Register for interest in events in the select mask. Note that this
+	 * automatically places the socket into non-blocking mode.
+	 */
+    
+	ioctlsocket(sock, (long) FIONBIO, &flag);
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		(LPARAM) infoPtr);
+
     } else {
 	/*
 	 * Try to bind to a local port, if specified.
@@ -1020,14 +1032,48 @@ CreateSocket(
 	}
 
 	/*
+	 * Allocate socket info structure
+	 */
+
+	infoPtr = NewSocketInfo(sock);
+
+	/*
 	 * Set the socket into nonblocking mode if the connect should be done
-	 * in the background.
+	 * in the background. Activate connect notification.
 	 */
 
 	if (async) {
-	    if (ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) {
-		goto error;
-	    }
+
+	    /* get infoPtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
+	    /*
+	     * Buffer new infoPtr in the tsd memory as long as it is not in
+	     * the info list. This allows the event procedure to process the
+	     * event.
+	     */
+
+	    tsdPtr->pendingSocketInfo = infoPtr;
+
+	    /*
+	     * Set connect mask to connect events
+	     * This is activated by a SOCKET_SELECT message to the notifier
+	     * thread.
+	     */
+
+	    infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE | FD_CLOSE;
+	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+	    
+	    /*
+	     * Free list lock
+	     */
+	    SetEvent(tsdPtr->socketListLock);
+
+	    /* activate accept notification and put in async mode */
+	    ioctlsocket(sock, (long) FIONBIO, &flag);
+	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+	            (LPARAM) infoPtr);
+
 	}
 
 	/*
@@ -1045,35 +1091,26 @@ CreateSocket(
 	     * The connection is progressing in the background.
 	     */
 
-	    asyncConnect = 1;
-	}
+	} else {
 
-	/*
-	 * Add this socket to the global list of sockets.
-	 */
+	    /*
+	     * Set up the select mask for read/write events. If the connect
+	     * attempt has not completed, include connect events.
+	     */
 
-	infoPtr = NewSocketInfo(sock);
+	    infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
 
-	/*
-	 * Set up the select mask for read/write events. If the connect
-	 * attempt has not completed, include connect events.
-	 */
+	    /*
+	     * Register for interest in events in the select mask. Note that this
+	     * automatically places the socket into non-blocking mode.
+	     */
 
-	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-	if (asyncConnect) {
-	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-	    infoPtr->selectEvents |= FD_CONNECT;
+	    ioctlsocket(sock, (long) FIONBIO, &flag);
+	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		    (LPARAM) infoPtr);
 	}
     }
 
-    /*
-     * Register for interest in events in the select mask. Note that this
-     * automatically places the socket into non-blocking mode.
-     */
-
-    ioctlsocket(sock, (long) FIONBIO, &flag);
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr);
-
     return infoPtr;
 
   error:
@@ -1082,7 +1119,17 @@ CreateSocket(
 	Tcl_AppendResult(interp, "couldn't open socket: ",
 		Tcl_PosixError(interp), NULL);
     }
-    if (sock != INVALID_SOCKET) {
+    /*
+     * Clear the tsd socket list pointer if we did not wait for
+     * the FD_CONNECT asyncroneously
+     */
+    tsdPtr->pendingSocketInfo = NULL;
+    if (infoPtr != NULL) {
+	/*
+	 * Free the allocated socket info structure and close the socket
+	 */
+	TcpCloseProc(infoPtr, interp);
+    } else if (sock != INVALID_SOCKET) {
 	closesocket(sock);
     }
     return NULL;
@@ -1482,7 +1529,7 @@ TcpAccept(
     SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0);
 
     /*
-     * Add this socket to the global list of sockets.
+     * Allocate socket info structure
      */
 
     newInfoPtr = NewSocketInfo(newSocket);
@@ -2248,6 +2295,7 @@ SocketProc(
     int event, error;
     SOCKET socket;
     SocketInfo *infoPtr;
+    int info_found = 0;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 #ifdef _WIN64
 	    GetWindowLongPtr(hwnd, GWLP_USERDATA);
@@ -2293,58 +2341,72 @@ SocketProc(
 	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 		infoPtr = infoPtr->nextPtr) {
 	    if (infoPtr->socket == socket) {
-		/*
-		 * Update the socket state.
-		 *
-		 * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
-		 * happens, then clear the FD_ACCEPT count. Otherwise,
-		 * increment the count if the current event is an FD_ACCEPT.
-		 */
+		info_found = 1;
+		break;
+	    }
+	}
+	/*
+	 * Check if there is a pending info structure not jet in the
+	 * list
+	 */
+	if ( !info_found
+		&& tsdPtr->pendingSocketInfo != NULL
+		&& tsdPtr->pendingSocketInfo->socket ==socket ) {
+	    infoPtr = tsdPtr->pendingSocketInfo;
+	    info_found = 1;
+	}
+	if (info_found) {
 
-		if (event & FD_CLOSE) {
-		    infoPtr->acceptEventCount = 0;
-		    infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
-		} else if (event & FD_ACCEPT) {
-		    infoPtr->acceptEventCount++;
-		}
+	    /*
+	     * Update the socket state.
+	     *
+	     * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
+	     * happens, then clear the FD_ACCEPT count. Otherwise,
+	     * increment the count if the current event is an FD_ACCEPT.
+	     */
 
-		if (event & FD_CONNECT) {
-		    /*
-		     * The socket is now connected, clear the async connect
-		     * flag.
-		     */
+	    if (event & FD_CLOSE) {
+	        infoPtr->acceptEventCount = 0;
+	        infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+	    } else if (event & FD_ACCEPT) {
+		infoPtr->acceptEventCount++;
+	    }
 
-		    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+	    if (event & FD_CONNECT) {
+		/*
+		 * The socket is now connected, clear the async connect
+		 * flag.
+		 */
 
-		    /*
-		     * Remember any error that occurred so we can report
-		     * connection failures.
-		     */
+		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
+		/*
+		 * Remember any error that occurred so we can report
+		 * connection failures.
+		 */
 
-		    if (error != ERROR_SUCCESS) {
-			TclWinConvertWSAError((DWORD) error);
-			infoPtr->lastError = Tcl_GetErrno();
-		    }
+		if (error != ERROR_SUCCESS) {
+		    TclWinConvertWSAError((DWORD) error);
+		    infoPtr->lastError = Tcl_GetErrno();
 		}
+	    }
 
-		if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
-		    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-		    if (error != ERROR_SUCCESS) {
-			TclWinConvertWSAError((DWORD) error);
-			infoPtr->lastError = Tcl_GetErrno();
-		    }
-		    infoPtr->readyEvents |= FD_WRITE;
+	    if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
+		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+		if (error != ERROR_SUCCESS) {
+		    TclWinConvertWSAError((DWORD) error);
+		    infoPtr->lastError = Tcl_GetErrno();
 		}
-		infoPtr->readyEvents |= event;
+		infoPtr->readyEvents |= FD_WRITE;
+	    }
+	    infoPtr->readyEvents |= event;
 
-		/*
-		 * Wake up the Main Thread.
-		 */
+	    /*
+	     * Wake up the Main Thread.
+	     */
 
-		SetEvent(tsdPtr->readyEvent);
-		Tcl_ThreadAlert(tsdPtr->threadId);
-		break;
-	    }
+	    SetEvent(tsdPtr->readyEvent);
+	    Tcl_ThreadAlert(tsdPtr->threadId);
 	}
 	SetEvent(tsdPtr->socketListLock);
 	break;
@@ -2580,6 +2642,11 @@ TcpThreadActionProc(
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 	infoPtr->nextPtr = tsdPtr->socketList;
 	tsdPtr->socketList = infoPtr;
+	
+	if (infoPtr == tsdPtr->pendingSocketInfo) {
+	    tsdPtr->pendingSocketInfo = NULL;
+	}
+	
 	SetEvent(tsdPtr->socketListLock);
 
 	notifyCmd = SELECT;
-- 
cgit v0.12


From c12228d755f6bbc24681d68ad69ae7b7dfde5ba4 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Sun, 23 Mar 2014 11:31:59 +0000
Subject: Be shure tsd pointer to the info structure is invalidated before
 memory free

---
 win/tclWinSock.c | 35 ++++++++++++++++++++++++++++-------
 1 file changed, 28 insertions(+), 7 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f0b210e..6633b89 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -820,7 +820,7 @@ TcpCloseProc(
     SocketInfo *infoPtr = (SocketInfo *) instanceData;
     /* TIP #218 */
     int errorCode = 0;
-    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
      * Check that WinSock is initialized; do not call it if not, to prevent
@@ -842,6 +842,23 @@ TcpCloseProc(
     }
 
     /*
+     * Clear an eventual tsd info list pointer.
+     * This may be called, if an async socket connect fails or is closed
+     * between connect and thread action callback.
+     */
+    if (tsdPtr->pendingSocketInfo != NULL
+	    && tsdPtr->pendingSocketInfo == infoPtr) {
+
+	/* get infoPtr lock, because this concerns the notifier thread */
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
+	tsdPtr->pendingSocketInfo = NULL;
+
+	/* Free list lock */
+	SetEvent(tsdPtr->socketListLock);
+    }
+
+    /*
      * TIP #218. Removed the code removing the structure from the global
      * socket list. This is now done by the thread action callbacks, and only
      * there. This happens before this code is called. We can free without
@@ -1051,6 +1068,8 @@ CreateSocket(
 	     * Buffer new infoPtr in the tsd memory as long as it is not in
 	     * the info list. This allows the event procedure to process the
 	     * event.
+	     * Bugfig for 336441ed59 to not ignore notifications until the
+	     * infoPtr is in the list..
 	     */
 
 	    tsdPtr->pendingSocketInfo = infoPtr;
@@ -1069,7 +1088,11 @@ CreateSocket(
 	     */
 	    SetEvent(tsdPtr->socketListLock);
 
-	    /* activate accept notification and put in async mode */
+	    /*
+	     * Activate accept notification and put in async mode
+	     * Bug 336441ed59: activate notification before connect
+	     * so we do not miss a notification of a fialed connect.
+	     */
 	    ioctlsocket(sock, (long) FIONBIO, &flag);
 	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 	            (LPARAM) infoPtr);
@@ -1119,17 +1142,15 @@ CreateSocket(
 	Tcl_AppendResult(interp, "couldn't open socket: ",
 		Tcl_PosixError(interp), NULL);
     }
-    /*
-     * Clear the tsd socket list pointer if we did not wait for
-     * the FD_CONNECT asyncroneously
-     */
-    tsdPtr->pendingSocketInfo = NULL;
     if (infoPtr != NULL) {
 	/*
 	 * Free the allocated socket info structure and close the socket
 	 */
 	TcpCloseProc(infoPtr, interp);
     } else if (sock != INVALID_SOCKET) {
+	/*
+	 * No socket structure jet - just close
+	 */
 	closesocket(sock);
     }
     return NULL;
-- 
cgit v0.12


From 8a2617f3adce19edcb1ff2f8099bf33435f9701d Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Sun, 23 Mar 2014 11:42:35 +0000
Subject: Be sure tsd pointer to the info structure is invalidated before
 memory free

---
 win/tclWinSock.c | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 3d41bd3..b1e2768 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -935,7 +935,7 @@ TcpCloseProc(
     TcpState *statePtr = instanceData;
     /* TIP #218 */
     int errorCode = 0;
-    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
      * Check that WinSock is initialized; do not call it if not, to prevent
@@ -970,6 +970,23 @@ TcpCloseProc(
     }
 
     /*
+     * Clear an eventual tsd info list pointer.
+     * This may be called, if an async socket connect fails or is closed
+     * between connect and thread action callback.
+     */
+    if (tsdPtr->pendingTcpState != NULL
+	    && tsdPtr->pendingTcpState == statePtr) {
+
+	/* get infoPtr lock, because this concerns the notifier thread */
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
+	tsdPtr->pendingTcpState = NULL;
+
+	/* Free list lock */
+	SetEvent(tsdPtr->socketListLock);
+    }
+
+    /*
      * TIP #218. Removed the code removing the structure from the global
      * socket list. This is now done by the thread action callbacks, and only
      * there. This happens before this code is called. We can free without
@@ -1644,6 +1661,8 @@ CreateClientSocket(
 		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
 		/*
+		 * Bugfig for 336441ed59 to not ignore notifications until the
+		 * infoPtr is in the list.
 		 * Check if my statePtr is already in the tsdPtr->socketList
 		 * It is set after this call by TcpThreadActionProc and is set
 		 * on a second round.
-- 
cgit v0.12


From 6db3b6dd9d1acdae281ff36db51632a2efbf1853 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 24 Mar 2014 11:03:04 +0000
Subject: Fire also readable event on final async connect failure. Armor
 WaitForSocketEvent by access signal against notifier thread access.

---
 win/tclWinSock.c | 129 ++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 84 insertions(+), 45 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index b1e2768..91f9e8c 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -181,7 +181,7 @@ struct TcpState {
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int status;                 /* Cache status of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
-    int lastError;		/* Error code from last message.
+    int connectError;		/* Async connect error set by notifier thread.
 				 * Set by notifier thread, access must be
 				 * protected by semaphore */
     struct TcpState *nextPtr;	/* The next socket on the per-thread socket
@@ -199,10 +199,13 @@ struct TcpState {
 					 * socket. */
 #define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
 					 * socket */
-#define SOCKET_REENTER_PENDING	(1<<4)	/* CreateClientSocket was called to
+#define TCP_ASYNC_CONNECT_REENTER_PENDING   (1<<4)
+					/* CreateClientSocket was called to
 					 * process an async connect. This
 					 * flag indicates that reentry is
 					 * still pending */
+#define TCP_ASYNC_CONNECT_FAILED    (1<<5)
+					/* An async connect finally failed */
 
 /*
  * The following structure is what is added to the Tcl event queue when a
@@ -585,7 +588,7 @@ WaitForConnect(
     /*
      * Check if an async connect is running. If not return ok
      */
-    if ( !(statePtr->flags & SOCKET_REENTER_PENDING) )
+    if ( !(statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) )
 	return 0;
     
     /*
@@ -625,7 +628,7 @@ WaitForConnect(
 
 	    /* Succesfully connected or async connect restarted */
 	    if (result == TCL_OK) {
-		if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
+		if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) {
 		    *errorCodePtr = EWOULDBLOCK;
 		    return -1;
 		}
@@ -1218,7 +1221,7 @@ TcpGetOptionProc(
 	/*
 	* Do not return any errors if async connect is running
 	*/
-	if (! (statePtr->flags & SOCKET_REENTER_PENDING) ) {
+	if (! (statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) ) {
 	    int optlen;
 	    int ret;
     	    DWORD err;
@@ -1250,8 +1253,9 @@ TcpGetOptionProc(
     if ((len > 1) && (optionName[1] == 'c') &&
 	    (strncmp(optionName, "-connecting", len) == 0)) {
 
-        Tcl_DStringAppend(dsPtr,
-                        (statePtr->flags & SOCKET_REENTER_PENDING) ? "1" : "0", -1);
+	Tcl_DStringAppend(dsPtr,
+		(statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING)
+		? "1" : "0", -1);
         return TCL_OK;
     }
 
@@ -1609,7 +1613,7 @@ CreateClientSocket(
 	    /*
 	     * Reset last error from last try
 	     */
-	    statePtr->lastError = 0;
+	    statePtr->connectError = 0;
 	    Tcl_SetErrno(0);
 	    
 	    statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, SOCK_STREAM, 0);
@@ -1719,7 +1723,7 @@ CreateClientSocket(
 		/*
 		 * Remember that we jump back behind this next round
 		 */
-		statePtr->flags |= SOCKET_REENTER_PENDING;
+		statePtr->flags |= TCP_ASYNC_CONNECT_REENTER_PENDING;
 		return TCL_OK;
 
 	    reenter:
@@ -1730,18 +1734,18 @@ CreateClientSocket(
 		 *
 		 * Clear the reenter flag
 		 */
-		statePtr->flags &= ~(SOCKET_REENTER_PENDING);
+		statePtr->flags &= ~(TCP_ASYNC_CONNECT_REENTER_PENDING);
 		/* get statePtr lock */
 		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 		/* Get signaled connect error */
-		Tcl_SetErrno(statePtr->lastError);
+		Tcl_SetErrno(statePtr->connectError);
 		/* Clear eventual connect flag */
 		statePtr->selectEvents &= ~(FD_CONNECT);
 		/* Free list lock */
 		SetEvent(tsdPtr->socketListLock);
 	    }
 #ifdef DEBUGGING
-	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
+	    fprintf(stderr, "connectError: %d\n", Tcl_GetErrno());
 #endif
 	    /*
 	     * Clear the tsd socket list pointer if we did not wait for
@@ -1760,8 +1764,6 @@ out:
      * Socket connected or connection failed
      */
     DEBUG("connected or finally failed");
-    /* Clear async flag (not really necessary, not used any more) */
-    statePtr->flags &= ~(TCP_ASYNC_CONNECT);
 
     /*
      * Final connect failure
@@ -1797,12 +1799,14 @@ out:
 	    /*
 	     * Set up the select mask for read/write events.
 	     */
-	    DEBUG("selectEvents = FD_WRITE for fail writable");    
-	    statePtr->selectEvents = FD_WRITE;
+	    DEBUG("selectEvents = FD_WRITE/FD_READ for connect fail");    
+	    statePtr->selectEvents = FD_WRITE|FD_READ;
 	    /* get statePtr lock */
 	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	    /* Clear eventual connect flag */
-	    statePtr->readyEvents |= FD_WRITE;
+	    /* Signal ready readable and writable events */
+	    statePtr->readyEvents |= FD_WRITE | FD_READ;
+	    /* Flag error to event routine */
+	    statePtr->flags |= TCP_ASYNC_CONNECT_FAILED;
 	    /* Free list lock */
 	    SetEvent(tsdPtr->socketListLock);
 	}
@@ -2607,7 +2611,7 @@ SocketEventProc(
     if ( statePtr->readyEvents & FD_CONNECT ) {
 	statePtr->readyEvents &= ~(FD_CONNECT);
 	DEBUG("FD_CONNECT");
-        if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
+	if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) {
 	    SetEvent(tsdPtr->socketListLock);
 	    CreateClientSocket(NULL, statePtr);
 	    return 1;
@@ -2702,38 +2706,59 @@ SocketEventProc(
 	Tcl_SetMaxBlockTime(&blockTime);
 	mask |= TCL_READABLE|TCL_WRITABLE;
     } else if (events & FD_READ) {
-	fd_set readFds;
-	struct timeval timeout;
 
 	/*
-	 * We must check to see if data is really available, since someone
-	 * could have consumed the data in the meantime. Turn off async
-	 * notification so select will work correctly. If the socket is still
-	 * readable, notify the channel driver, otherwise reset the async
-	 * select handler and keep waiting.
+	 * Throw the readable event if an async connect failed.
 	 */
-	DEBUG("FD_READ");
 
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) statePtr);
+	if ( statePtr->flags & TCP_ASYNC_CONNECT_FAILED ) {
 
-	FD_ZERO(&readFds);
-	FD_SET(statePtr->sockets->fd, &readFds);
-	timeout.tv_usec = 0;
-	timeout.tv_sec = 0;
-
-	if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
 	    mask |= TCL_READABLE;
+	    
 	} else {
-	    statePtr->readyEvents &= ~(FD_READ);
+	    fd_set readFds;
+	    struct timeval timeout;
+
+	    /*
+	     * We must check to see if data is really available, since someone
+	     * could have consumed the data in the meantime. Turn off async
+	     * notification so select will work correctly. If the socket is still
+	     * readable, notify the channel driver, otherwise reset the async
+	     * select handler and keep waiting.
+	     */
+	    DEBUG("FD_READ");
+
 	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		    (WPARAM) SELECT, (LPARAM) statePtr);
+		    (WPARAM) UNSELECT, (LPARAM) statePtr);
+
+	    FD_ZERO(&readFds);
+	    FD_SET(statePtr->sockets->fd, &readFds);
+	    timeout.tv_usec = 0;
+	    timeout.tv_sec = 0;
+
+	    if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
+		mask |= TCL_READABLE;
+	    } else {
+		statePtr->readyEvents &= ~(FD_READ);
+		SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+			(WPARAM) SELECT, (LPARAM) statePtr);
+	    }
 	}
     }
+
+    /*
+     * writable event
+     */
+
     if (events & FD_WRITE) {
 	DEBUG("FD_WRITE");
 	mask |= TCL_WRITABLE;
     }
+    
+    /*
+     * Call registered event procedures
+     */
+     
     if (mask) {
 	DEBUG("Calling Tcl_NotifyChannel...");
 	Tcl_NotifyChannel(statePtr->channel, mask);
@@ -2827,6 +2852,7 @@ NewSocketInfo(SOCKET socket)
  * WaitForSocketEvent --
  *
  *	Waits until one of the specified events occurs on a socket.
+ *	For event FD_CONNECT use WaitForConnect.
  *
  * Results:
  *	Returns 1 on success or 0 on failure, with an error code in
@@ -2841,7 +2867,9 @@ NewSocketInfo(SOCKET socket)
 static int
 WaitForSocketEvent(
     TcpState *statePtr,	/* Information about this socket. */
-    int events,			/* Events to look for. */
+    int events,			/* Events to look for. May be one of
+				 * FD_READ or FD_WRITE.
+				 */
     int *errorCodePtr)		/* Where to store errors? */
 {
     int result = 1;
@@ -2864,13 +2892,24 @@ WaitForSocketEvent(
 	    (LPARAM) statePtr);
 
     while (1) {
-	if (statePtr->lastError) {
-	    *errorCodePtr = statePtr->lastError;
-	    result = 0;
-	    break;
-	} else if (statePtr->readyEvents & events) {
+	int event_found;
+
+	/* get statePtr lock */
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	
+	/* Check if event occured */
+	event_found = (statePtr->readyEvents & events);
+
+	/* Free list lock */
+	SetEvent(tsdPtr->socketListLock);
+
+	/* exit loop if event occured */
+	if (event_found) {
 	    break;
-	} else if (statePtr->flags & TCP_ASYNC_SOCKET) {
+	}
+	
+	/* Exit loop if event did not occur but this is a non-blocking channel */
+	if (statePtr->flags & TCP_ASYNC_SOCKET) {
 	    *errorCodePtr = EWOULDBLOCK;
 	    result = 0;
 	    break;
@@ -3086,7 +3125,7 @@ SocketProc(
 		 */
 		if (error != ERROR_SUCCESS) {
 		    TclWinConvertError((DWORD) error);
-		    statePtr->lastError = Tcl_GetErrno();
+		    statePtr->connectError = Tcl_GetErrno();
 		}
 	    }
 	    /*
-- 
cgit v0.12


From 3b6523dd1f6ce2e08932508cf276ca55d04872e6 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 26 Mar 2014 10:37:57 +0000
Subject: Implementation of [b42b208ba4]: file attributes -readonly on Cygwin.
 For completeness, implemented -archive, -hidden and -system as well.

---
 unix/tclUnixFCmd.c | 185 +++++++++++++++++++++++++++++++++++++++++++++++++----
 unix/tclUnixPort.h |   3 +
 2 files changed, 174 insertions(+), 14 deletions(-)

diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index e270b6a..259c7e5 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -91,10 +91,10 @@ static int		SetPermissionsAttribute(Tcl_Interp *interp,
 			    Tcl_Obj *attributePtr);
 static int		GetModeFromPermString(Tcl_Interp *interp,
 			    const char *modeStringPtr, mode_t *modePtr);
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
-static int		GetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
+static int		GetUnixFileAttributes(Tcl_Interp *interp, int objIndex,
 			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
-static int		SetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
+static int		SetUnixFileAttributes(Tcl_Interp *interp, int objIndex,
 			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);
 #endif
 
@@ -124,10 +124,20 @@ extern const char *const tclpFileAttrStrings[];
 
 #else /* !DJGPP */
 enum {
-    UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
+#if defined(__CYGWIN__)
+    UNIX_ARCHIVE_ATTRIBUTE,
+#endif
+    UNIX_GROUP_ATTRIBUTE,
+#if defined(__CYGWIN__)
+    UNIX_HIDDEN_ATTRIBUTE,
+#endif
+    UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
     UNIX_READONLY_ATTRIBUTE,
 #endif
+#if defined(__CYGWIN__)
+    UNIX_SYSTEM_ATTRIBUTE,
+#endif
 #ifdef MAC_OSX_TCL
     MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE,
     MACOSX_RSRCLENGTH_ATTRIBUTE,
@@ -137,10 +147,20 @@ enum {
 
 MODULE_SCOPE const char *const tclpFileAttrStrings[];
 const char *const tclpFileAttrStrings[] = {
-    "-group", "-owner", "-permissions",
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
+#if defined(__CYGWIN__)
+    "-archive",
+#endif
+    "-group",
+#if defined(__CYGWIN__)
+    "-hidden",
+#endif
+    "-owner", "-permissions",
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
     "-readonly",
 #endif
+#if defined(__CYGWIN__)
+    "-system",
+#endif
 #ifdef MAC_OSX_TCL
     "-creator", "-type", "-hidden", "-rsrclength",
 #endif
@@ -149,11 +169,20 @@ const char *const tclpFileAttrStrings[] = {
 
 MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
 const TclFileAttrProcs tclpFileAttrProcs[] = {
+#if defined(__CYGWIN__)
+    {GetUnixFileAttributes, SetUnixFileAttributes},
+#endif
     {GetGroupAttribute, SetGroupAttribute},
+#if defined(__CYGWIN__)
+    {GetUnixFileAttributes, SetUnixFileAttributes},
+#endif
     {GetOwnerAttribute, SetOwnerAttribute},
     {GetPermissionsAttribute, SetPermissionsAttribute},
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
-    {GetReadOnlyAttribute, SetReadOnlyAttribute},
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
+    {GetUnixFileAttributes, SetUnixFileAttributes},
+#endif
+#if defined(__CYGWIN__)
+    {GetUnixFileAttributes, SetUnixFileAttributes},
 #endif
 #ifdef MAC_OSX_TCL
     {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
@@ -2246,11 +2275,139 @@ DefaultTempDir(void)
     return TCL_TEMPORARY_FILE_DIRECTORY;
 }
 
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
+#if defined(__CYGWIN__)
+
+static void
+StatError(
+    Tcl_Interp *interp,		/* The interp that has the error */
+    Tcl_Obj *fileName)		/* The name of the file which caused the
+				 * error. */
+{
+    TclWinConvertError(GetLastError());
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
+	    TclGetString(fileName), Tcl_PosixError(interp)));
+}
+
+static WCHAR *
+winPathFromNative(
+    const char *native)
+{
+	int size;
+	WCHAR *winPath;
+
+    size = cygwin_conv_path(1, native, NULL, 0);
+    winPath = ckalloc(size);
+    cygwin_conv_path(1, native, winPath, size);
+
+    return winPath;
+}
+
+static const int attributeArray[] = {
+    0x20, 0, 2, 0, 0, 1, 4};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetUnixFileAttributes
+ *
+ *	Gets the readonly attribute of a file.
+ *
+ * Results:
+ *	Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there
+ *	is no error. The object will have ref count 0.
+ *
+ * Side effects:
+ *	A new object is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetUnixFileAttributes(
+    Tcl_Interp *interp,		/* The interp we are using for errors. */
+    int objIndex,		/* The index of the attribute. */
+    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
+    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
+{
+    int fileAttributes;
+    const char *native = Tcl_FSGetNativePath(fileName);
+    WCHAR *winPath = winPathFromNative(native);
+
+    fileAttributes = GetFileAttributesW(winPath);
+    ckfree(winPath);
+
+    if (fileAttributes == -1) {
+	StatError(interp, fileName);
+	return TCL_ERROR;
+    }
+
+    *attributePtrPtr = Tcl_NewIntObj((fileAttributes&attributeArray[objIndex])!=0);
+
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetUnixFileAttributes
+ *
+ *	Sets the readonly attribute of a file.
+ *
+ * Results:
+ *	Standard TCL result.
+ *
+ * Side effects:
+ *	The readonly attribute of the file is changed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetUnixFileAttributes(
+    Tcl_Interp *interp,	    /* The interp we are using for errors. */
+    int objIndex,           /* The index of the attribute. */
+    Tcl_Obj *fileName,      /* The name of the file (UTF-8). */
+    Tcl_Obj *attributePtr)  /* The attribute to set. */
+{
+    int yesNo, fileAttributes;
+    const char *native;
+    WCHAR *winPath;
+
+    if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    native = Tcl_FSGetNativePath(fileName);
+    winPath = winPathFromNative(native);
+
+    fileAttributes = GetFileAttributesW(winPath);
+
+    if (fileAttributes == -1) {
+	ckfree(winPath);
+	StatError(interp, fileName);
+	return TCL_ERROR;
+    }
+
+    if (yesNo) {
+	fileAttributes |= attributeArray[objIndex];
+    } else {
+	fileAttributes &= ~attributeArray[objIndex];
+    }
+
+    if (!SetFileAttributesW(winPath, fileAttributes)) {
+	ckfree(winPath);
+	StatError(interp, fileName);
+	return TCL_ERROR;
+    }
+
+	ckfree(winPath);
+    return TCL_OK;
+}
+#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
 /*
  *----------------------------------------------------------------------
  *
- * GetReadOnlyAttribute
+ * GetUnixFileAttributes
  *
  *	Gets the readonly attribute (user immutable flag) of a file.
  *
@@ -2265,7 +2422,7 @@ DefaultTempDir(void)
  */
 
 static int
-GetReadOnlyAttribute(
+GetUnixFileAttributes(
     Tcl_Interp *interp,		/* The interp we are using for errors. */
     int objIndex,		/* The index of the attribute. */
     Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
@@ -2293,7 +2450,7 @@ GetReadOnlyAttribute(
 /*
  *---------------------------------------------------------------------------
  *
- * SetReadOnlyAttribute
+ * SetUnixFileAttributes
  *
  *	Sets the readonly attribute (user immutable flag) of a file.
  *
@@ -2307,7 +2464,7 @@ GetReadOnlyAttribute(
  */
 
 static int
-SetReadOnlyAttribute(
+SetUnixFileAttributes(
     Tcl_Interp *interp,		/* The interp we are using for errors. */
     int objIndex,		/* The index of the attribute. */
     Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 2ade1c0..f64d453 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -93,6 +93,9 @@ typedef off_t		Tcl_SeekOffset;
 	    WCHAR *, int);
     __declspec(dllimport) extern __stdcall void OutputDebugStringW(const WCHAR *);
     __declspec(dllimport) extern __stdcall int IsDebuggerPresent();
+    __declspec(dllimport) extern __stdcall int GetLastError();
+    __declspec(dllimport) extern __stdcall int GetFileAttributesW(const WCHAR *);
+    __declspec(dllimport) extern __stdcall int SetFileAttributesW(const WCHAR *, int);
 
     __declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int);
     __declspec(dllimport) extern int cygwin_conv_path_list(int, const void *, void *, int);
-- 
cgit v0.12


From 07ba2fc47f5d9c888ccb11ca3666f215159b5f45 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 26 Mar 2014 14:34:56 +0000
Subject: Only write back file attributes if any of them really changed.

---
 unix/tclUnixFCmd.c | 23 +++++++++++------------
 win/tclWinFCmd.c   |  7 ++++---
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 259c7e5..3b1b6ca 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -2289,11 +2289,12 @@ StatError(
 }
 
 static WCHAR *
-winPathFromNative(
-    const char *native)
+winPathFromObj(
+    Tcl_Obj *fileName)
 {
-	int size;
-	WCHAR *winPath;
+    int size;
+    const char *native =  Tcl_FSGetNativePath(fileName);
+    WCHAR *winPath;
 
     size = cygwin_conv_path(1, native, NULL, 0);
     winPath = ckalloc(size);
@@ -2330,8 +2331,7 @@ GetUnixFileAttributes(
     Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
 {
     int fileAttributes;
-    const char *native = Tcl_FSGetNativePath(fileName);
-    WCHAR *winPath = winPathFromNative(native);
+    WCHAR *winPath = winPathFromObj(fileName);
 
     fileAttributes = GetFileAttributesW(winPath);
     ckfree(winPath);
@@ -2369,18 +2369,16 @@ SetUnixFileAttributes(
     Tcl_Obj *fileName,      /* The name of the file (UTF-8). */
     Tcl_Obj *attributePtr)  /* The attribute to set. */
 {
-    int yesNo, fileAttributes;
-    const char *native;
+    int yesNo, fileAttributes, old;
     WCHAR *winPath;
 
     if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    native = Tcl_FSGetNativePath(fileName);
-    winPath = winPathFromNative(native);
+    winPath = winPathFromObj(fileName);
 
-    fileAttributes = GetFileAttributesW(winPath);
+    fileAttributes = old = GetFileAttributesW(winPath);
 
     if (fileAttributes == -1) {
 	ckfree(winPath);
@@ -2394,7 +2392,8 @@ SetUnixFileAttributes(
 	fileAttributes &= ~attributeArray[objIndex];
     }
 
-    if (!SetFileAttributesW(winPath, fileAttributes)) {
+    if ((fileAttributes != old)
+	    && !SetFileAttributesW(winPath, fileAttributes)) {
 	ckfree(winPath);
 	StatError(interp, fileName);
 	return TCL_ERROR;
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 2700cb3..f14d9ff 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1825,12 +1825,12 @@ SetWinFileAttributes(
     Tcl_Obj *fileName,		/* The name of the file. */
     Tcl_Obj *attributePtr)	/* The new value of the attribute. */
 {
-    DWORD fileAttributes;
+    DWORD fileAttributes, old;
     int yesNo, result;
     const TCHAR *nativeName;
 
     nativeName = Tcl_FSGetNativePath(fileName);
-    fileAttributes = GetFileAttributes(nativeName);
+    fileAttributes = old = GetFileAttributes(nativeName);
 
     if (fileAttributes == 0xffffffff) {
 	StatError(interp, fileName);
@@ -1848,7 +1848,8 @@ SetWinFileAttributes(
 	fileAttributes &= ~(attributeArray[objIndex]);
     }
 
-    if (!SetFileAttributes(nativeName, fileAttributes)) {
+    if ((fileAttributes != old)
+	    && !SetFileAttributes(nativeName, fileAttributes)) {
 	StatError(interp, fileName);
 	return TCL_ERROR;
     }
-- 
cgit v0.12


From 8868d903d92c976f3c5eb3ea4a4a98862de6e6c0 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Mar 2014 16:27:09 +0000
Subject: New test iortrans-4.8.1 exposes segfault bug [721ec69271].

---
 tests/ioTrans.test | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 5a8874c..b21d894 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -540,6 +540,25 @@ test iortrans-4.8 {chan read, read, bug 2921116} -setup {
     rename foo {}
 } -result {{read rt* {test data
 }} file*}
+test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {fd args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    chan configure $c -buffersize 2
+    lappend res [read $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} file*}
 test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
     set res {}
 } -match glob -body {
-- 
cgit v0.12


From faf7effffed566ae286f67f982029e5d7748cd40 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Mar 2014 16:44:04 +0000
Subject: Test iogt-2.4 is another segfault demo for [721ec69271].

---
 tests/iogt.test | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/tests/iogt.test b/tests/iogt.test
index 3882ecc..d54ae04 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -242,6 +242,26 @@ proc id_fulltrail {var op data} {
     return $res
 }
 
+proc id_torture {chan op data} {
+    switch -- $op {
+	create/write -
+	create/read  -
+	delete/write -
+	delete/read  -
+	clear_read   {;#ignore}
+	flush/write -
+	flush/read  -
+	write       -
+	read        {
+	    testchannel unstack $chan
+	    testchannel transform $chan \
+		-command [namespace code [list id_torture $chan]]
+	    return $data
+	}
+	query/maxRead {return -1}
+    }
+}
+
 proc counter {var op data} {
     variable $var
     upvar 0 $var n
@@ -364,6 +384,10 @@ proc audit_flow {var -attach channel} {
     testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
 }
 
+proc torture {-attach channel} {
+    testchannel transform $channel -command [namespace code [list id_torture $channel]]
+}
+
 proc stopafter {var n -attach channel} {
     variable $var
     upvar 0 $var vn
@@ -632,6 +656,15 @@ delete/read {} *ignored*
 flush/write {} {}
 delete/write {} *ignored*}
 
+test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
+    set fh [open $path(dummy) r]
+    torture -attach $fh
+    chan configure $fh -buffersize 2
+    set x [read $fh]
+    testchannel unstack $fh
+    close   $fh
+    set x
+} {}
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
 	{testchannel unknownFailure} {
-- 
cgit v0.12


From bb3eb0aaa60aba47a0e857fa2e34e5eb7ba8263f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Mar 2014 19:14:01 +0000
Subject: Test iocmd-23.11 demos another segfault.

---
 tests/ioCmd.test | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 768a748..262be9b 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -1013,6 +1013,21 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo
     rename foo {}
     unset res
 } -result {{read rc* 4096} {} 0}
+test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	set args [lassign $args sub id]
+	if {$sub ne "read"} {return}
+	close $id
+	return {}
+    }
+    set c [chan create {r} foo]
+    note [read $c]
+    close $c
+    rename foo {}
+    set res
+} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
 
 # --- === *** ###########################
 # method write
-- 
cgit v0.12


From 06f376eefe2af7c3eb3f8131dacd6bc296a2fb71 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Mar 2014 21:35:57 +0000
Subject: Minimal patch to fix iocmd-23.11.  Might not be the best fix, but is
 *a* fix.

---
 generic/tclIO.c      | 23 ++++++++++++++++++++---
 generic/tclIORChan.c |  2 ++
 tests/ioCmd.test     |  3 +--
 3 files changed, 23 insertions(+), 5 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3636861..c43e61e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3852,6 +3852,7 @@ Tcl_GetsObj(
      */
 
     chanPtr = statePtr->topChanPtr;
+    Tcl_Preserve(chanPtr);
 
     bufPtr = statePtr->inQueueHead;
     encoding = statePtr->encoding;
@@ -4144,6 +4145,7 @@ Tcl_GetsObj(
 
   done:
     UpdateInterest(chanPtr);
+    Tcl_Release(chanPtr);
     return copiedTotal;
 }
 
@@ -4189,6 +4191,7 @@ TclGetsObjBinary(
      */
 
     chanPtr = statePtr->topChanPtr;
+    Tcl_Preserve(chanPtr);
 
     bufPtr = statePtr->inQueueHead;
 
@@ -4388,6 +4391,7 @@ TclGetsObjBinary(
 
   done:
     UpdateInterest(chanPtr);
+    Tcl_Release(chanPtr);
     return copiedTotal;
 }
 
@@ -4860,6 +4864,7 @@ Tcl_ReadRaw(
      * requests more bytes.
      */
 
+    Tcl_Preserve(chanPtr);
     for (copied = 0; copied < bytesToRead; copied += copiedNow) {
 	copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
 		bytesToRead - copied);
@@ -4946,7 +4951,7 @@ Tcl_ReadRaw(
 			 * over EAGAIN/WOULDBLOCK handling.
 			 */
 
-			return copied;
+			goto done;
 		    }
 
 		    SetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4954,14 +4959,17 @@ Tcl_ReadRaw(
 		}
 
 		Tcl_SetErrno(result);
-		return -1;
+		copied = -1;
+		goto done;
 	    }
 
-	    return copied + nread;
+	    copied += nread;
+	    goto done;
 	}
     }
 
   done:
+    Tcl_Release(chanPtr);
     return copied;
 }
 
@@ -5069,6 +5077,7 @@ DoReadChars(
     chanPtr = statePtr->topChanPtr;
     encoding = statePtr->encoding;
     factor = UTF_EXPANSION_FACTOR;
+    Tcl_Preserve(chanPtr);
 
     if (appendFlag == 0) {
 	if (encoding == NULL) {
@@ -5158,6 +5167,7 @@ DoReadChars(
 
   done:
     UpdateInterest(chanPtr);
+    Tcl_Release(chanPtr);
     return copied;
 }
 
@@ -7700,6 +7710,11 @@ UpdateInterest(
 				/* State info for channel */
     int mask = statePtr->interestMask;
 
+    if (chanPtr->typePtr == NULL) {
+	/* Do not update interest on a closed channel */
+	return;
+    }
+
     /*
      * If there are flushed buffers waiting to be written, then we need to
      * watch for the channel to become writable.
@@ -8785,6 +8800,7 @@ DoRead(
      * operation.
      */
 
+    Tcl_Preserve(chanPtr);
     if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
 	ResetFlag(statePtr, CHANNEL_EOF);
     }
@@ -8822,6 +8838,7 @@ DoRead(
 
   done:
     UpdateInterest(chanPtr);
+    Tcl_Release(chanPtr);
     return copied;
 }
 
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index ca3ab4b..affed02 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -571,6 +571,7 @@ TclChanCreateObjCmd(
     chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
 	    mode);
     rcPtr->chan = chan;
+    Tcl_Preserve(chan);
     chanPtr = (Channel *) chan;
 
     /*
@@ -2145,6 +2146,7 @@ FreeReflectedChannel(
 
 	ckfree((char*) chanPtr->typePtr);
     }
+    Tcl_Release(chanPtr);
 
     n = rcPtr->argc - 2;
     for (i=0; i<n; i++) {
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 262be9b..bdf0fb3 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -1024,10 +1024,9 @@ test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
     }
     set c [chan create {r} foo]
     note [read $c]
-    close $c
     rename foo {}
     set res
-} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
+} -result {{read rc* 4096} {}}
 
 # --- === *** ###########################
 # method write
-- 
cgit v0.12


From c85fe58264794439fe6057b5d98428a033774bcc Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 31 Mar 2014 15:23:30 +0000
Subject: Cherry-pick [c54059aaad] from trunk: Added support for reporting
 TEA-like info via pkg-config. Add missing @TCL_LIB_FLAG@ (derived from ticket
 [5bcb5026ad])

---
 unix/Makefile.in  | 10 +++++++---
 unix/configure    |  3 ++-
 unix/configure.in |  1 +
 unix/tcl.pc.in    | 15 +++++++++++++++
 4 files changed, 25 insertions(+), 4 deletions(-)
 create mode 100644 unix/tcl.pc.in

diff --git a/unix/Makefile.in b/unix/Makefile.in
index c7caf5b..746abde 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -736,6 +736,9 @@ install-binaries: binaries
 	    @INSTALL_STUB_LIB@ ; \
 	fi
 	@EXTRA_INSTALL_BINARIES@
+	@echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/"
+	@mkdir -p $(LIB_INSTALL_DIR)/pkgconfig
+	@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc
 
 install-libraries: libraries $(INSTALL_TZDATA) install-msgs
 	@for i in "$(INCLUDE_INSTALL_DIR)" "$(SCRIPT_INSTALL_DIR)"; \
@@ -905,7 +908,8 @@ clean:
 
 distclean: clean
 	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
-		$(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework
+		$(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework \
+		tcl.pc
 	cd dltest ; $(MAKE) distclean
 
 depend:
@@ -1657,7 +1661,7 @@ $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
 	cd $(MAC_OSX_DIR); autoheader; touch $@
 
 EOLFIX=$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl
-dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure genstubs
+dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(MAC_OSX_DIR)/configure genstubs
 	rm -rf $(DISTDIR)
 	mkdir -p $(DISTDIR)/unix
 	cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix
@@ -1668,7 +1672,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure
 		$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \
 		$(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \
 		$(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \
-		$(DISTDIR)/unix
+		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
 	chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
 	chmod 775 $(DISTDIR)/unix/ldAix
 	@mkdir $(DISTDIR)/generic
diff --git a/unix/configure b/unix/configure
index 1b2ea41..02a3725 100755
--- a/unix/configure
+++ b/unix/configure
@@ -18915,7 +18915,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
 
 
 
-                              ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in"
+                              ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in"
 
 cat >confcache <<\_ACEOF
 # This file is a shell script that caches the results of configure
@@ -19469,6 +19469,7 @@ do
   "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;;
   "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;;
   "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;;
+  "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;;
   "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;;
   *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
 echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
diff --git a/unix/configure.in b/unix/configure.in
index b5a09dd..318bcf8 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -940,5 +940,6 @@ AC_CONFIG_FILES([
     Makefile:../unix/Makefile.in
     dltest/Makefile:../unix/dltest/Makefile.in
     tclConfig.sh:../unix/tclConfig.sh.in
+    tcl.pc:../unix/tcl.pc.in
 ])
 AC_OUTPUT
diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
new file mode 100644
index 0000000..6b6fe44
--- /dev/null
+++ b/unix/tcl.pc.in
@@ -0,0 +1,15 @@
+# tcl pkg-config source file
+
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+includedir=@includedir@
+
+Name: Tool Command Language
+Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
+URL: http://www.tcl.tk/
+Version: @TCL_VERSION@
+Requires:
+Conflicts:
+Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_LIBS@
+Cflags: -I${includedir}
-- 
cgit v0.12


From 228bbc8713a27f21735f74e4ed4a4e77c8edf3c7 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 1 Apr 2014 09:52:34 +0000
Subject: Set return message in close if a flush error is reported (which may
 be an error from a background flush). Ticket [97069ea11a]

---
 generic/tclIO.c | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index c43e61e..15fc8af 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3209,9 +3209,20 @@ Tcl_Close(
 	    Tcl_SetObjResult(interp,
 			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
 	}
-	flushcode = -1;
+	return TCL_ERROR;
     }
-    if ((flushcode != 0) || (result != 0)) {
+    if (result != 0) {
+	return TCL_ERROR;
+    }
+    /*
+     * Bug 97069ea11a: set error message if a flush code is set
+     */
+    if (flushcode != 0) {
+	Tcl_SetErrno(flushcode);
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
+	}
 	return TCL_ERROR;
     }
     return TCL_OK;
-- 
cgit v0.12


From e14e7323ec0a1a11668d5ae89f1e4a102e4757b4 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 1 Apr 2014 11:31:49 +0000
Subject: Fix test failure socket-2.9: "1 {not owner}" instead of "1 {couldn't
 open socket address already in use}" by only setting returned error message
 if not jet set.

---
 generic/tclIO.c | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 15fc8af..9e675c6 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3211,18 +3211,17 @@ Tcl_Close(
 	}
 	return TCL_ERROR;
     }
-    if (result != 0) {
-	return TCL_ERROR;
-    }
     /*
-     * Bug 97069ea11a: set error message if a flush code is set
+     * Bug 97069ea11a: set error message if a flush code is set and no error
+     * message set up to now.
      */
-    if (flushcode != 0) {
+    if (flushcode != 0 && interp != NULL
+	    && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
 	Tcl_SetErrno(flushcode);
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp,
-			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
-	}
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj(Tcl_PosixError(interp), -1));
+    }
+    if ((flushcode != 0) || (result != 0)) {
 	return TCL_ERROR;
     }
     return TCL_OK;
-- 
cgit v0.12


From bbc3bb7823030f97cb3f96d7a76ccf49b0245545 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 1 Apr 2014 12:16:39 +0000
Subject: Removed thread debugging printf messages

---
 win/tclWinSock.c | 123 ++++++-------------------------------------------------
 1 file changed, 13 insertions(+), 110 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 91f9e8c..1b252e0 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -50,14 +50,6 @@
 
 #include "tclWinInt.h"
 
-//#define DEBUGGING
-#ifdef DEBUGGING
-#define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
-			    statePtr, __FUNCTION__, __LINE__, x)
-#else
-#define DEBUG(x)
-#endif
-
 /*
  * Which version of the winsock API do we want?
  */
@@ -318,6 +310,10 @@ static TclInitProcessGlobalValueProc InitializeHostName;
 static ProcessGlobalValue hostName =
 	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
 
+/*
+ * Address print debug functions
+ */
+#if 0
 void printaddrinfo(struct addrinfo *ai, char *prefix)
 {
     char host[NI_MAXHOST], port[NI_MAXSERV];
@@ -325,9 +321,6 @@ void printaddrinfo(struct addrinfo *ai, char *prefix)
 		host, sizeof(host),
 		port, sizeof(port),
 		NI_NUMERICHOST|NI_NUMERICSERV);
-#ifdef DEBUGGING
-    fprintf(stderr,"%s: [%s]:%s\n", prefix, host, port);
-#endif
 }
 void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
 {
@@ -336,6 +329,7 @@ void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
 	printaddrinfo(ai, prefix);
     }
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -1319,9 +1313,6 @@ TcpGetOptionProc(
 	}
 	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
 	    sock = fds->fd;
-#ifdef DEBUGGING
-	    fprintf(stderr, "sock == %d\n", sock);
-#endif
 	    size = sizeof(sockname);
 	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
 		int flags = reverseDNS;
@@ -1452,9 +1443,6 @@ TcpWatchProc(
 {
     TcpState *statePtr = instanceData;
 
-    DEBUG((mask & TCL_READABLE) ? "+r":"-r");
-    DEBUG((mask & TCL_WRITABLE) ? "+w":"-w");
-
     /*
      * Update the watch events mask. Only if the socket is not a server
      * socket. [Bug 557878]
@@ -1567,13 +1555,8 @@ CreateClientSocket(
     int async_callback = statePtr->sockets->fd != INVALID_SOCKET;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
     
-    DEBUG(async_connect ? "async connect" : "sync connect");
-
     if (async_callback) {
-	DEBUG("subsequent call");
         goto reenter;
-    } else {
-	DEBUG("first call");
     }
     
     for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
@@ -1582,28 +1565,20 @@ CreateClientSocket(
         for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL;
 	     statePtr->myaddr = statePtr->myaddr->ai_next) {
 
-	    DEBUG("inner loop");
-
 	    /*
 	     * No need to try combinations of local and remote addresses
 	     * of different families.
 	     */
 
 	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
-		DEBUG("family mismatch");
 		continue;
 	    }
 
-	    DEBUG(statePtr->myaddr->ai_family == AF_INET ? "IPv4" : "IPv6");
-	    printaddrinfo(statePtr->myaddr, "~~ from");
-	    printaddrinfo(statePtr->addr,   "~~   to");
-
             /*
              * Close the socket if it is still open from the last unsuccessful
              * iteration.
              */	    
 	    if (statePtr->sockets->fd != INVALID_SOCKET) {
-		DEBUG("closesocket");
 		closesocket(statePtr->sockets->fd);
 	    }
 
@@ -1623,14 +1598,10 @@ CreateClientSocket(
 
 	    /* continue on socket creation error */
 	    if (statePtr->sockets->fd == INVALID_SOCKET) {
-		DEBUG("socket() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
 		continue;
 	    }
-	    
-#ifdef DEBUGGING
-	    fprintf(stderr, "Client socket %d created\n", statePtr->sockets->fd);
-#endif
+
 	    /*
 	     * Win-NT has a misfeature that sockets are inherited in child
 	     * processes by default. Turn off the inherit bit.
@@ -1650,7 +1621,6 @@ CreateClientSocket(
 
 	    if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
 			statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
-		DEBUG("bind() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
 		continue;
 	    }
@@ -1706,7 +1676,6 @@ CreateClientSocket(
 	     * Attempt to connect to the remote socket.
 	     */
 	    
-	    DEBUG("connect()");
 	    connect(statePtr->sockets->fd, statePtr->addr->ai_addr,
 		    statePtr->addr->ai_addrlen);
 
@@ -1717,8 +1686,6 @@ CreateClientSocket(
 		/*
 		 * Asynchroneous connect
 		 */
-		DEBUG("WSAEWOULDBLOCK");
-
 
 		/*
 		 * Remember that we jump back behind this next round
@@ -1727,7 +1694,6 @@ CreateClientSocket(
 		return TCL_OK;
 
 	    reenter:
-		DEBUG("reenter");
 		/*
 		 * Re-entry point for async connect after connect event or
 		 * blocking operation
@@ -1744,9 +1710,7 @@ CreateClientSocket(
 		/* Free list lock */
 		SetEvent(tsdPtr->socketListLock);
 	    }
-#ifdef DEBUGGING
-	    fprintf(stderr, "connectError: %d\n", Tcl_GetErrno());
-#endif
+
 	    /*
 	     * Clear the tsd socket list pointer if we did not wait for
 	     * the FD_CONNECT asyncroneously
@@ -1763,11 +1727,6 @@ out:
     /*
      * Socket connected or connection failed
      */
-    DEBUG("connected or finally failed");
-
-    /*
-     * Final connect failure
-     */
 
     if ( Tcl_GetErrno() == 0 ) {
 	/*
@@ -1776,7 +1735,6 @@ out:
 	/*
 	 * Set up the select mask for read/write events.
 	 */
-	DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
 	statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
         
 	/*
@@ -1790,7 +1748,6 @@ out:
 	/*
 	 * Connect failed
 	 */
-	DEBUG("ERRNO");
 
 	/*
 	 * For async connect schedule a writable event to report the fail.
@@ -1799,7 +1756,6 @@ out:
 	    /*
 	     * Set up the select mask for read/write events.
 	     */
-	    DEBUG("selectEvents = FD_WRITE/FD_READ for connect fail");    
 	    statePtr->selectEvents = FD_WRITE|FD_READ;
 	    /* get statePtr lock */
 	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
@@ -1885,8 +1841,6 @@ Tcl_OpenTcpClient(
         }
         return NULL;
     }
-    printaddrinfolist(myaddrlist, "local");
-    printaddrinfolist(addrlist, "remote");
 
     statePtr = NewSocketInfo(INVALID_SOCKET);
     statePtr->addrlist = addrlist;
@@ -1898,7 +1852,6 @@ Tcl_OpenTcpClient(
     /*
      * Create a new client socket and wrap it in a channel.
      */
-    DEBUG("");
     if (CreateClientSocket(interp, statePtr) != TCL_OK) {
 	TcpCloseProc(statePtr, NULL);
 	return NULL;
@@ -2480,7 +2433,6 @@ SocketSetupProc(
 	if (statePtr->readyEvents &
 	    (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
 	) {
-	    DEBUG("Tcl_SetMaxBlockTime");
 	    Tcl_SetMaxBlockTime(&blockTime);
 	    break;
 	}
@@ -2527,12 +2479,10 @@ SocketCheckProc(
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (statePtr = tsdPtr->socketList; statePtr != NULL;
 	    statePtr = statePtr->nextPtr) {
-	DEBUG("Socket loop");
 	if ((statePtr->readyEvents &
 		(statePtr->watchEvents | FD_CONNECT | FD_ACCEPT))
 	    && !(statePtr->flags & SOCKET_PENDING)
 	) {
-	    DEBUG("Event found");
 	    statePtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
 	    evPtr->header.proc = SocketEventProc;
@@ -2570,7 +2520,7 @@ SocketEventProc(
     int flags)			/* Flags that indicate what events to handle,
 				 * such as TCL_FILE_EVENTS. */
 {
-    TcpState *statePtr = NULL; /* DEBUG */
+    TcpState *statePtr;
     SocketEvent *eventPtr = (SocketEvent *) evPtr;
     int mask = 0, events;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -2579,7 +2529,6 @@ SocketEventProc(
     address addr;
     int len;
 
-    DEBUG("");
     if (!(flags & TCL_FILE_EVENTS)) {
 	return 0;
     }
@@ -2610,7 +2559,6 @@ SocketEventProc(
     /* Continue async connect if pending and ready */
     if ( statePtr->readyEvents & FD_CONNECT ) {
 	statePtr->readyEvents &= ~(FD_CONNECT);
-	DEBUG("FD_CONNECT");
 	if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) {
 	    SetEvent(tsdPtr->socketListLock);
 	    CreateClientSocket(NULL, statePtr);
@@ -2702,7 +2650,6 @@ SocketEventProc(
 
 	Tcl_Time blockTime = { 0, 0 };
 
-	DEBUG("FD_CLOSE");
 	Tcl_SetMaxBlockTime(&blockTime);
 	mask |= TCL_READABLE|TCL_WRITABLE;
     } else if (events & FD_READ) {
@@ -2722,11 +2669,10 @@ SocketEventProc(
 	    /*
 	     * We must check to see if data is really available, since someone
 	     * could have consumed the data in the meantime. Turn off async
-	     * notification so select will work correctly. If the socket is still
-	     * readable, notify the channel driver, otherwise reset the async
-	     * select handler and keep waiting.
+	     * notification so select will work correctly. If the socket is
+	     * still readable, notify the channel driver, otherwise reset the
+	     * async select handler and keep waiting.
 	     */
-	    DEBUG("FD_READ");
 
 	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
 		    (WPARAM) UNSELECT, (LPARAM) statePtr);
@@ -2751,7 +2697,6 @@ SocketEventProc(
      */
 
     if (events & FD_WRITE) {
-	DEBUG("FD_WRITE");
 	mask |= TCL_WRITABLE;
     }
     
@@ -2760,10 +2705,8 @@ SocketEventProc(
      */
      
     if (mask) {
-	DEBUG("Calling Tcl_NotifyChannel...");
 	Tcl_NotifyChannel(statePtr->channel, mask);
     }
-    DEBUG("returning...");
     return 1;
 }
 
@@ -2878,7 +2821,6 @@ WaitForSocketEvent(
     /*
      * Be sure to disable event servicing so we are truly modal.
      */
-    DEBUG("=============");
 
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
 
@@ -3017,7 +2959,7 @@ SocketProc(
 {
     int event, error;
     SOCKET socket;
-    TcpState *statePtr = NULL; /* DEBUG */
+    TcpState *statePtr;
     int info_found = 0;
     TcpFdList *fds = NULL;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
@@ -3056,17 +2998,6 @@ SocketProc(
 	error = WSAGETSELECTERROR(lParam);
 	socket = (SOCKET) wParam;
 
-        #ifdef DEBUGGING
-	fprintf(stderr,"event = %d, error=%d\n",event,error);
-	#endif
-	if (event & FD_READ) DEBUG("READ Event");
-	if (event & FD_WRITE) DEBUG("WRITE Event");
-	if (event & FD_CLOSE) DEBUG("CLOSE Event");
-	if (event & FD_CONNECT)
-	    DEBUG("CONNECT Event");
-	if (event & FD_ACCEPT) DEBUG("ACCEPT Event");
-
-	DEBUG("Get list lock");
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
 	/*
@@ -3076,10 +3007,8 @@ SocketProc(
 
 	for (statePtr = tsdPtr->socketList; statePtr != NULL;
 		statePtr = statePtr->nextPtr) {
-	    DEBUG("Cur InfoPtr");
 	    if ( FindFDInList(statePtr,socket) ) {
 		info_found = 1;
-		DEBUG("InfoPtr found");
 		break;
 	    }
 	}
@@ -3091,14 +3020,9 @@ SocketProc(
 		&& tsdPtr->pendingTcpState != NULL
 		&& FindFDInList(tsdPtr->pendingTcpState,socket) ) {
 	    statePtr = tsdPtr->pendingTcpState;
-	    DEBUG("Pending InfoPtr found");
 	    info_found = 1;
 	}
 	if (info_found) {
-	    if (event & FD_READ) 
-		DEBUG("|->FD_READ");
-	    if (event & FD_WRITE) 
-		DEBUG("|->FD_WRITE");
 
 	    /*
 	     * Update the socket state.
@@ -3109,16 +3033,13 @@ SocketProc(
 	     */
 
 	    if (event & FD_CLOSE) {
-		DEBUG("FD_CLOSE");
 		statePtr->acceptEventCount = 0;
 		statePtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
 	    } else if (event & FD_ACCEPT) {
-		DEBUG("FD_ACCEPT");
-		    statePtr->acceptEventCount++;
+		statePtr->acceptEventCount++;
 	    }
 
 	    if (event & FD_CONNECT) {
-		DEBUG("FD_CONNECT");
 		/*
 		 * Remember any error that occurred so we can report
 		 * connection failures.
@@ -3143,19 +3064,9 @@ SocketProc(
 	break;
 
     case SOCKET_SELECT:
-	DEBUG("SOCKET_SELECT");
 	statePtr = (TcpState *) lParam;
 	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
-#ifdef DEBUGGING
-	    fprintf(stderr,"loop over fd = %d\n",fds->fd);
-#endif
 	    if (wParam == SELECT) {
-		DEBUG("SELECT");
-		if (statePtr->selectEvents & FD_READ) DEBUG("  READ");
-		if (statePtr->selectEvents & FD_WRITE) DEBUG("  WRITE");
-		if (statePtr->selectEvents & FD_CLOSE) DEBUG("  CLOSE");
-		if (statePtr->selectEvents & FD_CONNECT) DEBUG("  CONNECT");
-		if (statePtr->selectEvents & FD_ACCEPT) DEBUG("  ACCEPT");
 		WSAAsyncSelect(fds->fd, hwnd,
 			SOCKET_MESSAGE, statePtr->selectEvents);
 	    } else {
@@ -3163,14 +3074,12 @@ SocketProc(
 		 * Clear the selection mask
 		 */
 
-		DEBUG("!SELECT");
 		WSAAsyncSelect(fds->fd, hwnd, 0, 0);
 	    }
 	}
 	break;
 
     case SOCKET_TERMINATE:
-	    DEBUG("SOCKET_TERMINATE");
 	DestroyWindow(hwnd);
 	break;
     }
@@ -3201,9 +3110,6 @@ FindFDInList(
 {
     TcpFdList *fds;
     for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
-        #ifdef DEBUGGING
-	fprintf(stderr,"socket = %d, fd=%d\n",socket,fds);
-	#endif
 	if (fds->fd == socket) {
 	    return 1;
 	}
@@ -3346,12 +3252,10 @@ TcpThreadActionProc(
 	tsdPtr = TCL_TSD_INIT(&dataKey);
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	DEBUG("Inserting pointer to list");
 	statePtr->nextPtr = tsdPtr->socketList;
 	tsdPtr->socketList = statePtr;
 	
 	if (statePtr == tsdPtr->pendingTcpState) {
-	    DEBUG("Clearing temporary info pointer");
 	    tsdPtr->pendingTcpState = NULL;
 	}
 	
@@ -3370,7 +3274,6 @@ TcpThreadActionProc(
 	 */
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	DEBUG("Removing pointer from list");
 	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
 		nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
 	    if ((*nextPtrPtr) == statePtr) {
-- 
cgit v0.12


From a34d5fc9fb803e7cd3b123445f615018c2e1e23c Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 1 Apr 2014 12:17:36 +0000
Subject: Add test cases for Bug [97069ea11a].

---
 tests/socket.test | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/tests/socket.test b/tests/socket.test
index 0ae5abd..5a6d9cd 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1672,6 +1672,33 @@ test socket-13.1 {Testing use of shared socket between two threads} \
 } -cleanup {
     removeFile script
 } -result {hello 1}
+test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \
+    -constraints {socket} \
+    -body {
+        set sock [socket -async 169.254.0.0 42424]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        fileevent $sock writable {set x 1}
+        vwait x
+        close $sock
+    } -cleanup {
+        catch {close $sock}
+        unset x
+    } -result {host is unreachable} -returnCodes 1
+test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
+    -constraints {socket} \
+    -body {
+        set sock [socket -async 169.254.0.0 42424]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        flush $sock
+        fileevent $sock writable {set x 1}
+        vwait x
+        close $sock
+    } -cleanup {
+        catch {close $sock}
+        catch {unset x}
+    } -result {host is unreachable} -returnCodes 1
 
 removeFile script1
 removeFile script2
-- 
cgit v0.12


From 8d1bb4056046a74a3f04fa04992d2eb9d7346776 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 1 Apr 2014 14:00:04 +0000
Subject: Centralize and clarify the user of 169.254.0.0 as a non-reachable
 address.

---
 tests/socket.test | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 5a6d9cd..9ffe506 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -63,6 +63,12 @@
 package require tcltest 2
 namespace import -force ::tcltest::*
 
+# For some tests we need an IP address that never responds.
+# 169.254.0.0 seems to be a good candidate, because it is from a
+# reserved part of the zeroconf address space. Should it ever cause
+# any problems, a different known-unreachable adress can be set here.
+set unreachableIP 169.254.0.0
+
 # Some tests require the testthread and exec commands
 testConstraint testthread [llength [info commands testthread]]
 testConstraint exec [llength [info commands exec]]
@@ -1675,7 +1681,7 @@ test socket-13.1 {Testing use of shared socket between two threads} \
 test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \
     -constraints {socket} \
     -body {
-        set sock [socket -async 169.254.0.0 42424]
+        set sock [socket -async $unreachableIP 42424]
         fconfigure $sock -blocking 0
         puts $sock ok
         fileevent $sock writable {set x 1}
@@ -1688,7 +1694,7 @@ test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, n
 test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
     -constraints {socket} \
     -body {
-        set sock [socket -async 169.254.0.0 42424]
+        set sock [socket -async $unreachableIP 42424]
         fconfigure $sock -blocking 0
         puts $sock ok
         flush $sock
@@ -1697,7 +1703,7 @@ test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, f
         close $sock
     } -cleanup {
         catch {close $sock}
-        catch {unset x}
+        unset x
     } -result {host is unreachable} -returnCodes 1
 
 removeFile script1
-- 
cgit v0.12


From 8945be288772dd0087122837b2b4432109180088 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 2 Apr 2014 08:22:12 +0000
Subject: Marked all communication variables which are set by notifier thread
 with "volatile".

---
 win/tclWinSock.c | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 1b252e0..036f3b9 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -146,7 +146,7 @@ struct TcpState {
     int watchEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are interesting. */
-    int readyEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
+    volatile int readyEvents;	/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events have occurred.
 				 * Set by notifier thread, access must be
@@ -155,7 +155,8 @@ struct TcpState {
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are currently being
 				 * selected. */
-    int acceptEventCount;	/* Count of the current number of FD_ACCEPTs
+    volatile int acceptEventCount;
+				/* Count of the current number of FD_ACCEPTs
 				 * that have arrived and not yet processed.
 				 * Set by notifier thread, access must be
 				 * protected by semaphore */
@@ -173,7 +174,7 @@ struct TcpState {
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int status;                 /* Cache status of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
-    int connectError;		/* Async connect error set by notifier thread.
+    volatile int connectError;	/* Async connect error set by notifier thread.
 				 * Set by notifier thread, access must be
 				 * protected by semaphore */
     struct TcpState *nextPtr;	/* The next socket on the per-thread socket
-- 
cgit v0.12


From fa9b84b398d88714ceaa6410047ccead8f15b1c3 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 2 Apr 2014 08:35:02 +0000
Subject: Set all variables written by the notifier thread as volatile.

---
 win/tclWinSock.c | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 6633b89..e7b086a 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -98,29 +98,31 @@ static ProcessGlobalValue hostName = {
 /*
  * The following structure is used to store the data associated with each
  * socket.
+ * All members modified by the notifier thread are defined as volatile.
  */
 
 typedef struct SocketInfo {
     Tcl_Channel channel;	/* Channel associated with this socket. */
     SOCKET socket;		/* Windows SOCKET handle. */
-    int flags;			/* Bit field comprised of the flags described
+    volatile int flags;		/* Bit field comprised of the flags described
 				 * below. */
     int watchEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are interesting. */
-    int readyEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
+    volatile int readyEvents;	/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events have occurred. */
     int selectEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are currently being
 				 * selected. */
-    int acceptEventCount;	/* Count of the current number of FD_ACCEPTs
+    volatile int acceptEventCount;
+				/* Count of the current number of FD_ACCEPTs
 				 * that have arrived and not yet processed. */
     Tcl_TcpAcceptProc *acceptProc;
 				/* Proc to call on accept. */
     ClientData acceptProcData;	/* The data for the accept proc. */
-    int lastError;		/* Error code from last message. */
+    volatile int lastError;	/* Error code from last message. */
     struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
 } SocketInfo;
-- 
cgit v0.12


From b5277efde02115a99b120d3a90fb1471c6aee409 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 2 Apr 2014 09:54:27 +0000
Subject: Test to demonstrate bug [336441ed59]. Depends on timing and will not
 always fire but is better than nothing. Reliable for me.

---
 tests/socket.test | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/tests/socket.test b/tests/socket.test
index 0ae5abd..218cce4 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -910,6 +910,22 @@ test socket-8.1 {testing -async flag on sockets} {socket} {
     set z
 } bye
 
+test socket-8.2 {testing writable event when quick failure} {socket win} {
+    # Test for bug 336441ed59 where a quick background fail was ignored
+
+    # Test only for windows as socket -async 255.255.255.255 fails directly
+    # on unix
+    
+    # The following connect should fail very quickly
+    set a1 [after 2000 {set x timeout}]
+    set s [socket -async 255.255.255.255 43434]
+    fileevent $s writable {set x writable}
+    vwait x
+    catch {close $s}
+    after cancel $a1
+    set x
+} writable
+
 test socket-9.1 {testing spurious events} {socket} {
     set len 0
     set spurious 0
-- 
cgit v0.12


From 3789b7493dc4baf577d118984bde1ea11cbe66e5 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 08:29:51 +0000
Subject: Revert the tests for bug#97069ea11a from socket.test, because it is
 hard to test with the socket command in a platform-independent way. As the
 bug is in tclIOChan.c and should be tested there with a dummy channel driver
 that can reliably reproduce the situation that suppresses the error message.

---
 tests/socket.test | 33 ---------------------------------
 1 file changed, 33 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 9ffe506..0ae5abd 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -63,12 +63,6 @@
 package require tcltest 2
 namespace import -force ::tcltest::*
 
-# For some tests we need an IP address that never responds.
-# 169.254.0.0 seems to be a good candidate, because it is from a
-# reserved part of the zeroconf address space. Should it ever cause
-# any problems, a different known-unreachable adress can be set here.
-set unreachableIP 169.254.0.0
-
 # Some tests require the testthread and exec commands
 testConstraint testthread [llength [info commands testthread]]
 testConstraint exec [llength [info commands exec]]
@@ -1678,33 +1672,6 @@ test socket-13.1 {Testing use of shared socket between two threads} \
 } -cleanup {
     removeFile script
 } -result {hello 1}
-test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \
-    -constraints {socket} \
-    -body {
-        set sock [socket -async $unreachableIP 42424]
-        fconfigure $sock -blocking 0
-        puts $sock ok
-        fileevent $sock writable {set x 1}
-        vwait x
-        close $sock
-    } -cleanup {
-        catch {close $sock}
-        unset x
-    } -result {host is unreachable} -returnCodes 1
-test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
-    -constraints {socket} \
-    -body {
-        set sock [socket -async $unreachableIP 42424]
-        fconfigure $sock -blocking 0
-        puts $sock ok
-        flush $sock
-        fileevent $sock writable {set x 1}
-        vwait x
-        close $sock
-    } -cleanup {
-        catch {close $sock}
-        unset x
-    } -result {host is unreachable} -returnCodes 1
 
 removeFile script1
 removeFile script2
-- 
cgit v0.12


From 8978760b1a95d061dff0d9c3f0c8a997aa56998d Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 08:51:58 +0000
Subject: Make the naming of TcpState variables consistent

---
 unix/tclUnixSock.c | 102 ++++++++++++++++++++++++++++-------------------------
 1 file changed, 53 insertions(+), 49 deletions(-)

diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index b26d707..466b231 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -991,21 +991,21 @@ TcpAsyncCallback(
 static int
 CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    TcpState *state)
+    TcpState *statePtr)
 {
     socklen_t optlen;
-    int async_callback = (state->addr != NULL);
-    int ret = -1, error;
-    int async = state->flags & TCP_ASYNC_CONNECT;
+    int async_callback = (statePtr->addr != NULL);
+    int ret = -1, error = 0;
+    int async = statePtr->flags & TCP_ASYNC_CONNECT;
 
     if (async_callback) {
         goto reenter;
     }
 
-    for (state->addr = state->addrlist; state->addr != NULL;
-            state->addr = state->addr->ai_next) {
-        for (state->myaddr = state->myaddrlist; state->myaddr != NULL;
-                state->myaddr = state->myaddr->ai_next) {
+    for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
+            statePtr->addr = statePtr->addr->ai_next) {
+        for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL;
+                statePtr->myaddr = statePtr->myaddr->ai_next) {
             int reuseaddr;
             
 	    /*
@@ -1013,7 +1013,7 @@ CreateClientSocket(
 	     * different families.
 	     */
 
-	    if (state->myaddr->ai_family != state->addr->ai_family) {
+	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
 		continue;
 	    }
 
@@ -1022,14 +1022,14 @@ CreateClientSocket(
              * iteration.
              */
 
-            if (state->fds.fd >= 0) {
-		close(state->fds.fd);
-		state->fds.fd = -1;
+            if (statePtr->fds.fd >= 0) {
+		close(statePtr->fds.fd);
+		statePtr->fds.fd = -1;
                 errno = 0;
 	    }
 
-	    state->fds.fd = socket(state->addr->ai_family, SOCK_STREAM, 0);
-	    if (state->fds.fd < 0) {
+	    statePtr->fds.fd = socket(statePtr->addr->ai_family, SOCK_STREAM, 0);
+	    if (statePtr->fds.fd < 0) {
 		continue;
 	    }
 
@@ -1038,27 +1038,28 @@ CreateClientSocket(
 	     * inherited by child processes.
 	     */
 	    
-	    fcntl(state->fds.fd, F_SETFD, FD_CLOEXEC);
+	    fcntl(statePtr->fds.fd, F_SETFD, FD_CLOEXEC);
 	    
 	    /*
 	     * Set kernel space buffering
 	     */
 	    
-	    TclSockMinimumBuffers(INT2PTR(state->fds.fd), SOCKET_BUFSIZE);
+	    TclSockMinimumBuffers(INT2PTR(statePtr->fds.fd), SOCKET_BUFSIZE);
     
 	    if (async) {
-                ret = TclUnixSetBlockingMode(state->fds.fd,TCL_MODE_NONBLOCKING);
+                ret = TclUnixSetBlockingMode(statePtr->fds.fd,TCL_MODE_NONBLOCKING);
                 if (ret < 0) {
                     continue;
                 }
             }
 
             reuseaddr = 1;
-            (void) setsockopt(state->fds.fd, SOL_SOCKET, SO_REUSEADDR,
+            (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR,
                     (char *) &reuseaddr, sizeof(reuseaddr));
-            ret = bind(state->fds.fd, state->myaddr->ai_addr,
-                    state->myaddr->ai_addrlen);
+            ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr,
+                    statePtr->myaddr->ai_addrlen);
             if (ret < 0) {
+                error = errno;
                 continue;
             }
 
@@ -1069,16 +1070,17 @@ CreateClientSocket(
 	     * in being informed when the connect completes.
 	     */
 	    
-	    ret = connect(state->fds.fd, state->addr->ai_addr,
-                        state->addr->ai_addrlen);
-            error = errno;
+	    ret = connect(statePtr->fds.fd, statePtr->addr->ai_addr,
+                        statePtr->addr->ai_addrlen);
+            if (ret < 0) error = errno;
 	    if (ret < 0 && errno == EINPROGRESS) {
-                Tcl_CreateFileHandler(state->fds.fd,
-                        TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, state);
+                Tcl_CreateFileHandler(statePtr->fds.fd,
+                        TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, statePtr);
+                statePtr->error = errno = EWOULDBLOCK;
                 return TCL_OK;
 
             reenter:
-                Tcl_DeleteFileHandler(state->fds.fd);
+                Tcl_DeleteFileHandler(statePtr->fds.fd);
 
                 /*
                  * Read the error state from the socket to see if the async
@@ -1089,26 +1091,26 @@ CreateClientSocket(
 
                 optlen = sizeof(int);
 
-                getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
+                getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
                         (char *) &error, &optlen);
                 errno = error;
             }
-	    if (ret == 0 || errno == 0) {
+	    if (error == 0) {
 		goto out;
 	    }
 	}
     }
 
 out:
-    state->error = errno;
-    CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT);
+    statePtr->error = error;
+    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
     if (async_callback) {
         /*
          * An asynchonous connection has finally succeeded or failed.
          */
 
-        TcpWatchProc(state, state->filehandlers);
-        TclUnixSetBlockingMode(state->fds.fd, state->cachedBlocking);
+        TcpWatchProc(statePtr, statePtr->filehandlers);
+        TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking);
 
         /*
          * We need to forward the writable event that brought us here, bcasue
@@ -1119,8 +1121,9 @@ out:
          * the event mechanism one roundtrip through select().
          */
 
-        Tcl_NotifyChannel(state->channel, TCL_WRITABLE);
-    } else if (ret != 0) {
+        Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE);
+    }
+    if (error != 0) {
         /*
          * Failure for either a synchronous connection, or an async one that
          * failed before it could enter background mode, e.g. because an
@@ -1128,6 +1131,7 @@ out:
          */
 
         if (interp != NULL) {
+            errno = error;
             Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                     "couldn't open socket: %s", Tcl_PosixError(interp)));
         }
@@ -1164,7 +1168,7 @@ Tcl_OpenTcpClient(
 				 * connect. Otherwise we do a blocking
 				 * connect. */
 {
-    TcpState *state;
+    TcpState *statePtr;
     const char *errorMsg = NULL;
     struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
     char channelName[SOCK_CHAN_LENGTH];
@@ -1189,32 +1193,32 @@ Tcl_OpenTcpClient(
     /*
      * Allocate a new TcpState for this socket.
      */
-    state = ckalloc(sizeof(TcpState));
-    memset(state, 0, sizeof(TcpState));
-    state->flags = async ? TCP_ASYNC_CONNECT : 0;
-    state->cachedBlocking = TCL_MODE_BLOCKING;
-    state->addrlist = addrlist;
-    state->myaddrlist = myaddrlist;
-    state->fds.fd = -1;
+    statePtr = ckalloc(sizeof(TcpState));
+    memset(statePtr, 0, sizeof(TcpState));
+    statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
+    statePtr->cachedBlocking = TCL_MODE_BLOCKING;
+    statePtr->addrlist = addrlist;
+    statePtr->myaddrlist = myaddrlist;
+    statePtr->fds.fd = -1;
 
     /*
      * Create a new client socket and wrap it in a channel.
      */
-    if (CreateClientSocket(interp, state) != TCL_OK) {
-        TcpCloseProc(state, NULL);
+    if (CreateClientSocket(interp, statePtr) != TCL_OK) {
+        TcpCloseProc(statePtr, NULL);
         return NULL;
     }
 
-    sprintf(channelName, SOCK_TEMPLATE, (long) state);
+    sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);
 
-    state->channel = Tcl_CreateChannel(&tcpChannelType, channelName, state,
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr,
             (TCL_READABLE | TCL_WRITABLE));
-    if (Tcl_SetChannelOption(interp, state->channel, "-translation",
+    if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
 	    "auto crlf") == TCL_ERROR) {
-	Tcl_Close(NULL, state->channel);
+	Tcl_Close(NULL, statePtr->channel);
 	return NULL;
     }
-    return state->channel;
+    return statePtr->channel;
 }
 
 /*
-- 
cgit v0.12


From 053685ad2952fe7a83cf63ff28ec273862c903b3 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 10:02:47 +0000
Subject:   *  Rework WaitForConnect() to fix synchronous completion of
 asynchronous connections.   *  Let TcpInputProc() and TcpOutputProc() fail
 before calling any I/O syscalls when an asynchronous connection has failed.  
 *  Adjust the tests accordingly.

---
 tests/socket.test  | 13 ++++++++-----
 unix/tclUnixSock.c | 54 ++++++++++++++++++++++++------------------------------
 2 files changed, 32 insertions(+), 35 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 61660cd..4fba2c3 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1993,7 +1993,7 @@ test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \
         list $x [fconfigure $sock -error]
     } -cleanup {
         close $sock
-    } -match glob -result {{error reading "sock*": socket is not connected} {connection refused}}
+    } -match glob -result {{error reading "sock*": connection refused} {}}
 test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \
     -constraints {socket supported_inet supported_inet6} \
     -setup {
@@ -2055,10 +2055,10 @@ test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener}
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
             after 200
         }
-        fconfigure $sock -error
+        list $x [fconfigure $sock -error]
     } -cleanup {
         close $sock
-    } -match glob -result {connection refused}
+    } -match glob -result {{error reading "sock*": connection refused} {}}
 test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \
     -constraints {socket supported_inet supported_inet6} \
     -setup {
@@ -2171,7 +2171,9 @@ test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, n
         vwait x
         close $sock
     } -cleanup {
-    } -result {broken pipe} -returnCodes 1
+        catch {close $sock}
+        unset x
+    } -result {connection refused} -returnCodes 1
 test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
     -constraints {socket supported_inet supported_inet6} \
     -body {
@@ -2183,8 +2185,9 @@ test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, f
         vwait x
         close $sock
     } -cleanup {
+        catch {close $sock}
         unset x
-    } -result {broken pipe} -returnCodes 1
+    } -result {connection refused} -returnCodes 1
 test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \
     -constraints {socket supported_inet supported_inet6} \
     -body {
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 466b231..d4b7b62 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -128,8 +128,7 @@ static int		TcpInputProc(ClientData instanceData, char *buf,
 static int		TcpOutputProc(ClientData instanceData,
 			    const char *buf, int toWrite, int *errorCode);
 static void		TcpWatchProc(ClientData instanceData, int mask);
-static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr,
-			    int noblock);
+static int		WaitForConnect(TcpState *statePtr, int noblock);
 
 /*
  * This structure describes the channel type structure for TCP socket
@@ -399,41 +398,33 @@ TcpBlockModeProc(
 static int
 WaitForConnect(
     TcpState *statePtr,		/* State of the socket. */
-    int *errorCodePtr,		/* Where to store errors? */
     int noblock)		/* Don't wait, even for sockets in blocking mode */
 {
-    int timeOut;		/* How long to wait. */
-    int state;			/* Of calling TclWaitForFile. */
-
     /*
      * If an asynchronous connect is in progress, attempt to wait for it to
      * complete before reading.
      */
 
     if (statePtr->flags & TCP_ASYNC_CONNECT) {
-	if (noblock || statePtr->flags & TCP_ASYNC_SOCKET) {
-	    timeOut = 0;
+	if (noblock || (statePtr->flags & TCP_ASYNC_SOCKET)) {
+            if (TclUnixWaitForFile(statePtr->fds.fd,
+                                    TCL_WRITABLE | TCL_EXCEPTION, 0) != 0) {
+                CreateClientSocket(NULL, statePtr);
+            }
 	} else {
-	    timeOut = -1;
-	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
-	}
-	errno = 0;
-	state = TclUnixWaitForFile(statePtr->fds.fd,
-		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-        if (state != 0) {
-            CreateClientSocket(NULL, statePtr);
-        }
-        if (statePtr->flags & TCP_ASYNC_CONNECT) {
-            /* We are still in progress, so ignore the result of the last
-             * attempt */
-	    *errorCodePtr = errno = EWOULDBLOCK;
-	    return -1;
+            while (statePtr->flags & TCP_ASYNC_CONNECT) {
+                if (TclUnixWaitForFile(statePtr->fds.fd,
+                                        TCL_WRITABLE | TCL_EXCEPTION, -1) != 0) {
+                    CreateClientSocket(NULL, statePtr);
+                }
+            }
         }
-	if (state & TCL_EXCEPTION) {
-	    return -1;
-	}
     }
-    return 0;
+    if (statePtr->error != 0) {
+        return -1;
+    } else {
+        return 0;
+    }
 }
 
 /*
@@ -471,7 +462,9 @@ TcpInputProc(
     int bytesRead;
 
     *errorCodePtr = 0;
-    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
+    if (WaitForConnect(statePtr, 0) != 0) {
+        *errorCodePtr = statePtr->error;
+        statePtr->error = 0;
 	return -1;
     }
     bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0);
@@ -521,7 +514,9 @@ TcpOutputProc(
     int written;
 
     *errorCodePtr = 0;
-    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
+    if (WaitForConnect(statePtr, 0) != 0) {
+        *errorCodePtr = statePtr->error;
+        statePtr->error = 0;
 	return -1;
     }
     written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0);
@@ -748,9 +743,8 @@ TcpGetOptionProc(
 {
     TcpState *statePtr = instanceData;
     size_t len = 0;
-    int errorCode;
 
-    WaitForConnect(statePtr, &errorCode, 1);
+    WaitForConnect(statePtr, 1);
 
     if (optionName != NULL) {
 	len = strlen(optionName);
-- 
cgit v0.12


From a07a756335137e754bcd490da46a1cc1fd8df06c Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 11:53:33 +0000
Subject: Add tests for bugs [336441ed59] and [581937ab1e] from
 core-8-5-branch.

---
 tests/socket.test | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/tests/socket.test b/tests/socket.test
index 4fba2c3..e2e40f1 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -998,6 +998,35 @@ test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket s
     close $s1
 } -result bye
 
+test socket_$af-8.2 {testing writable event when quick failure} {socket win} {
+    # Test for bug 336441ed59 where a quick background fail was ignored
+
+    # Test only for windows as socket -async 255.255.255.255 fails directly
+    # on unix
+    
+    # The following connect should fail very quickly
+    set a1 [after 2000 {set x timeout}]
+    set s [socket -async 255.255.255.255 43434]
+    fileevent $s writable {set x writable}
+    vwait x
+    catch {close $s}
+    after cancel $a1
+    set x
+} writable
+
+test socket_$af-8.3 {testing fileevent readable on failed async socket connect} {socket} {
+    # Test for bug 581937ab1e
+
+    set a1 [after 5000 {set x timeout}]
+    # This connect should fail
+    set s [socket -async localhost [randport]]
+    fileevent $s readable {set x readable}
+    vwait x
+    catch {close $s}
+    after cancel $a1
+    set x
+} readable
+
 test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
     set len 0
     set spurious 0
-- 
cgit v0.12


From a89a49e51557dc13104128a3692631f2edb5c712 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 15:45:34 +0000
Subject: Fix/improve tests.

---
 tests/socket.test | 67 +++++++++++++++++++++++++------------------------------
 1 file changed, 30 insertions(+), 37 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index e2e40f1..927e544 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -998,34 +998,36 @@ test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket s
     close $s1
 } -result bye
 
-test socket_$af-8.2 {testing writable event when quick failure} {socket win} {
+test socket_$af-8.2 {testing writable event when quick failure} -constraints [list socket win supported_$af] -body {
     # Test for bug 336441ed59 where a quick background fail was ignored
-
-    # Test only for windows as socket -async 255.255.255.255 fails directly
-    # on unix
+    
+    # Test only for windows as socket -async 255.255.255.255 fails
+    # directly on unix
     
     # The following connect should fail very quickly
     set a1 [after 2000 {set x timeout}]
-    set s [socket -async 255.255.255.255 43434]
+    set s [socket -async $localhost 43434]
     fileevent $s writable {set x writable}
     vwait x
+    set x
+} -cleanup {
     catch {close $s}
     after cancel $a1
-    set x
-} writable
+} -result writable
 
-test socket_$af-8.3 {testing fileevent readable on failed async socket connect} {socket} {
+test socket_$af-8.3 {testing fileevent readable on failed async socket connect} -constraints [list socket supported_$af] -body {
     # Test for bug 581937ab1e
-
+    
     set a1 [after 5000 {set x timeout}]
     # This connect should fail
     set s [socket -async localhost [randport]]
     fileevent $s readable {set x readable}
     vwait x
+    set x
+} -cleanup {
     catch {close $s}
     after cancel $a1
-    set x
-} readable
+} -result readable
 
 test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
     set len 0
@@ -1602,8 +1604,8 @@ test socket_$af-12.2 {testing inheritance of client sockets} -setup {
     close $f
     # If the socket doesn't hit end-of-file in 10 seconds, the script1 process
     # must have inherited the client.
-    set failed 0
-    set after [after 10000 [list set failed 1]]
+    set timeout 0
+    set after [after 10000 {set x "client socket was inherited"}]
 } -constraints [list socket supported_$af stdio exec] -body {
     # Create the server socket
     set server [socket -server accept -myaddr $localhost 0]
@@ -1613,26 +1615,20 @@ test socket_$af-12.2 {testing inheritance of client sockets} -setup {
 	close $server
 	fileevent $file readable [list getdata $file]
 	fconfigure $file -buffering line -blocking 0
+        set ::f $file
     }
     proc getdata { file } {
 	# Read handler on the accepted socket.
-	global x failed
+	global x
 	set status [catch {read $file} data]
 	if {$status != 0} {
-	    set x {read failed, error was $data}
-	    catch { close $file }
+	    set x "read failed, error was $data"
 	} elseif {$data ne ""} {
 	} elseif {[fblocked $file]} {
 	} elseif {[eof $file]} {
-	    if {$failed} {
-		set x {client socket was inherited}
-	    } else {
-		set x {client socket was not inherited}
-	    }
-	    catch { close $file }
+            set x "client socket was not inherited"
 	} else {
-	    set x {impossible case}
-	    catch { close $file }
+	    set x "impossible case"
 	}
     }
     # Launch the script2 process
@@ -1642,6 +1638,8 @@ test socket_$af-12.2 {testing inheritance of client sockets} -setup {
     vwait x
     return $x
 } -cleanup {
+    fconfigure $f -blocking 1
+    close $f
     after cancel $after
     close $p
 } -result {client socket was not inherited}
@@ -1683,35 +1681,30 @@ test socket_$af-12.3 {testing inheritance of accepted sockets} -setup {
     # If the socket is still open after 5 seconds, the script1 process must
     # have inherited the accepted socket.
     set failed 0
-    set after [after 5000 [list set failed 1]]
+    set after [after 5000 [list set x "accepted socket was inherited"]]
     proc getdata { file } {
 	# Read handler on the client socket.
 	global x
 	global failed
 	set status [catch {read $file} data]
 	if {$status != 0} {
-	    set x {read failed, error was $data}
-	    catch { close $file }
+	    set x "read failed, error was $data"
 	} elseif {[string compare {} $data]} {
 	} elseif {[fblocked $file]} {
 	} elseif {[eof $file]} {
-	    if {$failed} {
-		set x {accepted socket was inherited}
-	    } else {
-		set x {accepted socket was not inherited}
-	    }
-	    catch { close $file }
+            set x "accepted socket was not inherited"
 	} else {
-	    set x {impossible case}
-	    catch { close $file }
+	    set x "impossible case"
 	}
 	return
     }
     vwait x
-    return $x
+    set x
 } -cleanup {
+    fconfigure $f -blocking 1
+    close $f
     after cancel $after
-    catch {close $p}
+    close $p
 } -result {accepted socket was not inherited}
 
 test socket_$af-13.1 {Testing use of shared socket between two threads} -body {
-- 
cgit v0.12


From f0c184a069af5733133ae8b053918986b4cff221 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 15:56:48 +0000
Subject: Move tests 8.2 and 8.3 out of the IPv4/IPv6 loop to 14.13 and 14.14.

---
 tests/socket.test | 63 ++++++++++++++++++++++++++++---------------------------
 1 file changed, 32 insertions(+), 31 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 927e544..d36d2b3 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -998,37 +998,6 @@ test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket s
     close $s1
 } -result bye
 
-test socket_$af-8.2 {testing writable event when quick failure} -constraints [list socket win supported_$af] -body {
-    # Test for bug 336441ed59 where a quick background fail was ignored
-    
-    # Test only for windows as socket -async 255.255.255.255 fails
-    # directly on unix
-    
-    # The following connect should fail very quickly
-    set a1 [after 2000 {set x timeout}]
-    set s [socket -async $localhost 43434]
-    fileevent $s writable {set x writable}
-    vwait x
-    set x
-} -cleanup {
-    catch {close $s}
-    after cancel $a1
-} -result writable
-
-test socket_$af-8.3 {testing fileevent readable on failed async socket connect} -constraints [list socket supported_$af] -body {
-    # Test for bug 581937ab1e
-    
-    set a1 [after 5000 {set x timeout}]
-    # This connect should fail
-    set s [socket -async localhost [randport]]
-    fileevent $s readable {set x readable}
-    vwait x
-    set x
-} -cleanup {
-    catch {close $s}
-    after cancel $a1
-} -result readable
-
 test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
     set len 0
     set spurious 0
@@ -2225,6 +2194,38 @@ test socket-14.12 {[socket -async] background progress triggered by [fconfigure
         unset x s
     } -result {connection refused}
 
+test socket-14.13 {testing writable event when quick failure} -constraints {socket win supported_inet} -body {
+    # Test for bug 336441ed59 where a quick background fail was ignored
+    
+    # Test only for windows as socket -async 255.255.255.255 fails
+    # directly on unix
+    
+    # The following connect should fail very quickly
+    set a1 [after 2000 {set x timeout}]
+    set s [socket -async 255.255.255.255 43434]
+    fileevent $s writable {set x writable}
+    vwait x
+    set x
+} -cleanup {
+    catch {close $s}
+    after cancel $a1
+} -result writable
+
+test socket-14.14 {testing fileevent readable on failed async socket connect} -constraints [list socket] -body {
+    # Test for bug 581937ab1e
+    
+    set a1 [after 5000 {set x timeout}]
+    # This connect should fail
+    set s [socket -async localhost [randport]]
+    fileevent $s readable {set x readable}
+    vwait x
+    set x
+} -cleanup {
+    catch {close $s}
+    after cancel $a1
+} -result readable
+
+
 ::tcltest::cleanupTests
 flush stdout
 return
-- 
cgit v0.12


From 7e0a9605b9a1e3bc52ff27cdbc7311608f4cce18 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 8 Apr 2014 14:52:04 +0000
Subject: Provide full Tcl patchlevel to tcl.pc and move private libs to
 "Libs.private".

---
 unix/tcl.pc.in | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
index 6b6fe44..b750300 100644
--- a/unix/tcl.pc.in
+++ b/unix/tcl.pc.in
@@ -8,8 +8,7 @@ includedir=@includedir@
 Name: Tool Command Language
 Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
 URL: http://www.tcl.tk/
-Version: @TCL_VERSION@
-Requires:
-Conflicts:
-Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_LIBS@
+Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
+Libs: -L${libdir} @TCL_LIB_FLAG@
+Libs.private: @TCL_LIBS@
 Cflags: -I${includedir}
-- 
cgit v0.12


From da36dfe69e58aec61afac3c396af8cf6107b0ff1 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 10 Apr 2014 07:57:18 +0000
Subject: Fix bug [e663138a06]: Test failures in "string is"

---
 generic/tclExecute.c | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 41730d3..6394a60 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5990,6 +5990,15 @@ TEBCresume(
 	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
 	    type1 = 0;
 	}
+#ifndef TCL_WIDE_INT_IS_LONG
+	else if (type1 == TCL_NUMBER_WIDE) {
+		/** See bug [e663138a06] */
+	    Tcl_WideInt value = (OBJ_AT_TOS)->internalRep.wideValue;
+	    if ((-value <= ULONG_MAX) && (value <= ULONG_MAX)) {
+		type1 = TCL_NUMBER_LONG;
+	    }
+	}
+#endif
 	TclNewIntObj(objResultPtr, type1);
 	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
 	NEXT_INST_F(1, 1, 1);
-- 
cgit v0.12


From c5510a29171fa3a62f7a51af11bea2772bf10e3e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 10 Apr 2014 13:32:14 +0000
Subject: [792641f95b]: Normalized win32 paths should never contain backslash.

---
 win/tclWinFCmd.c |  5 +++++
 win/tclWinFile.c | 15 ++++++---------
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 8999831..441337e 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1156,7 +1156,12 @@ DoRemoveJustDirectory(
 
   end:
     if (errorPtr != NULL) {
+	char *p;
 	Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
+	p = Tcl_DStringValue(errorPtr);
+	for (; *p; ++p) {
+	    if (*p == '\\') *p = '/';
+	}
     }
     return TCL_ERROR;
 
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 676c443..ed0c40f 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -3197,17 +3197,14 @@ TclNativeCreateNativeRep(
     }
 
     str = Tcl_GetStringFromObj(validPathPtr, &len);
-    if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') {
-	char *p;
-
-	for (p = str; p && *p; ++p) {
-	    if (*p == '/') {
-		*p = '\\';
-	    }
-	}
-    }
     Tcl_WinUtfToTChar(str, len, &ds);
     if (tclWinProcs->useWide) {
+	WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds);
+	for (; *wp; ++wp) {
+	    if (*wp=='/') {
+		*wp = '\\';
+	    }
+	}
 	len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
     } else {
 	len = Tcl_DStringLength(&ds) + sizeof(char);
-- 
cgit v0.12


From 09e3a3c56b5d44c637c6ed0593257e51461e8861 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 11 Apr 2014 08:23:44 +0000
Subject: Fix [3118489] for Windows only: NUL in filenames. This allows various
 characters to be used in win32 filenames which are normally invalid, as
 described here:
 [http://cygwin.com/cygwin-ug-net/using-specialnames.html#pathnames-specialchars].
 The Cygwin shell can handle those same filenames as well. In other shells
 (cmd.exe/mSys) or on the Windows desktop the filenames will look strange, but
 that's all.

---
 tests/cmdAH.test | 3 +++
 win/tclWinFile.c | 8 +++++---
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 39e9ece..80706b6 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -141,6 +141,9 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
 } -cleanup {
     cd $dir
 } -result {/}
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -constraints win -returnCodes error -body {
+    cd .\0
+} -result "couldn't change working directory to \".\0\": no such file or directory"
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
     concat
 } {}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 80d0915..c9b95a0 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -2897,7 +2897,7 @@ TclNativeCreateNativeRep(
     char *nativePathPtr, *str;
     Tcl_DString ds;
     Tcl_Obj *validPathPtr;
-    int len;
+    int len, i = 2;
     WCHAR *wp;
 
     if (TclFSCwdIsNative()) {
@@ -2927,8 +2927,10 @@ TclNativeCreateNativeRep(
     Tcl_WinUtfToTChar(str, len, &ds);
     len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
     wp = (WCHAR *) Tcl_DStringValue(&ds);
-    for (; *wp; ++wp) {
-	if (*wp=='/') {
+    for (i=sizeof(WCHAR); i<len; ++wp,i+=sizeof(WCHAR)) {
+	if ( (*wp < ' ') || wcschr(L"\"*<>|", *wp) ){
+	    *wp |= 0xF000;
+	}else if (*wp=='/') {
 	    *wp = '\\';
 	}
     }
-- 
cgit v0.12


From 7fb053c9643440e5075f5e513853c9efff0ae44d Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 11 Apr 2014 09:55:15 +0000
Subject: Fix [3118489]: NUL in filenames, now fixed for both Windows and UNIX.
 For consistancy, any NUL character in a filename prevents the native
 filesystem to generate a native file representation for it. Other filesystems
 than the native one may still accept it, but it's not recommended.

---
 tests/cmdAH.test   | 2 +-
 unix/tclUnixFile.c | 6 ++++++
 win/tclWinFile.c   | 9 +++++++++
 3 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 80706b6..04a86fa 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -141,7 +141,7 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
 } -cleanup {
     cd $dir
 } -result {/}
-test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -constraints win -returnCodes error -body {
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
     cd .\0
 } -result "couldn't change working directory to \".\0\": no such file or directory"
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 5bfe5d9..2cb0027 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -1105,6 +1105,12 @@ TclNativeCreateNativeRep(
     str = Tcl_GetStringFromObj(validPathPtr, &len);
     Tcl_UtfToExternalDString(NULL, str, len, &ds);
     len = Tcl_DStringLength(&ds) + sizeof(char);
+    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
+	/* See bug [3118489]: NUL in filenames */
+	Tcl_DecrRefCount(validPathPtr);
+	Tcl_DStringFree(&ds);
+	return NULL;
+    }
     Tcl_DecrRefCount(validPathPtr);
     nativePathPtr = ckalloc(len);
     memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index c9b95a0..fc0ac9e 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1816,6 +1816,9 @@ TclpObjChdir(
 
     nativePath = Tcl_FSGetNativePath(pathPtr);
 
+    if (!nativePath) {
+	return -1;
+    }
     result = SetCurrentDirectory(nativePath);
 
     if (result == 0) {
@@ -2929,6 +2932,12 @@ TclNativeCreateNativeRep(
     wp = (WCHAR *) Tcl_DStringValue(&ds);
     for (i=sizeof(WCHAR); i<len; ++wp,i+=sizeof(WCHAR)) {
 	if ( (*wp < ' ') || wcschr(L"\"*<>|", *wp) ){
+	    if (!*wp){
+		/* See bug [3118489]: NUL in filenames */
+		Tcl_DecrRefCount(validPathPtr);
+		Tcl_DStringFree(&ds);
+		return NULL;
+	    }
 	    *wp |= 0xF000;
 	}else if (*wp=='/') {
 	    *wp = '\\';
-- 
cgit v0.12


From 7b02be1867d1e46c5a4b5bc9f8925a4a6784c3fd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 14 Apr 2014 18:45:04 +0000
Subject: [e663138a06] Fix the new INST_NUM_TYPE instruction so that the
 boundary cases of [string is] on integral values are computed right.  Code is
 now correct, though still suffers from a large amount of ugly.

---
 generic/tclExecute.c | 28 ++++++++++++++++++++++------
 1 file changed, 22 insertions(+), 6 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6394a60..2c136d7 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5989,16 +5989,32 @@ TEBCresume(
     case INST_NUM_TYPE:
 	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
 	    type1 = 0;
-	}
+	} else if (type1 == TCL_NUMBER_LONG) {
+	    /* value is between LONG_MIN and LONG_MAX */
+	    /* [string is integer] is -UINT_MAX to UINT_MAX range */
+	    int i;
+
+	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
+		type1 = TCL_NUMBER_WIDE;
+	    }
 #ifndef TCL_WIDE_INT_IS_LONG
-	else if (type1 == TCL_NUMBER_WIDE) {
-		/** See bug [e663138a06] */
-	    Tcl_WideInt value = (OBJ_AT_TOS)->internalRep.wideValue;
-	    if ((-value <= ULONG_MAX) && (value <= ULONG_MAX)) {
+	} else if (type1 == TCL_NUMBER_WIDE) {
+	    /* value is between WIDE_MIN and WIDE_MAX */
+	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+	    int i;
+	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
 		type1 = TCL_NUMBER_LONG;
 	    }
-	}
 #endif
+	} else if (type1 == TCL_NUMBER_BIG) {
+	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
+	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+	    Tcl_WideInt w;
+
+	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
+		type1 = TCL_NUMBER_WIDE;
+	    }
+	}
 	TclNewIntObj(objResultPtr, type1);
 	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
 	NEXT_INST_F(1, 1, 1);
-- 
cgit v0.12


From 363b6911107557283c7fec07e041e14c7af7eee3 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 15 Apr 2014 10:41:44 +0000
Subject: Test-cases which pick up the completion of bug-fix
 [e663138a06d98e48b5fbb42cc015cf1698f486cd|e663138a06]. Thanks, Don!

---
 tests/obj.test | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/obj.test b/tests/obj.test
index 71a39b4..151abfb 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -605,7 +605,7 @@ test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
     set x 0xffff; append x ffff
     list [string is integer $x] [expr { wide($x) }]
 } {1 4294967295}
-test obj-33.3 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.3 {integer overflow on input} {
     set x 0x10000; append x 0000
     list [string is integer $x] [expr { wide($x) }]
 } {0 4294967296}
@@ -621,7 +621,7 @@ test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
     set x -0xffff; append x ffff
     list [string is integer $x] [expr { wide($x) }]
 } {1 -4294967295}
-test obj-33.7 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.7 {integer overflow on input} {
     set x -0x10000; append x 0000
     list [string is integer $x] [expr { wide($x) }]
 } {0 -4294967296}
-- 
cgit v0.12


From d25403a5a8b4f784566eb15f30b46ed568efc478 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 15 Apr 2014 16:09:28 +0000
Subject: [88aef05cda] Stop reentrancy segfault in reflected channels by
 managing callbacks as (copies of) lists, not shared Tcl_Obj arrays.  Still
 could use cleanup and improvements.

---
 generic/tclIORChan.c | 22 ++++++++++++++++++++--
 tests/ioCmd.test     | 19 +++++++++++++++++++
 2 files changed, 39 insertions(+), 2 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index affed02..2d712a2 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -110,6 +110,7 @@ typedef struct {
 				 * plus 4 placeholders for method, channel,
 				 * and at most two varying (method specific)
 				 * words. */
+    Tcl_Obj *cmd;		/*  */
     int methods;		/* Bitmask of supported methods */
 
     /*
@@ -2044,6 +2045,10 @@ NewReflectedChannel(
      */
 
     /* ASSERT: cmdpfxObj is a Tcl List */
+    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, Tcl_NewObj());
+    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, handleObj);
+    Tcl_IncrRefCount(rcPtr->cmd);
 
     Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
 
@@ -2158,6 +2163,7 @@ FreeReflectedChannel(
      */
 
     Tcl_DecrRefCount(rcPtr->argv[n+1]);
+    Tcl_DecrRefCount(rcPtr->cmd);
 
     ckfree((char*) rcPtr->argv);
     ckfree((char*) rcPtr);
@@ -2200,6 +2206,8 @@ InvokeTclMethod(
     Tcl_InterpState sr;		/* State of handler interp */
     int result;			/* Result code of method invokation */
     Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
+    Tcl_Obj *cmd;
+    int len;
 
     if (!rcPtr->interp) {
 	/*
@@ -2236,6 +2244,11 @@ InvokeTclMethod(
     Tcl_IncrRefCount(methObj);
     rcPtr->argv[rcPtr->argc - 2] = methObj;
 
+    cmd = TclListObjCopy(NULL, rcPtr->cmd);
+    ListObjLength(cmd, len);
+    Tcl_ListObjReplace(NULL, cmd, len - 2, 1, 1, &methObj);
+
+
     /*
      * Append the additional argument containing method specific details
      * behind the channel id. If specified.
@@ -2244,9 +2257,11 @@ InvokeTclMethod(
     cmdc = rcPtr->argc;
     if (argOneObj) {
 	rcPtr->argv[cmdc] = argOneObj;
+	Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
 	cmdc++;
 	if (argTwoObj) {
 	    rcPtr->argv[cmdc] = argTwoObj;
+	    Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
 	    cmdc++;
 	}
     }
@@ -2256,9 +2271,11 @@ InvokeTclMethod(
      * existing state intact.
      */
 
+    Tcl_IncrRefCount(cmd);
     sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
     Tcl_Preserve(rcPtr->interp);
-    result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+//    result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+    result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
 
     /*
      * We do not try to extract the result information if the caller has no
@@ -2284,7 +2301,7 @@ InvokeTclMethod(
 	     */
 
 	    if (result != TCL_ERROR) {
-		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
+//		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
 		int cmdLen;
 		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
 
@@ -2303,6 +2320,7 @@ InvokeTclMethod(
 	}
 	Tcl_IncrRefCount(resObj);
     }
+    Tcl_DecrRefCount(cmd);
     Tcl_RestoreInterpState(rcPtr->interp, sr);
     Tcl_Release(rcPtr->interp);
 
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index bdf0fb3..f021ade 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -755,6 +755,25 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
     rename foo {}
     set res
 } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+    proc foo {method chan args} {
+	switch -- $method blocking {
+	    chan configure $chan -blocking [lindex $args 0]
+	    return
+	} initialize {
+	    return {initialize finalize watch blocking read write
+		    configure cget cgetall}
+	} finalize {
+	    return
+	}
+    }
+    set ch [chan create {read write} foo]
+} -body {
+    list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+    close $ch
+    rename foo {}
+} -match glob -result {1 {*nested eval*}}
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From 630c5dd08faa0ca5deac0606be3ac1b36b82a6d3 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 15 Apr 2014 17:45:26 +0000
Subject: Purge (now unused) argc and argv fields.

---
 generic/tclIORChan.c | 110 ++-------------------------------------------------
 1 file changed, 3 insertions(+), 107 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 2d712a2..eaabdfb 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -91,26 +91,7 @@ typedef struct {
 #ifdef TCL_THREADS
     Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
 #endif
-
-    /* See [==] as well.
-     * Storage for the command prefix and the additional words required for
-     * the invocation of methods in the command handler.
-     *
-     * argv [0] ... [.] | [argc-2] [argc-1] | [argc]  [argc+2]
-     *      cmd ... pfx | method   chan     | detail1 detail2
-     *      ~~~~ CT ~~~            ~~ CT ~~
-     *
-     * CT = Belongs to the 'Command handler Thread'.
-     */
-
-    int argc;			/* Number of preallocated words - 2 */
-    Tcl_Obj **argv;		/* Preallocated array for calling the handler.
-				 * args[0] is placeholder for cmd word.
-				 * Followed by the arguments in the prefix,
-				 * plus 4 placeholders for method, channel,
-				 * and at most two varying (method specific)
-				 * words. */
-    Tcl_Obj *cmd;		/*  */
+    Tcl_Obj *cmd;		/* Callback command prefix */
     int methods;		/* Bitmask of supported methods */
 
     /*
@@ -2023,8 +2004,6 @@ NewReflectedChannel(
     Tcl_Obj *handleObj)
 {
     ReflectedChannel *rcPtr;
-    int i, listc;
-    Tcl_Obj **listv;
 
     rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
 
@@ -2040,58 +2019,11 @@ NewReflectedChannel(
     rcPtr->mode = mode;
     rcPtr->interest = 0;		/* Initially no interest registered */
 
-    /*
-     * Method placeholder.
-     */
-
     /* ASSERT: cmdpfxObj is a Tcl List */
     rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
     Tcl_ListObjAppendElement(NULL, rcPtr->cmd, Tcl_NewObj());
     Tcl_ListObjAppendElement(NULL, rcPtr->cmd, handleObj);
     Tcl_IncrRefCount(rcPtr->cmd);
-
-    Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
-
-    /*
-     * See [==] as well.
-     * Storage for the command prefix and the additional words required for
-     * the invocation of methods in the command handler.
-     *
-     * listv [0] [listc-1] | [listc]  [listc+1] |
-     * argv  [0]   ... [.] | [argc-2] [argc-1]  | [argc]  [argc+2]
-     *       cmd   ... pfx | method   chan      | detail1 detail2
-     */
-
-    rcPtr->argc = listc + 2;
-    rcPtr->argv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4));
-
-    /*
-     * Duplicate object references.
-     */
-
-    for (i=0; i<listc ; i++) {
-	Tcl_Obj *word = rcPtr->argv[i] = listv[i];
-
-	Tcl_IncrRefCount(word);
-    }
-
-    i++;				/* Skip placeholder for method */
-
-    /*
-     * [Bug 1667990]: See [x] in FreeReflectedChannel for release
-     */
-
-    rcPtr->argv[i] = handleObj;
-    Tcl_IncrRefCount(handleObj);
-
-    /*
-     * The next two objects are kept empty, varying arguments.
-     */
-
-    /*
-     * Initialization complete.
-     */
-
     return rcPtr;
 }
 
@@ -2142,7 +2074,6 @@ FreeReflectedChannel(
     ReflectedChannel *rcPtr)
 {
     Channel *chanPtr = (Channel *) rcPtr->chan;
-    int i, n;
 
     if (chanPtr->typePtr != &tclRChannelType) {
 	/*
@@ -2152,20 +2083,7 @@ FreeReflectedChannel(
 	ckfree((char*) chanPtr->typePtr);
     }
     Tcl_Release(chanPtr);
-
-    n = rcPtr->argc - 2;
-    for (i=0; i<n; i++) {
-	Tcl_DecrRefCount(rcPtr->argv[i]);
-    }
-
-    /*
-     * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1.
-     */
-
-    Tcl_DecrRefCount(rcPtr->argv[n+1]);
     Tcl_DecrRefCount(rcPtr->cmd);
-
-    ckfree((char*) rcPtr->argv);
     ckfree((char*) rcPtr);
 }
 
@@ -2201,7 +2119,6 @@ InvokeTclMethod(
     Tcl_Obj *argTwoObj,		/* NULL'able */
     Tcl_Obj **resultObjPtr)	/* NULL'able */
 {
-    int cmdc;			/* #words in constructed command */
     Tcl_Obj *methObj = NULL;	/* Method name in object form */
     Tcl_InterpState sr;		/* State of handler interp */
     int result;			/* Result code of method invokation */
@@ -2236,33 +2153,24 @@ InvokeTclMethod(
      */
 
     /*
-     * Insert method into the pre-allocated area, after the command prefix,
+     * Insert method into the callback command, after the command prefix,
      * before the channel id.
      */
 
     methObj = Tcl_NewStringObj(method, -1);
-    Tcl_IncrRefCount(methObj);
-    rcPtr->argv[rcPtr->argc - 2] = methObj;
-
     cmd = TclListObjCopy(NULL, rcPtr->cmd);
     ListObjLength(cmd, len);
     Tcl_ListObjReplace(NULL, cmd, len - 2, 1, 1, &methObj);
 
-
     /*
      * Append the additional argument containing method specific details
      * behind the channel id. If specified.
      */
 
-    cmdc = rcPtr->argc;
     if (argOneObj) {
-	rcPtr->argv[cmdc] = argOneObj;
 	Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
-	cmdc++;
 	if (argTwoObj) {
-	    rcPtr->argv[cmdc] = argTwoObj;
 	    Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
-	    cmdc++;
 	}
     }
 
@@ -2274,7 +2182,6 @@ InvokeTclMethod(
     Tcl_IncrRefCount(cmd);
     sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
     Tcl_Preserve(rcPtr->interp);
-//    result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
     result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
 
     /*
@@ -2301,7 +2208,6 @@ InvokeTclMethod(
 	     */
 
 	    if (result != TCL_ERROR) {
-//		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
 		int cmdLen;
 		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
 
@@ -2325,16 +2231,6 @@ InvokeTclMethod(
     Tcl_Release(rcPtr->interp);
 
     /*
-     * Cleanup of the dynamic parts of the command.
-     *
-     * The detail objects survived the Tcl_EvalObjv without change because of
-     * the contract. Therefore there is no need to decrement the refcounts. Only
-     * the internal method object has to be disposed of.
-     */
-
-    Tcl_DecrRefCount(methObj);
-
-    /*
      * The resObj has a ref count of 1 at this location. This means that the
      * caller of InvokeTclMethod has to dispose of it (but only if it was
      * returned to it).
@@ -2857,7 +2753,7 @@ ForwardProc(
 	}
 
 	/*
-	 * Freeing is done here, in the origin thread, because the argv[]
+	 * Freeing is done here, in the origin thread, callback command
 	 * objects belong to this thread. Deallocating them in a different
 	 * thread is not allowed
 	 *
-- 
cgit v0.12


From 551367d26fffabaf2176de988521a98184f49ad0 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 16 Apr 2014 09:28:54 +0000
Subject: Upgrade from Winsock 1.1 to Winsock 2.2, which is always available on
 Win2000+. See:
 [http://msdn.microsoft.com/en-us/library/windows/desktop/ms742213%28v=vs.85%29.aspx]
 for details. Move winsock initialization to TclpInitPlatform(void), so we can
 be sure everywhere that we have an initialized winsock2. Stub entries for
 TclWinGetServByName/TclWinGetSockOpt/TclWinSetSockOpt are no longer necessary
 (will be removed in 9.0, but are kept in 8.x)

---
 generic/tclIntPlatDecls.h |  6 ++++
 win/tclWinInit.c          | 24 ++++++---------
 win/tclWinPort.h          |  9 ------
 win/tclWinSock.c          | 78 ++---------------------------------------------
 4 files changed, 19 insertions(+), 98 deletions(-)

diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 80dd2ad..f935efb 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -849,7 +849,13 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 
 #if defined(__WIN32__) || defined(__CYGWIN__)
 #   undef TclWinNToHS
+#   undef TclWinGetServByName
+#   undef TclWinGetSockOpt
+#   undef TclWinSetSockOpt
 #   define TclWinNToHS ntohs
+#   define TclWinGetServByName getservbyname
+#   define TclWinGetSockOpt getsockopt
+#   define TclWinSetSockOpt setsockopt
 #else
 #   undef TclpGetPid
 #   define TclpGetPid(pid) ((unsigned long) (pid))
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 2f3c7e8..4e860b2 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -113,8 +113,8 @@ static int		ToUtf(CONST WCHAR *wSrc, char *dst);
  *
  * TclpInitPlatform --
  *
- *	Initialize all the platform-dependant things like signals and
- *	floating-point error handling.
+ *	Initialize all the platform-dependant things like signals,
+ *	floating-point error handling and sockets.
  *
  *	Called at process initialization time.
  *
@@ -130,20 +130,16 @@ static int		ToUtf(CONST WCHAR *wSrc, char *dst);
 void
 TclpInitPlatform(void)
 {
-    tclPlatform = TCL_PLATFORM_WINDOWS;
+    WSADATA wsaData;
+    WORD wVersionRequested = MAKEWORD(2, 2);
 
-    /*
-     * The following code stops Windows 3.X and Windows NT 3.51 from
-     * automatically putting up Sharing Violation dialogs, e.g, when someone
-     * tries to access a file that is locked or a drive with no disk in it.
-     * Tcl already returns the appropriate error to the caller, and they can
-     * decide to put up their own dialog in response to that failure.
-     *
-     * Under 95 and NT 4.0, this is a NOOP because the system doesn't
-     * automatically put up dialogs when the above operations fail.
-     */
+    tclPlatform = TCL_PLATFORM_WINDOWS;
 
-    SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+	/*
+	 * Initialize the winsock library. On Windows XP and higher this
+	 * can never fail.
+	 */
+	WSAStartup(wVersionRequested, &wsaData);
 
 #ifdef STATIC_BUILD
     /*
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index ec9e867..ea6d8f8 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -448,15 +448,6 @@ typedef DWORD_PTR * PDWORD_PTR;
 #define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
 					    (DWORD)0, (LPVOID)ptr, (DWORD)size))
 
-/*
- * The following defines map from standard socket names to our internal
- * wrappers that redirect through the winSock function table (see the
- * file tclWinSock.c).
- */
-
-#define getservbyname	TclWinGetServByName
-#define getsockopt	TclWinGetSockOpt
-#define setsockopt	TclWinSetSockOpt
 /* This type is not defined in the Windows headers */
 #define socklen_t       int
 
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index aa298f5..e18a3dd 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -263,8 +263,6 @@ static void
 InitSockets(void)
 {
     DWORD id;
-    WSADATA wsaData;
-    DWORD err;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 	    TclThreadDataKeyGet(&dataKey);
 
@@ -295,38 +293,6 @@ InitSockets(void)
 	    goto initFailure;
 	}
 
-	/*
-	 * Initialize the winsock library and check the interface version
-	 * actually loaded. We only ask for the 1.1 interface and do require
-	 * that it not be less than 1.1.
-	 */
-
-#define WSA_VERSION_MAJOR 1
-#define WSA_VERSION_MINOR 1
-#define WSA_VERSION_REQD  MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
-
-	err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData);
-	if (err != 0) {
-	    TclWinConvertWSAError(err);
-	    goto initFailure;
-	}
-
-	/*
-	 * Note the byte positions are swapped for the comparison, so that
-	 * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1).
-	 * We want the comparison to be 0x0200 < 0x0101.
-	 */
-
-	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
-		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
-	    TclWinConvertWSAError(WSAVERNOTSUPPORTED);
-	    WSACleanup();
-	    goto initFailure;
-	}
-
-#undef WSA_VERSION_REQD
-#undef WSA_VERSION_MAJOR
-#undef WSA_VERSION_MINOR
     }
 
     /*
@@ -434,7 +400,6 @@ SocketExitHandler(
 
     TclpFinalizeSockets();
     UnregisterClass("TclSocket", TclWinGetTclInstance());
-    WSACleanup();
     initialized = 0;
     Tcl_MutexUnlock(&socketMutex);
 }
@@ -2564,71 +2529,34 @@ InitializeHostName(
  *----------------------------------------------------------------------
  */
 
+#undef TclWinGetSockOpt
 int
 TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval,
 	int *optlen)
 {
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
-
-    if (!SocketsEnabled()) {
-	return SOCKET_ERROR;
-    }
-
     return getsockopt(s, level, optname, optval, optlen);
 }
 
+#undef TclWinSetSockOpt
 int
 TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval,
     int optlen)
 {
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
-
-    if (!SocketsEnabled()) {
-	return SOCKET_ERROR;
-    }
-
     return setsockopt(s, level, optname, optval, optlen);
 }
 
 char *
 TclpInetNtoa(struct in_addr addr)
 {
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
-
-    if (!SocketsEnabled()) {
-        return NULL;
-    }
-
     return inet_ntoa(addr);
 }
 
+#undef TclWinGetServByName
 struct servent *
 TclWinGetServByName(
     const char *name,
     const char *proto)
 {
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
-
-    if (!SocketsEnabled()) {
-	return NULL;
-    }
-
     return getservbyname(name, proto);
 }
 
-- 
cgit v0.12


From ba983af978b8a50b61dd8dbebf32bdeed71a9837 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 16 Apr 2014 11:20:54 +0000
Subject: Remove unused variable, don't use deprecated function, some
 formatting.

---
 generic/tclIORChan.c |  2 +-
 win/tclWinInit.c     | 10 +++++-----
 win/tclWinSock.c     |  4 ++--
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 16dc1ed..29819b6 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -2324,7 +2324,7 @@ InvokeTclMethod(
     Tcl_IncrRefCount(cmd);
     sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
     Tcl_Preserve(rcPtr->interp);
-    result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
+    result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL);
 
     /*
      * We do not try to extract the result information if the caller has no
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index d90d57a..8b600f6 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -135,11 +135,11 @@ TclpInitPlatform(void)
 
     tclPlatform = TCL_PLATFORM_WINDOWS;
 
-	/*
-	 * Initialize the winsock library. On Windows XP and higher this
-	 * can never fail.
-	 */
-	WSAStartup(wVersionRequested, &wsaData);
+    /*
+     * Initialize the winsock library. On Windows XP and higher this
+     * can never fail.
+     */
+    WSAStartup(wVersionRequested, &wsaData);
 
 #ifdef STATIC_BUILD
     /*
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 8881cf2..3990111 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -280,7 +280,7 @@ static const Tcl_ChannelType tcpChannelType = {
 static void
 InitSockets(void)
 {
-    DWORD id, err;
+    DWORD id;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
     if (!initialized) {
@@ -2414,7 +2414,7 @@ SocketThread(
  *
  * Side effects:
  *	The flags for the given socket are updated to reflect the event that
- *	occured.
+ *	occurred.
  *
  *----------------------------------------------------------------------
  */
-- 
cgit v0.12


From 219058913602b9ddb2ddfbe5a9cac941272d7207 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Wed, 16 Apr 2014 13:18:56 +0000
Subject: Segmentation fault using some functions of tcl::clock, fixed, belong
 to ticket [d19a30db57]

---
 generic/tclClock.c | 39 +++++++++++++++++++++------------------
 1 file changed, 21 insertions(+), 18 deletions(-)

diff --git a/generic/tclClock.c b/generic/tclClock.c
index 5b95ae6..3ec94fb 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -548,19 +548,22 @@ ClockGetjuliandayfromerayearmonthdayObjCmd (
     }
     dict = objv[1];
     if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
 		&era) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
-		&fieldPtr) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || TclGetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
-		&fieldPtr) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],	&fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || TclGetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
-		&fieldPtr) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || TclGetIntFromObj(interp, fieldPtr,
 		&(fields.dayOfMonth)) != TCL_OK
 	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+    if (fieldPtr == NULL)
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
 	return TCL_ERROR;
     }
     fields.era = era;
@@ -639,21 +642,21 @@ ClockGetjuliandayfromerayearweekdayObjCmd (
     }
     dict = objv[1];
     if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
 		&era) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
-		&fieldPtr) != TCL_OK
-	    || TclGetIntFromObj(interp, fieldPtr,
-		&(fields.iso8601Year)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK],
-		&fieldPtr) != TCL_OK
-	    || TclGetIntFromObj(interp, fieldPtr,
-		&(fields.iso8601Week)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK],
-		&fieldPtr) != TCL_OK
-	    || TclGetIntFromObj(interp, fieldPtr,
-		&(fields.dayOfWeek)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
+	    || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
+	    || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
+	    || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
 	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+    if (fieldPtr == NULL)
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
 	return TCL_ERROR;
     }
     fields.era = era;
-- 
cgit v0.12


From 79c0ebdad2faa35f18303ba802eba9897e04e144 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 16 Apr 2014 14:04:02 +0000
Subject: Fix compiler warnings in win32/cygwin build.

---
 generic/tclIntPlatDecls.h |  2 +-
 generic/tclStubInit.c     | 18 +++++++++++++-----
 2 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index f935efb..fc20d09 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -847,7 +847,7 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 #undef TclpLocaltime_unix
 #undef TclpGmtime_unix
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(__WIN32__)
 #   undef TclWinNToHS
 #   undef TclWinGetServByName
 #   undef TclWinGetSockOpt
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 99f3e4b..6499bc2 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -33,6 +33,9 @@
 #undef Tcl_CreateHashEntry
 #undef TclpGetPid
 #undef TclSockMinimumBuffers
+#undef TclWinGetServByName
+#undef TclWinGetSockOpt
+#undef TclWinSetSockOpt
 #define TclUnusedStubEntry NULL
 
 /*
@@ -104,7 +107,8 @@ TclpIsAtty(int fd)
     return isatty(fd);
 }
 
-int
+#define TclWinGetPlatformId winGetPlatformId
+static int
 TclWinGetPlatformId()
 {
     /* Don't bother to determine the real platform on cygwin,
@@ -120,27 +124,31 @@ void *TclWinGetTclInstance()
     return hInstance;
 }
 
-int
+#define TclWinSetSockOpt winSetSockOpt
+static int
 TclWinSetSockOpt(SOCKET s, int level, int optname,
 	    const char *optval, int optlen)
 {
     return setsockopt((int) s, level, optname, optval, optlen);
 }
 
-int
+#define TclWinGetSockOpt winGetSockOpt
+static int
 TclWinGetSockOpt(SOCKET s, int level, int optname,
 	    char *optval, int *optlen)
 {
     return getsockopt((int) s, level, optname, optval, optlen);
 }
 
-struct servent *
+#define TclWinGetServByName winGetServByName
+static struct servent *
 TclWinGetServByName(const char *name, const char *proto)
 {
     return getservbyname(name, proto);
 }
 
-char *
+#define TclWinNoBackslash winNoBackslash
+static char *
 TclWinNoBackslash(char *path)
 {
     char *p;
-- 
cgit v0.12


From 605c8e8366d2242fdbc73a8322ec2e5e6fce73cf Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 16 Apr 2014 15:17:14 +0000
Subject: Test for [d19a30db57].

---
 tests/clock.test | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/tests/clock.test b/tests/clock.test
index fea1fc9..aef699e 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36927,6 +36927,11 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
     clock format [clock seconds] -format %%r
 } %r
 
+test clock-67.2 {Bug d19a30db57} -body {
+    # error, not segfault
+    tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+
 # cleanup
 
 namespace delete ::testClock
-- 
cgit v0.12


From 672a809211f32f12d7127dae83940756c7fb567d Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Wed, 16 Apr 2014 15:30:37 +0000
Subject: Test for [d19a30db57] extended

---
 tests/clock.test | 1 +
 1 file changed, 1 insertion(+)

diff --git a/tests/clock.test b/tests/clock.test
index aef699e..56763bd 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36930,6 +36930,7 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
 test clock-67.2 {Bug d19a30db57} -body {
     # error, not segfault
     tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+    tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
 } -returnCodes error -match glob -result *
 
 # cleanup
-- 
cgit v0.12


From ca6f13bb3001d560ccd18ff40400afca249ebe28 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 16 Apr 2014 15:37:26 +0000
Subject: Repair new test so all parts will be effective.

---
 tests/clock.test | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/tests/clock.test b/tests/clock.test
index 56763bd..7d62a60 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36930,6 +36930,9 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
 test clock-67.2 {Bug d19a30db57} -body {
     # error, not segfault
     tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+test clock-67.3 {Bug d19a30db57} -body {
+    # error, not segfault
     tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
 } -returnCodes error -match glob -result *
 
-- 
cgit v0.12


From a99f768a32b42d04735d090f7d6fd8a0f75bc8ec Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 17 Apr 2014 14:01:14 +0000
Subject: Remove all win95-specific test-cases, since Windows 95 is not
 supported any more.

---
 tests/fCmd.test    |  6 ----
 tests/http.test    | 12 +++----
 tests/winFCmd.test | 96 ++----------------------------------------------------
 tests/winFile.test | 18 ----------
 tests/winPipe.test |  8 -----
 5 files changed, 6 insertions(+), 134 deletions(-)

diff --git a/tests/fCmd.test b/tests/fCmd.test
index 8f27ad4..3d22b09 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -511,12 +511,6 @@ test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
 } -returnCodes error -cleanup {
     testchmod 755 td1
 } -result {error renaming "tf1" to "td1/tf1": permission denied}
-test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup {
-    cleanup
-} -constraints {win 95} -returnCodes error -body {
-    createfile tf1
-    file rename tf1 $long
-} -result [subst {error renaming "tf1" to "$long": file name too long}]
 test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
     cleanup
 } -constraints {unix notRoot} -body {
diff --git a/tests/http.test b/tests/http.test
index a52cfb1..a0a26de 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -492,14 +492,10 @@ proc myProgress {token total current} {
     }
     set progress [list $total $current]
 }
-if 0 {
-    # This test hangs on Windows95 because the client never gets EOF
-    set httpLog 1
-    test http-4.6.1 {http::Event} knownBug {
-	set token [http::geturl $url -blocksize 50 -progress myProgress]
-	return $progress
-    } {111 111}
-}
+test http-4.6.1 {http::Event} knownBug {
+    set token [http::geturl $url -blocksize 50 -progress myProgress]
+    return $progress
+} {111 111}
 test http-4.7 {http::Event} -body {
     set token [http::geturl $url -keepalive 0 -progress myProgress]
     return $progress
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 28a0e9f..bd50328 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -208,22 +208,11 @@ test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
 } -constraints {win win2000orXP testfile} -body {
     testfile mv nul tf1
 } -returnCodes error -result EINVAL
-test winFCmd-1.13.1 {TclpRenameFile: errno: EACCES} -setup {
+test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
     cleanup
 } -constraints {win nt winOlderThan2000 testfile} -body {
     testfile mv nul tf1
 } -returnCodes error -result EACCES
-test winFCmd-1.13.2 {TclpRenameFile: errno: ENOENT} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    testfile mv nul tf1
-} -returnCodes error -result ENOENT
-test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    createfile tf1
-    testfile mv tf1 nul
-} -returnCodes error -result EACCES
 test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
     cleanup
 } -constraints {win nt testfile} -body {
@@ -257,11 +246,6 @@ test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup {
 } -constraints {win nt winOlderThan2000 testfile} -body {
     testfile mv nul tf1
 } -returnCodes error -result EACCES
-test winFCmd-1.19.2 {TclpRenameFile: errno == ENOENT} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    testfile mv nul tf1
-} -returnCodes error -result ENOENT
 test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
     cleanup
 } -constraints {win nt testfile} -body {
@@ -474,29 +458,14 @@ test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} -setup {
 } -returnCodes error -result ENOENT
 test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
     cleanup
-} -constraints {win 95 testfile} -body {
-    createfile tf1
-    set fd [open tf2 w]
-    testfile cp tf1 tf2
-} -cleanup {
-    close $fd
-    cleanup
-} -returnCodes error -result EACCES
-test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
-    cleanup
 } -constraints {win win2000orXP testfile} -body {
     testfile cp nul tf1
 } -returnCodes error -result EINVAL
-test winFCmd-2.8.1 {TclpCopyFile: errno: EACCES} -setup {
+test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
     cleanup
 } -constraints {win nt winOlderThan2000 testfile} -body {
     testfile cp nul tf1
 } -returnCodes error -result EACCES
-test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    testfile cp nul tf1
-} -returnCodes error -result ENOENT
 test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
     cleanup
 } -constraints {win testfile} -body {
@@ -573,17 +542,6 @@ test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup {
     catch {testchmod 666 tf2}
     cleanup
 } -result {1 tf1}
-test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} -setup {
-    cleanup
-} -constraints {win 95 testfile testchmod} -body {
-    createfile tf1
-    createfile tf2
-    testchmod 000 tf2
-    set fd [open tf2]
-    set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
-    close $fd
-    lappend msg [file writable tf2]
-} -result {1 EACCES 0}
 
 test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body {
     testfile rm $cdfile $cdrom/dummy~~.fil
@@ -666,9 +624,6 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup {
 test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
     testfile mkdir $cdrom/dummy~~.dir
 } -constraints {win nt cdrom testfile} -returnCodes error -result EACCES
-test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} -body {
-    testfile mkdir $cdrom/dummy~~.dir
-} -constraints {win 95 cdrom testfile} -returnCodes error -result ENOSPC
 test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
     cleanup
 } -constraints {win testfile} -body {
@@ -764,11 +719,6 @@ test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
     catch {testchmod 666 td1}
     cleanup
 } -result {td1 EACCES}
-test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    testfile rmdir nul
-} -returnCodes error -result {nul EACCES}
 test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
     cleanup
 } -constraints {win nt testfile} -body {
@@ -776,16 +726,6 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
     # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
     # decision has been made as to which is correct.
 } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
-# This next test has a very hokey way of matching...
-test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    createfile tf1
-    set res [catch {testfile rmdir tf1} msg]
-    # get rid of path
-    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
-    list $res $msg
-} -result {1 {tf1 ENOTDIR}}
 test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
     cleanup
 } -constraints {winVista testfile testchmod} -body {
@@ -798,16 +738,6 @@ test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
     cleanup
 } -returnCodes error -result {td1 EACCES}
 # This next test has a very hokey way of matching...
-test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    file mkdir td1/td2
-    set res [catch {testfile rmdir td1} msg]
-    # get rid of path
-    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
-    list $res $msg
-} -result {1 {td1 EEXIST}}
-# This next test has a very hokey way of matching...
 test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
     cleanup
 } -constraints {win testfile} -body {
@@ -887,11 +817,6 @@ test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} -setup {
 } -cleanup {
     cleanup
 } -result {tf1}
-test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} -body {
-    # cdrom can return either d:\ or D:/, but we only care about the errcode
-    testfile rmdir $cdrom/
-} -constraints {win 95 cdrom testfile} -returnCodes error -match glob \
-    -result {* EACCES} ; # was EEXIST, but changed for win98.
 test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
     testfile rmdir $cdrom/
 } -constraints {win nt cdrom testfile} -returnCodes error -match glob \
@@ -930,14 +855,6 @@ test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} -setup {
 } -cleanup {
     cleanup
 } -result {tf1}
-test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    file mkdir td1
-    testfile cpdir td1 /
-} -cleanup {
-    cleanup
-} -returnCodes error -result {/ EEXIST}
 test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
     cleanup
 } -constraints {win nt testfile} -body {
@@ -1038,15 +955,6 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
     createfile td1/tf1
     testfile rmdir -force td1
 } -result {}
-test winFCmd-9.2 {TraversalDelete: DOTREE_F} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    file mkdir td1
-    set fd [open td1/tf1 w]
-    testfile rmdir -force td1
-} -cleanup {
-    close $fd
-} -returnCodes error -result {td1\tf1 EACCES}
 test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
     cleanup
 } -constraints {winVista testfile testchmod} -body {
diff --git a/tests/winFile.test b/tests/winFile.test
index fba9bcb..2c47f5f 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -37,24 +37,6 @@ test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
     # The administrator account should always exist.
     glob ~administrator
 } -match glob -result *
-test winFile-1.3 {TclpGetUserHome} -constraints {win 95} -body {
-    # Find some user in system.ini and then see if they have a home.
-
-    set f [open $::env(windir)/system.ini]
-    while {[gets $f line] >= 0} {
-	if {$line ne {[Password Lists]}} {
-	    continue
-	}
-	gets $f
-	set name [lindex [split [gets $f] =] 0]
-	if {$name ne ""} {
-	    return [catch {glob ~$name}]
-	}
-    }
-    return 0 ;# didn't find anything...
-} -cleanup {
-    catch {close $f}
-} -result {0}
 test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
     catch {glob ~stanton@workgroup}
 } {0}
diff --git a/tests/winPipe.test b/tests/winPipe.test
index d2e804d..9c6f94d 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -82,10 +82,6 @@ test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat3
     exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
     list [contents $path(stdout)] [contents $path(stderr)]
 } "{$big} stderr32"
-test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {win 95 exec cat32} {
-    exec command /c type $path(big) |& $cat32 > $path(stdout) 2> $path(stderr)
-    list [contents $path(stdout)] [contents $path(stderr)]
-} "{$big} stderr32"
 test winpipe-1.6 {32 bit comprehensive tests: from console} \
 	{win cat32 AllocConsole} {
     # would block waiting for human input
@@ -174,10 +170,6 @@ test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
     catch {close $f}
     set r
 } "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
-test winpipe-1.22 {Checking command.com for Win95/98 hanging} {win 95 exec} {
-    exec command.com /c dir /b
-    set result 1
-} 1
 
 test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
     proc readResults {f} {
-- 
cgit v0.12


From ffc78c758ef00181a0c05fb7086a07e4a4673cbc Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 17 Apr 2014 16:05:06 +0000
Subject: Simplify reflected channels. Instead of having two modes of Close
 operations and the need to choose between them with a special value of the
 methods field, when the initialize pass fails for some reason, simply do not
 create the channel so there's nothing that needs closing.  Then the methods
 field no longer holds anything used, so eliminate it.  All the methods
 checking is done by [chan create].

---
 generic/tclIORChan.c | 62 ++++++----------------------------------------------
 1 file changed, 7 insertions(+), 55 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index eaabdfb..a4d1ec5 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -92,7 +92,6 @@ typedef struct {
     Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
 #endif
     Tcl_Obj *cmd;		/* Callback command prefix */
-    int methods;		/* Bitmask of supported methods */
 
     /*
      * NOTE (9): Should we have predefined shared literals for the method
@@ -436,9 +435,7 @@ static int              ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj);
  * list-quoting to keep the words of the message together. See also [x].
  */
 
-static const char *msg_read_unsup = "{read not supported by Tcl driver}";
 static const char *msg_read_toomuch = "{read delivered more than requested}";
-static const char *msg_write_unsup = "{write not supported by Tcl driver}";
 static const char *msg_write_toomuch = "{write wrote more than requested}";
 static const char *msg_write_nothing = "{write wrote nothing}";
 static const char *msg_seek_beforestart = "{Tried to seek before origin}";
@@ -550,11 +547,6 @@ TclChanCreateObjCmd(
 
     rcId = NextHandle();
     rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
-    chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
-	    mode);
-    rcPtr->chan = chan;
-    Tcl_Preserve(chan);
-    chanPtr = (Channel *) chan;
 
     /*
      * Invoke 'initialize' and validate that the handler is present and ok.
@@ -657,7 +649,11 @@ TclChanCreateObjCmd(
      * Everything is fine now.
      */
 
-    rcPtr->methods = methods;
+    chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+	    mode);
+    rcPtr->chan = chan;
+    Tcl_Preserve(chan);
+    chanPtr = (Channel *) chan;
 
     if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
 	/*
@@ -720,12 +716,8 @@ TclChanCreateObjCmd(
     return TCL_OK;
 
  error:
-    /*
-     * Signal to ReflectClose to not call 'finalize'.
-     */
-
-    rcPtr->methods = 0;
-    Tcl_Close(interp, chan);
+    Tcl_DecrRefCount(rcPtr->cmd);
+    ckfree((char*) rcPtr);
     return TCL_ERROR;
 
 #undef MODE
@@ -1069,18 +1061,6 @@ ReflectClose(
     }
 
     /*
-     * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL)
-     *
-     * A cleaned method mask here implies that the channel creation was
-     * aborted, and "finalize" must not be called.
-     */
-
-    if (rcPtr->methods == 0) {
-        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-	return EOK;
-    }
-
-    /*
      * Are we in the correct thread?
      */
 
@@ -1176,18 +1156,6 @@ ReflectInput(
     Tcl_Obj *resObj;		/* Result data for 'read' */
 
     /*
-     * The following check can be done before thread redirection, because we
-     * are reading from an item which is readonly, i.e. will never change
-     * during the lifetime of the channel.
-     */
-
-    if (!(rcPtr->methods & FLAG(METH_READ))) {
-	SetChannelErrorStr(rcPtr->chan, msg_read_unsup);
-	*errorCodePtr = EINVAL;
-	return -1;
-    }
-
-    /*
      * Are we in the correct thread?
      */
 
@@ -1291,18 +1259,6 @@ ReflectOutput(
     int written;
 
     /*
-     * The following check can be done before thread redirection, because we
-     * are reading from an item which is readonly, i.e. will never change
-     * during the lifetime of the channel.
-     */
-
-    if (!(rcPtr->methods & FLAG(METH_WRITE))) {
-	SetChannelErrorStr(rcPtr->chan, msg_write_unsup);
-	*errorCodePtr = EINVAL;
-	return -1;
-    }
-
-    /*
      * Are we in the correct thread?
      */
 
@@ -1524,8 +1480,6 @@ ReflectWatch(
     ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
     Tcl_Obj *maskObj;
 
-    /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */
-
     /*
      * We restrict the interest to what the channel can support. IOW there
      * will never be write events for a channel which is not writable.
@@ -2008,10 +1962,8 @@ NewReflectedChannel(
     rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
 
     /* rcPtr->chan: Assigned by caller. Dummy data here. */
-    /* rcPtr->methods: Assigned by caller. Dummy data here. */
 
     rcPtr->chan = NULL;
-    rcPtr->methods = 0;
     rcPtr->interp = interp;
 #ifdef TCL_THREADS
     rcPtr->thread = Tcl_GetCurrentThread();
-- 
cgit v0.12


From 9814e7b3519b71ebace82cd8ca37748fc92b8185 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 17 Apr 2014 17:55:59 +0000
Subject: Reflected channels.  Keep a set of method names cached so we don't
 create new each operation, and we can benefit from any lookup info cached in
 intreps.

---
 generic/tclIORChan.c | 83 +++++++++++++++++++++++++++-------------------------
 1 file changed, 43 insertions(+), 40 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index a4d1ec5..17c1593 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -92,11 +92,8 @@ typedef struct {
     Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
 #endif
     Tcl_Obj *cmd;		/* Callback command prefix */
-
-    /*
-     * NOTE (9): Should we have predefined shared literals for the method
-     * names?
-     */
+    Tcl_Obj *methods;		/* Methods to append to command prefix */
+    Tcl_Obj *name;		/* Name of the channel as created */
 
     int mode;			/* Mask of R/W mode */
     int interest;		/* Mask of events the channel is interested
@@ -420,7 +417,7 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
 static Tcl_Obj *	NextHandle(void);
 static void		FreeReflectedChannel(ReflectedChannel *rcPtr);
 static int		InvokeTclMethod(ReflectedChannel *rcPtr,
-			    const char *method, Tcl_Obj *argOneObj,
+			    MethodName method, Tcl_Obj *argOneObj,
 			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
 
 static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
@@ -560,7 +557,7 @@ TclChanCreateObjCmd(
 
     modeObj = DecodeEventMask(mode);
     /* assert modeObj.refCount == 1 */
-    result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj);
+    result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
     Tcl_DecrRefCount(modeObj);
     if (result != TCL_OK) {
 	UnmarshallErrorResult(interp, resObj);
@@ -716,6 +713,8 @@ TclChanCreateObjCmd(
     return TCL_OK;
 
  error:
+    Tcl_DecrRefCount(rcPtr->name);
+    Tcl_DecrRefCount(rcPtr->methods);
     Tcl_DecrRefCount(rcPtr->cmd);
     ckfree((char*) rcPtr);
     return TCL_ERROR;
@@ -1081,7 +1080,7 @@ ReflectClose(
 	}
     } else {
 #endif
-	result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj);
+	result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
 	if ((result != TCL_OK) && (interp != NULL)) {
 	    Tcl_SetChannelErrorInterp(interp, resObj);
 	}
@@ -1193,7 +1192,7 @@ ReflectInput(
     toReadObj = Tcl_NewIntObj(toRead);
     Tcl_IncrRefCount(toReadObj);
 
-    if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
+    if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
 	int code = ErrnoReturn (rcPtr, resObj);
 
 	if (code < 0) {
@@ -1296,7 +1295,7 @@ ReflectOutput(
     bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
     Tcl_IncrRefCount(bufObj);
 
-    if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+    if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
 	int code = ErrnoReturn(rcPtr, resObj);
 
 	if (code < 0) {
@@ -1409,7 +1408,7 @@ ReflectSeekWide(
     Tcl_IncrRefCount(offObj);
     Tcl_IncrRefCount(baseObj);
 
-    if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) {
+    if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
 	Tcl_SetChannelError(rcPtr->chan, resObj);
         goto invalid;
     }
@@ -1522,7 +1521,7 @@ ReflectWatch(
 
     maskObj = DecodeEventMask(mask);
     /* assert maskObj.refCount == 1 */
-    (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+    (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
     Tcl_DecrRefCount(maskObj);
 
     Tcl_Release(rcPtr);
@@ -1581,7 +1580,7 @@ ReflectBlock(
 
     Tcl_Preserve(rcPtr);
 
-    if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj) != TCL_OK) {
+    if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) {
 	Tcl_SetChannelError(rcPtr->chan, resObj);
 	errorNum = EINVAL;
     } else {
@@ -1655,7 +1654,7 @@ ReflectSetOption(
     Tcl_IncrRefCount(optionObj);
     Tcl_IncrRefCount(valueObj);
 
-    result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj);
+    result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
     if (result != TCL_OK) {
 	UnmarshallErrorResult(interp, resObj);
     }
@@ -1700,7 +1699,7 @@ ReflectGetOption(
     Tcl_Obj *resObj;		/* Result data for 'configure' */
     int listc, result = TCL_OK;
     Tcl_Obj **listv;
-    const char *method;
+    MethodName method;
 
     /*
      * Are we in the correct thread?
@@ -1739,14 +1738,14 @@ ReflectGetOption(
 	 * Retrieve all options.
 	 */
 
-	method = "cgetall";
+	method = METH_CGETALL;
 	optionObj = NULL;
     } else {
 	/*
 	 * Retrieve the value of one option.
 	 */
 
-	method = "cget";
+	method = METH_CGET;
 	optionObj = Tcl_NewStringObj(optionName, -1);
         Tcl_IncrRefCount(optionObj);
     }
@@ -1958,6 +1957,7 @@ NewReflectedChannel(
     Tcl_Obj *handleObj)
 {
     ReflectedChannel *rcPtr;
+    MethodName mn = METH_BLOCKING;
 
     rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
 
@@ -1973,9 +1973,15 @@ NewReflectedChannel(
 
     /* ASSERT: cmdpfxObj is a Tcl List */
     rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
-    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, Tcl_NewObj());
-    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, handleObj);
     Tcl_IncrRefCount(rcPtr->cmd);
+    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
+    while (mn <= METH_WRITE) {
+	Tcl_ListObjAppendElement(NULL, rcPtr->methods,
+		Tcl_NewStringObj(methodNames[mn++], -1));
+    }
+    Tcl_IncrRefCount(rcPtr->methods);
+    rcPtr->name = handleObj;
+    Tcl_IncrRefCount(rcPtr->name);
     return rcPtr;
 }
 
@@ -2035,6 +2041,8 @@ FreeReflectedChannel(
 	ckfree((char*) chanPtr->typePtr);
     }
     Tcl_Release(chanPtr);
+    Tcl_DecrRefCount(rcPtr->name);
+    Tcl_DecrRefCount(rcPtr->methods);
     Tcl_DecrRefCount(rcPtr->cmd);
     ckfree((char*) rcPtr);
 }
@@ -2066,7 +2074,7 @@ FreeReflectedChannel(
 static int
 InvokeTclMethod(
     ReflectedChannel *rcPtr,
-    const char *method,
+    MethodName method,
     Tcl_Obj *argOneObj,		/* NULL'able */
     Tcl_Obj *argTwoObj,		/* NULL'able */
     Tcl_Obj **resultObjPtr)	/* NULL'able */
@@ -2076,7 +2084,6 @@ InvokeTclMethod(
     int result;			/* Result code of method invokation */
     Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
     Tcl_Obj *cmd;
-    int len;
 
     if (!rcPtr->interp) {
 	/*
@@ -2099,20 +2106,15 @@ InvokeTclMethod(
     }
 
     /*
-     * NOTE (5): Decide impl. issue: Cache objects with method names? Needs
-     * TSD data as reflections can be created in many different threads.
-     * NO: Caching of command resolutions means storage per channel.
-     */
-
-    /*
      * Insert method into the callback command, after the command prefix,
      * before the channel id.
      */
 
-    methObj = Tcl_NewStringObj(method, -1);
     cmd = TclListObjCopy(NULL, rcPtr->cmd);
-    ListObjLength(cmd, len);
-    Tcl_ListObjReplace(NULL, cmd, len - 2, 1, 1, &methObj);
+
+    Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
+    Tcl_ListObjAppendElement(NULL, cmd, methObj);
+    Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
 
     /*
      * Append the additional argument containing method specific details
@@ -2173,7 +2175,8 @@ InvokeTclMethod(
 		result = TCL_ERROR;
 	    }
 	    Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
-		    "\n    (chan handler subcommand \"%s\")", method));
+		    "\n    (chan handler subcommand \"%s\")",
+		    methodNames[method]));
 	    resObj = MarshallError(rcPtr->interp);
 	}
 	Tcl_IncrRefCount(resObj);
@@ -2700,7 +2703,7 @@ ForwardProc(
 	 * No parameters/results.
 	 */
 
-	if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) {
+	if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
 
@@ -2732,7 +2735,7 @@ ForwardProc(
         Tcl_IncrRefCount(toReadObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
+	if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
 	    int code = ErrnoReturn (rcPtr, resObj);
 
 	    if (code < 0) {
@@ -2772,7 +2775,7 @@ ForwardProc(
         Tcl_IncrRefCount(bufObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+	if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
 	    int code = ErrnoReturn(rcPtr, resObj);
 
 	    if (code < 0) {
@@ -2813,7 +2816,7 @@ ForwardProc(
         Tcl_IncrRefCount(baseObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){
+	if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	    paramPtr->seek.offset = -1;
 	} else {
@@ -2847,7 +2850,7 @@ ForwardProc(
         /* assert maskObj.refCount == 1 */
 
         Tcl_Preserve(rcPtr);
-	(void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+	(void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
 	Tcl_DecrRefCount(maskObj);
         Tcl_Release(rcPtr);
 	break;
@@ -2858,7 +2861,7 @@ ForwardProc(
         Tcl_IncrRefCount(blockObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
+	if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
 		&resObj) != TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
@@ -2874,7 +2877,7 @@ ForwardProc(
         Tcl_IncrRefCount(optionObj);
         Tcl_IncrRefCount(valueObj);
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
+	if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
 		&resObj) != TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
@@ -2893,7 +2896,7 @@ ForwardProc(
         Tcl_IncrRefCount(optionObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
+	if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	} else {
 	    Tcl_DStringAppend(paramPtr->getOpt.value,
@@ -2910,7 +2913,7 @@ ForwardProc(
 	 */
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){
+	if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	} else {
 	    /*
-- 
cgit v0.12


From 87f75437c09a8e8fbe5fe0eaa68200c773799e28 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 17 Apr 2014 19:58:41 +0000
Subject: Another test exposing another segfault.

---
 tests/ioCmd.test | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index f021ade..184f773 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -774,6 +774,22 @@ test iocmd-21.20 {Bug 88aef05cda} -setup {
     close $ch
     rename foo {}
 } -match glob -result {1 {*nested eval*}}
+test iocmd-21.21 {[close] in [read] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    close $chan
+	    return a
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    read $ch 1
+} -cleanup {
+    close $ch
+    rename foo {}
+} -result a
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From a07adf4d6d28771d9aa74ef06526e5fb3035f5c1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 21 Apr 2014 18:55:41 +0000
Subject: Added a refcounting mechanism to ChannelBuffers.  Other edits to stop
 segfaults in tests iocmd-21.2[12].

---
 generic/tclIO.c    | 50 ++++++++++++++++++++++++++++++++++++++++++--------
 generic/tclIO.h    |  1 +
 generic/tclIOCmd.c |  3 +++
 tests/ioCmd.test   | 20 ++++++++++++++++++--
 4 files changed, 64 insertions(+), 10 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 9e675c6..a60c97d 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -162,6 +162,8 @@ typedef struct CloseCallback {
  */
 
 static ChannelBuffer *	AllocChannelBuffer(int length);
+static void		PreserveChannelBuffer(ChannelBuffer *bufPtr);
+static void		ReleaseChannelBuffer(ChannelBuffer *bufPtr);
 static void		ChannelTimerProc(ClientData clientData);
 static int		CheckChannelErrors(ChannelState *statePtr,
 			    int direction);
@@ -352,6 +354,7 @@ ChanRead(
     int *errnoPtr)
 {
     if (WillRead(chanPtr) < 0) {
+	*errnoPtr = Tcl_GetErrno();
         return -1;
     }
 
@@ -2216,8 +2219,26 @@ AllocChannelBuffer(
     bufPtr->nextRemoved	= BUFFER_PADDING;
     bufPtr->bufLength	= length + BUFFER_PADDING;
     bufPtr->nextPtr	= NULL;
+    bufPtr->refCount	= 1;
     return bufPtr;
 }
+
+static void
+PreserveChannelBuffer(
+    ChannelBuffer *bufPtr)
+{
+    bufPtr->refCount++;
+}
+
+static void
+ReleaseChannelBuffer(
+    ChannelBuffer *bufPtr)
+{
+    if (--bufPtr->refCount) {
+	return;
+    }
+    ckfree((char *) bufPtr);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -2250,7 +2271,7 @@ RecycleBuffer(
      */
 
     if (mustDiscard) {
-	ckfree((char *) bufPtr);
+	ReleaseChannelBuffer(bufPtr);
 	return;
     }
 
@@ -2261,7 +2282,7 @@ RecycleBuffer(
      */
 
     if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
-	ckfree((char *) bufPtr);
+	ReleaseChannelBuffer(bufPtr);
 	return;
     }
 
@@ -2296,7 +2317,7 @@ RecycleBuffer(
      * If we reached this code we return the buffer to the OS.
      */
 
-    ckfree((char *) bufPtr);
+    ReleaseChannelBuffer(bufPtr);
     return;
 
   keepBuffer:
@@ -2470,6 +2491,7 @@ FlushChannel(
 	 * Produce the output on the channel.
 	 */
 
+	PreserveChannelBuffer(bufPtr);
 	toWrite = BytesLeft(bufPtr);
 	if (toWrite == 0) {
 	    written = 0;
@@ -2597,6 +2619,7 @@ FlushChannel(
 	    }
 	    RecycleBuffer(statePtr, bufPtr, 0);
 	}
+	ReleaseChannelBuffer(bufPtr);
     }	/* Closes "while (1)". */
 
     /*
@@ -2681,7 +2704,7 @@ CloseChannel(
      */
 
     if (statePtr->curOutPtr != NULL) {
-	ckfree((char *) statePtr->curOutPtr);
+	ReleaseChannelBuffer(statePtr->curOutPtr);
 	statePtr->curOutPtr = NULL;
     }
 
@@ -3566,6 +3589,11 @@ static void WillWrite(Channel *chanPtr)
 
 static int WillRead(Channel *chanPtr)
 {
+    if (chanPtr->typePtr == NULL) {
+	/* Prevent read attempts on a closed channel */
+	Tcl_SetErrno(EINVAL);
+	return -1;
+    }
     if ((chanPtr->typePtr->seekProc != NULL)
         && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
         if ((chanPtr->state->curOutPtr != NULL)
@@ -3652,6 +3680,7 @@ Write(
 	    bufPtr->nextAdded += saved;
 	    saved = 0;
 	}
+	PreserveChannelBuffer(bufPtr);
 	dst = InsertPoint(bufPtr);
 	dstLen = SpaceLeft(bufPtr);
 
@@ -3665,6 +3694,7 @@ Write(
 	
 	if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
 	    /* We're reading from invalid/incomplete UTF-8 */
+	    ReleaseChannelBuffer(bufPtr);
 	    if (total == 0) {
 		Tcl_SetErrno(EINVAL);
 		return -1;
@@ -3748,6 +3778,7 @@ Write(
 		needNlFlush = 0;
 	    }
 	}
+	ReleaseChannelBuffer(bufPtr);
     }
     if ((flushed < total) && (statePtr->flags & CHANNEL_UNBUFFERED ||
 	    (needNlFlush && statePtr->flags & CHANNEL_LINEBUFFERED))) {
@@ -5935,7 +5966,7 @@ DiscardInputQueued(
      */
 
     if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
-	ckfree((char *) statePtr->saveInBufPtr);
+	ReleaseChannelBuffer(statePtr->saveInBufPtr);
 	statePtr->saveInBufPtr = NULL;
     }
 }
@@ -6028,7 +6059,7 @@ GetInput(
 
 	if ((bufPtr != NULL)
 		&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
-	    ckfree((char *) bufPtr);
+	    ReleaseChannelBuffer(bufPtr);
 	    bufPtr = NULL;
 	}
 
@@ -6090,6 +6121,7 @@ GetInput(
     } else {
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
+	PreserveChannelBuffer(bufPtr);
 	nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
@@ -6097,6 +6129,7 @@ GetInput(
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
     if (nread > 0) {
+	result = 0;
 	bufPtr->nextAdded += nread;
 
 	/*
@@ -6122,6 +6155,7 @@ GetInput(
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
     } else if (nread == 0) {
+	result = 0;
 	SetFlag(statePtr, CHANNEL_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
     } else if (nread < 0) {
@@ -6130,9 +6164,9 @@ GetInput(
 	    result = EAGAIN;
 	}
 	Tcl_SetErrno(result);
-	return result;
     }
-    return 0;
+    ReleaseChannelBuffer(bufPtr);
+    return result;
 }
 
 /*
diff --git a/generic/tclIO.h b/generic/tclIO.h
index ebf2ef7..0ea7d1c 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -36,6 +36,7 @@
  */
 
 typedef struct ChannelBuffer {
+    int refCount;		/* Current uses count */
     int nextAdded;		/* The next position into which a character
 				 * will be put in the buffer. */
     int nextRemoved;		/* Position of next byte to be removed from
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 2958bc8..7e8e91a 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -447,6 +447,7 @@ Tcl_ReadObjCmd(
 
     resultPtr = Tcl_NewObj();
     Tcl_IncrRefCount(resultPtr);
+    Tcl_Preserve(chan);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead < 0) {
 	/*
@@ -462,6 +463,7 @@ Tcl_ReadObjCmd(
 		    TclGetString(chanObjPtr), "\": ",
 		    Tcl_PosixError(interp), NULL);
 	}
+	Tcl_Release(chan);
 	Tcl_DecrRefCount(resultPtr);
 	return TCL_ERROR;
     }
@@ -480,6 +482,7 @@ Tcl_ReadObjCmd(
 	}
     }
     Tcl_SetObjResult(interp, resultPtr);
+    Tcl_Release(chan);
     Tcl_DecrRefCount(resultPtr);
     return TCL_OK;
 }
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 184f773..8bf32d2 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -785,11 +785,27 @@ test iocmd-21.21 {[close] in [read] segfaults} -setup {
     }
     set ch [chan create read foo]
 } -body {
-    read $ch 1
+    read $ch 0
 } -cleanup {
     close $ch
     rename foo {}
-} -result a
+} -result {}
+test iocmd-21.22 {[close] in [read] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return a
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    read $ch 1
+} -returnCodes error -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -match glob -result {*invalid argument*}
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From 192fce9c01c4ee3827aa8f54967764c18bdd5dca Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Tue, 22 Apr 2014 13:25:41 +0000
Subject: Memory leak after thread exit, fixed (alloc cache released by exit),
 belong to ticket [3493120]

Moved over to branch bug-3493120.  This is not ready
for the core-8-5-branch.  Segfaults all over the place
in a thread-enabled build on a CentOS system.
---
 generic/tclInt.h         |  1 +
 generic/tclThread.c      |  8 ++++++--
 generic/tclThreadAlloc.c | 27 +++++++++++++++++++++++++++
 3 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1348340..00b246b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2550,6 +2550,7 @@ MODULE_SCOPE void	TclFinalizeObjects(void);
 MODULE_SCOPE void	TclFinalizePreserve(void);
 MODULE_SCOPE void	TclFinalizeSynchronization(void);
 MODULE_SCOPE void	TclFinalizeThreadAlloc(void);
+MODULE_SCOPE void	TclFinalizeThreadAllocThread(void);
 MODULE_SCOPE void	TclFinalizeThreadData(void);
 MODULE_SCOPE void	TclFinalizeThreadObjects(void);
 MODULE_SCOPE double	TclFloor(mp_int *a);
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 8384107..d6b5bcb 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -338,8 +338,9 @@ Tcl_ConditionFinalize(
  *
  * TclFinalizeThreadData --
  *
- *	This function cleans up the thread-local storage. This is called once
- *	for each thread.
+ *	This function cleans up the thread-local storage. Secondary, it cleans
+ *	thread alloc cache.
+ *	This is called once for each thread before thread exits.
  *
  * Results:
  *	None.
@@ -354,6 +355,9 @@ void
 TclFinalizeThreadData(void)
 {
     TclpFinalizeThreadDataThread();
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+    TclFinalizeThreadAllocThread();
+#endif
 }
 
 /*
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 2e74fa7..106e908 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -1012,6 +1012,33 @@ TclFinalizeThreadAlloc(void)
     TclpFreeAllocCache(NULL);
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeThreadAllocThread --
+ *
+ *	This procedure is used to destroy single thread private resources used
+ *	in this file. 
+ * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadAllocThread(void)
+{
+    Cache *cachePtr = TclpGetAllocCache();
+    if (cachePtr != NULL) {
+	TclpFreeAllocCache(cachePtr);
+    }
+}
+
 #else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
 /*
  *----------------------------------------------------------------------
-- 
cgit v0.12


From 190e2f09e8fa5bc975ba496a5544b4dd853378f0 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 22 Apr 2014 14:57:44 +0000
Subject: Add refcounting and preservation to [testchannel transform] to stop
 segfault in test iogt-2.4.

---
 generic/tclIOGT.c | 122 +++++++++++++++++++++++++++++++++---------------------
 1 file changed, 75 insertions(+), 47 deletions(-)

diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index eed21fb..beddf4f 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -210,7 +210,27 @@ struct TransformChannelData {
 				 * a transformation of incoming data. Also
 				 * serves as buffer of all data not yet
 				 * consumed by the reader. */
+    int refCount;
 };
+
+static void
+PreserveData(
+    TransformChannelData *dataPtr)
+{
+    dataPtr->refCount++;
+}
+
+static void
+ReleaseData(
+    TransformChannelData *dataPtr)
+{
+    if (--dataPtr->refCount) {
+	return;
+    }
+    ResultClear(&dataPtr->result);
+    Tcl_DecrRefCount(dataPtr->command);
+    ckfree((char *) dataPtr);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -240,6 +260,7 @@ TclChannelTransform(
     Channel *chanPtr;		/* The actual channel. */
     ChannelState *statePtr;	/* State info for channel. */
     int mode;			/* Read/write mode of the channel. */
+    int objc;
     TransformChannelData *dataPtr;
     Tcl_DString ds;
 
@@ -247,6 +268,12 @@ TclChannelTransform(
 	return TCL_ERROR;
     }
 
+    if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("-command value is not a list", -1));
+	return TCL_ERROR;
+    }
+
     chanPtr = (Channel *) chan;
     statePtr = chanPtr->state;
     chanPtr = statePtr->topChanPtr;
@@ -261,6 +288,7 @@ TclChannelTransform(
 
     dataPtr = (TransformChannelData *) ckalloc(sizeof(TransformChannelData));
 
+    dataPtr->refCount = 1;
     Tcl_DStringInit(&ds);
     Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
     dataPtr->readIsFlushed = 0;
@@ -286,9 +314,7 @@ TclChannelTransform(
     if (dataPtr->self == NULL) {
 	Tcl_AppendResult(interp, "\nfailed to stack channel \"",
 		Tcl_GetChannelName(chan), "\"", NULL);
-	Tcl_DecrRefCount(dataPtr->command);
-	ResultClear(&dataPtr->result);
-	ckfree((char *) dataPtr);
+	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
 
@@ -296,9 +322,11 @@ TclChannelTransform(
      * At last initialize the transformation at the script level.
      */
 
+    PreserveData(dataPtr);
     if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
 	    A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
 	Tcl_UnstackChannel(interp, chan);
+	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
 
@@ -307,9 +335,11 @@ TclChannelTransform(
 	ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
 		P_NO_PRESERVE);
 	Tcl_UnstackChannel(interp, chan);
+	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
 
+    ReleaseData(dataPtr);
     return TCL_OK;
 }
 
@@ -350,7 +380,10 @@ ExecuteCallback(
     unsigned char *resBuf;
     Tcl_InterpState state = NULL;
     int res = TCL_OK;
-    Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
+    Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+    Tcl_Interp *eval = dataPtr->interp;
+
+    Tcl_Preserve(eval);
 
     /*
      * Step 1, create the complete command to execute. Do this by appending
@@ -361,26 +394,18 @@ ExecuteCallback(
      */
 
     if (preserve == P_PRESERVE) {
-	state = Tcl_SaveInterpState(dataPtr->interp, res);
+	state = Tcl_SaveInterpState(eval, res);
     }
 
     Tcl_IncrRefCount(command);
-    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
-	    Tcl_NewStringObj((char *) op, -1));
-    if (res != TCL_OK) {
-	goto cleanup;
-    }
+    Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
 
     /*
      * Use a byte-array to prevent the misinterpretation of binary data coming
      * through as UTF while at the tcl level.
      */
 
-    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
-	    Tcl_NewByteArrayObj(buf, bufLen));
-    if (res != TCL_OK) {
-	goto cleanup;
-    }
+    Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));
 
     /*
      * Step 2, execute the command at the global level of the interpreter used
@@ -390,13 +415,14 @@ ExecuteCallback(
      * current interpreter. Don't copy if in preservation mode.
      */
 
-    res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
+    res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
     Tcl_DecrRefCount(command);
     command = NULL;
 
-    if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
+    if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
 	    && (preserve == P_NO_PRESERVE)) {
-	Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+	Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
+	Tcl_Release(eval);
 	return res;
     }
 
@@ -411,20 +437,20 @@ ExecuteCallback(
 	break;
 
     case TRANSMIT_DOWN:
-	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
 		resLen);
 	break;
 
     case TRANSMIT_SELF:
-	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
 	break;
 
     case TRANSMIT_IBUF:
-	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	ResultAdd(&dataPtr->result, resBuf, resLen);
 	break;
@@ -434,24 +460,16 @@ ExecuteCallback(
 	 * Interpret result as integer number.
 	 */
 
-	resObj = Tcl_GetObjResult(dataPtr->interp);
-	TclGetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
+	resObj = Tcl_GetObjResult(eval);
+	TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
 	break;
     }
 
-    Tcl_ResetResult(dataPtr->interp);
-    if (preserve == P_PRESERVE) {
-	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
-    }
-    return res;
-
-  cleanup:
+    Tcl_ResetResult(eval);
     if (preserve == P_PRESERVE) {
-	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
-    }
-    if (command != NULL) {
-	Tcl_DecrRefCount(command);
+	(void) Tcl_RestoreInterpState(eval, state);
     }
+    Tcl_Release(eval);
     return res;
 }
 
@@ -535,6 +553,7 @@ TransformCloseProc(
      * system rely on (f.e. signaling the close to interested parties).
      */
 
+    PreserveData(dataPtr);
     if (dataPtr->mode & TCL_WRITABLE) {
 	ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
 		TRANSMIT_DOWN, P_PRESERVE);
@@ -554,14 +573,13 @@ TransformCloseProc(
 	ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
 		TRANSMIT_DONT, P_PRESERVE);
     }
+    ReleaseData(dataPtr);
 
     /*
      * General cleanup.
      */
 
-    ResultClear(&dataPtr->result);
-    Tcl_DecrRefCount(dataPtr->command);
-    ckfree((char *) dataPtr);
+    ReleaseData(dataPtr);
     return TCL_OK;
 }
 
@@ -606,6 +624,7 @@ TransformInputProc(
     gotBytes = 0;
     downChan = Tcl_GetStackedChannel(dataPtr->self);
 
+    PreserveData(dataPtr);
     while (toRead > 0) {
 	/*
 	 * Loop until the request is satisfied (or no data is available from
@@ -623,7 +642,7 @@ TransformInputProc(
 	     * break out of the loop and return to the caller.
 	     */
 
-	    return gotBytes;
+	    break;
 	}
 
 	/*
@@ -647,7 +666,7 @@ TransformInputProc(
 	    }
 	} /* else: 'maxRead < 0' == Accept the current value of toRead. */
 	if (toRead <= 0) {
-	    return gotBytes;
+	    break;
 	}
 
 	/*
@@ -663,11 +682,12 @@ TransformInputProc(
 	     */
 
 	    if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
-		return gotBytes;
+		break;
 	    }
 
 	    *errorCodePtr = Tcl_GetErrno();
-	    return -1;
+	    gotBytes = -1;
+	    break;
 	} else if (read == 0) {
 	    /*
 	     * Check wether we hit on EOF in the underlying channel or not. If
@@ -682,9 +702,9 @@ TransformInputProc(
 	    if (!Tcl_Eof(downChan)) {
 		if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
 		    *errorCodePtr = EWOULDBLOCK;
-		    return -1;
+		    gotBytes = -1;
 		}
-		return gotBytes;
+		break;
 	    }
 
 	    if (dataPtr->readIsFlushed) {
@@ -692,7 +712,7 @@ TransformInputProc(
 		 * Already flushed, nothing to do anymore.
 		 */
 
-		return gotBytes;
+		break;
 	    }
 
 	    dataPtr->readIsFlushed = 1;
@@ -704,7 +724,7 @@ TransformInputProc(
 		 * We had nothing to flush.
 		 */
 
-		return gotBytes;
+		break;
 	    }
 
 	    continue;		/* at: while (toRead > 0) */
@@ -718,9 +738,11 @@ TransformInputProc(
 	if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
 		TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
 	    *errorCodePtr = EINVAL;
-	    return -1;
+	    gotBytes = -1;
+	    break;
 	}
     } /* while toRead > 0 */
+    ReleaseData(dataPtr);
 
     return gotBytes;
 }
@@ -762,11 +784,13 @@ TransformOutputProc(
 	return 0;
     }
 
+    PreserveData(dataPtr);
     if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
 	    TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
 	*errorCodePtr = EINVAL;
-	return -1;
+	toWrite = -1;
     }
+    ReleaseData(dataPtr);
 
     return toWrite;
 }
@@ -819,6 +843,7 @@ TransformSeekProc(
      * request down, unchanged.
      */
 
+    PreserveData(dataPtr);
     if (dataPtr->mode & TCL_WRITABLE) {
 	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
 		P_NO_PRESERVE);
@@ -830,6 +855,7 @@ TransformSeekProc(
 	ResultClear(&dataPtr->result);
 	dataPtr->readIsFlushed = 0;
     }
+    ReleaseData(dataPtr);
 
     return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
 	    errorCodePtr);
@@ -890,6 +916,7 @@ TransformWideSeekProc(
      * request down, unchanged.
      */
 
+    PreserveData(dataPtr);
     if (dataPtr->mode & TCL_WRITABLE) {
 	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
 		P_NO_PRESERVE);
@@ -901,6 +928,7 @@ TransformWideSeekProc(
 	ResultClear(&dataPtr->result);
 	dataPtr->readIsFlushed = 0;
     }
+    ReleaseData(dataPtr);
 
     /*
      * If we have a wide seek capability, we should stick with that.
-- 
cgit v0.12


From f231f10b58b9f58583b664655b513d3f3ee0c382 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Wed, 23 Apr 2014 09:18:20 +0000
Subject: *nix segfault cleared: we should reset a thread key after freeing of
 alloc cache (in tclUnixThrd.c)

---
 unix/tclUnixThrd.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index ad36242..d30791d 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -814,6 +814,7 @@ TclpFreeAllocCache(
 	 */
 
 	TclFreeAllocCache(ptr);
+	pthread_setspecific(key, NULL);
 
     } else if (initialized) {
 	/*
-- 
cgit v0.12


From 790e5adaf4cabf6c9dcaa3d109427dbe18f786ff Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Apr 2014 15:27:58 +0000
Subject: Make sure the ReflectedChannel struct is freed in the handler thread,
 where it was allocated.  This constraint allows the struct to safely hold
 Tcl_Obj values, which has been convenient for storing callback commands.

---
 generic/tclIORChan.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index e462f61..94428bb 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -1145,6 +1145,7 @@ ReflectClose(
 	    if (result != TCL_OK) {
 		FreeReceivedError(&p);
 	    }
+	    return EOK;
 	}
 #endif
 
@@ -1169,8 +1170,6 @@ ReflectClose(
 
         Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
 
-        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-
 	if (result != TCL_OK) {
 	    PassReceivedErrorInterp(interp, &p);
 	}
@@ -2903,6 +2902,7 @@ ForwardProc(
                 Tcl_GetChannelName(rcPtr->chan));
 	Tcl_DeleteHashEntry(hPtr);
 
+	Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	break;
 
     case ForwardedInput: {
-- 
cgit v0.12


From 0781259dd17444340c1a926c4cd2b5ade72bfebe Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 25 Apr 2014 17:34:11 +0000
Subject: Test iortrans-4.8.2 demos an infinite loop.  Possible trouble with
 pushback buffers.

---
 generic/tclIO.c    |  5 +++++
 tests/ioTrans.test | 20 ++++++++++++++++++++
 2 files changed, 25 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index e6439ef..41ac1e1 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5611,6 +5611,11 @@ DoReadChars(
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
 	    result = GetInput(chanPtr);
+if (chanPtr != statePtr->topChanPtr) {
+Tcl_Release(chanPtr);
+chanPtr = statePtr->topChanPtr;
+Tcl_Preserve(chanPtr);
+}
 	    if (result != 0) {
 		if (result == EAGAIN) {
 		    break;
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index b21d894..3bbd170 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -559,6 +559,26 @@ test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
     rename foo {}
 } -result {{read rt* {test data
 }} file*}
+test iortrans-4.8.2 {chan read, bug 721ec69271} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {fd args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+	return x
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    chan configure $c -buffersize 1
+    lappend res [read $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} file*}
 test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
     set res {}
 } -match glob -body {
-- 
cgit v0.12


From 4119a864755c221944bcd1967b8243a2acc3d9aa Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 25 Apr 2014 19:51:36 +0000
Subject: Disable buffer recycling, which creates mysteries.

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 41ac1e1..df863cc 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2342,7 +2342,7 @@ RecycleBuffer(
      * Do we have to free the buffer to the OS?
      */
 
-    if (mustDiscard) {
+    if (1 || mustDiscard) {
 	ReleaseChannelBuffer(bufPtr);
 	return;
     }
-- 
cgit v0.12


From 1fc337bda0ffe4523e3a47f27077378b4c1349cf Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 25 Apr 2014 20:12:48 +0000
Subject: Disable buffer recycling to expose bugs for fixing.

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index a60c97d..3f9ca0a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2270,7 +2270,7 @@ RecycleBuffer(
      * Do we have to free the buffer to the OS?
      */
 
-    if (mustDiscard) {
+    if (1 || mustDiscard) {
 	ReleaseChannelBuffer(bufPtr);
 	return;
     }
-- 
cgit v0.12


From 9a76d245a9dcf48449c6f147252a9be6b43abf09 Mon Sep 17 00:00:00 2001
From: ferrieux <ferrieux@users.sourceforge.net>
Date: Mon, 28 Apr 2014 20:28:10 +0000
Subject: Clarify fcopy manpage regarding its bidirectional uses. [1350564]

---
 doc/fcopy.n | 27 ++++++++++++++++++++++++---
 1 file changed, 24 insertions(+), 3 deletions(-)

diff --git a/doc/fcopy.n b/doc/fcopy.n
index ec3d5c6..071896c 100644
--- a/doc/fcopy.n
+++ b/doc/fcopy.n
@@ -46,8 +46,11 @@ non-blocking mode; the \fBfcopy\fR command takes care of that automatically.
 However, it is necessary to enter the event loop by using
 the \fBvwait\fR command or by using Tk.
 .PP
-You are not allowed to do other I/O operations with
-\fIinchan\fR or \fIoutchan\fR during a background \fBfcopy\fR.
+You are not allowed to do other input operations with \fIinchan\fR, or
+output operations with \fIoutchan\fR, during a background
+\fBfcopy\fR. The converse is entirely legitimate, as exhibited by the
+bidirectional fcopy example below.
+.PP
 If either \fIinchan\fR or \fIoutchan\fR get closed
 while the copy is in progress, the current copy is stopped
 and the command callback is \fInot\fR made.
@@ -57,7 +60,7 @@ then all data already queued for \fIoutchan\fR is written out.
 Note that \fIinchan\fR can become readable during a background copy.
 You should turn off any \fBfileevent\fR handlers during a background
 copy so those handlers do not interfere with the copy.
-Any I/O attempted by a \fBfileevent\fR handler will get a
+Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a
 .QW "channel busy"
 error.
 .PP
@@ -149,6 +152,24 @@ set total 0
         -command [list CopyMore $in $out $chunk]
 vwait done
 .CE
+.PP
+The fourth example starts an asynchronous, bidirectional fcopy between
+two sockets. Those could also be pipes from two [open "|hal 9000" r+]
+(though their conversation would remain secret to the script, since
+all four fileevent slots are busy).
+.PP
+.CS
+set flows 2
+proc Done {dir args} {
+     global flows done
+     puts "$dir is over."
+     incr flows -1
+     if {$flows<=0} {set done 1}
+}
+\fBfcopy\fR $sok1 $sok2 -command [list Done UP]
+\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
+vwait done
+.CE
 .SH "SEE ALSO"
 eof(n), fblocked(n), fconfigure(n), file(n)
 .SH KEYWORDS
-- 
cgit v0.12


From 0725c745416a8cfec6c72440cfc62d5fdc686f04 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 29 Apr 2014 15:54:03 +0000
Subject: Revise the logic for setting TCL_ENCODING_END in the
 outputEncodingFlags so it does not rely on buffer recycling.

---
 generic/tclIO.c | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3f9ca0a..6ff8806 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3142,7 +3142,8 @@ Tcl_Close(
 
     stickyError = 0;
 
-    if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+    if ((statePtr->encoding != NULL)
+	    && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
 	    && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
 	statePtr->outputEncodingFlags |= TCL_ENCODING_END;
 	if (WriteChars(chanPtr, "", 0) < 0) {
@@ -7330,7 +7331,8 @@ Tcl_SetChannelOption(
 	 * iso2022, the terminated escape sequence must write to the buffer.
 	 */
 
-	if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+	if ((statePtr->encoding != NULL)
+		&& !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
 		&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
 	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
 	    WriteChars(chanPtr, "", 0);
-- 
cgit v0.12


From 267c1eb9f4c15531f7bf4095ffb56151ad8f9203 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 29 Apr 2014 17:40:15 +0000
Subject: Make sure no shared ChannelBuffers get recycled.

---
 generic/tclIO.c | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 08d0d93..6831c47 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -164,6 +164,7 @@ typedef struct CloseCallback {
 static ChannelBuffer *	AllocChannelBuffer(int length);
 static void		PreserveChannelBuffer(ChannelBuffer *bufPtr);
 static void		ReleaseChannelBuffer(ChannelBuffer *bufPtr);
+static int		IsShared(ChannelBuffer *bufPtr);
 static void		ChannelTimerProc(ClientData clientData);
 static int		CheckChannelErrors(ChannelState *statePtr,
 			    int direction);
@@ -2239,6 +2240,13 @@ ReleaseChannelBuffer(
     }
     ckfree((char *) bufPtr);
 }
+
+static int
+IsShared(
+    ChannelBuffer *bufPtr)
+{
+    return bufPtr->refCount > 1;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -2269,6 +2277,9 @@ RecycleBuffer(
     /*
      * Do we have to free the buffer to the OS?
      */
+    if (IsShared(bufPtr)) {
+	mustDiscard = 1;
+    }
 
     if (mustDiscard) {
 	ReleaseChannelBuffer(bufPtr);
-- 
cgit v0.12


From 75c22ad9870b02a3a9b9d213a1d38a1e93a7f7e7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Apr 2014 19:12:37 +0000
Subject: Another segfault demo test, this one with [close] during [gets].

---
 tests/ioCmd.test | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 8bf32d2..d2c0173 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -806,6 +806,22 @@ test iocmd-21.22 {[close] in [read] segfaults} -setup {
     catch {close $ch}
     rename foo {}
 } -match glob -result {*invalid argument*}
+test iocmd-21.23 {[close] in [gets] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return \n
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    gets $ch
+} -returnCodes error -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -match glob -result {*invalid argument*}
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From 1264e873bbaae9d4328826b749e459e88b32e820 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Apr 2014 19:33:21 +0000
Subject: Panic message to pinpoint the cause of iocmd-21.23 segfault.

---
 generic/tclIO.c | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6831c47..0c9db67 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4570,6 +4570,9 @@ FilterInputBytes(
 	}
 	bufPtr = statePtr->inQueueTail;
 	gsPtr->bufPtr = bufPtr;
+	if (bufPtr == NULL) {
+	    Tcl_Panic("GetInput nuked buffers!");
+	}
     }
 
     /*
-- 
cgit v0.12


From 1c909a3352991d577a7164d5bb33dbe8d295ae67 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Apr 2014 19:54:51 +0000
Subject: Stop the segfaults in [close] during [gets] tests. Not sure this is
 the right behavior, but it's better than crashing.

---
 generic/tclIO.c  | 23 ++++++++++++++---------
 tests/ioCmd.test | 21 +++++++++++++++++++--
 2 files changed, 33 insertions(+), 11 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0c9db67..cd28a0e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4163,12 +4163,12 @@ Tcl_GetsObj(
 
   restore:
     bufPtr = statePtr->inQueueHead;
-    if (bufPtr == NULL) {
-	Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL");
+    if (bufPtr != NULL) {
+	bufPtr->nextRemoved = oldRemoved;
+	bufPtr = bufPtr->nextPtr;
     }
-    bufPtr->nextRemoved = oldRemoved;
 
-    for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+    for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
 	bufPtr->nextRemoved = BUFFER_PADDING;
     }
     CommonGetsCleanup(chanPtr);
@@ -4298,6 +4298,9 @@ TclGetsObjBinary(
 		goto restore;
 	    }
 	    bufPtr = statePtr->inQueueTail;
+	    if (bufPtr == NULL) {
+		goto restore;
+	    }
 	}
 
 	dst = (unsigned char *) RemovePoint(bufPtr);
@@ -4410,12 +4413,12 @@ TclGetsObjBinary(
 
   restore:
     bufPtr = statePtr->inQueueHead;
-    if (bufPtr == NULL) {
-	Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL");
+    if (bufPtr) {
+	bufPtr->nextRemoved = oldRemoved;
+	bufPtr = bufPtr->nextPtr;
     }
-    bufPtr->nextRemoved = oldRemoved;
 
-    for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+    for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
 	bufPtr->nextRemoved = BUFFER_PADDING;
     }
     CommonGetsCleanup(chanPtr);
@@ -4571,7 +4574,9 @@ FilterInputBytes(
 	bufPtr = statePtr->inQueueTail;
 	gsPtr->bufPtr = bufPtr;
 	if (bufPtr == NULL) {
-	    Tcl_Panic("GetInput nuked buffers!");
+	    gsPtr->charsWrote = 0;
+	    gsPtr->rawRead = 0;
+	    return -1;
 	}
     }
 
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index d2c0173..bb133f9 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -818,10 +818,27 @@ test iocmd-21.23 {[close] in [gets] segfaults} -setup {
     set ch [chan create read foo]
 } -body {
     gets $ch
-} -returnCodes error -cleanup {
+} -cleanup {
     catch {close $ch}
     rename foo {}
-} -match glob -result {*invalid argument*}
+} -result {}
+test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return \n
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    chan configure $ch -translation binary
+    gets $ch
+} -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -result {}
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From 10d7a2ac566063ffdd10a932a0d610ae6ecd62dd Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 30 Apr 2014 21:24:39 +0000
Subject: [82e7f67325] Fix an evil refcount problem in compiled [string
 replace].

---
 generic/tclExecute.c  | 14 ++++++++++++--
 tests/stringComp.test | 34 +++++++++++++++++++++++++++++++++-
 2 files changed, 45 insertions(+), 3 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2c136d7..4ecca5b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5702,11 +5702,21 @@ TEBCresume(
 			length - toIdx);
 	    }
 	} else {
-	    objResultPtr = value3Ptr;
+	    /*
+	     * Be careful with splicing the stack in this case; we have a
+	     * refCount:1 object in value3Ptr and we want to append to it and
+	     * make it be the refCount:1 object at the top of the stack
+	     * afterwards. [Bug 82e7f67325]
+	     */
+
 	    if (toIdx < length) {
-		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+		Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
 			length - toIdx);
 	    }
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+	    TclDecrRefCount(valuePtr);
+	    OBJ_AT_TOS = value3Ptr;	/* Tricky! */
+	    NEXT_INST_F(1, 0, 0);
 	}
 	TclDecrRefCount(value3Ptr);
 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 9e00ce7..39dac78 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -26,6 +26,22 @@ catch [list package require -exact Tcltest [info patchlevel]]
 # Some tests require the testobj command
 
 testConstraint testobj [expr {[info commands testobj] != {}}]
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
 
 test stringComp-1.1 {error conditions} {
     proc foo {} {string gorp a b}
@@ -687,7 +703,23 @@ test stringComp-12.1 {Bug 3588366: end-offsets before start} {
 ## not yet bc
 
 ## string replace
-## not yet bc
+test stringComp-14.1 {Bug 82e7f67325} {
+    apply {{} {
+	set a [join {a b} {}]
+	lappend b [string length [string replace ___! 0 2 $a]]
+	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+    }}
+} {3 3}
+test stringComp-14.2 {Bug 82e7f67325} {
+    # As in stringComp-14.1, but make sure we don't retain too many refs
+    leaktest {
+	apply {{} {
+	    set a [join {a b} {}]
+	    lappend b [string length [string replace ___! 0 2 $a]]
+	    lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+	}}
+    }
+} {0}
 
 ## string tolower
 ## not yet bc
-- 
cgit v0.12


From 7df749abdc0780eb176e6fade94388d60cd8a0ef Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 30 Apr 2014 21:59:00 +0000
Subject: Better (safer) fix for [0e92c404f1]

---
 generic/tclCmdMZ.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 6fd468c..d106f53 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2086,7 +2086,7 @@ StringRangeCmd(
      * Unicode string rep to get the range.
      */
 
-    if (objv[1]->typePtr == &tclByteArrayType) {
+    if (objv[1]->typePtr == &tclByteArrayType && (objv[1]->bytes==NULL)) {
 	string = Tcl_GetByteArrayFromObj(objv[1], &length);
 	length--;
     } else {
-- 
cgit v0.12


From f715c2fad2a69457bbcbdf99167c66a3f62ed3a5 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 1 May 2014 01:15:42 +0000
Subject: missing constraint

---
 tests/stringComp.test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/stringComp.test b/tests/stringComp.test
index 39dac78..0d134b5 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -710,7 +710,7 @@ test stringComp-14.1 {Bug 82e7f67325} {
 	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
     }}
 } {3 3}
-test stringComp-14.2 {Bug 82e7f67325} {
+test stringComp-14.2 {Bug 82e7f67325} memory {
     # As in stringComp-14.1, but make sure we don't retain too many refs
     leaktest {
 	apply {{} {
-- 
cgit v0.12


From 1c52941e5f67f7f374dbc110234bf18a7ac4844a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 1 May 2014 07:38:27 +0000
Subject: Fix more corner-cases like
 [0e92c404f19ede5b2eb06e6db27647d3138cc56|0e92c404f1]: The only place where a
 type of &tclByteArrayType can be trusted is when determining its length,
 because the character length of a (UTF-8) string is always equal to the byte
 length of the byte array.

---
 generic/tclCmdMZ.c   | 12 ++++++------
 generic/tclExecute.c | 10 +++++-----
 generic/tclInt.h     | 18 ++++++++++++++++++
 generic/tclUtil.c    |  2 +-
 4 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d106f53..70943e9 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1345,7 +1345,7 @@ StringIndexCmd(
      * Unicode string rep to get the index'th char.
      */
 
-    if (objv[1]->typePtr == &tclByteArrayType) {
+    if (TclIsPureByteArray(objv[1])) {
 	const unsigned char *string =
 		Tcl_GetByteArrayFromObj(objv[1], &length);
 
@@ -2086,7 +2086,7 @@ StringRangeCmd(
      * Unicode string rep to get the range.
      */
 
-    if (objv[1]->typePtr == &tclByteArrayType && (objv[1]->bytes==NULL)) {
+    if (TclIsPureByteArray(objv[1])) {
 	string = Tcl_GetByteArrayFromObj(objv[1], &length);
 	length--;
     } else {
@@ -2537,8 +2537,8 @@ StringEqualCmd(
 	return TCL_OK;
     }
 
-    if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
-	    objv[1]->typePtr == &tclByteArrayType) {
+    if (!nocase && TclIsPureByteArray(objv[0]) &&
+	    TclIsPureByteArray(objv[1])) {
 	/*
 	 * Use binary versions of comparisons since that won't cause undue
 	 * type conversions and it is much faster. Only do this if we're
@@ -2684,8 +2684,8 @@ StringCmpCmd(
 	return TCL_OK;
     }
 
-    if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
-	    objv[1]->typePtr == &tclByteArrayType) {
+    if (!nocase && TclIsPureByteArray(objv[0]) &&
+	    TclIsPureByteArray(objv[1])) {
 	/*
 	 * Use binary versions of comparisons since that won't cause undue
 	 * type conversions and it is much faster. Only do this if we're
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2e396e8..c4f9836 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4235,8 +4235,8 @@ TclExecuteByteCode(
 	     */
 
 	    iResult = s1len = s2len = 0;
-	} else if ((valuePtr->typePtr == &tclByteArrayType)
-		&& (value2Ptr->typePtr == &tclByteArrayType)) {
+	} else if (TclIsPureByteArray(valuePtr)
+		&& TclIsPureByteArray(value2Ptr)) {
 	    s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
 	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
 	    iResult = memcmp(s1, s2,
@@ -4354,7 +4354,7 @@ TclExecuteByteCode(
 	 * use the Unicode string rep to get the index'th char.
 	 */
 
-	if (valuePtr->typePtr == &tclByteArrayType) {
+	if (TclIsPureByteArray(valuePtr)) {
 	    bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
 	} else {
 	    /*
@@ -4370,7 +4370,7 @@ TclExecuteByteCode(
 	}
 
 	if ((index >= 0) && (index < length)) {
-	    if (valuePtr->typePtr == &tclByteArrayType) {
+	    if (TclIsPureByteArray(valuePtr)) {
 		objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
 			(&bytes[index]), 1);
 	    } else if (valuePtr->bytes && length == valuePtr->length) {
@@ -4422,7 +4422,7 @@ TclExecuteByteCode(
 	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
 	    match = TclUniCharMatch(ustring1, length1, ustring2, length2,
 		    nocase);
-	} else if ((valuePtr->typePtr == &tclByteArrayType) && !nocase) {
+	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
 	    unsigned char *string1, *string2;
 	    int length1, length2;
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 00b246b..2353450 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3668,6 +3668,24 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
 
 /*
  *----------------------------------------------------------------
+ * Macro that encapsulates the logic that determines when it is safe to
+ * interpret a string as a byte array directly. In summary, the object must be
+ * a byte array and must not have a string representation (as the operations
+ * that it is used in are defined on strings, not byte arrays). Theoretically
+ * it is possible to also be efficient in the case where the object's bytes
+ * field is filled by generation from the byte array (c.f. list canonicality)
+ * but we don't do that at the moment since this is purely about efficiency.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclIsPureByteArray(objPtr) \
+	(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
+
+/*
+ *----------------------------------------------------------------
  * Macro used by the Tcl core to compare Unicode strings. On big-endian
  * systems we can use the more efficient memcmp, but this would not be
  * lexically correct on little-endian systems. The ANSI C "prototype" for
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5f4cdae..8c6adfe 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2334,7 +2334,7 @@ TclStringMatchObj(
 	udata = Tcl_GetUnicodeFromObj(strObj, &length);
 	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
 	match = TclUniCharMatch(udata, length, uptn, plen, flags);
-    } else if ((strObj->typePtr == &tclByteArrayType) && !flags) {
+    } else if (TclIsPureByteArray(strObj) && !flags) {
 	unsigned char *data, *ptn;
 
 	data = Tcl_GetByteArrayFromObj(strObj, &length);
-- 
cgit v0.12


From f90303fa441e484833044f364aae0974a6a705d4 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 1 May 2014 09:11:09 +0000
Subject: make doubly sure that things which should be unshared stay unshared

---
 tests/stringComp.test | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/tests/stringComp.test b/tests/stringComp.test
index 0d134b5..165ef20 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -704,20 +704,20 @@ test stringComp-12.1 {Bug 3588366: end-offsets before start} {
 
 ## string replace
 test stringComp-14.1 {Bug 82e7f67325} {
-    apply {{} {
-	set a [join {a b} {}]
+    apply {x {
+	set a [join $x {}]
 	lappend b [string length [string replace ___! 0 2 $a]]
 	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
-    }}
+    }} {a b}
 } {3 3}
 test stringComp-14.2 {Bug 82e7f67325} memory {
     # As in stringComp-14.1, but make sure we don't retain too many refs
     leaktest {
-	apply {{} {
-	    set a [join {a b} {}]
+	apply {x {
+	    set a [join $x {}]
 	    lappend b [string length [string replace ___! 0 2 $a]]
 	    lappend b [string length [string replace ___! 0 2 $a[unset a]]]
-	}}
+	}} {a b}
     }
 } {0}
 
-- 
cgit v0.12


From cf5a2fcdb5b8dd834e530641922f7ba5c841553f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 1 May 2014 14:18:35 +0000
Subject: We must Preserve channels if we're going to use
 TclChanCaughtErrorBypass() to get error information after channel routines
 are called (and have possibly called for the channel to go away).

---
 generic/tclIOCmd.c | 26 ++++++++++++++++++++++----
 1 file changed, 22 insertions(+), 4 deletions(-)

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 7e8e91a..b206303 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -177,6 +177,7 @@ Tcl_PutsObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     result = Tcl_WriteObj(chan, string);
     if (result < 0) {
 	goto error;
@@ -187,6 +188,7 @@ Tcl_PutsObjCmd(
 	    goto error;
 	}
     }
+    Tcl_Release(chan);
     return TCL_OK;
 
     /*
@@ -202,6 +204,7 @@ Tcl_PutsObjCmd(
 		TclGetString(chanObjPtr), "\": ",
 		Tcl_PosixError(interp), NULL);
     }
+    Tcl_Release(chan);
     return TCL_ERROR;
 }
 
@@ -248,6 +251,7 @@ Tcl_FlushObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     if (Tcl_Flush(chan) != TCL_OK) {
 	/*
 	 * TIP #219.
@@ -261,8 +265,10 @@ Tcl_FlushObjCmd(
 		    TclGetString(chanObjPtr), "\": ",
 		    Tcl_PosixError(interp), NULL);
 	}
+	Tcl_Release(chan);
 	return TCL_ERROR;
     }
+    Tcl_Release(chan);
     return TCL_OK;
 }
 
@@ -295,6 +301,7 @@ Tcl_GetsObjCmd(
     int lineLen;		/* Length of line just read. */
     int mode;			/* Mode in which channel is opened. */
     Tcl_Obj *linePtr, *chanObjPtr;
+    int code = TCL_OK;
 
     if ((objc != 2) && (objc != 3)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
@@ -310,6 +317,7 @@ Tcl_GetsObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     linePtr = Tcl_NewObj();
     lineLen = Tcl_GetsObj(chan, linePtr);
     if (lineLen < 0) {
@@ -329,7 +337,8 @@ Tcl_GetsObjCmd(
 			TclGetString(chanObjPtr), "\": ",
 			Tcl_PosixError(interp), NULL);
 	    }
-	    return TCL_ERROR;
+	    code = TCL_ERROR;
+	    goto done;
 	}
 	lineLen = -1;
     }
@@ -339,11 +348,12 @@ Tcl_GetsObjCmd(
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
-	return TCL_OK;
     } else {
 	Tcl_SetObjResult(interp, linePtr);
     }
-    return TCL_OK;
+  done:
+    Tcl_Release(chan);
+    return code;
 }
 
 /*
@@ -542,6 +552,7 @@ Tcl_SeekObjCmd(
 	mode = modeArray[optionIndex];
     }
 
+    Tcl_Preserve(chan);
     result = Tcl_Seek(chan, offset, mode);
     if (result == Tcl_LongAsWide(-1)) {
 	/*
@@ -555,8 +566,10 @@ Tcl_SeekObjCmd(
 		    TclGetString(objv[1]), "\": ",
 		    Tcl_PosixError(interp), NULL);
 	}
+	Tcl_Release(chan);
 	return TCL_ERROR;
     }
+    Tcl_Release(chan);
     return TCL_OK;
 }
 
@@ -587,6 +600,7 @@ Tcl_TellObjCmd(
 {
     Tcl_Channel chan;		/* The channel to tell on. */
     Tcl_WideInt newLoc;
+    int code;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
@@ -602,6 +616,7 @@ Tcl_TellObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     newLoc = Tcl_Tell(chan);
 
     /*
@@ -610,7 +625,10 @@ Tcl_TellObjCmd(
      * them into the regular interpreter result.
      */
 
-    if (TclChanCaughtErrorBypass(interp, chan)) {
+
+    code  = TclChanCaughtErrorBypass(interp, chan);
+    Tcl_Release(chan);
+    if (code) {
 	return TCL_ERROR;
     }
 
-- 
cgit v0.12


From b18161555e63f857014d2306adcb9fbcad3c6144 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 1 May 2014 16:33:39 +0000
Subject: Stop the segfault in iogt-2.4.  First by changing the
 UpdateInterest() call that triggers it.  "downChanPtr" may no longer be the
 right argument at that point.  Second, after ending the segfault, the test
 became an infinite loop (nested unstacking?!  whoa.), so revised the test to
 one that terminates (and passes).  Left behind a comment that the recursive
 unstacking case may require more examination.

---
 generic/tclIO.c | 9 ++++++++-
 tests/iogt.test | 2 +-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 776ff12..a83cdcd 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1876,6 +1876,13 @@ Tcl_UnstackChannel(
 	 * into the old structure.
 	 */
 
+	/*
+	 * TODO: Figure out how to handle the situation where the chan
+	 * operations called below by this unstacking operation cause
+	 * another unstacking recursively.  In that case the downChanPtr
+	 * value we're holding on to will not be the right thing.
+	 */
+
 	Channel *downChanPtr = chanPtr->downChanPtr;
 
 	/*
@@ -1980,7 +1987,7 @@ Tcl_UnstackChannel(
 	 */
 
 	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
-	UpdateInterest(downChanPtr);
+	UpdateInterest(statePtr->topChanPtr);
 
 	if (result != 0) {
 	    Tcl_SetErrno(result);
diff --git a/tests/iogt.test b/tests/iogt.test
index bd3c67b..ded8bb9 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -228,7 +228,7 @@ proc id_torture {chan op data} {
 	delete/read  -
 	clear_read   {;#ignore}
 	flush/write -
-	flush/read  -
+	flush/read  {}
 	write       -
 	read        {
 	    testchannel unstack $chan
-- 
cgit v0.12


From 4f1714013f16d9993d2d68175d81fdb91ffc8190 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 2 May 2014 12:39:14 +0000
Subject: Re-enable buffer recycling.

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index a83cdcd..8ae2fd2 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2360,7 +2360,7 @@ RecycleBuffer(
 	mustDiscard = 1;
     }
 
-    if (1 || mustDiscard) {
+    if (mustDiscard) {
 	ReleaseChannelBuffer(bufPtr);
 	return;
     }
-- 
cgit v0.12


From 3452d681c93ec5cab5edc2d45bbd0d02f9beadb1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 2 May 2014 13:02:48 +0000
Subject: Fully restore topChan resetting to accommodate self-restacking
 channels.

---
 generic/tclIO.c | 43 ++++++++++++++++++++++++++-----------------
 1 file changed, 26 insertions(+), 17 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 8ae2fd2..adea32e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4554,9 +4554,12 @@ Tcl_GetsObj(
      * Regenerate the top channel, in case it was changed due to
      * self-modifying reflected transforms.
      */
-    /*
-    chanPtr = statePtr->topChanPtr;
-     */
+
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_Release(chanPtr);
+	chanPtr = statePtr->topChanPtr;
+	Tcl_Preserve(chanPtr);
+    }
 
     bufPtr = gs.bufPtr;
     if (bufPtr == NULL) {
@@ -4590,9 +4593,11 @@ Tcl_GetsObj(
      * Regenerate the top channel, in case it was changed due to
      * self-modifying reflected transforms.
      */
-    /*
-    chanPtr = statePtr->topChanPtr;
-     */
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_Release(chanPtr);
+	chanPtr = statePtr->topChanPtr;
+	Tcl_Preserve(chanPtr);
+    }
     bufPtr = statePtr->inQueueHead;
     if (bufPtr != NULL) {
 	bufPtr->nextRemoved = oldRemoved;
@@ -4632,9 +4637,11 @@ Tcl_GetsObj(
      * Regenerate the top channel, in case it was changed due to
      * self-modifying reflected transforms.
      */
-    /*
-    chanPtr = statePtr->topChanPtr;
-     */
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_Release(chanPtr);
+	chanPtr = statePtr->topChanPtr;
+	Tcl_Preserve(chanPtr);
+    }
     UpdateInterest(chanPtr);
     Tcl_Release(chanPtr);
     return copiedTotal;
@@ -5638,11 +5645,11 @@ DoReadChars(
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
 	    result = GetInput(chanPtr);
-if (chanPtr != statePtr->topChanPtr) {
-Tcl_Release(chanPtr);
-chanPtr = statePtr->topChanPtr;
-Tcl_Preserve(chanPtr);
-}
+	    if (chanPtr != statePtr->topChanPtr) {
+		Tcl_Release(chanPtr);
+		chanPtr = statePtr->topChanPtr;
+		Tcl_Preserve(chanPtr);
+	    }
 	    if (result != 0) {
 		if (result == EAGAIN) {
 		    break;
@@ -5673,9 +5680,11 @@ Tcl_Preserve(chanPtr);
      * Regenerate the top channel, in case it was changed due to
      * self-modifying reflected transforms.
      */
-    /*
-    chanPtr = statePtr->topChanPtr;
-     */
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_Release(chanPtr);
+	chanPtr = statePtr->topChanPtr;
+	Tcl_Preserve(chanPtr);
+    }
     UpdateInterest(chanPtr);
     Tcl_Release(chanPtr);
     return copied;
-- 
cgit v0.12


From ab2c4a52f1dbcc67939ad86233d21cf7fc38a5cd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 2 May 2014 14:45:03 +0000
Subject: Add some comments about possible other self-restacking troubles.

---
 generic/tclIO.c | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index adea32e..58c7b3c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1747,6 +1747,10 @@ Tcl_StackChannel(
 	statePtr->csPtrR = NULL;
 	statePtr->csPtrW = NULL;
 
+	/*
+	 * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
+	 * the stacking state of this channel during its operations.
+	 */
 	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
 	    statePtr->csPtrR = csPtrR;
 	    statePtr->csPtrW = csPtrW;
@@ -9786,12 +9790,15 @@ StackSetBlockMode(
 {
     int result = 0;
     Tcl_DriverBlockModeProc *blockModeProc;
+    ChannelState *statePtr = chanPtr->state;
 
     /*
      * Start at the top of the channel stack
+     * TODO: Examine what can go wrong when blockModeProc calls
+     * disturb the stacking state of the channel.
      */
 
-    chanPtr = chanPtr->state->topChanPtr;
+    chanPtr = statePtr->topChanPtr;
     while (chanPtr != NULL) {
 	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
 	if (blockModeProc != NULL) {
-- 
cgit v0.12


From b0f443a7d7b38c2220cfb1b1c0710a804f55c811 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 5 May 2014 09:17:46 +0000
Subject: Backport "GotFlag" macro from Tcl 8.6. Makes code more readable. No
 change in functionality.

---
 generic/tclIO.c | 186 +++++++++++++++++++++++++++-----------------------------
 1 file changed, 89 insertions(+), 97 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 46a17f5..2f652e7 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -298,6 +298,7 @@ static int WillRead(Channel *chanPtr);
 
 #define SetFlag(statePtr, flag)		((statePtr)->flags |= (flag))
 #define ResetFlag(statePtr, flag)	((statePtr)->flags &= ~(flag))
+#define GotFlag(statePtr, flag)		((statePtr)->flags & (flag))
 
 /*
  * Macro for testing whether a string (in optionName, length len) matches a
@@ -463,7 +464,7 @@ TclFinalizeIOSubsystem(void)
 		statePtr != NULL;
 		statePtr = statePtr->nextCSPtr) {
 	    chanPtr = statePtr->topChanPtr;
-	    if (!(statePtr->flags & (CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD))) {
+	    if (!GotFlag(statePtr, CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD)) {
 		active = 1;
 		break;
 	    }
@@ -560,6 +561,7 @@ Tcl_SetStdChannel(
     int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
     switch (type) {
     case TCL_STDIN:
 	tsdPtr->stdinInitialized = 1;
@@ -676,11 +678,9 @@ Tcl_CreateCloseHandler(
     ClientData clientData)	/* Arbitrary data to pass to the close
 				 * callback. */
 {
-    ChannelState *statePtr;
+    ChannelState *statePtr = ((Channel *) chan)->state;
     CloseCallback *cbPtr;
 
-    statePtr = ((Channel *) chan)->state;
-
     cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
     cbPtr->proc = proc;
     cbPtr->clientData = clientData;
@@ -716,10 +716,9 @@ Tcl_DeleteCloseHandler(
     ClientData clientData)	/* The callback data for the callback to
 				 * remove. */
 {
-    ChannelState *statePtr;
+    ChannelState *statePtr = ((Channel *) chan)->state;
     CloseCallback *cbPtr, *cbPrevPtr;
 
-    statePtr = ((Channel *) chan)->state;
     for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;
 	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
 	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
@@ -873,7 +872,7 @@ DeleteChannelTable(
 	SetFlag(statePtr, CHANNEL_TAINTED);
 	statePtr->refCount--;
 	if (statePtr->refCount <= 0) {
-	    if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
 	    }
 	}
@@ -1064,7 +1063,7 @@ Tcl_UnregisterChannel(
 
     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
 
-    if (statePtr->flags & CHANNEL_INCLOSE) {
+    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
 	if (interp != NULL) {
 	    Tcl_AppendResult(interp, "Illegal recursive call to close "
 		    "through close-handler of channel", NULL);
@@ -1103,12 +1102,12 @@ Tcl_UnregisterChannel(
 	    SetFlag(statePtr, BUFFER_READY);
 	}
 	Tcl_Preserve((ClientData)statePtr);
-	if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	    /*
 	     * We don't want to re-enter Tcl_Close().
 	     */
 
-	    if (!(statePtr->flags & CHANNEL_CLOSED)) {
+	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
 		if (Tcl_Close(interp, chan) != TCL_OK) {
 		    SetFlag(statePtr, CHANNEL_CLOSED);
 		    Tcl_Release((ClientData)statePtr);
@@ -1317,7 +1316,7 @@ Tcl_GetChannel(
     chanPtr = Tcl_GetHashValue(hPtr);
     chanPtr = chanPtr->state->bottomChanPtr;
     if (modePtr != NULL) {
-	*modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
+	*modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE);
     }
 
     return (Tcl_Channel) chanPtr;
@@ -1365,7 +1364,7 @@ TclGetChannelFromObj(
     *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
 
     if (modePtr != NULL) {
-	*modePtr = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
+	*modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE);
     }
 
     return TCL_OK;
@@ -1645,13 +1644,10 @@ Tcl_StackChannel(
      */
 
     if ((mask & TCL_WRITABLE) != 0) {
-        CopyState *csPtrR;
-        CopyState *csPtrW;
+	CopyState *csPtrR = statePtr->csPtrR;
+	CopyState *csPtrW = statePtr->csPtrW;
 
-        csPtrR           = statePtr->csPtrR;
 	statePtr->csPtrR = NULL;
-
-        csPtrW           = statePtr->csPtrW;
 	statePtr->csPtrW = NULL;
 
 	/*
@@ -1807,14 +1803,11 @@ Tcl_UnstackChannel(
 	 * CheckForChannelErrors inside.
 	 */
 
-	if (statePtr->flags & TCL_WRITABLE) {
-	    CopyState *csPtrR;
-	    CopyState *csPtrW;
+	if (GotFlag(statePtr, TCL_WRITABLE)) {
+	    CopyState *csPtrR = statePtr->csPtrR;
+	    CopyState *csPtrW = statePtr->csPtrW;
 
-	    csPtrR           = statePtr->csPtrR;
 	    statePtr->csPtrR = NULL;
-
-	    csPtrW           = statePtr->csPtrW;
 	    statePtr->csPtrW = NULL;
 
 	    if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
@@ -1851,16 +1844,14 @@ Tcl_UnstackChannel(
 	 * 'DiscardInputQueued' on that.
 	 */
 
-	if ((((statePtr->flags & TCL_READABLE) != 0)) &&
+	if (GotFlag(statePtr, TCL_READABLE) &&
 		((statePtr->inQueueHead != NULL) ||
 		(chanPtr->inQueueHead != NULL))) {
-
 	    if ((statePtr->inQueueHead != NULL) &&
 		    (chanPtr->inQueueHead != NULL)) {
 		statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
 		statePtr->inQueueTail = chanPtr->inQueueTail;
 		statePtr->inQueueHead = statePtr->inQueueTail;
-
 	    } else if (chanPtr->inQueueHead != NULL) {
 		statePtr->inQueueHead = chanPtr->inQueueHead;
 		statePtr->inQueueTail = chanPtr->inQueueTail;
@@ -2312,7 +2303,7 @@ RecycleBuffer(
      * Only save buffers for the input queue if the channel is readable.
      */
 
-    if (statePtr->flags & TCL_READABLE) {
+    if (GotFlag(statePtr, TCL_READABLE)) {
 	if (statePtr->inQueueHead == NULL) {
 	    statePtr->inQueueHead = bufPtr;
 	    statePtr->inQueueTail = bufPtr;
@@ -2328,7 +2319,7 @@ RecycleBuffer(
      * Only save buffers for the output queue if the channel is writable.
      */
 
-    if (statePtr->flags & TCL_WRITABLE) {
+    if (GotFlag(statePtr, TCL_WRITABLE)) {
 	if (statePtr->curOutPtr == NULL) {
 	    statePtr->curOutPtr = bufPtr;
 	    goto keepBuffer;
@@ -2401,7 +2392,7 @@ CheckForDeadChannel(
     Tcl_Interp *interp,		/* For error reporting (can be NULL) */
     ChannelState *statePtr)	/* The channel state to check. */
 {
-    if (statePtr->flags & CHANNEL_DEAD) {
+    if (GotFlag(statePtr, CHANNEL_DEAD)) {
 	Tcl_SetErrno(EINVAL);
 	if (interp) {
 	    Tcl_AppendResult(interp,
@@ -2477,7 +2468,7 @@ FlushChannel(
 
 	if (((statePtr->curOutPtr != NULL) &&
 		IsBufferFull(statePtr->curOutPtr))
-		|| ((statePtr->flags & BUFFER_READY) &&
+		|| (GotFlag(statePtr, BUFFER_READY) &&
 			(statePtr->outQueueHead == NULL))) {
 	    ResetFlag(statePtr, BUFFER_READY);
 	    statePtr->curOutPtr->nextPtr = NULL;
@@ -2496,8 +2487,7 @@ FlushChannel(
 	 * is active, we just return without producing any output.
 	 */
 
-	if ((!calledFromAsyncFlush) &&
-		(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+	if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	    return 0;
 	}
 
@@ -2551,7 +2541,7 @@ FlushChannel(
 		 * it's a tty channel (dup'ed underneath)
 		 */
 
-		if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);
 		    UpdateInterest(chanPtr);
 		}
@@ -2651,7 +2641,7 @@ FlushChannel(
      * data has been flushed at the system level.
      */
 
-    if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	if (wroteSome) {
 	    return errorCode;
 	} else if (statePtr->outQueueHead == NULL) {
@@ -2667,7 +2657,7 @@ FlushChannel(
      * current output buffer.
      */
 
-    if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
+    if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
 	    (statePtr->outQueueHead == NULL) &&
 	    ((statePtr->curOutPtr == NULL) ||
 	    IsBufferEmpty(statePtr->curOutPtr))) {
@@ -2743,7 +2733,7 @@ CloseChannel(
      * device.
      */
 
-    if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
+    if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
 	int dummy;
 	char c = (char) statePtr->outEofChar;
 
@@ -3148,7 +3138,7 @@ Tcl_Close(
 	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
     }
 
-    if (statePtr->flags & CHANNEL_INCLOSE) {
+    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
 	if (interp) {
 	    Tcl_AppendResult(interp, "Illegal recursive call to close "
 		    "through close-handler of channel", NULL);
@@ -3673,7 +3663,7 @@ Write(
 
     endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
 
-    if ((statePtr->flags & CHANNEL_LINEBUFFERED)
+    if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
 	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
 	nextNewLine = memchr(src, '\n', srcLen);
     }
@@ -3803,8 +3793,8 @@ Write(
 	}
 	ReleaseChannelBuffer(bufPtr);
     }
-    if ((flushed < total) && (statePtr->flags & CHANNEL_UNBUFFERED ||
-	    (needNlFlush && statePtr->flags & CHANNEL_LINEBUFFERED))) {
+    if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
+	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
 	SetFlag(statePtr, BUFFER_READY);
 	if (FlushChannel(NULL, chanPtr, 0) != 0) {
 	    return -1;
@@ -4049,7 +4039,7 @@ Tcl_GetsObj(
 	case TCL_TRANSLATE_AUTO:
 	    eol = dst;
 	    skip = 1;
-	    if (statePtr->flags & INPUT_SAW_CR) {
+	    if (GotFlag(statePtr, INPUT_SAW_CR)) {
 		ResetFlag(statePtr, INPUT_SAW_CR);
 		if ((eol < dstEnd) && (*eol == '\n')) {
 		    /*
@@ -4117,7 +4107,7 @@ Tcl_GetsObj(
 	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	}
-	if (statePtr->flags & CHANNEL_EOF) {
+	if (GotFlag(statePtr, CHANNEL_EOF)) {
 	    skip = 0;
 	    eol = dstEnd;
 	    if (eol == objPtr->bytes + oldLength) {
@@ -4328,8 +4318,8 @@ TclGetsObjBinary(
 	     * device. Side effect is to allocate another channel buffer.
 	     */
 
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    goto restore;
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4383,7 +4373,7 @@ TclGetsObjBinary(
 	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	}
-	if (statePtr->flags & CHANNEL_EOF) {
+	if (GotFlag(statePtr, CHANNEL_EOF)) {
 	    skip = 0;
 	    eol = dstEnd;
 	    if ((dst == dstEnd) && (byteLen == oldLength)) {
@@ -4598,8 +4588,8 @@ FilterInputBytes(
 	 */
 
     read:
-	if (statePtr->flags & CHANNEL_BLOCKED) {
-	    if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		gsPtr->charsWrote = 0;
 		gsPtr->rawRead = 0;
 		return -1;
@@ -4684,7 +4674,7 @@ FilterInputBytes(
 		 * returning those UTF-8 characters because a EOL might be
 		 * present in them.
 		 */
-	    } else if (statePtr->flags & CHANNEL_EOF) {
+	    } else if (GotFlag(statePtr, CHANNEL_EOF)) {
 		/*
 		 * There was a partial character followed by EOF on the
 		 * device. Fall through, returning that nothing was found.
@@ -4706,7 +4696,7 @@ FilterInputBytes(
 		statePtr->inQueueTail = nextPtr;
 	    }
 	    extra = rawLen - gsPtr->rawRead;
-	    memcpy(nextPtr->buf + BUFFER_PADDING - extra,
+	    memcpy(nextPtr->buf + (BUFFER_PADDING - extra),
 		    raw + gsPtr->rawRead, (size_t) extra);
 	    nextPtr->nextRemoved -= extra;
 	    bufPtr->nextAdded -= extra;
@@ -4773,7 +4763,7 @@ PeekAhead(
 
 		goto cleanup;
 	    }
-	    if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
+	    if (!GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
 		if (blockModeProc == NULL) {
 		    /*
@@ -4970,11 +4960,11 @@ Tcl_ReadRaw(
 	copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
 		bytesToRead - copied);
 	if (copiedNow == 0) {
-	    if (statePtr->flags & CHANNEL_EOF) {
+	    if (GotFlag(statePtr, CHANNEL_EOF)) {
 		goto done;
 	    }
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    goto done;
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4988,9 +4978,9 @@ Tcl_ReadRaw(
 	     * and only if we are sure to have data.
 	     */
 
-	    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
 		    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-		    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+		    !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
 		/*
 		 * We bypass the driver; it would block as no data is
 		 * available.
@@ -5231,11 +5221,11 @@ DoReadChars(
 	}
 
 	if (copiedNow < 0) {
-	    if (statePtr->flags & CHANNEL_EOF) {
+	    if (GotFlag(statePtr, CHANNEL_EOF)) {
 		break;
 	    }
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    break;
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -5362,7 +5352,7 @@ ReadBytes(
     }
     dst += offset;
 
-    if (statePtr->flags & INPUT_NEED_NL) {
+    if (GotFlag(statePtr, INPUT_NEED_NL)) {
 	ResetFlag(statePtr, INPUT_NEED_NL);
 	if ((srcLen == 0) || (*src != '\n')) {
 	    *dst = '\r';
@@ -5543,7 +5533,7 @@ ReadChars(
     }
 
     oldState = statePtr->inputEncodingState;
-    if (statePtr->flags & INPUT_NEED_NL) {
+    if (GotFlag(statePtr, INPUT_NEED_NL)) {
 	/*
 	 * We want a '\n' because the last character we saw was '\r'.
 	 */
@@ -5809,7 +5799,7 @@ TranslateInputEOL(
 	srcEnd = srcStart + dstLen;
 	srcMax = srcStart + *srcLenPtr;
 
-	if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+	if (GotFlag(statePtr, INPUT_SAW_CR) && (src < srcMax)) {
 	    if (*src == '\n') {
 		src++;
 	    }
@@ -5914,7 +5904,7 @@ Tcl_Ungets(
      * bit. We want to discover these conditions anew in each operation.
      */
 
-    if (statePtr->flags & CHANNEL_STICKY_EOF) {
+    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
 	goto done;
     }
     ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
@@ -6171,7 +6161,7 @@ GetInput(
      * platforms it is impossible to read from a device after EOF.
      */
 
-    if (statePtr->flags & CHANNEL_EOF) {
+    if (GotFlag(statePtr, CHANNEL_EOF)) {
 	return 0;
     }
 
@@ -6183,9 +6173,9 @@ GetInput(
      * sure to have data.
      */
 
-    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+    if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
 	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+	    !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
 	/*
 	 * Bypass the driver, it would block, as no data is available
 	 */
@@ -6355,14 +6345,14 @@ Tcl_Seek(
      */
 
     wasAsync = 0;
-    if (statePtr->flags & CHANNEL_NONBLOCKING) {
+    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 	wasAsync = 1;
 	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
 	if (result != 0) {
 	    return Tcl_LongAsWide(-1);
 	}
 	ResetFlag(statePtr, CHANNEL_NONBLOCKING);
-	if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
 	}
     }
@@ -6698,8 +6688,7 @@ CheckChannelErrors(
      * order to drain data from stacked channels.
      */
 
-    if ((statePtr->flags & CHANNEL_CLOSED) &&
-	    ((flags & CHANNEL_RAW_MODE) == 0)) {
+    if (GotFlag(statePtr, CHANNEL_CLOSED) && !(flags & CHANNEL_RAW_MODE)) {
 	Tcl_SetErrno(EACCES);
 	return -1;
     }
@@ -6721,7 +6710,7 @@ CheckChannelErrors(
      * retrieving and transforming the data to copy.
      */
 
-    if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
+    if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
 	Tcl_SetErrno(EBUSY);
 	return -1;
     }
@@ -6734,7 +6723,7 @@ CheckChannelErrors(
 	 * discover these conditions anew in each operation.
 	 */
 
-	if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
+	if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
 	    ResetFlag(statePtr, CHANNEL_EOF);
 	}
 	ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
@@ -6766,8 +6755,8 @@ Tcl_Eof(
     ChannelState *statePtr = ((Channel *) chan)->state;
 				/* State of real channel structure. */
 
-    return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
-	    ((statePtr->flags & CHANNEL_EOF) &&
+    return (GotFlag(statePtr, CHANNEL_STICKY_EOF) ||
+	    (GotFlag(statePtr, CHANNEL_EOF) &&
 	    (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
 }
 
@@ -6794,7 +6783,7 @@ Tcl_InputBlocked(
     ChannelState *statePtr = ((Channel *) chan)->state;
 				/* State of real channel structure. */
 
-    return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
+    return GotFlag(statePtr, CHANNEL_BLOCKED) ? 1 : 0;
 }
 
 /*
@@ -7437,10 +7426,10 @@ Tcl_SetChannelOption(
 		ckfree((char *) argv);
 		return TCL_ERROR;
 	    }
-	    if (statePtr->flags & TCL_READABLE) {
+	    if (GotFlag(statePtr, TCL_READABLE)) {
 		statePtr->inEofChar = inValue;
 	    }
-	    if (statePtr->flags & TCL_WRITABLE) {
+	    if (GotFlag(statePtr, TCL_WRITABLE)) {
 		statePtr->outEofChar = outValue;
 	    }
 	} else {
@@ -7474,11 +7463,11 @@ Tcl_SetChannelOption(
 	}
 
 	if (argc == 1) {
-	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
-	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
+	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;
 	} else if (argc == 2) {
-	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
-	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
+	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
 	} else {
 	    if (interp) {
 		Tcl_AppendResult(interp,
@@ -7694,9 +7683,9 @@ Tcl_NotifyChannel(
      */
 
     if ((mask & TCL_READABLE) &&
-	    (statePtr->flags & CHANNEL_NONBLOCKING) &&
+	    GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
 	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !(statePtr->flags & CHANNEL_TIMER_FEV)) {
+	    !GotFlag(statePtr, CHANNEL_TIMER_FEV)) {
 	SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
     }
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
@@ -7759,7 +7748,7 @@ Tcl_NotifyChannel(
      * don't call any write handlers before the flush is complete.
      */
 
-    if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
 	FlushChannel(NULL, chanPtr, 1);
 	mask &= ~TCL_WRITABLE;
     }
@@ -7839,7 +7828,7 @@ UpdateInterest(
      * watch for the channel to become writable.
      */
 
-    if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	mask |= TCL_WRITABLE;
     }
 
@@ -7851,7 +7840,7 @@ UpdateInterest(
      */
 
     if (mask & TCL_READABLE) {
-	if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+	if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
 		&& (statePtr->inQueueHead != NULL)
 		&& IsBufferReady(statePtr->inQueueHead)) {
 	    mask &= ~TCL_READABLE;
@@ -7930,7 +7919,7 @@ ChannelTimerProc(
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
 
-    if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+    if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
 	    && (statePtr->interestMask & TCL_READABLE)
 	    && (statePtr->inQueueHead != NULL)
 	    && IsBufferReady(statePtr->inQueueHead)) {
@@ -7950,14 +7939,14 @@ ChannelTimerProc(
 	 * similar test is done in "PeekAhead".
 	 */
 
-	if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
+	if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
+		(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
 	    SetFlag(statePtr, CHANNEL_TIMER_FEV);
 	}
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
 	Tcl_Preserve(statePtr);
-	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
+	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
 	ResetFlag(statePtr, CHANNEL_TIMER_FEV);
@@ -8920,7 +8909,7 @@ DoRead(
      */
 
     Tcl_Preserve(chanPtr);
-    if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
+    if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
 	ResetFlag(statePtr, CHANNEL_EOF);
     }
     ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
@@ -8929,11 +8918,11 @@ DoRead(
 	copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
 		toRead - copied);
 	if (copiedNow == 0) {
-	    if (statePtr->flags & CHANNEL_EOF) {
+	    if (GotFlag(statePtr, CHANNEL_EOF)) {
 		goto done;
 	    }
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    goto done;
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -9088,7 +9077,7 @@ CopyAndTranslateBuffer(
 	    curByte = *src;
 	    if (curByte == '\n') {
 		ResetFlag(statePtr, INPUT_SAW_CR);
-	    } else if (statePtr->flags & INPUT_SAW_CR) {
+	    } else if (GotFlag(statePtr, INPUT_SAW_CR)) {
 		ResetFlag(statePtr, INPUT_SAW_CR);
 		*dst = '\r';
 		dst++;
@@ -9131,7 +9120,7 @@ CopyAndTranslateBuffer(
 		*dst = '\n';
 		dst++;
 	    } else {
-		if ((curByte != '\n') || !(statePtr->flags & INPUT_SAW_CR)) {
+		if ((curByte != '\n') || !GotFlag(statePtr, INPUT_SAW_CR)) {
 		    *dst = (char) curByte;
 		    dst++;
 		}
@@ -10551,8 +10540,9 @@ SetChannelFromAny(
 	 * The channel is valid until any call to DetachChannel occurs.
 	 * Ensure consistency checks are done.
 	 */
-	statePtr  = GET_CHANNELSTATE(objPtr);
-	if (statePtr->flags & (CHANNEL_TAINTED|CHANNEL_CLOSED)) {
+
+	statePtr = GET_CHANNELSTATE(objPtr);
+	if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
 	    ResetFlag(statePtr, CHANNEL_TAINTED);
 	    Tcl_Release((ClientData) statePtr);
 	    objPtr->typePtr = NULL;
@@ -10650,5 +10640,7 @@ DumpFlags(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
  * End:
  */
-- 
cgit v0.12


From 7d27109da91753ce0ed031d0c7c3eb095b0b7fed Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 5 May 2014 17:18:51 +0000
Subject: Segfaulting test (backport of iortrans-5.11).

---
 tests/iogt.test | 22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

diff --git a/tests/iogt.test b/tests/iogt.test
index d81acd6..abe4246 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -251,7 +251,17 @@ proc id_torture {chan op data} {
 	clear_read   {;#ignore}
 	flush/write -
 	flush/read  {}
-	write       -
+	write       {
+	    global level
+	    if {$level} {
+		return
+	    }
+	    incr level
+	    testchannel unstack $chan
+	    testchannel transform $chan \
+		-command [namespace code [list id_torture $chan]]
+	    return $data
+	}
 	read        {
 	    testchannel unstack $chan
 	    testchannel transform $chan \
@@ -665,6 +675,16 @@ test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
     close   $fh
     set x
 } {}
+test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
+    set ::level 0
+    set fh [open $path(dummyout) w]
+    torture -attach $fh
+    puts -nonewline $fh abcdef
+    flush $fh
+    testchannel unstack $fh
+    close   $fh
+    set x
+} {}
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
 	{testchannel unknownFailure} {
-- 
cgit v0.12


From 0fc3bdcc7e6bd2903a1e84017073bf39dff8a3ad Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 May 2014 13:56:29 +0000
Subject: Have to manage the lifetime of the self handle in testchannel
 transform.

---
 generic/tclIOGT.c | 15 +++++++++++++--
 tests/iogt.test   |  1 -
 2 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index beddf4f..c5372b1 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -298,7 +298,6 @@ TclChannelTransform(
     }
     Tcl_DStringFree(&ds);
 
-    dataPtr->self = chan;
     dataPtr->watchMask = 0;
     dataPtr->mode = mode;
     dataPtr->timer = NULL;
@@ -317,6 +316,7 @@ TclChannelTransform(
 	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
+    Tcl_Preserve(dataPtr->self);
 
     /*
      * At last initialize the transformation at the script level.
@@ -437,6 +437,9 @@ ExecuteCallback(
 	break;
 
     case TRANSMIT_DOWN:
+	if (dataPtr->self == NULL) {
+	    break;
+	}
 	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
@@ -444,6 +447,9 @@ ExecuteCallback(
 	break;
 
     case TRANSMIT_SELF:
+	if (dataPtr->self == NULL) {
+	    break;
+	}
 	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
@@ -579,6 +585,8 @@ TransformCloseProc(
      * General cleanup.
      */
 
+    Tcl_Release(dataPtr->self);
+    dataPtr->self = NULL;
     ReleaseData(dataPtr);
     return TCL_OK;
 }
@@ -614,7 +622,7 @@ TransformInputProc(
      * Should assert(dataPtr->mode & TCL_READABLE);
      */
 
-    if (toRead == 0) {
+    if (toRead == 0 || dataPtr->self == NULL) {
 	/*
 	 * Catch a no-op.
 	 */
@@ -1083,6 +1091,9 @@ TransformWatchProc(
      * unchanged.
      */
 
+    if (dataPtr->self == NULL) {
+	return;
+    }
     downChan = Tcl_GetStackedChannel(dataPtr->self);
 
     Tcl_GetChannelType(downChan)->watchProc(
diff --git a/tests/iogt.test b/tests/iogt.test
index abe4246..d4291b3 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -683,7 +683,6 @@ test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
     flush $fh
     testchannel unstack $fh
     close   $fh
-    set x
 } {}
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
-- 
cgit v0.12


From e35a33106d2918d82903fa94e973f42fd5f28a1d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 May 2014 22:34:45 +0000
Subject: Stop memory leak in io-29.27.

---
 generic/tclIO.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2f652e7..fc3722c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2613,6 +2613,7 @@ FlushChannel(
 	     */
 
 	    DiscardOutputQueued(statePtr);
+	    ReleaseChannelBuffer(bufPtr);
 	    continue;
 	} else {
 	    wroteSome = 1;
-- 
cgit v0.12


From 06da97fda1d8384b5700cf28a14998a15ca94c0a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 May 2014 23:23:43 +0000
Subject: Stop memory leak in io-29.34

---
 generic/tclIO.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index fc3722c..b2b4e5c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2525,6 +2525,7 @@ FlushChannel(
 
 	    if (errorCode == EINTR) {
 		errorCode = 0;
+		ReleaseChannelBuffer(bufPtr);
 		continue;
 	    }
 
@@ -2546,6 +2547,7 @@ FlushChannel(
 		    UpdateInterest(chanPtr);
 		}
 		errorCode = 0;
+		ReleaseChannelBuffer(bufPtr);
 		break;
 	    }
 
-- 
cgit v0.12


From d9de529a706559caa6f3cadab3c54249eca3c8d9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 May 2014 23:51:32 +0000
Subject: Stop leak in io-33.7.

---
 generic/tclIOCmd.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index b206303..afd6272 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -345,7 +345,8 @@ Tcl_GetsObjCmd(
     if (objc == 3) {
 	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
 		TCL_LEAVE_ERR_MSG) == NULL) {
-	    return TCL_ERROR;
+	    code = TCL_ERROR;
+	    goto done;
 	}
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
     } else {
-- 
cgit v0.12


From 5c31837bdf02ca496a7764d983b7186c62228026 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 May 2014 02:28:56 +0000
Subject: Stop leak in io-53.5.

---
 generic/tclIO.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b2b4e5c..f2d1f44 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3787,6 +3787,7 @@ Write(
 
 	if (IsBufferFull(bufPtr)) {
 	    if (FlushChannel(NULL, chanPtr, 0) != 0) {
+		ReleaseChannelBuffer(bufPtr);
 		return -1;
 	    }
 	    flushed += statePtr->bufSize;
-- 
cgit v0.12


From 228272365c7aec6154a3468e75f99981152c7a3c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 May 2014 03:30:55 +0000
Subject: Stop leaks of cloned Tcl_ChannelTypes.

---
 generic/tclIORChan.c | 28 ++++++++++++++++++++--------
 1 file changed, 20 insertions(+), 8 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 17c1593..7630473 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -1019,6 +1019,7 @@ ReflectClose(
     Tcl_Obj *resObj;		/* Result data for 'close' */
     ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
     Tcl_HashEntry* hPtr;         /* Entry in the above map */
+    Tcl_ChannelType *tctPtr;
 
     if (TclInThreadExit()) {
 	/*
@@ -1055,6 +1056,11 @@ ReflectClose(
 	}
 #endif
 
+	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+	if (tctPtr && tctPtr != &tclRChannelType) {
+	    ckfree((char *)tctPtr);
+	    ((Channel *)rcPtr->chan)->typePtr = NULL;
+	}
         Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	return EOK;
     }
@@ -1118,6 +1124,11 @@ ReflectClose(
 	}
 #endif
 
+	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+	if (tctPtr && tctPtr != &tclRChannelType) {
+	    ckfree((char *)tctPtr);
+	    ((Channel *)rcPtr->chan)->typePtr = NULL;
+	}
         Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 #ifdef TCL_THREADS
     }
@@ -2033,13 +2044,6 @@ FreeReflectedChannel(
 {
     Channel *chanPtr = (Channel *) rcPtr->chan;
 
-    if (chanPtr->typePtr != &tclRChannelType) {
-	/*
-	 * Delete a cloned ChannelType structure.
-	 */
-
-	ckfree((char*) chanPtr->typePtr);
-    }
     Tcl_Release(chanPtr);
     Tcl_DecrRefCount(rcPtr->name);
     Tcl_DecrRefCount(rcPtr->methods);
@@ -2698,11 +2702,13 @@ ForwardProc(
 	 * call upon for the driver.
 	 */
 
-    case ForwardedClose:
+    case ForwardedClose: {
 	/*
 	 * No parameters/results.
 	 */
 
+	Tcl_ChannelType *tctPtr;
+
 	if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
@@ -2727,8 +2733,14 @@ ForwardProc(
 				  Tcl_GetChannelName (rcPtr->chan));
 	Tcl_DeleteHashEntry (hPtr);
 
+	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+	if (tctPtr && tctPtr != &tclRChannelType) {
+	    ckfree((char *)tctPtr);
+	    ((Channel *)rcPtr->chan)->typePtr = NULL;
+	}
         Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	break;
+    }
 
     case ForwardedInput: {
 	Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
-- 
cgit v0.12


From 7c1d853a93ed3c14acece6af7b054bed1a22b67b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 7 May 2014 22:19:30 +0000
Subject: Corrected description of where tcl_platform(user) comes from on Unix.

---
 doc/tclvars.n | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/doc/tclvars.n b/doc/tclvars.n
index b3e1bee..84823e0 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -284,8 +284,8 @@ was compiled with threads enabled.
 \fBuser\fR
 This identifies the
 current user based on the login information available on the platform.
-This comes from the USER or LOGNAME environment variable on Unix,
-and the value from GetUserName on Windows.
+This value comes from the getuid() and getpwuid() system calls on Unix,
+and the value from the GetUserName() system call on Windows.
 .TP
 \fBwordSize\fR
 This gives the size of the native-machine word in bytes (strictly, it
-- 
cgit v0.12


From 48ae7e42c1bd6a104c78d737fd6b826a1a4ee7bd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 8 May 2014 02:38:52 +0000
Subject: Stop leak in iocmd-21.22.

---
 generic/tclIO.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index f2d1f44..4628e90 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3607,6 +3607,7 @@ static int WillRead(Channel *chanPtr)
 {
     if (chanPtr->typePtr == NULL) {
 	/* Prevent read attempts on a closed channel */
+        DiscardInputQueued(chanPtr->state, 0);
 	Tcl_SetErrno(EINVAL);
 	return -1;
     }
-- 
cgit v0.12