From 18b04fd803de5db258180ee7d4d4d128a77fb03d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 9 Jul 2014 14:44:13 +0000
Subject: First draft of using buffer moves in place of buffer copies to create
 an efficient [chan copy].

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

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 5cdf2c3..1938173 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -182,6 +182,7 @@ static int		CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
 static int		CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
 static void		CommonGetsCleanup(Channel *chanPtr);
 static int		CopyData(CopyState *csPtr, int mask);
+static int		MoveBytes(CopyState *csPtr);
 static void		CopyEventProc(ClientData clientData, int mask);
 static void		CreateScriptRecord(Tcl_Interp *interp,
 			    Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
@@ -8778,6 +8779,7 @@ TclCopyChannel(
     int readFlags, writeFlags;
     CopyState *csPtr;
     int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
+    int moveBytes;
 
     inStatePtr = inPtr->state;
     outStatePtr = outPtr->state;
@@ -8829,13 +8831,27 @@ TclCopyChannel(
 	    | CHANNEL_UNBUFFERED;
 
     /*
+     * Very strict set of conditions where we know we can just move bytes
+     * from input channel to output channel with no transformation or even
+     * examination of the bytes themselves.
+     * TODO: Find ways to relax this.
+     */
+
+    moveBytes = inStatePtr->inEofChar == '\0'	/* No eofChar to stop input */
+	    && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
+	    && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
+	    && inStatePtr->encoding == NULL
+	    && outStatePtr->encoding == NULL
+	    && !nonBlocking;	/* First draft do only blocking case */
+
+    /*
      * Allocate a new CopyState to maintain info about the current copy in
      * progress. This structure will be deallocated when the copy is
      * completed.
      */
 
-    csPtr = ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
-    csPtr->bufSize = inStatePtr->bufSize;
+    csPtr = ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
+    csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
     csPtr->readPtr = inPtr;
     csPtr->writePtr = outPtr;
     csPtr->readFlags = readFlags;
@@ -8851,6 +8867,10 @@ TclCopyChannel(
     inStatePtr->csPtrR  = csPtr;
     outStatePtr->csPtrW = csPtr;
 
+    if (moveBytes) {
+	return MoveBytes(csPtr);
+    }
+
     /*
      * Special handling of -size 0 async transfers, so that the -command is
      * still called asynchronously.
@@ -8886,6 +8906,101 @@ TclCopyChannel(
  */
 
 static int
+MoveBytes(
+    CopyState *csPtr)		/* State of copy operation. */
+{
+    ChannelState *inStatePtr = csPtr->readPtr->state;
+    ChannelState *outStatePtr = csPtr->writePtr->state;
+    ChannelBuffer *bufPtr = outStatePtr->curOutPtr;
+    int code = TCL_OK;
+
+    if (bufPtr && BytesLeft(bufPtr)) {
+	/* If we start with unflushed bytes in the destination
+	 * channel, flush them out of the way first. */
+
+	if (0 != FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0)) {
+	    code = TCL_ERROR;
+	    goto done;
+	}
+    }
+
+    while (csPtr->toRead != 0) {
+	ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+	ChannelBuffer *tail = NULL;
+	int inBytes = 0;
+
+	if (bufPtr == NULL || BytesLeft(bufPtr) == 0) {
+	    /* Nothing in the input queue;  Get more input. */
+
+	    if (0 != GetInput(inStatePtr->topChanPtr)) { 
+		code = TCL_ERROR;
+		break;
+	    }
+	    bufPtr = inStatePtr->inQueueHead;
+	}
+
+	/* Count up number of bytes waiting in the input queue */
+	while (bufPtr) {
+	    inBytes += BytesLeft(bufPtr);
+	    tail = bufPtr;
+	    if (csPtr->toRead != -1 && csPtr->toRead < inBytes) {
+		/* Queue has enough bytes to complete the copy */
+		break;
+	    }
+	    bufPtr = bufPtr->nextPtr;
+	}
+
+	if (bufPtr) {
+	    /* Split the overflowing buffer in two */
+	    int extra = inBytes - csPtr->toRead;
+
+	    bufPtr = AllocChannelBuffer(extra);
+
+	    tail->nextAdded -= extra;
+	    memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra);
+	    bufPtr->nextAdded += extra;
+	    bufPtr->nextPtr = tail->nextPtr;
+	    tail->nextPtr = NULL;
+	    inBytes = csPtr->toRead;
+	}
+
+	/* Update the byte counts */
+	if (csPtr->toRead != -1) {
+	    csPtr->toRead -= inBytes;
+	}
+	csPtr->total += inBytes;
+
+	/* Move buffers from input to output channels */
+	if (outStatePtr->outQueueTail) {
+	    outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
+	} else {
+	    outStatePtr->outQueueHead = inStatePtr->inQueueHead;
+	}
+	outStatePtr->outQueueTail = tail;
+	inStatePtr->inQueueHead = bufPtr;
+	if (bufPtr == NULL) {
+	    inStatePtr->inQueueTail = NULL;
+	}
+
+	/* Flush destination */
+	if (0 != FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0)) {
+	    code = TCL_ERROR;
+	    break;
+	}
+	if (GotFlag(inStatePtr, CHANNEL_EOF)) {
+	    break;
+	}
+    }
+
+    if (code == TCL_OK) {
+	Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
+    }
+  done:
+    StopCopy(csPtr);
+    return code;
+}
+
+static int
 CopyData(
     CopyState *csPtr,		/* State of copy operation. */
     int mask)			/* Current channel event flags. */
-- 
cgit v0.12


From 1bd8f407a5fc44a8b7a54bb78d8d29a2e5b0358f Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 18 Jul 2014 12:18:44 +0000
Subject: [b43f2b49f7] New compilation strategy for lappend that allows
 multi-value lappend to not have quadratic performance (through better
 reference management).

---
 generic/tclAssembly.c   |   4 ++
 generic/tclCompCmdsGR.c |  60 +++++------------
 generic/tclCompile.c    |  13 ++++
 generic/tclCompile.h    |   7 +-
 generic/tclExecute.c    | 167 +++++++++++++++++++++++++++++++++++++++++++++++-
 5 files changed, 206 insertions(+), 45 deletions(-)

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index d1866c8..6d5676b 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -410,6 +410,10 @@ static const TalInstDesc TalInstructionTable[] = {
     {"lappendArray",	ASSEM_LVT,	(INST_LAPPEND_ARRAY1<<8
 					 | INST_LAPPEND_ARRAY4),2,	1},
     {"lappendArrayStk", ASSEM_1BYTE,	INST_LAPPEND_ARRAY_STK,	3,	1},
+    {"lappendList",	ASSEM_LVT4,	INST_LAPPEND_LIST,	1,	1},
+    {"lappendListArray",ASSEM_LVT4,	INST_LAPPEND_LIST_ARRAY,2,	1},
+    {"lappendListArrayStk", ASSEM_1BYTE,INST_LAPPEND_LIST_ARRAY_STK, 3,	1},
+    {"lappendListStk",	ASSEM_1BYTE,	INST_LAPPEND_LIST_STK,	2,	1},
     {"lappendStk",	ASSEM_1BYTE,	INST_LAPPEND_STK,	2,	1},
     {"le",		ASSEM_1BYTE,	INST_LE,		2,	1},
     {"lindexMulti",	ASSEM_LINDEX_MULTI,
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index b3e273f..166fea0 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -868,28 +868,16 @@ TclCompileLappendCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
-    int isScalar, localIndex, numWords, i, fwd, offsetFwd;
+    int isScalar, localIndex, numWords, i;
     DefineLineInformation;	/* TIP #280 */
 
-    /*
-     * If we're not in a procedure, don't compile.
-     */
-
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
-
     /* TODO: Consider support for compiling expanded args. */
     numWords = parsePtr->numWords;
     if (numWords == 1) {
 	return TCL_ERROR;
     }
-    if (numWords != 3) {
-	/*
-	 * LAPPEND instructions currently only handle one value, but we can
-	 * handle some multi-value cases by stringing them together.
-	 */
 
+    if (numWords != 3 || envPtr->procPtr == NULL) {
 	goto lappendMultiple;
     }
 
@@ -943,42 +931,28 @@ TclCompileLappendCmd(
     return TCL_OK;
 
   lappendMultiple:
-    /*
-     * Can only handle the case where we are appending to a local scalar when
-     * there are multiple values to append.  Fortunately, this is common.
-     */
-
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
+    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
 	    &localIndex, &isScalar, 1);
-    if (!isScalar || localIndex < 0) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Definitely appending to a local scalar; generate the words and append
-     * them.
-     */
-
     valueTokenPtr = TokenAfter(varTokenPtr);
     for (i = 2 ; i < numWords ; i++) {
 	CompileWord(envPtr, valueTokenPtr, interp, i);
 	valueTokenPtr = TokenAfter(valueTokenPtr);
     }
-    TclEmitInstInt4(	  INST_LIST, numWords-2,		envPtr);
-    TclEmitInstInt4(	  INST_EXIST_SCALAR, localIndex,	envPtr);
-    offsetFwd = CurrentOffset(envPtr);
-    TclEmitInstInt1(	  INST_JUMP_FALSE1, 0,			envPtr);
-    Emit14Inst(		  INST_LOAD_SCALAR, localIndex,		envPtr);
-    TclEmitInstInt4(	  INST_REVERSE, 2,			envPtr);
-    TclEmitOpcode(	  INST_LIST_CONCAT,			envPtr);
-    fwd = CurrentOffset(envPtr) - offsetFwd;
-    TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
-    Emit14Inst(		  INST_STORE_SCALAR, localIndex,	envPtr);
-
+    TclEmitInstInt4(	    INST_LIST, numWords-2,		envPtr);
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode(  INST_LAPPEND_LIST_STK,		envPtr);
+	} else {
+	    TclEmitInstInt4(INST_LAPPEND_LIST, localIndex,	envPtr);
+	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode(  INST_LAPPEND_LIST_ARRAY_STK,	envPtr);
+	} else {
+	    TclEmitInstInt4(INST_LAPPEND_LIST_ARRAY, localIndex,envPtr);
+	}
+    }
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 347e3f0..838b195 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -650,6 +650,19 @@ InstructionDesc const tclInstructionTable[] = {
 	 * satisfy the class check (standard definition of "all").
 	 * Stack:  ... stringValue => ... boolean */
 
+    {"lappendList",	 5,	0,	1,	{OPERAND_LVT4}},
+	/* Lappend list to scalar variable at op4 in frame.
+	 * Stack:  ... list => ... listVarContents */
+    {"lappendListArray", 5,	-1,	1,	{OPERAND_LVT4}},
+	/* Lappend list to array element; array at op4.
+	 * Stack:  ... elem list => ... listVarContents */
+    {"lappendListArrayStk", 1,	-2,	0,	{OPERAND_NONE}},
+	/* Lappend list to array element.
+	 * Stack:  ... arrayName elem list => ... listVarContents */
+    {"lappendListStk",	 1,	-1,	0,	{OPERAND_NONE}},
+	/* Lappend list to general variable.
+	 * Stack:  ... varName list => ... listVarContents */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5665ca9..fa4a360 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -799,8 +799,13 @@ typedef struct ByteCode {
 #define INST_TRY_CVT_TO_BOOLEAN		183
 #define INST_STR_CLASS			184
 
+#define INST_LAPPEND_LIST		185
+#define INST_LAPPEND_LIST_ARRAY		186
+#define INST_LAPPEND_LIST_ARRAY_STK	187
+#define INST_LAPPEND_LIST_STK		188
+
 /* The last opcode */
-#define LAST_INST_OPCODE		184
+#define LAST_INST_OPCODE		188
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0cd074d..2098e50 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3347,7 +3347,7 @@ TEBCresume(
      */
 
     {
-	int storeFlags;
+	int storeFlags, len;
 
     case INST_STORE_ARRAY4:
 	opnd = TclGetUInt4AtPtr(pc+1);
@@ -3587,6 +3587,171 @@ TEBCresume(
 #endif
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+    case INST_LAPPEND_LIST:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	valuePtr = OBJ_AT_TOS;
+	varPtr = LOCAL(opnd);
+	cleanup = 1;
+	pcAdjustment = 5;
+	while (TclIsVarLink(varPtr)) {
+	    varPtr = varPtr->value.linkPtr;
+	}
+	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+	if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+		!= TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	if (TclIsVarDirectReadable(varPtr)
+		&& TclIsVarDirectWritable(varPtr)) {
+	    goto lappendListDirect;
+	}
+	arrayPtr = NULL;
+	part1Ptr = part2Ptr = NULL;
+	goto lappendListPtr;
+
+    case INST_LAPPEND_LIST_ARRAY:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	valuePtr = OBJ_AT_TOS;
+	part1Ptr = NULL;
+	part2Ptr = OBJ_UNDER_TOS;
+	arrayPtr = LOCAL(opnd);
+	cleanup = 2;
+	pcAdjustment = 5;
+	while (TclIsVarLink(arrayPtr)) {
+	    arrayPtr = arrayPtr->value.linkPtr;
+	}
+	TRACE(("%u \"%.30s\" \"%.30s\" => ",
+		opnd, O2S(part2Ptr), O2S(valuePtr)));
+	if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+		!= TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)
+		&& !WriteTraced(arrayPtr)) {
+	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
+	    if (varPtr && TclIsVarDirectReadable(varPtr)
+		    && TclIsVarDirectWritable(varPtr)) {
+		goto lappendListDirect;
+	    }
+	}
+	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
+	if (varPtr == NULL) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	goto lappendListPtr;
+
+    case INST_LAPPEND_LIST_ARRAY_STK:
+	pcAdjustment = 1;
+	cleanup = 3;
+	valuePtr = OBJ_AT_TOS;
+	part2Ptr = OBJ_UNDER_TOS;	/* element name */
+	part1Ptr = OBJ_AT_DEPTH(2);	/* array name */
+	TRACE(("\"%.30s(%.30s)\" \"%.30s\" => ",
+		O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
+	goto lappendList;
+
+    case INST_LAPPEND_LIST_STK:
+	pcAdjustment = 1;
+	cleanup = 2;
+	valuePtr = OBJ_AT_TOS;
+	part2Ptr = NULL;
+	part1Ptr = OBJ_UNDER_TOS;	/* variable name */
+	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(part1Ptr), O2S(valuePtr)));
+	goto lappendList;
+
+    lappendListDirect:
+	objResultPtr = varPtr->value.objPtr;
+	if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	if (Tcl_IsShared(objResultPtr)) {
+	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
+
+	    TclDecrRefCount(objResultPtr);
+	    varPtr->value.objPtr = objResultPtr = newValue;
+	    Tcl_IncrRefCount(newValue);
+	}
+	if (Tcl_ListObjReplace(interp, objResultPtr, len, 0, objc, objv)
+		!= TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+    lappendList:
+	opnd = -1;
+	if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+		!= TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+	DECACHE_STACK_INFO();
+	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
+		TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
+	CACHE_STACK_INFO();
+	if (!varPtr) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+
+    lappendListPtr:
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)++;
+	}
+	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	    VarHashRefCount(arrayPtr)++;
+	}
+	DECACHE_STACK_INFO();
+	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
+		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
+	CACHE_STACK_INFO();
+	if (TclIsVarInHash(varPtr)) {
+	    VarHashRefCount(varPtr)--;
+	}
+	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
+	    VarHashRefCount(arrayPtr)--;
+	}
+
+	{
+	    int createdNewObj = 0;
+
+	    if (!objResultPtr) {
+		objResultPtr = valuePtr;
+	    } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    } else {
+		if (Tcl_IsShared(objResultPtr)) {
+		    objResultPtr = Tcl_DuplicateObj(objResultPtr);
+		    createdNewObj = 1;
+		}
+		if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv)
+			!= TCL_OK) {
+		    goto errorInLappendListPtr;
+		}
+	    }
+	    DECACHE_STACK_INFO();
+	    objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
+		    part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd);
+	    CACHE_STACK_INFO();
+	    if (!objResultPtr) {
+	    errorInLappendListPtr:
+		if (createdNewObj) {
+		    TclDecrRefCount(objResultPtr);
+		}
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
+	}
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+	NEXT_INST_V(pcAdjustment, cleanup, 1);
     }
 
     /*
-- 
cgit v0.12


From b32141b751698c59b7c8b574b52963976f3e0dd4 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 18 Jul 2014 22:05:16 +0000
Subject: [75b8433707] Plug a subtle memory leak in TclOO.

Test suite very unhappy with this.  Shoving into
a mistake branch until that's sorted.
---
 generic/tclOO.c |  1 +
 tests/oo.test   | 13 +++++++++++++
 2 files changed, 14 insertions(+)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index de00733..74de6d0 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1280,6 +1280,7 @@ TclOORemoveFromInstances(
 
   removeInstance:
     if (Deleted(clsPtr->thisPtr)) {
+	DelRef(clsPtr->instances.list[i]);
 	clsPtr->instances.list[i] = NULL;
     } else {
 	clsPtr->instances.num--;
diff --git a/tests/oo.test b/tests/oo.test
index d63e931..fcd9818 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -258,6 +258,19 @@ test oo-1.18 {OO: create object in NS with same name as global cmd} -setup {
     rename test-oo-1.18 {}
     A destroy
 } -result ::C
+test oo-1.18.1 {Bug 75b8433707: memory leak in oo-1.18} -setup {
+    proc test-oo-1.18 {} return
+} -constraints memory -body {
+    leaktest {
+	oo::class create A
+	oo::class create B {superclass A}
+	oo::define B constructor {} {A create test-oo-1.18}
+	B create C
+	A destroy
+    }
+} -cleanup {
+    rename test-oo-1.18 {}
+} -result 0
 test oo-1.19 {basic test of OO functionality: teardown order} -body {
     oo::object create o
     namespace delete [info object namespace o]
-- 
cgit v0.12


From 4a913825d6e04adfddffb4f70cd7d35ae6b92efb Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 21 Jul 2014 14:26:56 +0000
Subject: [e6477e1b0f] Plug memleak in AtForkChild() detected in iocmd-11.4.

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

diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index b234667..b2bea45 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -311,6 +311,7 @@ Tcl_InitNotifier(void)
 	 * pipe to the original notifier thread
 	 */
 	if (notifierCount > 0 && processIDInitialized != getpid()) {
+	    Tcl_ConditionFinalize(&notifierCV);
 	    notifierCount = 0;
 	    processIDInitialized = 0;
 	    close(triggerPipe);
@@ -1375,8 +1376,7 @@ AtForkParent(void)
 static void
 AtForkChild(void)
 {
-    notifierMutex = NULL;
-    notifierCV = NULL;
+    Tcl_MutexFinalize(&notifierMutex);
     Tcl_InitNotifier();
 }
 #endif /* HAVE_PTHREAD_ATFORK */
-- 
cgit v0.12


From b48cbaeccb8ec71c06c18c3eec115aad92346c38 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 22 Jul 2014 16:44:38 +0000
Subject: [12b0997ce7] Plug memleak in iocmd.tf-32.0 .

---
 generic/tclIORChan.c | 63 +++++++++++++++++++++++++++++++++-------------------
 1 file changed, 40 insertions(+), 23 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index ff602c6..3506a44 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -436,6 +436,7 @@ static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
 static void		DeleteReflectedChannelMap(ClientData clientData,
 			    Tcl_Interp *interp);
 static int		ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
+static void		MarkDead(ReflectedChannel *rcPtr);
 
 /*
  * Global constant strings (messages). ==================
@@ -1146,7 +1147,6 @@ ReflectClose(
 	    if (result != TCL_OK) {
 		FreeReceivedError(&p);
 	    }
-	    return EOK;
 	}
 #endif
 
@@ -1217,17 +1217,14 @@ ReflectClose(
 	if (hPtr) {
 	    Tcl_DeleteHashEntry(hPtr);
 	}
+    }
 #endif
-
-	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
-	if (tctPtr && tctPtr != &tclRChannelType) {
+    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
     }
-#endif
+    Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
     return (result == TCL_OK) ? EOK : EINVAL;
 }
 
@@ -2192,9 +2189,15 @@ FreeReflectedChannel(
     Channel *chanPtr = (Channel *) rcPtr->chan;
 
     Tcl_Release(chanPtr);
-    Tcl_DecrRefCount(rcPtr->name);
-    Tcl_DecrRefCount(rcPtr->methods);
-    Tcl_DecrRefCount(rcPtr->cmd);
+    if (rcPtr->name) {
+	Tcl_DecrRefCount(rcPtr->name);
+    }
+    if (rcPtr->methods) {
+	Tcl_DecrRefCount(rcPtr->methods);
+    }
+    if (rcPtr->cmd) {
+	Tcl_DecrRefCount(rcPtr->cmd);
+    }
     ckfree(rcPtr);
 }
 
@@ -2460,6 +2463,28 @@ GetReflectedChannelMap(
  */
 
 static void
+MarkDead(
+    ReflectedChannel *rcPtr)
+{
+    if (rcPtr->dead) {
+	return;
+    }
+    if (rcPtr->name) {
+	Tcl_DecrRefCount(rcPtr->name);
+	rcPtr->name = NULL;
+    }
+    if (rcPtr->methods) {
+	Tcl_DecrRefCount(rcPtr->methods);
+	rcPtr->methods = NULL;
+    }
+    if (rcPtr->cmd) {
+	Tcl_DecrRefCount(rcPtr->cmd);
+	rcPtr->cmd = NULL;
+    }
+    rcPtr->dead = 1;
+}
+
+static void
 DeleteReflectedChannelMap(
     ClientData clientData,	/* The per-interpreter data structure. */
     Tcl_Interp *interp)		/* The interpreter being deleted. */
@@ -2494,7 +2519,7 @@ DeleteReflectedChannelMap(
 	chan = Tcl_GetHashValue(hPtr);
 	rcPtr = Tcl_GetChannelInstanceData(chan);
 
-	rcPtr->dead = 1;
+	MarkDead(rcPtr);
 	Tcl_DeleteHashEntry(hPtr);
     }
     Tcl_DeleteHashTable(&rcmPtr->map);
@@ -2577,7 +2602,7 @@ DeleteReflectedChannelMap(
 	    continue;
 	}
 
-	rcPtr->dead = 1;
+	MarkDead(rcPtr);
 	Tcl_DeleteHashEntry(hPtr);
     }
 #endif
