merge trunk

5 files changed, 168 insertions, 33 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index f6f66ed..1220239 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -8186,9 +8186,16 @@ Tcl_NRCmdSwap(
  *
  *   One delicate point is to properly define the NRCommand where the tailcall
  *   will execute. There are functions whose purpose is to help define the
- *   precise spot: TclMarkTailcall ("this is the spot") and TclSkipTailcall
- *   ("skip the next command: we are redirecting to it, tailcalls should run
- *   after WE return"), TclPushTailcallPoint (special for OO).
+ *   precise spot:
+ *     TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution
+ *         should continue right here
+ *     TclSkipTailcall:  if the NEXT command to be pushed tailcalls, execution
+ *         should continue after the CURRENT command is fully returned ("skip
+ *         the next command: we are redirecting to it, tailcalls should run
+ *         after WE return") 
+ *     TclPushTailcallPoint: the search for a tailcalling spot cannot traverse
+ *         this point. This is special for OO, as some of the oo constructs
+ *         that behave like commands may not push an NRCommand callback.
  */
 
 void
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 179ca17..a7ef199 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2334,7 +2334,7 @@ UtfToUtfProc(
 
 	    *dst++ = *src++;
 	} else if (pureNullMode == 1 && UCHAR(*src) == 0xc0 &&
-		UCHAR(*(src+1)) == 0x80) {
+		(src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
 	    /*
 	     * Convert 0xc080 to real nulls when we are in output mode.
 	     */
diff --git a/generic/tclIO.c b/generic/tclIO.c
index c4757ea..b97f57a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -421,7 +421,11 @@ ChanRead(
      * Each read op must set the blocked and eof states anew, not let
      * the effect of prior reads leak through.
      */
+    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
+        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
+    }
     ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
+    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
     if (WillRead(chanPtr) < 0) {
         return -1;
     }
@@ -430,7 +434,11 @@ ChanRead(
 	    dst, dstSize, &result);
 
     /* Stop any flag leakage through stacked channel levels */
+    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
+        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
+    }
     ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
+    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
     if (bytesRead > 0) {
 	/*
 	 * If we get a short read, signal up that we may be BLOCKED.
@@ -2649,6 +2657,8 @@ FlushChannel(
      * the post-condition that on a successful return to caller we've
      * left space in the current output buffer for more writing (the flush
      * call was to make new room).
+     * If the channel is blocking, then yes, so we guarantee that 
+     * blocking flushes actually flush all pending data.
      * Otherwise, no.  Keep the current output buffer where it is so more
      * can be written to it, possibly filling it, to promote more efficient
      * buffer usage.
@@ -2656,7 +2666,8 @@ FlushChannel(
 
     bufPtr = statePtr->curOutPtr;
     if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
-	    (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr))) {
+	    (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr)
+		    || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
 	if (statePtr->outQueueHead == NULL) {
 	    statePtr->outQueueHead = bufPtr;
 	} else {
@@ -5739,7 +5750,11 @@ DoReadChars(
 
     /* Special handling for zero-char read request. */
     if (toRead == 0) {
+	if (GotFlag(statePtr, CHANNEL_EOF)) {
+	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+	}
 	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
+	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
 	UpdateInterest(chanPtr);
 	return 0;
     }
@@ -5752,7 +5767,11 @@ DoReadChars(
     TclChannelPreserve((Tcl_Channel)chanPtr);
 
     /* Must clear the BLOCKED|EOF flags here since we check before reading */
+    if (GotFlag(statePtr, CHANNEL_EOF)) {
+	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+    }
     ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
+    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
     for (copied = 0; (unsigned) toRead > 0; ) {
 	copiedNow = -1;
 	if (statePtr->inQueueHead != NULL) {
@@ -6004,12 +6023,24 @@ ReadChars(
 	/*
 	 * Perform the encoding transformation.  Read no more than
 	 * srcLen bytes, write no more than dstLimit bytes.
+	 *
+	 * Some trickiness with encoding flags here.  We do not want
+	 * the end of a buffer to be treated as the end of all input
+	 * when the presence of bytes in a next buffer are already
+	 * known to exist.  This is checked with an assert() because
+	 * so far no test case causing the assertion to be false has
+	 * been created.  The normal operations of channel reading
+	 * appear to cause EOF and TCL_ENCODING_END setting to appear
+	 * only in situations where there are no further bytes in
+	 * any buffers.
 	 */
 
+	assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0
+		|| (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);
+
 	code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		flags & (bufPtr->nextPtr ? ~0 : ~TCL_ENCODING_END),
-		&statePtr->inputEncodingState, dst, dstLimit, &srcRead,
-		&dstDecoded, &numChars);
+		flags, &statePtr->inputEncodingState,
+		dst, dstLimit, &srcRead, &dstDecoded, &numChars);
 
 	/*
 	 * Perform the translation transformation in place.  Read no more
@@ -6126,9 +6157,12 @@ ReadChars(
 		statePtr->inputEncodingFlags = savedIEFlags;
 		statePtr->inputEncodingState = savedState;
 
+		assert(bufPtr->nextPtr == NULL
+			|| BytesLeft(bufPtr->nextPtr) == 0 || 0 ==
+			(statePtr->inputEncodingFlags & TCL_ENCODING_END));
+
 		Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		(statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE)
-		& (bufPtr->nextPtr ? ~0 : ~TCL_ENCODING_END),
+		(statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE),
 		&statePtr->inputEncodingState, buffer, TCL_UTF_MAX + 1,
 		&read, &decoded, &count);
 
@@ -6503,9 +6537,13 @@ Tcl_Ungets(
     /*
      * Clear the EOF flags, and clear the BLOCKED bit.
      */
-
+ 
+    if (GotFlag(statePtr, CHANNEL_EOF)) {
+	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+    }
     ResetFlag(statePtr,
 	    CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
+    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
 
     bufPtr = AllocChannelBuffer(len);
     memcpy(InsertPoint(bufPtr), str, (size_t) len);
@@ -6875,8 +6913,12 @@ Tcl_Seek(
      * point. Also clear CR related flags.
      */
 
+    if (GotFlag(statePtr, CHANNEL_EOF)) {
+	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+    }
     ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED |
 	    INPUT_SAW_CR);
+    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
 
     /*
      * If the channel is in asynchronous output mode, switch it back to
@@ -7970,7 +8012,11 @@ Tcl_SetChannelOption(
 	 * ahead'. Ditto for blocked.
 	 */
 
+	if (GotFlag(statePtr, CHANNEL_EOF)) {
+	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+	}
 	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
+	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
 	return TCL_OK;
     } else if (HaveOpt(1, "-translation")) {
 	const char *readMode, *writeMode;
@@ -9666,7 +9712,11 @@ DoRead(
 
     /* Special handling for zero-char read request. */
     if (bytesToRead == 0) {
+	if (GotFlag(statePtr, CHANNEL_EOF)) {
+	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
+	}
 	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
+	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
 	UpdateInterest(chanPtr);
 	return 0;
     }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3f84717..c89f053 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4116,7 +4116,8 @@ MODULE_SCOPE void	TclpFreeAllocCache(void *);
 	AllocCache *cachePtr;						\
 	if (((interp) == NULL) ||					\
 		((cachePtr = ((Interp *)(interp))->allocCache),		\
-			(cachePtr->numObjects >= ALLOC_NOBJHIGH))) {	\
+			((cachePtr->numObjects == 0) ||			\
+			(cachePtr->numObjects >= ALLOC_NOBJHIGH)))) {	\
 	    TclThreadFreeObj(objPtr);					\
 	} else {							\
 	    (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 560556d..3267a0d 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -84,6 +84,7 @@ typedef union Block {
 
 typedef struct Bucket {
     Block *firstPtr;		/* First block available */
+    Block *lastPtr;		/* End of block list */
     long numFree;		/* Number of blocks available */
 
     /* All fields below for accounting only */
@@ -107,6 +108,7 @@ typedef struct Cache {
     Tcl_ThreadId owner;		/* Which thread's cache is this? */
     Tcl_Obj *firstObjPtr;	/* List of free objects for thread */
     int numObjects;		/* Number of objects for thread */
+    Tcl_Obj *lastPtr;		/* Last object in this cache */
     int totalAssigned;		/* Total space assigned to thread */
     Bucket buckets[NBUCKETS];	/* The buckets for this thread */
 } Cache;
@@ -135,6 +137,7 @@ static int	GetBlocks(Cache *cachePtr, int bucket);
 static Block *	Ptr2Block(char *ptr);
 static char *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
 static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
+static void	PutObjs(Cache *fromPtr, int numMove);
 
 /*
  * Local variables defined in this file and initialized at startup.
@@ -271,9 +274,7 @@ TclFreeAllocCache(
      */
 
     if (cachePtr->numObjects > 0) {
-	Tcl_MutexLock(objLockPtr);
-	MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
-	Tcl_MutexUnlock(objLockPtr);
+	PutObjs(cachePtr, cachePtr->numObjects);
     }
 
     /*
@@ -415,6 +416,9 @@ TclpFree(
     cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
     blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
     cachePtr->buckets[bucket].firstPtr = blockPtr;
+    if (cachePtr->buckets[bucket].numFree == 0) {
+	cachePtr->buckets[bucket].lastPtr = blockPtr;
+    }
     cachePtr->buckets[bucket].numFree++;
     cachePtr->buckets[bucket].numInserts++;
 
@@ -572,11 +576,13 @@ TclThreadAllocObj(void)
 	    if (newObjsPtr == NULL) {
 		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
 	    }
+	    cachePtr->lastPtr = newObjsPtr + numMove - 1;
+	    objPtr = cachePtr->firstObjPtr;	/* NULL */
 	    while (--numMove >= 0) {
-		objPtr = &newObjsPtr[numMove];
-		objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
-		cachePtr->firstObjPtr = objPtr;
+		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
+		objPtr = newObjsPtr + numMove;
 	    }
+	    cachePtr->firstObjPtr = newObjsPtr;
 	}
     }
 
@@ -624,6 +630,9 @@ TclThreadFreeObj(
 
     objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
     cachePtr->firstObjPtr = objPtr;
+    if (cachePtr->numObjects == 0) {
+	cachePtr->lastPtr = objPtr;
+    }
     cachePtr->numObjects++;
 
     /*
@@ -632,9 +641,7 @@ TclThreadFreeObj(
      */
 
     if (cachePtr->numObjects > NOBJHIGH) {
-	Tcl_MutexLock(objLockPtr);
-	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
-	Tcl_MutexUnlock(objLockPtr);
+	PutObjs(cachePtr, NOBJALLOC);
     }
 }
 
@@ -732,13 +739,67 @@ MoveObjs(
      * just have to update the first and last.
      */
 
-    objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr;
+    toPtr->lastPtr = objPtr;
+    objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr; /* NULL */
     toPtr->firstObjPtr = fromFirstObjPtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * PutObjs --
+ *
+ *	Move Tcl_Obj's from thread cache to shared cache.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PutObjs(
+    Cache *fromPtr,
+    int numMove)
+{
+    int keep = fromPtr->numObjects - numMove;
+    Tcl_Obj *firstPtr, *lastPtr = NULL;
+
+    fromPtr->numObjects = keep;
+    firstPtr = fromPtr->firstObjPtr;
+    if (keep == 0) {
+	fromPtr->firstObjPtr = NULL;
+    } else {
+	do {
+	    lastPtr = firstPtr;
+	    firstPtr = firstPtr->internalRep.twoPtrValue.ptr1;
+	} while (--keep > 0);
+	lastPtr->internalRep.twoPtrValue.ptr1 = NULL;
+    }
+
+    /*
+     * Move all objects as a block - they are already linked to each other, we
+     * just have to update the first and last.
+     */
+
+    Tcl_MutexLock(objLockPtr);
+    fromPtr->lastPtr->internalRep.twoPtrValue.ptr1 = sharedPtr->firstObjPtr;
+    sharedPtr->firstObjPtr = firstPtr;
+    if (sharedPtr->numObjects == 0) {
+	sharedPtr->lastPtr = fromPtr->lastPtr;
+    }
+    sharedPtr->numObjects += numMove;
+    Tcl_MutexUnlock(objLockPtr);
+
+    fromPtr->lastPtr = lastPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Block2Ptr, Ptr2Block --
  *
  *	Convert between internal blocks and user pointers.
@@ -848,20 +909,25 @@ PutBlocks(
     int bucket,
     int numMove)
 {
-    register Block *lastPtr, *firstPtr;
-    register int n = numMove;
-
     /*
-     * Before acquiring the lock, walk the block list to find the last block
-     * to be moved.
+     * We have numFree.  Want to shed numMove. So compute how many
+     * Blocks to keep.
      */
 
-    firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
-    while (--n > 0) {
-	lastPtr = lastPtr->nextBlock;
+    int keep = cachePtr->buckets[bucket].numFree - numMove;
+    Block *lastPtr = NULL, *firstPtr;
+
+    cachePtr->buckets[bucket].numFree = keep;
+    firstPtr = cachePtr->buckets[bucket].firstPtr;
+    if (keep == 0) {
+	cachePtr->buckets[bucket].firstPtr = NULL;
+    } else {
+	do {
+	    lastPtr = firstPtr;
+	    firstPtr = firstPtr->nextBlock;
+	} while (--keep > 0);
+	lastPtr->nextBlock = NULL;
     }
-    cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
-    cachePtr->buckets[bucket].numFree -= numMove;
 
     /*
      * Aquire the lock and place the list of blocks at the front of the shared
@@ -869,10 +935,17 @@ PutBlocks(
      */
 
     LockBucket(cachePtr, bucket);
-    lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
+    cachePtr->buckets[bucket].lastPtr->nextBlock
+	    = sharedPtr->buckets[bucket].firstPtr;
     sharedPtr->buckets[bucket].firstPtr = firstPtr;
+    if (sharedPtr->buckets[bucket].numFree == 0) {
+	sharedPtr->buckets[bucket].lastPtr
+		= cachePtr->buckets[bucket].lastPtr;
+    }
     sharedPtr->buckets[bucket].numFree += numMove;
     UnlockBucket(cachePtr, bucket);
+
+    cachePtr->buckets[bucket].lastPtr = lastPtr;
 }
 
 /*
@@ -919,6 +992,8 @@ GetBlocks(
 	    if (n >= sharedPtr->buckets[bucket].numFree) {
 		cachePtr->buckets[bucket].firstPtr =
 			sharedPtr->buckets[bucket].firstPtr;
+		cachePtr->buckets[bucket].lastPtr =
+			sharedPtr->buckets[bucket].lastPtr;
 		cachePtr->buckets[bucket].numFree =
 			sharedPtr->buckets[bucket].numFree;
 		sharedPtr->buckets[bucket].firstPtr = NULL;
@@ -932,6 +1007,7 @@ GetBlocks(
 		    blockPtr = blockPtr->nextBlock;
 		}
 		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
+		cachePtr->buckets[bucket].lastPtr = blockPtr;
 		blockPtr->nextBlock = NULL;
 	    }
 	}
@@ -983,6 +1059,7 @@ GetBlocks(
 		((char *) blockPtr + bucketInfo[bucket].blockSize);
 	    blockPtr = blockPtr->nextBlock;
 	}
+	cachePtr->buckets[bucket].lastPtr = blockPtr;
 	blockPtr->nextBlock = NULL;
     }
     return 1;