merge trunk

6 files changed, 128 insertions, 83 deletions

diff --git a/generic/tclClock.c b/generic/tclClock.c
index 7e917f6..9d4bcd6 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -522,6 +522,46 @@ 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,
+    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 */
@@ -532,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;
@@ -547,22 +586,14 @@ 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
-	    || 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
+    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)
+		!= 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;
@@ -625,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;
@@ -640,22 +670,14 @@ 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
-	    || 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
+    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],
+		&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;
diff --git a/generic/tclIO.c b/generic/tclIO.c
index d9d37a2..7381f4d 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 *)chan)->refCount++;
+}
+
+void
+TclChannelRelease(
+    Tcl_Channel chan)
+{
+    Channel *chanPtr = (Channel *) chan;
+
+    if (chanPtr->refCount == 0) {
+	Tcl_Panic("Channel released more than preserved");
+    }
+    if (--chanPtr->refCount) {
+	return;
+    }
+    if (chanPtr->typePtr == NULL) {
+	ckfree(chanPtr);
+    }
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -2044,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) {
@@ -2642,7 +2664,7 @@ FlushChannel(
      * of the queued output to the channel.
      */
 
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
     while (statePtr->outQueueHead) {
 	bufPtr = statePtr->outQueueHead;
 
@@ -2833,7 +2855,7 @@ FlushChannel(
     }
 
   done:
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     return errorCode;
 }
 
@@ -3001,7 +3023,6 @@ CloseChannel(
 	downChanPtr->upChanPtr = NULL;
 	chanPtr->typePtr = NULL;
 
-	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
 	return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
     }
 
@@ -3009,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;
 }
@@ -4391,7 +4410,7 @@ Tcl_GetsObj(
      */
 
     chanPtr = statePtr->topChanPtr;
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
 
     bufPtr = statePtr->inQueueHead;
     encoding = statePtr->encoding;
@@ -4627,9 +4646,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 +4684,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 +4728,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 +4779,7 @@ TclGetsObjBinary(
      */
 
     chanPtr = statePtr->topChanPtr;
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
 
     bufPtr = statePtr->inQueueHead;
 
@@ -4965,7 +4984,7 @@ TclGetsObjBinary(
 
   done:
     UpdateInterest(chanPtr);
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     return copiedTotal;
 }
 
@@ -5589,7 +5608,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 +5669,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 +5699,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 +5709,7 @@ DoReadChars(
      * in the buffers.
      */
     UpdateInterest(chanPtr);
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     return copied;
 }
 
@@ -8062,7 +8081,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 +8131,7 @@ Tcl_NotifyChannel(
     }
 
     Tcl_Release(statePtr);
-    Tcl_Release(channel);
+    TclChannelRelease(channel);
 
     tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
 }
@@ -8594,7 +8613,7 @@ TclChannelEventScriptInvoker(
      */
 
     Tcl_Preserve(interp);
-    Tcl_Preserve(chanPtr);
+    TclChannelPreserve((Tcl_Channel)chanPtr);
     result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
 
     /*
@@ -8611,7 +8630,7 @@ TclChannelEventScriptInvoker(
 	}
 	Tcl_BackgroundException(interp, result);
     }
-    Tcl_Release(chanPtr);
+    TclChannelRelease((Tcl_Channel)chanPtr);
     Tcl_Release(interp);
 }
 
@@ -9464,7 +9483,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 +9522,7 @@ DoRead(
 	    if (code) {
 		/* Read error */
 		UpdateInterest(chanPtr);
-		Tcl_Release(chanPtr);
+		TclChannelRelease((Tcl_Channel)chanPtr);
 		return -1;
 	    }
 
@@ -9601,7 +9620,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,