@@ -2724,7 +2749,7 @@ DeleteThreadReflectedChannelMap(
 	Tcl_Channel chan = Tcl_GetHashValue(hPtr);
 	ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
 
-	rcPtr->dead = 1;
+	MarkDead(rcPtr);
 	Tcl_DeleteHashEntry(hPtr);
     }
     ckfree(rcmPtr);
@@ -2907,8 +2932,6 @@ ForwardProc(
 	 * No parameters/results.
 	 */
 
-	const Tcl_ChannelType *tctPtr;
-
 	if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
@@ -2932,13 +2955,7 @@ ForwardProc(
 	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
                 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);
+	MarkDead(rcPtr);
 	break;
     }
 
-- 
cgit v0.12


From 531afdcf4e0d725402db70a2b207305dfa7f8903 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 22 Jul 2014 18:12:27 +0000
Subject: Avoid [thread::exit]; Using it leads to memleaks.

---
 tests/ioCmd.test | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 8d35ec7..dcca1f5 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -2814,7 +2814,9 @@ test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
 	    update
 	}
 	LOG THREAD-LOOP-DONE
-	thread::exit
+	#thread::exit
+	# Thread exits cause leaks;  Use clean thread shutdown
+	set forever yourGirl
     }
 
     LOG MAIN_WAITING
-- 
cgit v0.12


From 91e311e52d7fd08f0eb70ddd211e5aa51a5e2d22 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 22 Jul 2014 19:57:51 +0000
Subject: Workaround [info frame] troubles with -singleproc 1 testing
 operations.

---
 tests/all.tcl | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/tests/all.tcl b/tests/all.tcl
index 05d3024..0a6f57f 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -15,5 +15,8 @@ package require Tcl 8.5
 package require tcltest 2.2
 namespace import tcltest::*
 configure {*}$argv -testdir [file dir [info script]]
+if {[singleProcess]} {
+    interp debug {} -frame 1
+}
 runAllTests
 proc exit args {}
-- 
cgit v0.12


From e2d932c2e380daab4ccf6f1a2fa6a0a43e66f425 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 23 Jul 2014 17:10:26 +0000
Subject: Extend the buffer move optimization to the "same encodings" case.

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

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 256b411..6718788 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8840,8 +8840,9 @@ TclCopyChannel(
     moveBytes = inStatePtr->inEofChar == '\0'	/* No eofChar to stop input */
 	    && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
 	    && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
-	    && inStatePtr->encoding == NULL
-	    && outStatePtr->encoding == NULL
+	    && ((inStatePtr->encoding == NULL
+		&& outStatePtr->encoding == NULL)
+		|| (inStatePtr->encoding == outStatePtr->encoding))
 	    && !nonBlocking;	/* First draft do only blocking case */
 
     /*
-- 
cgit v0.12


From 36ec4e104487d2d718dc0a62e145afa4bdfecafc Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Jul 2014 15:00:07 +0000
Subject: Test read error during binary [chan copy].

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

diff --git a/tests/io.test b/tests/io.test
index bf5adb0..b707c01 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7612,6 +7612,36 @@ test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix op
     close $f1
     list $::done $ch
 } {ok A}
+test io-53.13 {TclCopyChannel: read error reporting} -setup {
+    proc driver {cmd args} {
+        variable buffer
+        variable index
+        set chan [lindex $args 0]
+        switch -- $cmd {
+            initialize {
+                return {initialize finalize watch read}
+            }
+            finalize {
+                return
+            }
+            watch {}
+            read {
+		error FAIL
+            }
+        }
+    }
+    set outFile [makeFile {} out]
+} -body {
+    set in [chan create read [namespace which driver]]
+    chan configure $in -translation binary
+    set out [open $outFile wb]
+    chan copy $in $out
+} -cleanup {
+    catch {close $in}
+    catch {close $out}
+    removeFile out
+    rename driver {}
+} -result {error reading "*": *} -returnCodes error -match glob
 
 test io-54.1 {Recursive channel events} {socket fileevent} {
     # This test checks to see if file events are delivered during recursive
-- 
cgit v0.12


From f3e831dfbc16475f7b102489a0beb702801519a4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Jul 2014 15:02:09 +0000
Subject: Make sure MoveBytes records read error messages.

---
 generic/tclIO.c | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6718788..017494e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8931,9 +8931,13 @@ MoveBytes(
 	int inBytes = 0;
 
 	if (bufPtr == NULL || BytesLeft(bufPtr) == 0) {
-	    /* Nothing in the input queue;  Get more input. */
 
+	    /* Nothing in the input queue;  Get more input. */
 	    if (0 != GetInput(inStatePtr->topChanPtr)) { 
+		Tcl_SetObjResult(csPtr->interp, Tcl_ObjPrintf(
+			"error reading \"%s\": %s",
+			Tcl_GetChannelName((Tcl_Channel)csPtr->readPtr), 
+			Tcl_PosixError(csPtr->interp)));
 		code = TCL_ERROR;
 		break;
 	    }
-- 
cgit v0.12


From 103265bd2b0e08ddb0c3d1fa280411f904f3490b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Jul 2014 15:17:19 +0000
Subject: Test format of write error messages during binary [chan copy]

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

diff --git a/tests/io.test b/tests/io.test
index b707c01..cef3e81 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7642,6 +7642,36 @@ test io-53.13 {TclCopyChannel: read error reporting} -setup {
     removeFile out
     rename driver {}
 } -result {error reading "*": *} -returnCodes error -match glob
+test io-53.14 {TclCopyChannel: write error reporting} -setup {
+    proc driver {cmd args} {
+        variable buffer
+        variable index
+        set chan [lindex $args 0]
+        switch -- $cmd {
+            initialize {
+                return {initialize finalize watch write}
+            }
+            finalize {
+                return
+            }
+            watch {}
+            write {
+                error FAIL
+            }
+        }
+    }
+    set inFile [makeFile {aaa} in]
+} -body {
+    set in [open $inFile rb]
+    set out [chan create write [namespace which driver]]
+    chan configure $out -translation binary
+    chan copy $in $out
+} -cleanup {
+    catch {close $in}
+    catch {close $out}
+    removeFile in
+    rename driver {}
+} -result {error writing "*": *} -returnCodes error -match glob
 
 test io-54.1 {Recursive channel events} {socket fileevent} {
     # This test checks to see if file events are delivered during recursive
-- 
cgit v0.12


From 8b939b74f8a4c8617410768e840ab04abbaec043 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Jul 2014 15:24:11 +0000
Subject: Make sure MoveBytes error reporting reproduces what CopyData does. 
 Bugward compatibility!

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

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 017494e..7e793a9 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8920,6 +8920,10 @@ MoveBytes(
 	 * channel, flush them out of the way first. */
 
 	if (0 != FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0)) {
+	    Tcl_SetObjResult(csPtr->interp, Tcl_ObjPrintf(
+		"error writing \"%s\": %s",
+		Tcl_GetChannelName((Tcl_Channel)csPtr->writePtr), 
+		Tcl_PosixError(csPtr->interp)));
 	    code = TCL_ERROR;
 	    goto done;
 	}
@@ -8989,6 +8993,10 @@ MoveBytes(
 
 	/* Flush destination */
 	if (0 != FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0)) {
+	    Tcl_SetObjResult(csPtr->interp, Tcl_ObjPrintf(
+		"error writing \"%s\": %s",
+		Tcl_GetChannelName((Tcl_Channel)csPtr->writePtr), 
+		Tcl_PosixError(csPtr->interp)));
 	    code = TCL_ERROR;
 	    break;
 	}
-- 
cgit v0.12


From de9c0d8432dc3afcfc1d0442c602f42983c134ca Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Jul 2014 15:34:05 +0000
Subject: simplify moveBytes selection logic

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

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 7e793a9..6052c43 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8840,9 +8840,7 @@ TclCopyChannel(
     moveBytes = inStatePtr->inEofChar == '\0'	/* No eofChar to stop input */
 	    && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
 	    && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
-	    && ((inStatePtr->encoding == NULL
-		&& outStatePtr->encoding == NULL)
-		|| (inStatePtr->encoding == outStatePtr->encoding))
+	    && inStatePtr->encoding == outStatePtr->encoding
 	    && !nonBlocking;	/* First draft do only blocking case */
 
     /*
-- 
cgit v0.12


From 369c6f29cb094e06083a203dfd622b21fc9eb226 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Jul 2014 17:17:41 +0000
Subject: [9d19af7adb] Make sure all timer events get canceled.

---
 tests/ioCmd.test | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index dcca1f5..57f8d47 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -2748,10 +2748,9 @@ test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
 	    init* {set ret {initialize finalize watch read}}
 	    watch {
 		set l [lindex $args 0]
+		catch {after cancel $::timer}
 		if {[llength $l]} {
 		    set ::timer [after $::drive [list POST $ch]]
-		} else {
-		    after cancel $::timer
 		}
 	    }
 	    finalize {
-- 
cgit v0.12


From e038532fb8781902982dca87003dbd6121f22e3f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 26 Jul 2014 15:02:09 +0000
Subject: Extend the "move buffer" implementation to cover the async case.

---
 generic/tclIO.c | 186 ++++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 175 insertions(+), 11 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6052c43..724c20f 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -183,6 +183,12 @@ static int		CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
 static void		CommonGetsCleanup(Channel *chanPtr);
 static int		CopyData(CopyState *csPtr, int mask);
 static int		MoveBytes(CopyState *csPtr);
+
+static void		MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
+static void		MBError(CopyState *csPtr, int mask, int errorCode);
+static void		MBRead(ClientData clientData, int mask);
+static void		MBWrite(ClientData clientData, int mask);
+
 static void		CopyEventProc(ClientData clientData, int mask);
 static void		CreateScriptRecord(Tcl_Interp *interp,
 			    Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
@@ -8831,17 +8837,15 @@ TclCopyChannel(
 	    | CHANNEL_UNBUFFERED;
 
     /*
-     * Very strict set of conditions where we know we can just move bytes
-     * from input channel to output channel with no transformation or even
-     * examination of the bytes themselves.
-     * TODO: Find ways to relax this.
+     * Test for conditions where we know we can just move bytes from input
+     * channel to output channel with no transformation or even examination
+     * of the bytes themselves.
      */
 
     moveBytes = inStatePtr->inEofChar == '\0'	/* No eofChar to stop input */
 	    && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
 	    && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
-	    && inStatePtr->encoding == outStatePtr->encoding
-	    && !nonBlocking;	/* First draft do only blocking case */
+	    && inStatePtr->encoding == outStatePtr->encoding;
 
     /*
      * Allocate a new CopyState to maintain info about the current copy in
@@ -8904,6 +8908,156 @@ TclCopyChannel(
  *----------------------------------------------------------------------
  */
 
+static void
+MBCallback(
+    CopyState *csPtr,
+    Tcl_Obj *errObj)
+{
+    Tcl_Obj *cmdPtr = Tcl_DuplicateObj(csPtr->cmdPtr);
+    Tcl_WideInt total = csPtr->total;
+    Tcl_Interp *interp = csPtr->interp;
+    int code;
+
+    Tcl_IncrRefCount(cmdPtr);
+    StopCopy(csPtr);
+
+    /* TODO: What if cmdPtr is not a list?! */
+
+    Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewWideIntObj(total));
+    if (errObj) {
+	Tcl_ListObjAppendElement(NULL, cmdPtr, errObj);
+    }
+
+    Tcl_Preserve(interp);
+    code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+    if (code != TCL_OK) {
+	Tcl_BackgroundException(interp, code);
+    }
+    Tcl_Release(interp);
+    TclDecrRefCount(cmdPtr);
+}
+
+static void
+MBError(
+    CopyState *csPtr,
+    int mask,
+    int errorCode)
+{
+    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+
+    Tcl_SetErrno(errorCode);
+    MBCallback(csPtr, Tcl_ObjPrintf( "error %sing \"%s\": %s",
+	    (mask & TCL_READABLE) ? "read" : "writ",
+	    Tcl_GetChannelName((mask & TCL_READABLE) ? inChan : outChan),
+	    Tcl_PosixError(csPtr->interp)));
+}
+
+static void
+MBRead(
+    ClientData clientData,
+    int mask)
+{
+    CopyState *csPtr = (CopyState *) clientData;
+    ChannelState *inStatePtr = csPtr->readPtr->state;
+
+    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+
+    int code = GetInput(inStatePtr->topChanPtr);
+
+    assert (mask & TCL_READABLE);
+
+    if (code == 0) {
+	/* Successful read -- set up to write the bytes we read */
+	Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBWrite, csPtr);
+
+	/* When at least one full buffer is present, stop reading. */
+	if (IsBufferFull(inStatePtr->inQueueHead)
+		|| !Tcl_InputBlocked(inChan)) {
+	    Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
+	}
+    } else {
+	MBError(csPtr, mask, code);
+    }
+}
+
+static void
+MBWrite(
+    ClientData clientData,
+    int mask)
+{
+    CopyState *csPtr = (CopyState *) clientData;
+    ChannelState *inStatePtr = csPtr->readPtr->state;
+    ChannelState *outStatePtr = csPtr->writePtr->state;
+
+    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+
+    ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+    ChannelBuffer *tail = NULL;
+    int code, inBytes = 0;
+
+    assert (mask & TCL_WRITABLE);
+
+    Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
+    Tcl_DeleteChannelHandler(outChan, MBWrite, csPtr);
+
+    /* Count up number of bytes waiting in the input queue */
+    while (bufPtr) {
+	inBytes += BytesLeft(bufPtr);
+	tail = bufPtr;
+	if (csPtr->toRead != -1 && csPtr->toRead < inBytes) {
+	    /* Queue has enough bytes to complete the copy */
+	    break;
+	}
+	bufPtr = bufPtr->nextPtr;
+    }
+
+    if (bufPtr) {
+	/* Split the overflowing buffer in two */
+	int extra = inBytes - csPtr->toRead;
+
+	bufPtr = AllocChannelBuffer(extra);
+
+	tail->nextAdded -= extra;
+	memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra);
+	bufPtr->nextAdded += extra;
+	bufPtr->nextPtr = tail->nextPtr;
+	tail->nextPtr = NULL;
+	inBytes = csPtr->toRead;
+    }
+
+    /* Update the byte counts */
+    if (csPtr->toRead != -1) {
+	csPtr->toRead -= inBytes;
+    }
+    csPtr->total += inBytes;
+
+    /* Move buffers from input to output channels */
+    if (outStatePtr->outQueueTail) {
+	outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
+    } else {
+	outStatePtr->outQueueHead = inStatePtr->inQueueHead;
+    }
+    outStatePtr->outQueueTail = tail;
+    inStatePtr->inQueueHead = bufPtr;
+    if (bufPtr == NULL) {
+	inStatePtr->inQueueTail = NULL;
+    }
+
+    code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+    if (code == 0) {
+	if (csPtr->toRead == 0 || Tcl_Eof(inChan)) {
+	    MBCallback(csPtr, NULL);
+	} else {
+	    Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBRead, csPtr);
+	}
+    } else {
+	MBError(csPtr, mask, code);
+    }
+}
+
 static int
 MoveBytes(
     CopyState *csPtr)		/* State of copy operation. */
@@ -8927,6 +9081,12 @@ MoveBytes(
 	}
     }
 
+    if (csPtr->cmdPtr) {
+	Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+	Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBRead, csPtr);
+	return TCL_OK;
+    }
+
     while (csPtr->toRead != 0) {
 	ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
 	ChannelBuffer *tail = NULL;
@@ -9536,12 +9696,16 @@ StopCopy(
     CopyState *csPtr)		/* State for bg copy to stop . */
 {
     ChannelState *inStatePtr, *outStatePtr;
+    Tcl_Channel inChan, outChan;
+
     int nonBlocking;
 
     if (!csPtr) {
 	return;
     }
 
+    inChan = (Tcl_Channel) csPtr->readPtr;
+    outChan = (Tcl_Channel) csPtr->writePtr;
     inStatePtr = csPtr->readPtr->state;
     outStatePtr = csPtr->writePtr->state;
 
@@ -9566,12 +9730,12 @@ StopCopy(
 	    csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
 
     if (csPtr->cmdPtr) {
-	Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc,
-		csPtr);
-	if (csPtr->readPtr != csPtr->writePtr) {
-	    Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr,
-		    CopyEventProc, csPtr);
+	Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
+	if (inChan != outChan) {
+	    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
 	}
+	Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
+	Tcl_DeleteChannelHandler(outChan, MBWrite, csPtr);
 	TclDecrRefCount(csPtr->cmdPtr);
     }
     inStatePtr->csPtrR = NULL;
-- 
cgit v0.12


From 7e8a2b53273eff3984db888b49f2067fc442dd2d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 26 Jul 2014 15:44:32 +0000
Subject: Use common MBError() routine for sync and async operations.

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

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 724c20f..aed2abf 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8945,12 +8945,21 @@ MBError(
 {
     Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
     Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+    Tcl_Obj *errObj;
 
     Tcl_SetErrno(errorCode);
-    MBCallback(csPtr, Tcl_ObjPrintf( "error %sing \"%s\": %s",
+
+    errObj = Tcl_ObjPrintf( "error %sing \"%s\": %s",
 	    (mask & TCL_READABLE) ? "read" : "writ",
 	    Tcl_GetChannelName((mask & TCL_READABLE) ? inChan : outChan),
-	    Tcl_PosixError(csPtr->interp)));
+	    Tcl_PosixError(csPtr->interp));
+
+    if (csPtr->cmdPtr) {
+	MBCallback(csPtr, errObj);
+    } else {
+	Tcl_SetObjResult(csPtr->interp, errObj);
+	StopCopy(csPtr);
+    }
 }
 
 static void
@@ -9065,19 +9074,16 @@ MoveBytes(
     ChannelState *inStatePtr = csPtr->readPtr->state;
     ChannelState *outStatePtr = csPtr->writePtr->state;
     ChannelBuffer *bufPtr = outStatePtr->curOutPtr;
-    int code = TCL_OK;
+    int errorCode, code = TCL_OK;
 
     if (bufPtr && BytesLeft(bufPtr)) {
 	/* If we start with unflushed bytes in the destination
 	 * channel, flush them out of the way first. */
 
-	if (0 != FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0)) {
-	    Tcl_SetObjResult(csPtr->interp, Tcl_ObjPrintf(
-		"error writing \"%s\": %s",
-		Tcl_GetChannelName((Tcl_Channel)csPtr->writePtr), 
-		Tcl_PosixError(csPtr->interp)));
-	    code = TCL_ERROR;
-	    goto done;
+	errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+	if (errorCode != 0) {
+	    MBError(csPtr, TCL_WRITABLE, errorCode);
+	    return TCL_ERROR;
 	}
     }
 
@@ -9095,13 +9101,10 @@ MoveBytes(
 	if (bufPtr == NULL || BytesLeft(bufPtr) == 0) {
 
 	    /* Nothing in the input queue;  Get more input. */
-	    if (0 != GetInput(inStatePtr->topChanPtr)) { 
-		Tcl_SetObjResult(csPtr->interp, Tcl_ObjPrintf(
-			"error reading \"%s\": %s",
-			Tcl_GetChannelName((Tcl_Channel)csPtr->readPtr), 
-			Tcl_PosixError(csPtr->interp)));
-		code = TCL_ERROR;
-		break;
+	    errorCode = GetInput(inStatePtr->topChanPtr);
+	    if (errorCode != 0) { 
+		MBError(csPtr, TCL_READABLE, errorCode);
+		return TCL_ERROR;
 	    }
 	    bufPtr = inStatePtr->inQueueHead;
 	}
@@ -9150,13 +9153,10 @@ MoveBytes(
 	}
 
 	/* Flush destination */
-	if (0 != FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0)) {
-	    Tcl_SetObjResult(csPtr->interp, Tcl_ObjPrintf(
-		"error writing \"%s\": %s",
-		Tcl_GetChannelName((Tcl_Channel)csPtr->writePtr), 
-		Tcl_PosixError(csPtr->interp)));
-	    code = TCL_ERROR;
-	    break;
+	errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
+	if (errorCode != 0) {
+	    MBError(csPtr, TCL_WRITABLE, errorCode);
+	    return TCL_ERROR;
 	}
 	if (GotFlag(inStatePtr, CHANNEL_EOF)) {
 	    break;
@@ -9166,7 +9166,6 @@ MoveBytes(
     if (code == TCL_OK) {
 	Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
     }
-  done:
     StopCopy(csPtr);
     return code;
 }
-- 
cgit v0.12


From 2568ef5dacb9a7092df97e94312fd7fe7ddf60e2 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sun, 27 Jul 2014 17:20:32 +0000
Subject: Rework MBWrite() so it can be used in both sync and async modes.
 Reduce code duplication.

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

diff --git a/generic/tclIO.c b/generic/tclIO.c
index aed2abf..907a070 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -187,7 +187,8 @@ static int		MoveBytes(CopyState *csPtr);
 static void		MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
 static void		MBError(CopyState *csPtr, int mask, int errorCode);
 static void		MBRead(ClientData clientData, int mask);
-static void		MBWrite(ClientData clientData, int mask);
+static int		MBWrite(CopyState *csPtr, int mask);
+static void		MBEvent(ClientData clientData, int mask);
 
 static void		CopyEventProc(ClientData clientData, int mask);
 static void		CreateScriptRecord(Tcl_Interp *interp,
@@ -8963,6 +8964,20 @@ MBError(
 }
 
 static void
+MBEvent(
+    ClientData clientData,
+    int mask)
+{
+    CopyState *csPtr = (CopyState *) clientData;
+
+    if (mask & TCL_WRITABLE) {
+	(void) MBWrite(csPtr, mask);
+    } else if (mask & TCL_READABLE) {
+	(void) MBRead(clientData, mask);
+    }
+}
+
+static void
 MBRead(
     ClientData clientData,
     int mask)
@@ -8979,7 +8994,7 @@ MBRead(
 
     if (code == 0) {
 	/* Successful read -- set up to write the bytes we read */
-	Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBWrite, csPtr);
+	Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr);
 
 	/* When at least one full buffer is present, stop reading. */
 	if (IsBufferFull(inStatePtr->inQueueHead)
@@ -8991,12 +9006,11 @@ MBRead(
     }
 }
 
-static void
+static int 
 MBWrite(
-    ClientData clientData,
+    CopyState *csPtr,
     int mask)
 {
-    CopyState *csPtr = (CopyState *) clientData;
     ChannelState *inStatePtr = csPtr->readPtr->state;
     ChannelState *outStatePtr = csPtr->writePtr->state;
 
@@ -9010,7 +9024,7 @@ MBWrite(
     assert (mask & TCL_WRITABLE);
 
     Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
-    Tcl_DeleteChannelHandler(outChan, MBWrite, csPtr);
+    Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
 
     /* Count up number of bytes waiting in the input queue */
     while (bufPtr) {
@@ -9058,12 +9072,21 @@ MBWrite(
     code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
     if (code == 0) {
 	if (csPtr->toRead == 0 || Tcl_Eof(inChan)) {
-	    MBCallback(csPtr, NULL);
-	} else {
+	    if (csPtr->cmdPtr) {
+		MBCallback(csPtr, NULL);
+	    } else {
+		Tcl_SetObjResult(csPtr->interp,
+			Tcl_NewWideIntObj(csPtr->total));
+		StopCopy(csPtr);
+	    }
+	    return TCL_OK;
+	} else if (csPtr->cmdPtr) {
 	    Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBRead, csPtr);
 	}
+	return TCL_CONTINUE;
     } else {
 	MBError(csPtr, mask, code);
+	return TCL_ERROR;
     }
 }
 
@@ -9074,7 +9097,7 @@ MoveBytes(
     ChannelState *inStatePtr = csPtr->readPtr->state;
     ChannelState *outStatePtr = csPtr->writePtr->state;
     ChannelBuffer *bufPtr = outStatePtr->curOutPtr;
-    int errorCode, code = TCL_OK;
+    int errorCode;
 
     if (bufPtr && BytesLeft(bufPtr)) {
 	/* If we start with unflushed bytes in the destination
@@ -9093,10 +9116,9 @@ MoveBytes(
 	return TCL_OK;
     }
 
-    while (csPtr->toRead != 0) {
+    while (1) {
 	ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
-	ChannelBuffer *tail = NULL;
-	int inBytes = 0;
+	int code;
 
 	if (bufPtr == NULL || BytesLeft(bufPtr) == 0) {
 
@@ -9108,66 +9130,17 @@ MoveBytes(
 	    }
 	    bufPtr = inStatePtr->inQueueHead;
 	}
-
-	/* Count up number of bytes waiting in the input queue */
-	while (bufPtr) {
-	    inBytes += BytesLeft(bufPtr);
-	    tail = bufPtr;
-	    if (csPtr->toRead != -1 && csPtr->toRead < inBytes) {
-		/* Queue has enough bytes to complete the copy */
-		break;
-	    }
-	    bufPtr = bufPtr->nextPtr;
-	}
-
-	if (bufPtr) {
-	    /* Split the overflowing buffer in two */
-	    int extra = inBytes - csPtr->toRead;
-
-	    bufPtr = AllocChannelBuffer(extra);
-
-	    tail->nextAdded -= extra;
-	    memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra);
-	    bufPtr->nextAdded += extra;
-	    bufPtr->nextPtr = tail->nextPtr;
-	    tail->nextPtr = NULL;
-	    inBytes = csPtr->toRead;
-	}
-
-	/* Update the byte counts */
-	if (csPtr->toRead != -1) {
-	    csPtr->toRead -= inBytes;
+	code = MBWrite(csPtr, TCL_WRITABLE);
+	if (code == TCL_CONTINUE) {
+	    continue;
 	}
-	csPtr->total += inBytes;
-
-	/* Move buffers from input to output channels */
-	if (outStatePtr->outQueueTail) {
-	    outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
+	if (code == TCL_OK) {
+	    return TCL_OK;
 	} else {
-	    outStatePtr->outQueueHead = inStatePtr->inQueueHead;
-	}
-	outStatePtr->outQueueTail = tail;
-	inStatePtr->inQueueHead = bufPtr;
-	if (bufPtr == NULL) {
-	    inStatePtr->inQueueTail = NULL;
-	}
-
-	/* Flush destination */
-	errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
-	if (errorCode != 0) {
-	    MBError(csPtr, TCL_WRITABLE, errorCode);
 	    return TCL_ERROR;
 	}
-	if (GotFlag(inStatePtr, CHANNEL_EOF)) {
-	    break;
-	}
     }
-
-    if (code == TCL_OK) {
-	Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
-    }
-    StopCopy(csPtr);
-    return code;
+    return TCL_OK;	/* Silence compiler warnings */
 }
 
 static int
@@ -9734,7 +9707,7 @@ StopCopy(
 	    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
 	}
 	Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
-	Tcl_DeleteChannelHandler(outChan, MBWrite, csPtr);
+	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
 	TclDecrRefCount(csPtr->cmdPtr);
     }
     inStatePtr->csPtrR = NULL;
-- 
cgit v0.12


From 5773d025383ed2c6186a6bcf53e118df17eaceef Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 27 Jul 2014 22:44:36 +0000
Subject: correct EOLFIX macro, broken by [a803608ed5]

---
 unix/Makefile.in | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/unix/Makefile.in b/unix/Makefile.in
index 1738570..4f32c87 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1660,7 +1660,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
+EOLFIX=$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl
 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
@@ -1756,7 +1756,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
 		$(TOOL_DIR)/tcl.wse.in $(TOOL_DIR)/*.bmp \
 		$(TOOL_DIR)/tcl.hpj.in \
 		$(DISTDIR)/tools
-	@$(EOLFIX)-crlf $(DISTDIR)/tools/tcl.hpj.in \
+	@$(EOLFIX) -crlf $(DISTDIR)/tools/tcl.hpj.in \
 		$(DISTDIR)/tools/tcl.wse.in
 	@mkdir $(DISTDIR)/libtommath
 	cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \
-- 
cgit v0.12


From 4217a749df3219697b93f646009792e35fe398db Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sun, 27 Jul 2014 22:53:01 +0000
Subject: Push MBWrite() differences out to callers.

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

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 907a070..73e1274 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8969,9 +8969,20 @@ MBEvent(
     int mask)
 {
     CopyState *csPtr = (CopyState *) clientData;
+    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
+    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
 
     if (mask & TCL_WRITABLE) {
-	(void) MBWrite(csPtr, mask);
+	Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
+	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
+	switch (MBWrite(csPtr, mask)) {
+	case TCL_OK:
+	    MBCallback(csPtr, NULL);
+	    break;
+	case TCL_CONTINUE:
+	    Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBRead, csPtr);
+	    break;
+	}
     } else if (mask & TCL_READABLE) {
 	(void) MBRead(clientData, mask);
     }
@@ -9013,19 +9024,12 @@ MBWrite(
 {
     ChannelState *inStatePtr = csPtr->readPtr->state;
     ChannelState *outStatePtr = csPtr->writePtr->state;
-
-    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
-    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
-
     ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
     ChannelBuffer *tail = NULL;
     int code, inBytes = 0;
 
     assert (mask & TCL_WRITABLE);
 
-    Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
-    Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
-
     /* Count up number of bytes waiting in the input queue */
     while (bufPtr) {
 	inBytes += BytesLeft(bufPtr);
@@ -9070,24 +9074,14 @@ MBWrite(
     }
 
     code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
-    if (code == 0) {
-	if (csPtr->toRead == 0 || Tcl_Eof(inChan)) {
-	    if (csPtr->cmdPtr) {
-		MBCallback(csPtr, NULL);
-	    } else {
-		Tcl_SetObjResult(csPtr->interp,
-			Tcl_NewWideIntObj(csPtr->total));
-		StopCopy(csPtr);
-	    }
-	    return TCL_OK;
-	} else if (csPtr->cmdPtr) {
-	    Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBRead, csPtr);
-	}
-	return TCL_CONTINUE;
-    } else {
+    if (code) {
 	MBError(csPtr, mask, code);
 	return TCL_ERROR;
     }
+    if (csPtr->toRead == 0 || GotFlag(inStatePtr, CHANNEL_EOF)) {
+	return TCL_OK;
+    }
+    return TCL_CONTINUE;
 }
 
 static int
@@ -9131,14 +9125,15 @@ MoveBytes(
 	    bufPtr = inStatePtr->inQueueHead;
 	}
 	code = MBWrite(csPtr, TCL_WRITABLE);
-	if (code == TCL_CONTINUE) {
-	    continue;
-	}
 	if (code == TCL_OK) {
+	    Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
+	    StopCopy(csPtr);
 	    return TCL_OK;
-	} else {
+	}
+	if (code == TCL_ERROR) {
 	    return TCL_ERROR;
 	}
+	/* code == TCL_CONTINUE --> continue the loop */
     }
     return TCL_OK;	/* Silence compiler warnings */
 }
-- 
cgit v0.12


From ab81262de8a6b9f32445810c18f8a509c692384c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 28 Jul 2014 01:42:42 +0000
Subject: Revise MBRead() to be used in both sync and async modes.

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

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 73e1274..d9d37a2 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -186,8 +186,8 @@ static int		MoveBytes(CopyState *csPtr);
 
 static void		MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
 static void		MBError(CopyState *csPtr, int mask, int errorCode);
-static void		MBRead(ClientData clientData, int mask);
-static int		MBWrite(CopyState *csPtr, int mask);
+static int		MBRead(CopyState *csPtr);
+static int		MBWrite(CopyState *csPtr);
 static void		MBEvent(ClientData clientData, int mask);
 
 static void		CopyEventProc(ClientData clientData, int mask);
@@ -8971,56 +8971,57 @@ MBEvent(
     CopyState *csPtr = (CopyState *) clientData;
     Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
     Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
+    ChannelState *inStatePtr = csPtr->readPtr->state;
 
     if (mask & TCL_WRITABLE) {
-	Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
+	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
 	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
-	switch (MBWrite(csPtr, mask)) {
+	switch (MBWrite(csPtr)) {
 	case TCL_OK:
 	    MBCallback(csPtr, NULL);
 	    break;
 	case TCL_CONTINUE:
-	    Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBRead, csPtr);
+	    Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
 	    break;
 	}
     } else if (mask & TCL_READABLE) {
-	(void) MBRead(clientData, mask);
+	if (TCL_OK == MBRead(csPtr)) {
+	    /* When at least one full buffer is present, stop reading. */
+	    if (IsBufferFull(inStatePtr->inQueueHead)
+		    || !Tcl_InputBlocked(inChan)) {
+		Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
+	    }
+
+	    /* Successful read -- set up to write the bytes we read */
+	    Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr);
+	}
     }
 }
 
-static void
+static int 
 MBRead(
-    ClientData clientData,
-    int mask)
+    CopyState *csPtr)
 {
-    CopyState *csPtr = (CopyState *) clientData;
     ChannelState *inStatePtr = csPtr->readPtr->state;
+    ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
+    int code;
 
-    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
-    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
-
-    int code = GetInput(inStatePtr->topChanPtr);
-
-    assert (mask & TCL_READABLE);
+    if (bufPtr && BytesLeft(bufPtr) > 0) {
+	return TCL_OK;
+    }
 
+    code = GetInput(inStatePtr->topChanPtr);
     if (code == 0) {
-	/* Successful read -- set up to write the bytes we read */
-	Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr);
-
-	/* When at least one full buffer is present, stop reading. */
-	if (IsBufferFull(inStatePtr->inQueueHead)
-		|| !Tcl_InputBlocked(inChan)) {
-	    Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
-	}
+	return TCL_OK;
     } else {
-	MBError(csPtr, mask, code);
+	MBError(csPtr, TCL_READABLE, code);
+	return TCL_ERROR;
     }
 }
 
 static int 
 MBWrite(
-    CopyState *csPtr,
-    int mask)
+    CopyState *csPtr)
 {
     ChannelState *inStatePtr = csPtr->readPtr->state;
     ChannelState *outStatePtr = csPtr->writePtr->state;
@@ -9028,8 +9029,6 @@ MBWrite(
     ChannelBuffer *tail = NULL;
     int code, inBytes = 0;
 
-    assert (mask & TCL_WRITABLE);
-
     /* Count up number of bytes waiting in the input queue */
     while (bufPtr) {
 	inBytes += BytesLeft(bufPtr);
@@ -9075,7 +9074,7 @@ MBWrite(
 
     code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
     if (code) {
-	MBError(csPtr, mask, code);
+	MBError(csPtr, TCL_WRITABLE, code);
 	return TCL_ERROR;
     }
     if (csPtr->toRead == 0 || GotFlag(inStatePtr, CHANNEL_EOF)) {
@@ -9088,7 +9087,6 @@ static int
 MoveBytes(
     CopyState *csPtr)		/* State of copy operation. */
 {
-    ChannelState *inStatePtr = csPtr->readPtr->state;
     ChannelState *outStatePtr = csPtr->writePtr->state;
     ChannelBuffer *bufPtr = outStatePtr->curOutPtr;
     int errorCode;
@@ -9106,25 +9104,17 @@ MoveBytes(
 
     if (csPtr->cmdPtr) {
 	Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
-	Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBRead, csPtr);
+	Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
 	return TCL_OK;
     }
 
     while (1) {
-	ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
 	int code;
 
-	if (bufPtr == NULL || BytesLeft(bufPtr) == 0) {
-
-	    /* Nothing in the input queue;  Get more input. */
-	    errorCode = GetInput(inStatePtr->topChanPtr);
-	    if (errorCode != 0) { 
-		MBError(csPtr, TCL_READABLE, errorCode);
-		return TCL_ERROR;
-	    }
-	    bufPtr = inStatePtr->inQueueHead;
+	if (TCL_ERROR == MBRead(csPtr)) {
+	    return TCL_ERROR;
 	}
-	code = MBWrite(csPtr, TCL_WRITABLE);
+	code = MBWrite(csPtr);
 	if (code == TCL_OK) {
 	    Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
 	    StopCopy(csPtr);
@@ -9701,7 +9691,7 @@ StopCopy(
 	if (inChan != outChan) {
 	    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
 	}
-	Tcl_DeleteChannelHandler(inChan, MBRead, csPtr);
+	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
 	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
 	TclDecrRefCount(csPtr->cmdPtr);
     }
-- 
cgit v0.12


From 397413cd716cc73ca6291b8ba67c1c1950624fd2 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 29 Jul 2014 00:22:32 +0000
Subject: [3757cdf808] Refactoring seems to reduce (maybe somewhat kinda sorta)
 a bizarre performance regression.  Still not what it was.  Damn Heisenbugs.

---
 generic/tclClock.c | 54 ++++++++++++++++++++++++++++++++----------------------
 1 file changed, 32 insertions(+), 22 deletions(-)

diff --git a/generic/tclClock.c b/generic/tclClock.c
index 7e917f6..524a9e8 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -522,6 +522,26 @@ ClockGetdatefieldsObjCmd(
  */
 
 static int
+FetchIntField(
+    Tcl_Interp *interp,
+    Tcl_Obj *dict,
+    Tcl_Obj *key,
+    int *storePtr)
+{
+    Tcl_Obj *value = NULL;
+
+    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (value == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"expected key(s) not found in dictionary", -1));
+	return TCL_ERROR;
+    }
+    return TclGetIntFromObj(interp, value, storePtr);
+}
+
+static int
 ClockGetjuliandayfromerayearmonthdayObjCmd(
     ClientData clientData,	/* Opaque pointer to literal pool, etc. */
     Tcl_Interp *interp,		/* Tcl interpreter */
@@ -551,18 +571,13 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
 		 || fieldPtr == NULL
 	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
 		&era) != 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
-		 || fieldPtr == NULL
-	    || TclGetIntFromObj(interp, fieldPtr, &fields.month) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
-		 || fieldPtr == NULL
-	    || TclGetIntFromObj(interp, fieldPtr, &fields.dayOfMonth)!=TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year)
+		!= TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month)
+		!= TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_DAYOFMONTH],
+		&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;
@@ -644,18 +659,13 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
 		 || fieldPtr == NULL
 	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
 		&era) != 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
+	    || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR],
+		&fields.iso8601Year) != TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK],
+		&fields.iso8601Week) != TCL_OK
+	    || FetchIntField(interp, dict, literals[LIT_DAYOFWEEK],
+		&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 2e1ca1d9e14de68527cb660bb11fb459fdb8f01e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Jul 2014 00:22:33 +0000
Subject: Reduce the cost of Preserve/Release on channels

---
 generic/tclIO.c      | 77 +++++++++++++++++++++++++++++++++++-----------------
 generic/tclIO.h      |  2 ++
 generic/tclIOCmd.c   | 32 +++++++++++-----------
 generic/tclIORChan.c |  4 +--
 generic/tclInt.h     |  2 ++
 5 files changed, 74 insertions(+), 43 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index d9d37a2..36ec903 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1652,6 +1652,7 @@ Tcl_CreateChannel(
     chanPtr->upChanPtr		= NULL;
     chanPtr->inQueueHead	= NULL;
     chanPtr->inQueueTail	= NULL;
+    chanPtr->refCount		= 0;
 
     /*
      * TIP #219, Tcl Channel Reflection API
@@ -1872,6 +1873,7 @@ Tcl_StackChannel(
     chanPtr->upChanPtr		= NULL;
     chanPtr->inQueueHead	= NULL;
     chanPtr->inQueueTail	= NULL;
+    chanPtr->refCount		= 0;
 
     /*
      * Place new block at the head of a possibly existing list of previously
@@ -1896,6 +1898,31 @@ Tcl_StackChannel(
 
     return (Tcl_Channel) chanPtr;
 }
+
+void
+TclChannelPreserve(
+    Tcl_Channel chan)
+{
+    Channel *chanPtr = (Channel *) chan;
+
+    if (chanPtr->refCount == 0) {
+	Tcl_Preserve(chan);
+    }
+    chanPtr->refCount++;
+}
+
+void
+TclChannelRelease(
+    Tcl_Channel chan)
+{
+    Channel *chanPtr = (Channel *) chan;
+
+    if (--chanPtr->refCount) {
+	return;
+    }
+    Tcl_Release(chan);
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -2642,7 +2669,7 @@ FlushChannel(
      * of the queued output to the channel.
      */
 
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
     while (statePtr->outQueueHead) {
 	bufPtr = statePtr->outQueueHead;
 
@@ -2833,7 +2860,7 @@ FlushChannel(
     }
 
   done:
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     return errorCode;
 }
 
@@ -4391,7 +4418,7 @@ Tcl_GetsObj(
      */
 
     chanPtr = statePtr->topChanPtr;
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
 
     bufPtr = statePtr->inQueueHead;
     encoding = statePtr->encoding;
@@ -4627,9 +4654,9 @@ Tcl_GetsObj(
      */
 
     if (chanPtr != statePtr->topChanPtr) {
-	Tcl_Release(chanPtr);
+	TclChannelRelease((Tcl_Channel)chanPtr);
 	chanPtr = statePtr->topChanPtr;
-	Tcl_Preserve(chanPtr);
+	TclChannelPreserve((Tcl_Channel)chanPtr);
     }
 
     bufPtr = gs.bufPtr;
@@ -4665,9 +4692,9 @@ Tcl_GetsObj(
      * self-modifying reflected transforms.
      */
     if (chanPtr != statePtr->topChanPtr) {
-	Tcl_Release(chanPtr);
+	TclChannelRelease((Tcl_Channel)chanPtr);
 	chanPtr = statePtr->topChanPtr;
-	Tcl_Preserve(chanPtr);
+	TclChannelPreserve((Tcl_Channel)chanPtr);
     }
     bufPtr = statePtr->inQueueHead;
     if (bufPtr != NULL) {
@@ -4709,12 +4736,12 @@ Tcl_GetsObj(
      * self-modifying reflected transforms.
      */
     if (chanPtr != statePtr->topChanPtr) {
-	Tcl_Release(chanPtr);
+	TclChannelRelease((Tcl_Channel)chanPtr);
 	chanPtr = statePtr->topChanPtr;
-	Tcl_Preserve(chanPtr);
+	TclChannelPreserve((Tcl_Channel)chanPtr);
     }
     UpdateInterest(chanPtr);
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     return copiedTotal;
 }
 
@@ -4760,7 +4787,7 @@ TclGetsObjBinary(
      */
 
     chanPtr = statePtr->topChanPtr;
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
 
     bufPtr = statePtr->inQueueHead;
 
@@ -4965,7 +4992,7 @@ TclGetsObjBinary(
 
   done:
     UpdateInterest(chanPtr);
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     return copiedTotal;
 }
 
@@ -5589,7 +5616,7 @@ DoReadChars(
     chanPtr = statePtr->topChanPtr;
     encoding = statePtr->encoding;
     factor = UTF_EXPANSION_FACTOR;
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
 
     binaryMode = (encoding == NULL)
 	    && (statePtr->inputTranslation == TCL_TRANSLATE_LF) 
@@ -5650,9 +5677,9 @@ DoReadChars(
 	    }
 	    result = GetInput(chanPtr);
 	    if (chanPtr != statePtr->topChanPtr) {
-		Tcl_Release(chanPtr);
+		TclChannelRelease((Tcl_Channel)chanPtr);
 		chanPtr = statePtr->topChanPtr;
-		Tcl_Preserve(chanPtr);
+		TclChannelPreserve((Tcl_Channel)chanPtr);
 	    }
 	    if (result != 0) {
 		if (!GotFlag(statePtr, CHANNEL_BLOCKED)) {
@@ -5680,9 +5707,9 @@ DoReadChars(
      * self-modifying reflected transforms.
      */
     if (chanPtr != statePtr->topChanPtr) {
-	Tcl_Release(chanPtr);
+	TclChannelRelease((Tcl_Channel)chanPtr);
 	chanPtr = statePtr->topChanPtr;
-	Tcl_Preserve(chanPtr);
+	TclChannelPreserve((Tcl_Channel)chanPtr);
     }
 
     /*
@@ -5690,7 +5717,7 @@ DoReadChars(
      * in the buffers.
      */
     UpdateInterest(chanPtr);
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     return copied;
 }
 
@@ -8062,7 +8089,7 @@ Tcl_NotifyChannel(
      * Preserve the channel struct in case the script closes it.
      */
 
-    Tcl_Preserve(channel);
+    TclChannelPreserve((Tcl_Channel)channel);
     Tcl_Preserve(statePtr);
 
     /*
@@ -8112,7 +8139,7 @@ Tcl_NotifyChannel(
     }
 
     Tcl_Release(statePtr);
-    Tcl_Release(channel);
+    TclChannelRelease(channel);
 
     tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
 }
@@ -8594,7 +8621,7 @@ TclChannelEventScriptInvoker(
      */
 
     Tcl_Preserve(interp);
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
     result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
 
     /*
@@ -8611,7 +8638,7 @@ TclChannelEventScriptInvoker(
 	}
 	Tcl_BackgroundException(interp, result);
     }
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     Tcl_Release(interp);
 }
 
@@ -9464,7 +9491,7 @@ DoRead(
     ChannelState *statePtr = chanPtr->state;
     char *p = dst;
 
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
     while (bytesToRead) {
 	/*
 	 * Each pass through the loop is intended to process up to 
@@ -9503,7 +9530,7 @@ DoRead(
 	    if (code) {
 		/* Read error */
 		UpdateInterest(chanPtr);
-		Tcl_Release(chanPtr);
+		TclChannelRelease((Tcl_Channel)chanPtr);
 		return -1;
 	    }
 
@@ -9601,7 +9628,7 @@ DoRead(
 	ResetFlag(statePtr, CHANNEL_BLOCKED);
     }
 
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     return (int)(p - dst);
 }
 
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 097cd61..ca74c3e 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -112,6 +112,8 @@ typedef struct Channel {
 
     ChannelBuffer *inQueueHead;	/* Points at first buffer in input queue. */
     ChannelBuffer *inQueueTail;	/* Points at last buffer in input queue. */
+
+    int refCount;
 } Channel;
 
 /*
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 3368a76..834f225 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -181,7 +181,7 @@ Tcl_PutsObjCmd(
 	return TCL_ERROR;
     }
 
-    Tcl_Preserve(chan);
+    TclChannelPreserve(chan);
     result = Tcl_WriteObj(chan, string);
     if (result < 0) {
 	goto error;
@@ -192,7 +192,7 @@ Tcl_PutsObjCmd(
 	    goto error;
 	}
     }
-    Tcl_Release(chan);
+    TclChannelRelease(chan);
     return TCL_OK;
 
     /*
@@ -207,7 +207,7 @@ Tcl_PutsObjCmd(
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
 		TclGetString(chanObjPtr), Tcl_PosixError(interp)));
     }
-    Tcl_Release(chan);
+    TclChannelRelease(chan);
     return TCL_ERROR;
 }
 
@@ -255,7 +255,7 @@ Tcl_FlushObjCmd(
 	return TCL_ERROR;
     }
 
-    Tcl_Preserve(chan);
+    TclChannelPreserve(chan);
     if (Tcl_Flush(chan) != TCL_OK) {
 	/*
 	 * TIP #219.
@@ -269,10 +269,10 @@ Tcl_FlushObjCmd(
 		    "error flushing \"%s\": %s",
 		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	}
-	Tcl_Release(chan);
+	TclChannelRelease(chan);
 	return TCL_ERROR;
     }
-    Tcl_Release(chan);
+    TclChannelRelease(chan);
     return TCL_OK;
 }
 
@@ -322,7 +322,7 @@ Tcl_GetsObjCmd(
 	return TCL_ERROR;
     }
 
-    Tcl_Preserve(chan);
+    TclChannelPreserve(chan);
     linePtr = Tcl_NewObj();
     lineLen = Tcl_GetsObj(chan, linePtr);
     if (lineLen < 0) {
@@ -357,7 +357,7 @@ Tcl_GetsObjCmd(
 	Tcl_SetObjResult(interp, linePtr);
     }
   done:
-    Tcl_Release(chan);
+    TclChannelRelease(chan);
     return code;
 }
 
@@ -465,7 +465,7 @@ Tcl_ReadObjCmd(
 
     resultPtr = Tcl_NewObj();
     Tcl_IncrRefCount(resultPtr);
-    Tcl_Preserve(chan);
+    TclChannelPreserve(chan);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead < 0) {
 	/*
@@ -480,7 +480,7 @@ Tcl_ReadObjCmd(
 		    "error reading \"%s\": %s",
 		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	}
-	Tcl_Release(chan);
+	TclChannelRelease(chan);
 	Tcl_DecrRefCount(resultPtr);
 	return TCL_ERROR;
     }
@@ -499,7 +499,7 @@ Tcl_ReadObjCmd(
 	}
     }
     Tcl_SetObjResult(interp, resultPtr);
-    Tcl_Release(chan);
+    TclChannelRelease(chan);
     Tcl_DecrRefCount(resultPtr);
     return TCL_OK;
 }
@@ -559,7 +559,7 @@ Tcl_SeekObjCmd(
 	mode = modeArray[optionIndex];
     }
 
-    Tcl_Preserve(chan);
+    TclChannelPreserve(chan);
     result = Tcl_Seek(chan, offset, mode);
     if (result == Tcl_LongAsWide(-1)) {
 	/*
@@ -574,10 +574,10 @@ Tcl_SeekObjCmd(
 		    "error during seek on \"%s\": %s",
 		    TclGetString(objv[1]), Tcl_PosixError(interp)));
 	}
-	Tcl_Release(chan);
+	TclChannelRelease(chan);
 	return TCL_ERROR;
     }
-    Tcl_Release(chan);
+    TclChannelRelease(chan);
     return TCL_OK;
 }
 
@@ -624,7 +624,7 @@ Tcl_TellObjCmd(
 	return TCL_ERROR;
     }
 
-    Tcl_Preserve(chan);
+    TclChannelPreserve(chan);
     newLoc = Tcl_Tell(chan);
 
     /*
@@ -635,7 +635,7 @@ Tcl_TellObjCmd(
 
 
     code  = TclChanCaughtErrorBypass(interp, chan);
-    Tcl_Release(chan);
+    TclChannelRelease(chan);
     if (code) {
 	return TCL_ERROR;
     }
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 3506a44..21c766e 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -658,7 +658,7 @@ TclChanCreateObjCmd(
     chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
 	    mode);
     rcPtr->chan = chan;
-    Tcl_Preserve(chan);
+    TclChannelPreserve(chan);
     chanPtr = (Channel *) chan;
 
     if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
@@ -2188,7 +2188,7 @@ FreeReflectedChannel(
 {
     Channel *chanPtr = (Channel *) rcPtr->chan;
 
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     if (rcPtr->name) {
 	Tcl_DecrRefCount(rcPtr->name);
     }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9a2e8dd..1bb2103 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2864,6 +2864,8 @@ MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
 			    int strLen, const unsigned char *pattern,
 			    int ptnLen, int flags);
 MODULE_SCOPE double	TclCeil(const mp_int *a);
+MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
+MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
 MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp,
 			    const char *value);
 MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
-- 
cgit v0.12


From 4a9e78c1c81ac5ec6d37a5ead62ff57fa90b0875 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Jul 2014 02:58:27 +0000
Subject: Complete transformation off Tcl_Preserve() legacy onto ref counting.

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

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 36ec903..7381f4d 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1903,12 +1903,7 @@ void
 TclChannelPreserve(
     Tcl_Channel chan)
 {
-    Channel *chanPtr = (Channel *) chan;
-
-    if (chanPtr->refCount == 0) {
-	Tcl_Preserve(chan);
-    }
-    chanPtr->refCount++;
+    ((Channel *)chan)->refCount++;
 }
 
 void
@@ -1917,10 +1912,15 @@ TclChannelRelease(
 {
     Channel *chanPtr = (Channel *) chan;
 
+    if (chanPtr->refCount == 0) {
+	Tcl_Panic("Channel released more than preserved");
+    }
     if (--chanPtr->refCount) {
 	return;
     }
-    Tcl_Release(chan);
+    if (chanPtr->typePtr == NULL) {
+	ckfree(chanPtr);
+    }
 }
 
 
@@ -2071,11 +2071,6 @@ Tcl_UnstackChannel(
 	result = ChanClose(chanPtr, interp);
 	chanPtr->typePtr = NULL;
 
-	/*
-	 * AK: Tcl_NotifyChannel may hold a reference to this block of memory
-	 */
-
-	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
 	UpdateInterest(statePtr->topChanPtr);
 
 	if (result != 0) {
@@ -3028,7 +3023,6 @@ CloseChannel(
 	downChanPtr->upChanPtr = NULL;
 	chanPtr->typePtr = NULL;
 
-	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
 	return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
     }
 
@@ -3036,13 +3030,11 @@ CloseChannel(
      * There is only the TOP Channel, so we free the remaining pointers we
      * have and then ourselves. Since this is the last of the channels in the
      * stack, make sure to free the ChannelState structure associated with it.
-     * We use Tcl_EventuallyFree to allow for any last references.
      */
 
     chanPtr->typePtr = NULL;
 
     Tcl_EventuallyFree(statePtr, TCL_DYNAMIC);
-    Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
 
     return errorCode;
 }
-- 
cgit v0.12


From f10bee2648e7e87c576a1afe761e8525255d3a7a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Jul 2014 16:41:24 +0000
Subject: [3757cdf808] More clock refactoring with spooky impact on [string
 match] performance.

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

diff --git a/generic/tclClock.c b/generic/tclClock.c
index 524a9e8..9d4bcd6 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -522,6 +522,26 @@ ClockGetdatefieldsObjCmd(
  */
 
 static int
+FetchEraField(
+    Tcl_Interp *interp,
+    Tcl_Obj *dict,
+    Tcl_Obj *key,
+    int *storePtr)
+{
+    Tcl_Obj *value = NULL;
+
+    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (value == NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"expected key(s) not found in dictionary", -1));
+	return TCL_ERROR;
+    }
+    return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr);
+}
+
+static int
 FetchIntField(
     Tcl_Interp *interp,
     Tcl_Obj *dict,
@@ -552,7 +572,6 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
     Tcl_Obj *dict;
     ClockClientData *data = clientData;
     Tcl_Obj *const *literals = data->literals;
-    Tcl_Obj *fieldPtr;
     int changeover;
     int copied = 0;
     int status;
@@ -567,10 +586,7 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
 	return TCL_ERROR;
     }
     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
+    if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
 	    || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year)
 		!= TCL_OK
 	    || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month)
@@ -640,7 +656,6 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
     Tcl_Obj *dict;
     ClockClientData *data = clientData;
     Tcl_Obj *const *literals = data->literals;
-    Tcl_Obj *fieldPtr;
     int changeover;
     int copied = 0;
     int status;
@@ -655,10 +670,7 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
 	return TCL_ERROR;
     }
     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
+    if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
 	    || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR],
 		&fields.iso8601Year) != TCL_OK
 	    || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK],
-- 
cgit v0.12