diff options
Diffstat (limited to 'generic/tclIO.c')
| -rw-r--r-- | generic/tclIO.c | 2696 | 
1 files changed, 1440 insertions, 1256 deletions
| diff --git a/generic/tclIO.c b/generic/tclIO.c index ebbb3d1..58c7b3c 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9,8 +9,6 @@   *   * See the file "license.terms" for information on usage and redistribution of   * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclIO.c,v 1.137.2.17 2010/03/20 17:53:07 dkf Exp $   */  #include "tclInt.h" @@ -18,6 +16,108 @@  #include <assert.h>  /* + * For each channel handler registered in a call to Tcl_CreateChannelHandler, + * there is one record of the following type. All of records for a specific + * channel are chained together in a singly linked list which is stored in + * the channel structure. + */ + +typedef struct ChannelHandler { +    Channel *chanPtr;		/* The channel structure for this channel. */ +    int mask;			/* Mask of desired events. */ +    Tcl_ChannelProc *proc;	/* Procedure to call in the type of +				 * Tcl_CreateChannelHandler. */ +    ClientData clientData;	/* Argument to pass to procedure. */ +    struct ChannelHandler *nextPtr; +				/* Next one in list of registered handlers. */ +} ChannelHandler; + +/* + * This structure keeps track of the current ChannelHandler being invoked in + * the current invocation of ChannelHandlerEventProc. There is a potential + * problem if a ChannelHandler is deleted while it is the current one, since + * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this + * problem, structures of the type below indicate the next handler to be + * processed for any (recursively nested) dispatches in progress. The + * nextHandlerPtr field is updated if the handler being pointed to is deleted. + * The nextPtr field is used to chain together all recursive invocations, so + * that Tcl_DeleteChannelHandler can find all the recursively nested + * invocations of ChannelHandlerEventProc and compare the handler being + * deleted against the NEXT handler to be invoked in that invocation; when it + * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr + * field of the structure to the next handler. + */ + +typedef struct NextChannelHandler { +    ChannelHandler *nextHandlerPtr;	/* The next handler to be invoked in +					 * this invocation. */ +    struct NextChannelHandler *nestedHandlerPtr; +					/* Next nested invocation of +					 * ChannelHandlerEventProc. */ +} NextChannelHandler; + +/* + * The following structure describes the event that is added to the Tcl + * event queue by the channel handler check procedure. + */ + +typedef struct ChannelHandlerEvent { +    Tcl_Event header;		/* Standard header for all events. */ +    Channel *chanPtr;		/* The channel that is ready. */ +    int readyMask;		/* Events that have occurred. */ +} ChannelHandlerEvent; + +/* + * The following structure is used by Tcl_GetsObj() to encapsulates the + * state for a "gets" operation. + */ + +typedef struct GetsState { +    Tcl_Obj *objPtr;		/* The object to which UTF-8 characters +				 * will be appended. */ +    char **dstPtr;		/* Pointer into objPtr's string rep where +				 * next character should be stored. */ +    Tcl_Encoding encoding;	/* The encoding to use to convert raw bytes +				 * to UTF-8.  */ +    ChannelBuffer *bufPtr;	/* The current buffer of raw bytes being +				 * emptied. */ +    Tcl_EncodingState state;	/* The encoding state just before the last +				 * external to UTF-8 conversion in +				 * FilterInputBytes(). */ +    int rawRead;		/* The number of bytes removed from bufPtr +				 * in the last call to FilterInputBytes(). */ +    int bytesWrote;		/* The number of bytes of UTF-8 data +				 * appended to objPtr during the last call to +				 * FilterInputBytes(). */ +    int charsWrote;		/* The corresponding number of UTF-8 +				 * characters appended to objPtr during the +				 * last call to FilterInputBytes(). */ +    int totalChars;		/* The total number of UTF-8 characters +				 * appended to objPtr so far, just before the +				 * last call to FilterInputBytes(). */ +} GetsState; + +/* + * The following structure encapsulates the state for a background channel + * copy.  Note that the data buffer for the copy will be appended to this + * structure. + */ + +typedef struct CopyState { +    struct Channel *readPtr;	/* Pointer to input channel. */ +    struct Channel *writePtr;	/* Pointer to output channel. */ +    int readFlags;		/* Original read channel flags. */ +    int writeFlags;		/* Original write channel flags. */ +    Tcl_WideInt toRead;		/* Number of bytes to copy, or -1. */ +    Tcl_WideInt total;		/* Total bytes transferred (written). */ +    Tcl_Interp *interp;		/* Interp that started the copy. */ +    Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */ +    int bufSize;		/* Size of appended buffer. */ +    char buffer[1];		/* Copy buffer, this must be the last +                                 * field. */ +} CopyState; + +/*   * All static variables used in this file are collected into a single instance   * of the following structure. For multi-threaded implementations, there is   * one instance of this structure for each thread. @@ -46,15 +146,28 @@ typedef struct ThreadSpecificData {  static Tcl_ThreadDataKey dataKey;  /* + * Structure to record a close callback. One such record exists for + * each close callback registered for a channel. + */ + +typedef struct CloseCallback { +    Tcl_CloseProc *proc;		/* The procedure to call. */ +    ClientData clientData;		/* Arbitrary one-word data to pass +					 * to the callback. */ +    struct CloseCallback *nextPtr;	/* For chaining close callbacks. */ +} CloseCallback; + +/*   * Static functions in this file:   */  static ChannelBuffer *	AllocChannelBuffer(int length); +static void		PreserveChannelBuffer(ChannelBuffer *bufPtr); +static void		ReleaseChannelBuffer(ChannelBuffer *bufPtr); +static int		IsShared(ChannelBuffer *bufPtr);  static void		ChannelTimerProc(ClientData clientData);  static int		CheckChannelErrors(ChannelState *statePtr,  			    int direction); -static int		CheckFlush(Channel *chanPtr, ChannelBuffer *bufPtr, -			    int newlineFlag);  static int		CheckForDeadChannel(Tcl_Interp *interp,  			    ChannelState *statePtr);  static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan); @@ -62,6 +175,9 @@ static void		CleanupChannelHandlers(Tcl_Interp *interp,  			    Channel *chanPtr);  static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,  			    int errorCode); +static int		CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr, +			    int errorCode, int flags); +static int		CloseWrite(Tcl_Interp *interp, Channel *chanPtr);  static void		CommonGetsCleanup(Channel *chanPtr);  static int		CopyAndTranslateBuffer(ChannelState *statePtr,  			    char *result, int space); @@ -78,16 +194,15 @@ static int		DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);  static void		DiscardInputQueued(ChannelState *statePtr,  			    int discardSavedBuffers);  static void		DiscardOutputQueued(ChannelState *chanPtr); -static int		DoRead(Channel *chanPtr, char *srcPtr, int slen); -static int		DoWrite(Channel *chanPtr, const char *src, int srcLen); +static int		DoRead(Channel *chanPtr, char *srcPtr, int slen, int allowShortReads);  static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,  			    int appendFlag); -static int		DoWriteChars(Channel *chan, const char *src, int len);  static int		FilterInputBytes(Channel *chanPtr,  			    GetsState *statePtr);  static int		FlushChannel(Tcl_Interp *interp, Channel *chanPtr,  			    int calledFromAsyncFlush);  static int		TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr); +static Tcl_Encoding	GetBinaryEncoding();  static void		FreeBinaryEncoding(ClientData clientData);  static Tcl_HashTable *	GetChannelTable(Tcl_Interp *interp);  static int		GetInput(Channel *chanPtr); @@ -107,16 +222,18 @@ static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,  static void		StopCopy(CopyState *csPtr);  static int		TranslateInputEOL(ChannelState *statePtr, char *dst,  			    const char *src, int *dstLenPtr, int *srcLenPtr); -static int		TranslateOutputEOL(ChannelState *statePtr, char *dst, -			    const char *src, int *dstLenPtr, int *srcLenPtr);  static void		UpdateInterest(Channel *chanPtr); -static int		WriteBytes(Channel *chanPtr, const char *src, -			    int srcLen); -static int		WriteChars(Channel *chanPtr, const char *src, -			    int srcLen); +static int		Write(Channel *chanPtr, const char *src, +			    int srcLen, Tcl_Encoding encoding);  static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);  static void		SpliceChannel(Tcl_Channel chan);  static void		CutChannel(Tcl_Channel chan); +static int              WillRead(Channel *chanPtr); + +#define WriteChars(chanPtr, src, srcLen) \ +			Write(chanPtr, src, srcLen, chanPtr->state->encoding) +#define WriteBytes(chanPtr, src, srcLen) \ +			Write(chanPtr, src, srcLen, tclIdentityEncoding)  /*   * Simplifying helper macros. All may use their argument(s) multiple times. @@ -162,21 +279,21 @@ static void		CutChannel(Tcl_Channel chan);   * --------------------------------------------------------------------------   */ -#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved) +#define BytesLeft(bufPtr)	((bufPtr)->nextAdded - (bufPtr)->nextRemoved) -#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded) +#define SpaceLeft(bufPtr)	((bufPtr)->bufLength - (bufPtr)->nextAdded) -#define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved) +#define IsBufferReady(bufPtr)	((bufPtr)->nextAdded > (bufPtr)->nextRemoved) -#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved) +#define IsBufferEmpty(bufPtr)	((bufPtr)->nextAdded == (bufPtr)->nextRemoved) -#define IsBufferFull(bufPtr) ((bufPtr)->nextAdded >= (bufPtr)->bufLength) +#define IsBufferFull(bufPtr)	((bufPtr)->nextAdded >= (bufPtr)->bufLength) -#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->bufLength) +#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength) -#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded) +#define InsertPoint(bufPtr)	((bufPtr)->buf + (bufPtr)->nextAdded) -#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved) +#define RemovePoint(bufPtr)	((bufPtr)->buf + (bufPtr)->nextRemoved)  /*   * For working with channel state flag bits. @@ -184,6 +301,7 @@ static void		CutChannel(Tcl_Channel chan);  #define SetFlag(statePtr, flag)		((statePtr)->flags |= (flag))  #define ResetFlag(statePtr, flag)	((statePtr)->flags &= ~(flag)) +#define GotFlag(statePtr, flag)		((statePtr)->flags & (flag))  /*   * Macro for testing whether a string (in optionName, length len) matches a @@ -204,28 +322,28 @@ static void		CutChannel(Tcl_Channel chan);   */  static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); -static int		SetChannelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void		UpdateStringOfChannel(Tcl_Obj *objPtr); +static int		SetChannelFromAny(Tcl_Interp *interp, +			    Tcl_Obj *objPtr);  static void		FreeChannelIntRep(Tcl_Obj *objPtr); -static Tcl_ObjType tclChannelType = { +static const Tcl_ObjType chanObjType = {      "channel",			/* name for this type */      FreeChannelIntRep,		/* freeIntRepProc */      DupChannelIntRep,		/* dupIntRepProc */ -    NULL,			/* updateStringProc UpdateStringOfChannel */ +    NULL,			/* updateStringProc */      NULL			/* setFromAnyProc SetChannelFromAny */  };  #define GET_CHANNELSTATE(objPtr) \ -    ((ChannelState *) (objPtr)->internalRep.otherValuePtr) +    ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)  #define SET_CHANNELSTATE(objPtr, storePtr) \ -    ((objPtr)->internalRep.otherValuePtr = (void *) (storePtr)) +    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))  #define GET_CHANNELINTERP(objPtr) \ -    ((Interp *) (objPtr)->internalRep.twoPtrValue.ptr2) +    ((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)  #define SET_CHANNELINTERP(objPtr, storePtr) \      ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr)) -#define BUSY_STATE(st,fl) \ +#define BUSY_STATE(st, fl) \       ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \        (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) @@ -234,6 +352,114 @@ static Tcl_ObjType tclChannelType = {  /*   *---------------------------------------------------------------------------   * + * ChanClose, ChanRead, ChanSeek, ChanThreadAction, ChanWatch, ChanWrite -- + * + *	Simplify the access to selected channel driver "methods" that are used + *	in multiple places in a stereotypical fashion. These are just thin + *	wrappers around the driver functions. + * + *--------------------------------------------------------------------------- + */ + +static inline int +ChanClose( +    Channel *chanPtr, +    Tcl_Interp *interp) +{ +    if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { +	return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp); +    } else { +	return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0); +    } +} + +static inline int +ChanCloseHalf( +    Channel *chanPtr, +    Tcl_Interp *interp, +    int flags) +{ +    return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, flags); +} + +static inline int +ChanRead( +    Channel *chanPtr, +    char *dst, +    int dstSize, +    int *errnoPtr) +{ +    if (WillRead(chanPtr) < 0) { +	*errnoPtr = Tcl_GetErrno(); +        return -1; +    } + +    return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize, +	    errnoPtr); +} + +static inline Tcl_WideInt +ChanSeek( +    Channel *chanPtr, +    Tcl_WideInt offset, +    int mode, +    int *errnoPtr) +{ +    /* +     * Note that we prefer the wideSeekProc if that field is available in the +     * type and non-NULL. +     */ + +    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) && +	    chanPtr->typePtr->wideSeekProc != NULL) { +	return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData, +		offset, mode, errnoPtr); +    } + +    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) { +	*errnoPtr = EOVERFLOW; +	return Tcl_LongAsWide(-1); +    } + +    return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData, +	    Tcl_WideAsLong(offset), mode, errnoPtr)); +} + +static inline void +ChanThreadAction( +    Channel *chanPtr, +    int action) +{ +    Tcl_DriverThreadActionProc *threadActionProc = +	    Tcl_ChannelThreadActionProc(chanPtr->typePtr); + +    if (threadActionProc != NULL) { +	threadActionProc(chanPtr->instanceData, action); +    } +} + +static inline void +ChanWatch( +    Channel *chanPtr, +    int mask) +{ +    chanPtr->typePtr->watchProc(chanPtr->instanceData, mask); +} + +static inline int +ChanWrite( +    Channel *chanPtr, +    const char *src, +    int srcLen, +    int *errnoPtr) +{ +    return chanPtr->typePtr->outputProc(chanPtr->instanceData, src, srcLen, +	    errnoPtr); +} + +/* + *--------------------------------------------------------------------------- + *   * TclInitIOSubsystem --   *   *	Initialize all resources used by this subsystem on a per-process @@ -285,6 +511,19 @@ TclFinalizeIOSubsystem(void)      Channel *chanPtr = NULL;	/* Iterates over open channels. */      ChannelState *statePtr;	/* State of channel stack */      int active = 1;		/* Flag == 1 while there's still work to do */ +    int doflushnb; + +    /* Fetch the pre-TIP#398 compatibility flag */  +    { +        const char *s; +        Tcl_DString ds; +         +        s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); +        doflushnb = ((s != NULL) && strcmp(s, "0")); +        if (s != NULL) { +            Tcl_DStringFree(&ds); +        } +    }      /*       * Walk all channel state structures known to this thread and close @@ -303,24 +542,37 @@ TclFinalizeIOSubsystem(void)  		statePtr != NULL;  		statePtr = statePtr->nextCSPtr) {  	    chanPtr = statePtr->topChanPtr; -	    if (!(statePtr->flags & (CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD))) { +            if (GotFlag(statePtr, CHANNEL_DEAD)) { +                continue; +            } +	    if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED ) +                || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { +                ResetFlag(statePtr, BG_FLUSH_SCHEDULED);  		active = 1;  		break;  	    }  	}  	/* -	 * We've found a live channel. Close it. +	 * We've found a live (or bg-closing) channel. Close it.  	 */  	if (active) { +  	    /* -	     * Set the channel back into blocking mode to ensure that we wait -	     * for all data to flush out. +	     * TIP #398:  by default, we no  longer set the  channel back into +             * blocking  mode.  To  restore  the old  blocking  behavior,  the +             * environment variable  TCL_FLUSH_NONBLOCKING_ON_EXIT must be set +             * and not be "0".  	     */ - -	    (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, -		    "-blocking", "on"); +            if (doflushnb) { +                    /* Set the channel back into blocking mode to ensure that we wait +                     * for all data to flush out. +                     */ +                 +                (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, +                                            "-blocking", "on");                     +            }  	    if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||  		    (chanPtr == (Channel *) tsdPtr->stdoutChannel) || @@ -353,12 +605,7 @@ TclFinalizeIOSubsystem(void)  		 * device for this channel.  		 */ -		if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { -		    (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL); -		} else { -		    (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, -			    NULL, 0); -		} +		(void) ChanClose(chanPtr, NULL);  		/*  		 * Finally, we clean up the fields in the channel data @@ -400,6 +647,7 @@ Tcl_SetStdChannel(      int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */  {      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); +      switch (type) {      case TCL_STDIN:  	tsdPtr->stdinInitialized = 1; @@ -516,12 +764,10 @@ Tcl_CreateCloseHandler(      ClientData clientData)	/* Arbitrary data to pass to the close  				 * callback. */  { -    ChannelState *statePtr; +    ChannelState *statePtr = ((Channel *) chan)->state;      CloseCallback *cbPtr; -    statePtr = ((Channel *) chan)->state; - -    cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback)); +    cbPtr = ckalloc(sizeof(CloseCallback));      cbPtr->proc = proc;      cbPtr->clientData = clientData; @@ -556,21 +802,21 @@ Tcl_DeleteCloseHandler(      ClientData clientData)	/* The callback data for the callback to  				 * remove. */  { -    ChannelState *statePtr; +    ChannelState *statePtr = ((Channel *) chan)->state;      CloseCallback *cbPtr, *cbPrevPtr; -    statePtr = ((Channel *) chan)->state;      for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;  	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {  	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {  	    if (cbPrevPtr == NULL) {  		statePtr->closeCbPtr = cbPtr->nextPtr; +	    } else { +		cbPrevPtr->nextPtr = cbPtr->nextPtr;  	    } -	    ckfree((char *) cbPtr); +	    ckfree(cbPtr);  	    break; -	} else { -	    cbPrevPtr = cbPtr;  	} +	cbPrevPtr = cbPtr;      }  } @@ -602,7 +848,7 @@ GetChannelTable(      hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);      if (hTblPtr == NULL) { -	hTblPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); +	hTblPtr = ckalloc(sizeof(Tcl_HashTable));  	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);  	Tcl_SetAssocData(interp, "tclIO",  		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr); @@ -691,10 +937,10 @@ DeleteChannelTable(  		}  		Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, -			TclChannelEventScriptInvoker, (ClientData) sPtr); +			TclChannelEventScriptInvoker, sPtr);  		TclDecrRefCount(sPtr->scriptPtr); -		ckfree((char *) sPtr); +		ckfree(sPtr);  	    } else {  		prevPtr = sPtr;  	    } @@ -711,14 +957,14 @@ DeleteChannelTable(  	SetFlag(statePtr, CHANNEL_TAINTED);  	statePtr->refCount--;  	if (statePtr->refCount <= 0) { -	    if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { +	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {  		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);  	    }  	}      }      Tcl_DeleteHashTable(hTblPtr); -    ckfree((char *) hTblPtr); +    ckfree(hTblPtr);  }  /* @@ -750,21 +996,25 @@ CheckForStdChannelsBeingClosed(      ChannelState *statePtr = ((Channel *) chan)->state;      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); -    if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) { +    if (tsdPtr->stdinInitialized +	    && tsdPtr->stdinChannel != NULL +	    && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {  	if (statePtr->refCount < 2) {  	    statePtr->refCount = 0;  	    tsdPtr->stdinChannel = NULL;  	    return;  	} -    } else if ((chan == tsdPtr->stdoutChannel) -	    && (tsdPtr->stdoutInitialized)) { +    } else if (tsdPtr->stdoutInitialized +	    && tsdPtr->stdoutChannel != NULL +	    && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {  	if (statePtr->refCount < 2) {  	    statePtr->refCount = 0;  	    tsdPtr->stdoutChannel = NULL;  	    return;  	} -    } else if ((chan == tsdPtr->stderrChannel) -	    && (tsdPtr->stderrInitialized)) { +    } else if (tsdPtr->stderrInitialized +	    && tsdPtr->stderrChannel != NULL +	    && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {  	if (statePtr->refCount < 2) {  	    statePtr->refCount = 0;  	    tsdPtr->stderrChannel = NULL; @@ -898,10 +1148,11 @@ Tcl_UnregisterChannel(      statePtr = ((Channel *) chan)->state->bottomChanPtr->state; -    if (statePtr->flags & CHANNEL_INCLOSE) { +    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {  	if (interp != NULL) { -	    Tcl_AppendResult(interp, "Illegal recursive call to close " -		    "through close-handler of channel", NULL); +	    Tcl_SetObjResult(interp, Tcl_NewStringObj( +                    "illegal recursive call to close through close-handler" +                    " of channel", -1));  	}  	return TCL_ERROR;      } @@ -936,22 +1187,22 @@ Tcl_UnregisterChannel(  		IsBufferReady(statePtr->curOutPtr)) {  	    SetFlag(statePtr, BUFFER_READY);  	} -	Tcl_Preserve((ClientData)statePtr); -	if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { +	Tcl_Preserve(statePtr); +	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {  	    /*  	     * We don't want to re-enter Tcl_Close().  	     */ -	    if (!(statePtr->flags & CHANNEL_CLOSED)) { +	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {  		if (Tcl_Close(interp, chan) != TCL_OK) {  		    SetFlag(statePtr, CHANNEL_CLOSED); -		    Tcl_Release((ClientData)statePtr); +		    Tcl_Release(statePtr);  		    return TCL_ERROR;  		}  	    }  	}  	SetFlag(statePtr, CHANNEL_CLOSED); -	Tcl_Release((ClientData)statePtr); +	Tcl_Release(statePtr);      }      return TCL_OK;  } @@ -1136,8 +1387,8 @@ Tcl_GetChannel(      hTblPtr = GetChannelTable(interp);      hPtr = Tcl_FindHashEntry(hTblPtr, name);      if (hPtr == NULL) { -	Tcl_AppendResult(interp, "can not find channel named \"", chanName, -		"\"", NULL); +	Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                "can not find channel named \"%s\"", chanName));  	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);  	return NULL;      } @@ -1151,7 +1402,7 @@ Tcl_GetChannel(      chanPtr = Tcl_GetHashValue(hPtr);      chanPtr = chanPtr->state->bottomChanPtr;      if (modePtr != NULL) { -	*modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE)); +	*modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE);      }      return (Tcl_Channel) chanPtr; @@ -1196,10 +1447,10 @@ TclGetChannelFromObj(      }      statePtr = GET_CHANNELSTATE(objPtr); -    *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr); +    *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;      if (modePtr != NULL) { -	*modePtr = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE)); +	*modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE);      }      return TCL_OK; @@ -1223,7 +1474,7 @@ TclGetChannelFromObj(  Tcl_Channel  Tcl_CreateChannel( -    Tcl_ChannelType *typePtr, /* The channel type record. */ +    const Tcl_ChannelType *typePtr, /* The channel type record. */      const char *chanName,	/* Name of channel to record. */      ClientData instanceData,	/* Instance specific data. */      int mask)			/* TCL_READABLE & TCL_WRITABLE to indicate if @@ -1233,6 +1484,7 @@ Tcl_CreateChannel(      ChannelState *statePtr;	/* The stack-level independent state info for  				 * the channel. */      const char *name; +    char *tmp;      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      /* @@ -1245,15 +1497,15 @@ Tcl_CreateChannel(       * as well.       */ -    assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*)); +    assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *));      /*       * JH: We could subsequently memset these to 0 to avoid the numerous       * assignments to 0/NULL below.       */ -    chanPtr = (Channel *) ckalloc(sizeof(Channel)); -    statePtr = (ChannelState *) ckalloc(sizeof(ChannelState)); +    chanPtr = ckalloc(sizeof(Channel)); +    statePtr = ckalloc(sizeof(ChannelState));      chanPtr->state = statePtr;      chanPtr->instanceData = instanceData; @@ -1265,14 +1517,20 @@ Tcl_CreateChannel(       */      if (chanName != NULL) { -	char *tmp = ckalloc((unsigned) (strlen(chanName) + 1)); +	unsigned len = strlen(chanName) + 1; + +	/* +         * Make sure we allocate at least 7 bytes, so it fits for "stdout" +         * later. +         */ -	statePtr->channelName = tmp; +	tmp = ckalloc((len < 7) ? 7 : len);  	strcpy(tmp, chanName);      } else { -	Tcl_Panic("Tcl_CreateChannel: NULL channel name"); +	tmp = ckalloc(7); +	tmp[0] = '\0';      } - +    statePtr->channelName = tmp;      statePtr->flags = mask;      /* @@ -1324,12 +1582,7 @@ Tcl_CreateChannel(      statePtr->timer		= NULL;      statePtr->csPtrR		= NULL;      statePtr->csPtrW		= NULL; -      statePtr->outputStage	= NULL; -    if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) { -	statePtr->outputStage = (char *) -		ckalloc((unsigned) (statePtr->bufSize + 2)); -    }      /*       * As we are creating the channel, it is obviously the top for now. @@ -1375,14 +1628,17 @@ Tcl_CreateChannel(       */      if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) { +	strcpy(tmp, "stdin");  	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);  	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);      } else if ((tsdPtr->stdoutChannel == NULL) &&  	    (tsdPtr->stdoutInitialized == 1)) { +	strcpy(tmp, "stdout");  	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);  	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);      } else if ((tsdPtr->stderrChannel == NULL) &&  	    (tsdPtr->stderrInitialized == 1)) { +	strcpy(tmp, "stderr");  	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);  	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);      } @@ -1419,7 +1675,8 @@ Tcl_CreateChannel(  Tcl_Channel  Tcl_StackChannel(      Tcl_Interp *interp,		/* The interpreter we are working in */ -    Tcl_ChannelType *typePtr,	/* The channel type record for the new +    const Tcl_ChannelType *typePtr, +				/* The channel type record for the new  				 * channel. */      ClientData instanceData,	/* Instance specific data for the new  				 * channel. */ @@ -1430,7 +1687,6 @@ Tcl_StackChannel(      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      Channel *chanPtr, *prevChanPtr;      ChannelState *statePtr; -    Tcl_DriverThreadActionProc *threadActionProc;      /*       * Find the given channel (prevChan) in the list of all channels. If we do @@ -1448,8 +1704,9 @@ Tcl_StackChannel(      if (statePtr == NULL) {  	if (interp) { -	    Tcl_AppendResult(interp, "couldn't find state for channel \"", -		    Tcl_GetChannelName(prevChan), "\"", NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                    "couldn't find state for channel \"%s\"", +		    Tcl_GetChannelName(prevChan)));  	}  	return NULL;      } @@ -1469,9 +1726,9 @@ Tcl_StackChannel(      if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {  	if (interp) { -	    Tcl_AppendResult(interp, -		    "reading and writing both disallowed for channel \"", -		    Tcl_GetChannelName(prevChan), "\"", NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +		    "reading and writing both disallowed for channel \"%s\"", +		    Tcl_GetChannelName(prevChan)));  	}  	return NULL;      } @@ -1484,21 +1741,23 @@ Tcl_StackChannel(       */      if ((mask & TCL_WRITABLE) != 0) { -        CopyState *csPtrR; -        CopyState *csPtrW; +	CopyState *csPtrR = statePtr->csPtrR; +	CopyState *csPtrW = statePtr->csPtrW; -        csPtrR           = statePtr->csPtrR;  	statePtr->csPtrR = NULL; - -        csPtrW           = statePtr->csPtrW;  	statePtr->csPtrW = NULL; +	/* +	 * TODO: Examine what can go wrong if Tcl_Flush() call disturbs +	 * the stacking state of this channel during its operations. +	 */  	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {  	    statePtr->csPtrR = csPtrR;  	    statePtr->csPtrW = csPtrW;  	    if (interp) { -		Tcl_AppendResult(interp, "could not flush channel \"", -			Tcl_GetChannelName(prevChan), "\"", NULL); +		Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                        "could not flush channel \"%s\"", +			Tcl_GetChannelName(prevChan)));  	    }  	    return NULL;  	} @@ -1539,7 +1798,7 @@ Tcl_StackChannel(  	statePtr->inQueueTail = NULL;      } -    chanPtr = (Channel *) ckalloc(sizeof(Channel)); +    chanPtr = ckalloc(sizeof(Channel));      /*       * Save some of the current state into the new structure, reinitialize the @@ -1575,10 +1834,7 @@ Tcl_StackChannel(       * time, mangling it.       */ -    threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr); -    if (threadActionProc != NULL) { -	(*threadActionProc)(chanPtr->instanceData, TCL_CHANNEL_THREAD_INSERT); -    } +    ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);      return (Tcl_Channel) chanPtr;  } @@ -1609,7 +1865,6 @@ Tcl_UnstackChannel(      Channel *chanPtr = (Channel *) chan;      ChannelState *statePtr = chanPtr->state;      int result = 0; -    Tcl_DriverThreadActionProc *threadActionProc;      /*       * This operation should occur at the top of a channel stack. @@ -1620,9 +1875,16 @@ Tcl_UnstackChannel(      if (chanPtr->downChanPtr != NULL) {  	/*  	 * Instead of manipulating the per-thread / per-interp list/hashtable -	 * of registered channels we wind down the state of the transformation, -	 * and then restore the state of underlying channel into the old -	 * structure. +	 * of registered channels we wind down the state of the +	 * transformation, and then restore the state of underlying channel +	 * into the old structure. +	 */ + +	/* +	 * TODO: Figure out how to handle the situation where the chan +	 * operations called below by this unstacking operation cause +	 * another unstacking recursively.  In that case the downChanPtr +	 * value we're holding on to will not be the right thing.  	 */  	Channel *downChanPtr = chanPtr->downChanPtr; @@ -1635,14 +1897,11 @@ Tcl_UnstackChannel(  	 * CheckForChannelErrors inside.  	 */ -	if (statePtr->flags & TCL_WRITABLE) { -	    CopyState *csPtrR; -	    CopyState *csPtrW; +	if (GotFlag(statePtr, TCL_WRITABLE)) { +	    CopyState *csPtrR = statePtr->csPtrR; +	    CopyState *csPtrW = statePtr->csPtrW; -	    csPtrR           = statePtr->csPtrR;  	    statePtr->csPtrR = NULL; - -	    csPtrW           = statePtr->csPtrW;  	    statePtr->csPtrW = NULL;  	    if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) { @@ -1658,9 +1917,9 @@ Tcl_UnstackChannel(  		 */  		if (!TclChanCaughtErrorBypass(interp, chan) && interp) { -		    Tcl_AppendResult(interp, "could not flush channel \"", -			    Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"", -			    NULL); +		    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                            "could not flush channel \"%s\"", +			    Tcl_GetChannelName((Tcl_Channel) chanPtr)));  		}  		return TCL_ERROR;  	    } @@ -1679,16 +1938,14 @@ Tcl_UnstackChannel(  	 * 'DiscardInputQueued' on that.  	 */ -	if ((((statePtr->flags & TCL_READABLE) != 0)) && +	if (GotFlag(statePtr, TCL_READABLE) &&  		((statePtr->inQueueHead != NULL) ||  		(chanPtr->inQueueHead != NULL))) { -  	    if ((statePtr->inQueueHead != NULL) &&  		    (chanPtr->inQueueHead != NULL)) {  		statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;  		statePtr->inQueueTail = chanPtr->inQueueTail;  		statePtr->inQueueHead = statePtr->inQueueTail; -  	    } else if (chanPtr->inQueueHead != NULL) {  		statePtr->inQueueHead = chanPtr->inQueueHead;  		statePtr->inQueueTail = chanPtr->inQueueTail; @@ -1712,11 +1969,7 @@ Tcl_UnstackChannel(  	 * the state which are still active.  	 */ -	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr); -	if (threadActionProc != NULL) { -	    (*threadActionProc)(chanPtr->instanceData, -		    TCL_CHANNEL_THREAD_REMOVE); -	} +	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);  	statePtr->topChanPtr = downChanPtr;  	downChanPtr->upChanPtr = NULL; @@ -1730,14 +1983,7 @@ Tcl_UnstackChannel(  	 * Close and free the channel driver state.  	 */ -	if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { -	    result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, -		    interp); -	} else { -	    result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, -		    interp, 0); -	} - +	result = ChanClose(chanPtr, interp);  	chanPtr->typePtr = NULL;  	/* @@ -1745,7 +1991,7 @@ Tcl_UnstackChannel(  	 */  	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC); -	UpdateInterest(downChanPtr); +	UpdateInterest(statePtr->topChanPtr);  	if (result != 0) {  	    Tcl_SetErrno(result); @@ -1913,7 +2159,7 @@ Tcl_GetChannelThread(   *----------------------------------------------------------------------   */ -Tcl_ChannelType * +const Tcl_ChannelType *  Tcl_GetChannelType(      Tcl_Channel chan)		/* The channel to return type for. */  { @@ -1972,9 +2218,9 @@ const char *  Tcl_GetChannelName(      Tcl_Channel chan)		/* The channel for which to return the name. */  { -    ChannelState *statePtr;	/* State of actual channel. */ +    ChannelState *statePtr = ((Channel *) chan)->state; +				/* State of actual channel. */ -    statePtr = ((Channel *) chan)->state;      return statePtr->channelName;  } @@ -2007,15 +2253,13 @@ Tcl_GetChannelHandle(      chanPtr = ((Channel *) chan)->state->bottomChanPtr;      if (!chanPtr->typePtr->getHandleProc) { -	Tcl_Obj* err; -	TclNewLiteralStringObj(err, "channel \""); -	Tcl_AppendToObj(err, Tcl_GetChannelName(chan), -1); -	Tcl_AppendToObj(err, "\" does not support OS handles", -1); -	Tcl_SetChannelError (chan,err); +        Tcl_SetChannelError(chan, Tcl_ObjPrintf( +                "channel \"%s\" does not support OS handles", +                Tcl_GetChannelName(chan)));  	return TCL_ERROR;      } -    result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData, -	    direction, &handle); +    result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction, +	    &handle);      if (handlePtr) {  	*handlePtr = handle;      } @@ -2054,13 +2298,38 @@ AllocChannelBuffer(      int n;      n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING; -    bufPtr = (ChannelBuffer *) ckalloc((unsigned) n); +    bufPtr = ckalloc(n);      bufPtr->nextAdded	= BUFFER_PADDING;      bufPtr->nextRemoved	= BUFFER_PADDING;      bufPtr->bufLength	= length + BUFFER_PADDING;      bufPtr->nextPtr	= NULL; +    bufPtr->refCount	= 1;      return bufPtr;  } + +static void +PreserveChannelBuffer( +    ChannelBuffer *bufPtr) +{ +    bufPtr->refCount++; +} + +static void +ReleaseChannelBuffer( +    ChannelBuffer *bufPtr) +{ +    if (--bufPtr->refCount) { +	return; +    } +    ckfree(bufPtr); +} + +static int +IsShared( +    ChannelBuffer *bufPtr) +{ +    return bufPtr->refCount > 1; +}  /*   *---------------------------------------------------------------------- @@ -2091,9 +2360,12 @@ RecycleBuffer(      /*       * Do we have to free the buffer to the OS?       */ +    if (IsShared(bufPtr)) { +	mustDiscard = 1; +    }      if (mustDiscard) { -	ckfree((char *) bufPtr); +	ReleaseChannelBuffer(bufPtr);  	return;      } @@ -2104,7 +2376,7 @@ RecycleBuffer(       */      if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) { -	ckfree((char *) bufPtr); +	ReleaseChannelBuffer(bufPtr);  	return;      } @@ -2112,7 +2384,7 @@ RecycleBuffer(       * Only save buffers for the input queue if the channel is readable.       */ -    if (statePtr->flags & TCL_READABLE) { +    if (GotFlag(statePtr, TCL_READABLE)) {  	if (statePtr->inQueueHead == NULL) {  	    statePtr->inQueueHead = bufPtr;  	    statePtr->inQueueTail = bufPtr; @@ -2128,7 +2400,7 @@ RecycleBuffer(       * Only save buffers for the output queue if the channel is writable.       */ -    if (statePtr->flags & TCL_WRITABLE) { +    if (GotFlag(statePtr, TCL_WRITABLE)) {  	if (statePtr->curOutPtr == NULL) {  	    statePtr->curOutPtr = bufPtr;  	    goto keepBuffer; @@ -2139,7 +2411,7 @@ RecycleBuffer(       * If we reached this code we return the buffer to the OS.       */ -    ckfree((char *) bufPtr); +    ReleaseChannelBuffer(bufPtr);      return;    keepBuffer: @@ -2201,15 +2473,16 @@ CheckForDeadChannel(      Tcl_Interp *interp,		/* For error reporting (can be NULL) */      ChannelState *statePtr)	/* The channel state to check. */  { -    if (statePtr->flags & CHANNEL_DEAD) { -	Tcl_SetErrno(EINVAL); -	if (interp) { -	    Tcl_AppendResult(interp, -		    "unable to access channel: invalid channel", NULL); -	} -	return 1; +    if (!GotFlag(statePtr, CHANNEL_DEAD)) { +	return 0;      } -    return 0; + +    Tcl_SetErrno(EINVAL); +    if (interp) { +	Tcl_SetObjResult(interp, Tcl_NewStringObj( +                "unable to access channel: invalid channel", -1)); +    } +    return 1;  }  /* @@ -2217,9 +2490,9 @@ CheckForDeadChannel(   *   * FlushChannel --   * - *	This function flushes as much of the queued output as is possible - *	now. If calledFromAsyncFlush is nonzero, it is being called in an - *	event handler to flush channel output asynchronously. + *	This function flushes as much of the queued output as is possible now. + *	If calledFromAsyncFlush is nonzero, it is being called in an event + *	handler to flush channel output asynchronously.   *   * Results:   *	0 if successful, else the error code that was returned by the channel @@ -2268,6 +2541,7 @@ FlushChannel(       * of the queued output to the channel.       */ +    Tcl_Preserve(chanPtr);      while (1) {  	/*  	 * If the queue is empty and there is a ready current buffer, OR if @@ -2277,7 +2551,7 @@ FlushChannel(  	if (((statePtr->curOutPtr != NULL) &&  		IsBufferFull(statePtr->curOutPtr)) -		|| ((statePtr->flags & BUFFER_READY) && +		|| (GotFlag(statePtr, BUFFER_READY) &&  			(statePtr->outQueueHead == NULL))) {  	    ResetFlag(statePtr, BUFFER_READY);  	    statePtr->curOutPtr->nextPtr = NULL; @@ -2296,9 +2570,9 @@ FlushChannel(  	 * is active, we just return without producing any output.  	 */ -	if ((!calledFromAsyncFlush) && -		(statePtr->flags & BG_FLUSH_SCHEDULED)) { -	    return 0; +	if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { +	    errorCode = 0; +	    goto done;  	}  	/* @@ -2306,19 +2580,20 @@ FlushChannel(  	 */  	if (bufPtr == NULL) { -	    break;	/* Out of the "while (1)". */ +	    break;		/* Out of the "while (1)". */  	}  	/*  	 * Produce the output on the channel.  	 */ +	PreserveChannelBuffer(bufPtr);  	toWrite = BytesLeft(bufPtr);  	if (toWrite == 0) { -	    written = 0; +            written = 0;  	} else { -	    written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData, -		RemovePoint(bufPtr), toWrite, &errorCode); +	    written = ChanWrite(chanPtr, RemovePoint(bufPtr), toWrite, +		    &errorCode);  	}  	/* @@ -2350,7 +2625,7 @@ FlushChannel(  		 * it's a tty channel (dup'ed underneath)  		 */ -		if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { +		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) {  		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);  		    UpdateInterest(chanPtr);  		} @@ -2400,14 +2675,8 @@ FlushChannel(  		Tcl_SetErrno(errorCode);  		if (interp != NULL && !TclChanCaughtErrorBypass(interp,  			(Tcl_Channel) chanPtr)) { -		    /* -		     * Casting away const here is safe because the -		     * TCL_VOLATILE flag guarantees const treatment of the -		     * Posix error string. -		     */ - -		    Tcl_SetResult(interp, (char *) Tcl_PosixError(interp), -			    TCL_VOLATILE); +		    Tcl_SetObjResult(interp, +			    Tcl_NewStringObj(Tcl_PosixError(interp), -1));  		}  		/* @@ -2427,7 +2696,9 @@ FlushChannel(  	    wroteSome = 1;  	} -	bufPtr->nextRemoved += written; +	if (!IsBufferEmpty(bufPtr)) { +	    bufPtr->nextRemoved += written; +	}  	/*  	 * If this buffer is now empty, recycle it. @@ -2440,6 +2711,7 @@ FlushChannel(  	    }  	    RecycleBuffer(statePtr, bufPtr, 0);  	} +	ReleaseChannelBuffer(bufPtr);      }	/* Closes "while (1)". */      /* @@ -2449,13 +2721,12 @@ FlushChannel(       * data has been flushed at the system level.       */ -    if (statePtr->flags & BG_FLUSH_SCHEDULED) { +    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {  	if (wroteSome) { -	    return errorCode; +	    goto done;  	} else if (statePtr->outQueueHead == NULL) {  	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED); -	    (chanPtr->typePtr->watchProc)(chanPtr->instanceData, -		    statePtr->interestMask); +	    ChanWatch(chanPtr, statePtr->interestMask);  	}      } @@ -2465,12 +2736,30 @@ FlushChannel(       * current output buffer.       */ -    if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) && +    if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) && +	    (statePtr->outQueueHead == NULL) && +	    ((statePtr->curOutPtr == NULL) || +	    IsBufferEmpty(statePtr->curOutPtr))) { +	errorCode = CloseChannel(interp, chanPtr, errorCode); +	goto done; +    } + +    /* +     * If the write-side of the channel is flagged as closed, delete it when +     * the output queue is empty and there is no output in the current output +     * buffer. +     */ + +    if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) &&  	    (statePtr->outQueueHead == NULL) &&  	    ((statePtr->curOutPtr == NULL) ||  	    IsBufferEmpty(statePtr->curOutPtr))) { -	return CloseChannel(interp, chanPtr, errorCode); +	errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE); +	goto done;      } + +  done: +    Tcl_Release(chanPtr);      return errorCode;  } @@ -2524,7 +2813,7 @@ CloseChannel(       */      if (statePtr->curOutPtr != NULL) { -	ckfree((char *) statePtr->curOutPtr); +	ReleaseChannelBuffer(statePtr->curOutPtr);  	statePtr->curOutPtr = NULL;      } @@ -2541,11 +2830,11 @@ CloseChannel(       * device.       */ -    if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) { +    if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {  	int dummy;  	char c = (char) statePtr->outEofChar; -	(chanPtr->typePtr->outputProc)(chanPtr->instanceData, &c, 1, &dummy); +	(void) ChanWrite(chanPtr, &c, 1, &dummy);      }      /* @@ -2556,7 +2845,7 @@ CloseChannel(      if (statePtr->chanMsg != NULL) {  	if (interp != NULL) { -	    Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg); +	    Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);  	}  	TclDecrRefCount(statePtr->chanMsg);  	statePtr->chanMsg = NULL; @@ -2573,12 +2862,7 @@ CloseChannel(       * This may leave a TIP #219 error message in the interp.       */ -    if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { -	result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp); -    } else { -	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, -		interp, 0); -    } +    result = ChanClose(chanPtr, interp);      /*       * Some resources can be cleared only if the bottom channel in a stack is @@ -2587,15 +2871,11 @@ CloseChannel(      if (chanPtr == statePtr->bottomChanPtr) {  	if (statePtr->channelName != NULL) { -	    ckfree((char *) statePtr->channelName); +	    ckfree(statePtr->channelName);  	    statePtr->channelName = NULL;  	}  	Tcl_FreeEncoding(statePtr->encoding); -	if (statePtr->outputStage != NULL) { -	    ckfree((char *) statePtr->outputStage); -	    statePtr->outputStage = NULL; -	}      }      /* @@ -2617,7 +2897,7 @@ CloseChannel(  	    statePtr->chanMsg = NULL;  	}  	if (interp) { -	    Tcl_SetChannelErrorInterp(interp,statePtr->unreportedMsg); +	    Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);  	}      }      if (errorCode == 0) { @@ -2702,7 +2982,6 @@ CutChannel(  				 * the list on close. */      ChannelState *statePtr = ((Channel *) chan)->state;  				/* State of the channel stack. */ -    Tcl_DriverThreadActionProc *threadActionProc;      /*       * Remove this channel from of the list of all channels (in the current @@ -2729,11 +3008,7 @@ CutChannel(       * TIP #218, Channel Thread Actions       */ -    threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan)); -    if (threadActionProc != NULL) { -	(*threadActionProc)(Tcl_GetChannelInstanceData(chan), -		TCL_CHANNEL_THREAD_REMOVE); -    } +    ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_REMOVE);  }  void @@ -2748,7 +3023,6 @@ Tcl_CutChannel(  				 * the list on close. */      ChannelState *statePtr = chanPtr->state;  				/* State of the channel stack. */ -    Tcl_DriverThreadActionProc *threadActionProc;      /*       * Remove this channel from of the list of all channels (in the current @@ -2776,13 +3050,8 @@ Tcl_CutChannel(       * For all transformations and the base channel.       */ -    while (chanPtr) { -	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr); -	if (threadActionProc != NULL) { -	    (*threadActionProc)(chanPtr->instanceData, -		    TCL_CHANNEL_THREAD_REMOVE); -	} -	chanPtr= chanPtr->upChanPtr; +    for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) { +	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);      }  } @@ -2819,7 +3088,6 @@ SpliceChannel(  {      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ChannelState *statePtr = ((Channel *) chan)->state; -    Tcl_DriverThreadActionProc *threadActionProc;      if (statePtr->nextCSPtr != NULL) {  	Tcl_Panic("SpliceChannel: trying to add channel used in different list"); @@ -2840,11 +3108,7 @@ SpliceChannel(       * TIP #218, Channel Thread Actions       */ -    threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan)); -    if (threadActionProc != NULL) { -	(*threadActionProc) (Tcl_GetChannelInstanceData(chan), -		TCL_CHANNEL_THREAD_INSERT); -    } +    ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_INSERT);  }  void @@ -2855,7 +3119,6 @@ Tcl_SpliceChannel(      Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ChannelState *statePtr = chanPtr->state; -    Tcl_DriverThreadActionProc *threadActionProc;      if (statePtr->nextCSPtr != NULL) {  	Tcl_Panic("SpliceChannel: trying to add channel used in different list"); @@ -2877,13 +3140,8 @@ Tcl_SpliceChannel(       * For all transformations and the base channel.       */ -    while (chanPtr) { -	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr); -	if (threadActionProc != NULL) { -	    (*threadActionProc)(chanPtr->instanceData, -		    TCL_CHANNEL_THREAD_INSERT); -	} -	chanPtr= chanPtr->upChanPtr; +    for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) { +	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);      }  } @@ -2950,10 +3208,11 @@ Tcl_Close(  	Tcl_Panic("called Tcl_Close on channel with refCount > 0");      } -    if (statePtr->flags & CHANNEL_INCLOSE) { +    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {  	if (interp) { -	    Tcl_AppendResult(interp, "Illegal recursive call to close " -		    "through close-handler of channel", NULL); +	    Tcl_SetObjResult(interp, Tcl_NewStringObj( +                    "illegal recursive call to close through close-handler" +                    " of channel", -1));  	}  	return TCL_ERROR;      } @@ -2966,7 +3225,8 @@ Tcl_Close(      stickyError = 0; -    if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL) +    if ((statePtr->encoding != NULL) +	    && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)  	    && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {  	statePtr->outputEncodingFlags |= TCL_ENCODING_END;  	if (WriteChars(chanPtr, "", 0) < 0) { @@ -2981,7 +3241,7 @@ Tcl_Close(  	if (statePtr->chanMsg != NULL) {  	    if (interp != NULL) { -		Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg); +		Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);  	    }  	    TclDecrRefCount(statePtr->chanMsg);  	    statePtr->chanMsg = NULL; @@ -2997,8 +3257,8 @@ Tcl_Close(      while (statePtr->closeCbPtr != NULL) {  	cbPtr = statePtr->closeCbPtr;  	statePtr->closeCbPtr = cbPtr->nextPtr; -	(cbPtr->proc)(cbPtr->clientData); -	ckfree((char *) cbPtr); +	cbPtr->proc(cbPtr->clientData); +	ckfree(cbPtr);      }      ResetFlag(statePtr, CHANNEL_INCLOSE); @@ -3017,7 +3277,7 @@ Tcl_Close(       */      if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) { -	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp, +	result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp,  		TCL_CLOSE_READ);      } else {  	result = 0; @@ -3056,7 +3316,17 @@ Tcl_Close(  	    Tcl_SetObjResult(interp,  			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));  	} -	flushcode = -1; +	return TCL_ERROR; +    } +    /* +     * Bug 97069ea11a: set error message if a flush code is set and no error +     * message set up to now. +     */ +    if (flushcode != 0 && interp != NULL +	    && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) { +	Tcl_SetErrno(flushcode); +	Tcl_SetObjResult(interp, +		Tcl_NewStringObj(Tcl_PosixError(interp), -1));      }      if ((flushcode != 0) || (result != 0)) {  	return TCL_ERROR; @@ -3067,6 +3337,353 @@ Tcl_Close(  /*   *----------------------------------------------------------------------   * + * Tcl_CloseEx -- + * + *	Closes one side of a channel, read or write. + * + * Results: + *	A standard Tcl result. + * + * Side effects: + *	Closes one direction of the channel. + * + * NOTE: + *	Tcl_CloseEx closes the specified direction of the channel as far as + *	the user is concerned. The channel keeps existing however. You cannot + *	calls this function to close the last possible direction of the + *	channel. Use Tcl_Close for that. + * + *---------------------------------------------------------------------- + */ + +	/* ARGSUSED */ +int +Tcl_CloseEx( +    Tcl_Interp *interp,		/* Interpreter for errors. */ +    Tcl_Channel chan,		/* The channel being closed. May still be used +				 * by some interpreter. */ +    int flags)			/* Flags telling us which side to close. */ +{ +    Channel *chanPtr;		/* The real IO channel. */ +    ChannelState *statePtr;	/* State of real IO channel. */ + +    if (chan == NULL) { +	return TCL_OK; +    } + +    /* TODO: assert flags validity ? */ + +    chanPtr = (Channel *) chan; +    statePtr = chanPtr->state; + +    /* +     * Does the channel support half-close anyway? Error if not. +     */ + +    if (!chanPtr->typePtr->close2Proc) { +	Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                "half-close of channels not supported by %ss", +		chanPtr->typePtr->typeName)); +	return TCL_ERROR; +    } + +    /* +     * Is the channel unstacked ? If not we fail. +     */ + +    if (chanPtr != statePtr->topChanPtr) { +	Tcl_SetObjResult(interp, Tcl_NewStringObj( +		"half-close not applicable to stack of transformations", -1)); +	return TCL_ERROR; +    } + +    /* +     * Check direction against channel mode. It is an error if we try to close +     * a direction not supported by the channel (already closed, or never +     * opened for that direction). +     */ + +    if (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) { +	const char *msg; + +	if (flags & TCL_CLOSE_READ) { +	    msg = "read"; +	} else { +	    msg = "write"; +	} +	Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                "Half-close of %s-side not possible, side not opened or" +                " already closed", msg)); +	return TCL_ERROR; +    } + +    /* +     * A user may try to call half-close from within a channel close +     * handler. That won't do. +     */ + +    if (statePtr->flags & CHANNEL_INCLOSE) { +	if (interp) { +	    Tcl_SetObjResult(interp, Tcl_NewStringObj( +                    "illegal recursive call to close through close-handler" +                    " of channel", -1)); +	} +	return TCL_ERROR; +    } + +    if (flags & TCL_CLOSE_READ) { +	/* +	 * Call the finalization code directly. There are no events to handle, +	 * there cannot be for the read-side. +	 */ + +	return CloseChannelPart(interp, chanPtr, 0, flags); +    } else if (flags & TCL_CLOSE_WRITE) { +	if ((statePtr->curOutPtr != NULL) && +		IsBufferReady(statePtr->curOutPtr)) { +	    SetFlag(statePtr, BUFFER_READY); +	} +	Tcl_Preserve(statePtr); +	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { +	    /* +	     * We don't want to re-enter CloseWrite(). +	     */ + +	    if (!GotFlag(statePtr, CHANNEL_CLOSEDWRITE)) { +		if (CloseWrite(interp, chanPtr) != TCL_OK) { +		    SetFlag(statePtr, CHANNEL_CLOSEDWRITE); +		    Tcl_Release(statePtr); +		    return TCL_ERROR; +		} +	    } +	} +	SetFlag(statePtr, CHANNEL_CLOSEDWRITE); +	Tcl_Release(statePtr); +    } + +    return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CloseWrite -- + * + *	Closes the write side a channel. + * + * Results: + *	A standard Tcl result. + * + * Side effects: + *	Closes the write side of the channel. + * + * NOTE: + *	CloseWrite removes the channel as far as the user is concerned. + *	However, the ooutput data structures may continue to exist for a while + *	longer if it has a background flush scheduled. The device itself is + *	eventually closed and the channel structures modified, in + *	CloseChannelPart, below. + * + *---------------------------------------------------------------------- + */ + +static int +CloseWrite( +    Tcl_Interp *interp,		/* Interpreter for errors. */ +    Channel *chanPtr)		/* The channel whose write side is being +                                 * closed. May still be used by some +                                 * interpreter */ +{ +    /* Notes: clear-channel-handlers - write side only ? or keep around, just +     * not called. */ +    /* No close cllbacks are run - channel is still open (read side) */ + +    ChannelState *statePtr = chanPtr->state; +                                /* State of real IO channel. */ +    int flushcode; +    int result = 0; + +    /* +     * Ensure that the last output buffer will be flushed. +     */ + +    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { +	SetFlag(statePtr, BUFFER_READY); +    } + +    /* +     * The call to FlushChannel will flush any queued output and invoke the +     * close function of the channel driver, or it will set up the channel to +     * be flushed and closed asynchronously. +     */ + +    SetFlag(statePtr, CHANNEL_CLOSEDWRITE); + +    flushcode = FlushChannel(interp, chanPtr, 0); + +    /* +     * TIP #219. +     * Capture error messages put by the driver into the bypass area and put +     * them into the regular interpreter result. +     * +     * Notes: Due to the assertion of CHANNEL_CLOSEDWRITE in the flags +     * FlushChannel() has called CloseChannelPart(). While we can still access +     * "chan" (no structures were freed), the only place which may still +     * contain a message is the interpreter itself, and "CloseChannelPart" made +     * sure to lift any channel message it generated into it. Hence the NULL +     * argument in the call below. +     */ + +    if (TclChanCaughtErrorBypass(interp, NULL)) { +	result = EINVAL; +    } + +    if ((flushcode != 0) || (result != 0)) { +	return TCL_ERROR; +    } + +    return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * CloseChannelPart -- + * + *	Utility procedure to close a channel partially and free associated + *	resources. If the channel was stacked it will never be run (The higher + *	level forbid this). If the channel was not stacked, then we will free + *	all the bits of the chosen side (read, or write) for the TOP channel. + * + * Results: + *	Error code from an unreported error or the driver close2 operation. + * + * Side effects: + *	May free memory, may change the value of errno. + * + *---------------------------------------------------------------------- + */ + +static int +CloseChannelPart( +    Tcl_Interp *interp,		/* Interpreter for errors. */ +    Channel *chanPtr,		/* The channel being closed. May still be used +				 * by some interpreter. */ +    int errorCode,		/* Status of operation so far. */ +    int flags)			/* Flags telling us which side to close. */ +{ +    ChannelState *statePtr;	/* State of real IO channel. */ +    int result;			/* Of calling the close2proc. */ + +    statePtr = chanPtr->state; + +    if (flags & TCL_CLOSE_READ) { +	/* +	 * No more input can be consumed so discard any leftover input. +	 */ + +	DiscardInputQueued(statePtr, 1); +    } else if (flags & TCL_CLOSE_WRITE) { +	/* +	 * The caller guarantees that there are no more buffers queued for +	 * output. +	 */ + +	if (statePtr->outQueueHead != NULL) { +	    Tcl_Panic("ClosechanHalf, closed write-side of channel: " +		    "queued output left"); +	} + +	/* +	 * If the EOF character is set in the channel, append that to the +	 * output device. +	 */ + +	if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) { +	    int dummy; +	    char c = (char) statePtr->outEofChar; + +	    (void) ChanWrite(chanPtr, &c, 1, &dummy); +	} + +	/* +	 * TIP #219, Tcl Channel Reflection API. +	 * Move a leftover error message in the channel bypass into the +	 * interpreter bypass. Just clear it if there is no interpreter. +	 */ + +	if (statePtr->chanMsg != NULL) { +	    if (interp != NULL) { +		Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg); +	    } +	    TclDecrRefCount(statePtr->chanMsg); +	    statePtr->chanMsg = NULL; +	} +    } + +    /* +     * Finally do what is asked of us. Close and free the channel driver state +     * for the chosen side of the channel. This may leave a TIP #219 error +     * message in the interp. +     */ + +    result = ChanCloseHalf(chanPtr, interp, flags); + +    /* +     * If we are being called synchronously, report either any latent error on +     * the channel or the current error. +     */ + +    if (statePtr->unreportedError != 0) { +	errorCode = statePtr->unreportedError; + +	/* +	 * TIP #219, Tcl Channel Reflection API. +	 * Move an error message found in the unreported area into the regular +	 * bypass (interp). This kills any message in the channel bypass area. +	 */ + +	if (statePtr->chanMsg != NULL) { +	    TclDecrRefCount(statePtr->chanMsg); +	    statePtr->chanMsg = NULL; +	} +	if (interp) { +	    Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg); +	} +    } +    if (errorCode == 0) { +	errorCode = result; +	if (errorCode != 0) { +	    Tcl_SetErrno(errorCode); +	} +    } + +    /* +     * TIP #219. +     * Capture error messages put by the driver into the bypass area and put +     * them into the regular interpreter result. See also the bottom of +     * CloseWrite(). +     */ + +    if (TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { +	result = EINVAL; +    } + +    if (result != 0) { +	return TCL_ERROR; +    } + +    /* +     * Remove the closed side from the channel mode/flags. +     */ + +    ResetFlag(statePtr, flags & (TCL_READABLE | TCL_WRITABLE)); +    return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + *   * Tcl_ClearChannelHandlers --   *   *	Removes all channel handlers and event scripts from the channel, @@ -3126,7 +3743,7 @@ Tcl_ClearChannelHandlers(      for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {  	chNext = chPtr->nextPtr; -	ckfree((char *) chPtr); +	ckfree(chPtr);      }      statePtr->chPtr = NULL; @@ -3153,7 +3770,7 @@ Tcl_ClearChannelHandlers(      for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {  	eNextPtr = ePtr->nextPtr;  	TclDecrRefCount(ePtr->scriptPtr); -	ckfree((char *) ePtr); +	ckfree(ePtr);      }      statePtr->scriptRecordPtr = NULL;  } @@ -3206,7 +3823,7 @@ Tcl_Write(      if (srcLen < 0) {  	srcLen = strlen(src);      } -    return DoWrite(chanPtr, src, srcLen); +    return WriteBytes(chanPtr, src, srcLen);  }  /* @@ -3258,9 +3875,7 @@ Tcl_WriteRaw(       * The code was stolen from 'FlushChannel'.       */ -    written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData, -	    src, srcLen, &errorCode); - +    written = ChanWrite(chanPtr, src, srcLen, &errorCode);      if (written < 0) {  	Tcl_SetErrno(errorCode);      } @@ -3299,81 +3914,40 @@ Tcl_WriteChars(      int len)			/* Length of string in bytes, or < 0 for  				 * strlen(). */  { -    ChannelState *statePtr;	/* State info for channel */ - -    statePtr = ((Channel *) chan)->state; +    Channel *chanPtr = (Channel *) chan; +    ChannelState *statePtr = chanPtr->state;	/* State info for channel */ +    int result; +    Tcl_Obj *objPtr;      if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {  	return -1;      } -    return DoWriteChars((Channel *) chan, src, len); -} - -/* - *--------------------------------------------------------------------------- - * - * DoWriteChars -- - * - *	Takes a sequence of UTF-8 characters and converts them for output - *	using the channel's current encoding, may queue the buffer for output - *	if it gets full, and also remembers whether the current buffer is - *	ready e.g. if it contains a newline and we are in line buffering mode. - *	Compensates stacking, i.e. will redirect the data from the specified - *	channel to the topmost channel in a stack. - * - * Results: - *	The number of bytes written or -1 in case of error. If -1, - *	Tcl_GetErrno will return the error code. - * - * Side effects: - *	May buffer up output and may cause output to be produced on the - *	channel. - * - *---------------------------------------------------------------------- - */ - -static int -DoWriteChars( -    Channel *chanPtr,		/* The channel to buffer output for. */ -    const char *src,		/* UTF-8 characters to queue in output -				 * buffer. */ -    int len)			/* Length of string in bytes, or < 0 for -				 * strlen(). */ -{ -    /* -     * Always use the topmost channel of the stack -     */ - -    ChannelState *statePtr;	/* State info for channel */ - -    statePtr = chanPtr->state;      chanPtr = statePtr->topChanPtr;      if (len < 0) {  	len = strlen(src);      } -    if (statePtr->encoding == NULL) { -	/* -	 * Inefficient way to convert UTF-8 to byte-array, but the code -	 * parallels the way it is done for objects. -	 * Special case for 1-byte (used by eg [puts] for the \n) could -	 * be extended to more efficient translation of the src string. -	 */ +    if (statePtr->encoding) { +	return WriteChars(chanPtr, src, len); +    } - 	int result; +    /* +     * Inefficient way to convert UTF-8 to byte-array, but the code +     * parallels the way it is done for objects.  Special case for 1-byte +     * (used by eg [puts] for the \n) could be extended to more efficient +     * translation of the src string. +     */ -	if ((len == 1) && (UCHAR(*src) < 0xC0)) { -	    result = WriteBytes(chanPtr, src, len); -	} else { -	    Tcl_Obj *objPtr = Tcl_NewStringObj(src, len); -	    src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); -	    result = WriteBytes(chanPtr, src, len); -	    TclDecrRefCount(objPtr); -	} -	return result; +    if ((len == 1) && (UCHAR(*src) < 0xC0)) { +	return WriteBytes(chanPtr, src, len);      } -    return WriteChars(chanPtr, src, len); + +    objPtr = Tcl_NewStringObj(src, len); +    src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); +    result = WriteBytes(chanPtr, src, len); +    TclDecrRefCount(objPtr); +    return result;  }  /* @@ -3412,7 +3986,7 @@ Tcl_WriteObj(      Channel *chanPtr;      ChannelState *statePtr;	/* State info for channel */ -    char *src; +    const char *src;      int srcLen;      statePtr = ((Channel *) chan)->state; @@ -3430,109 +4004,49 @@ Tcl_WriteObj(      }  } -/* - *---------------------------------------------------------------------- - * - * WriteBytes -- - * - *	Write a sequence of bytes into an output buffer, may queue the buffer - *	for output if it gets full, and also remembers whether the current - *	buffer is ready e.g. if it contains a newline and we are in line - *	buffering mode. - * - * Results: - *	The number of bytes written or -1 in case of error. If -1, - *	Tcl_GetErrno will return the error code. - * - * Side effects: - *	May buffer up output and may cause output to be produced on the - *	channel. - * - *---------------------------------------------------------------------- - */ - -static int -WriteBytes( -    Channel *chanPtr,		/* The channel to buffer output for. */ -    const char *src,		/* Bytes to write. */ -    int srcLen)			/* Number of bytes to write. */ +static void +WillWrite( +    Channel *chanPtr)  { -    ChannelState *statePtr = chanPtr->state; -				/* State info for channel */ -    ChannelBuffer *bufPtr; -    char *dst; -    int dstMax, sawLF, savedLF, total, dstLen, toWrite, translate; - -    total = 0; -    sawLF = 0; -    savedLF = 0; -    translate = (statePtr->flags & CHANNEL_LINEBUFFERED) -	|| (statePtr->outputTranslation != TCL_TRANSLATE_LF); - -    /* -     * Loop over all bytes in src, storing them in output buffer with proper -     * EOL translation. -     */ - -    while (srcLen + savedLF > 0) { -	bufPtr = statePtr->curOutPtr; -	if (bufPtr == NULL) { -	    bufPtr = AllocChannelBuffer(statePtr->bufSize); -	    statePtr->curOutPtr = bufPtr; -	} -	dst = InsertPoint(bufPtr); -	dstMax = SpaceLeft(bufPtr); -	dstLen = dstMax; - -	toWrite = dstLen; -	if (toWrite > srcLen) { -	    toWrite = srcLen; -	} - -	if (translate) { -	    if (savedLF) { -		/* -		 * A '\n' was left over from last call to TranslateOutputEOL() -		 * and we need to store it in this buffer. If the channel is -		 * line-based, we will need to flush it. -		 */ +    int inputBuffered; -		*dst++ = '\n'; -		dstLen--; -		sawLF++; -	    } -	    if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) { -		sawLF++; -	    } -	    dstLen += savedLF; -	    savedLF = 0; -	    if (dstLen > dstMax) { -		savedLF = 1; -		dstLen = dstMax; -	    } -	} else { -	    memcpy(dst, src, toWrite); -	    dstLen = toWrite; -	} +    if ((chanPtr->typePtr->seekProc != NULL) && +            ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ +        int ignore; -	bufPtr->nextAdded += dstLen; -	if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) { -	    return -1; -	} -	total += dstLen; -	src += toWrite; -	srcLen -= toWrite; -	sawLF = 0; +        DiscardInputQueued(chanPtr->state, 0); +        ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);      } -    return total; +} + +static int +WillRead( +    Channel *chanPtr) +{ +    if (chanPtr->typePtr == NULL) { +	/* Prevent read attempts on a closed channel */ +	Tcl_SetErrno(EINVAL); +	return -1; +    } +    if ((chanPtr->typePtr->seekProc != NULL) +            && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { +        if ((chanPtr->state->curOutPtr != NULL) +                && IsBufferReady(chanPtr->state->curOutPtr)) { +            SetFlag(chanPtr->state, BUFFER_READY); +        } +        if (FlushChannel(NULL, chanPtr, 0) != 0) { +            return -1; +        } +    } +    return 0;  }  /*   *----------------------------------------------------------------------   * - * WriteChars -- + * Write --   * - *	Convert UTF-8 bytes to the channel's external encoding and write the + *	Convert srcLen bytes starting at src according to encoding and write   *	produced bytes into an output buffer, may queue the buffer for output   *	if it gets full, and also remembers whether the current buffer is   *	ready e.g. if it contains a newline and we are in line buffering mode. @@ -3549,26 +4063,20 @@ WriteBytes(   */  static int -WriteChars( +Write(      Channel *chanPtr,		/* The channel to buffer output for. */      const char *src,		/* UTF-8 string to write. */ -    int srcLen)			/* Length of UTF-8 string in bytes. */ +    int srcLen,			/* Length of UTF-8 string in bytes. */ +    Tcl_Encoding encoding)  {      ChannelState *statePtr = chanPtr->state;  				/* State info for channel */ -    ChannelBuffer *bufPtr; -    char *dst, *stage; -    int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote; -    int stageLen, toWrite, stageRead, endEncoding, result; -    int consumedSomething, translate; -    Tcl_Encoding encoding; -    char safe[BUFFER_PADDING]; +    char *nextNewLine = NULL; +    int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0; -    total = 0; -    sawLF = 0; -    savedLF = 0; -    saved = 0; -    encoding = statePtr->encoding; +    if (srcLen) { +        WillWrite(chanPtr); +    }      /*       * Write the terminated escape sequence even if srcLen is 0. @@ -3576,349 +4084,145 @@ WriteChars(      endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0); -    translate = (statePtr->flags & CHANNEL_LINEBUFFERED) -	|| (statePtr->outputTranslation != TCL_TRANSLATE_LF); - -    /* -     * Loop over all UTF-8 characters in src, storing them in staging buffer -     * with proper EOL translation. -     */ +    if (GotFlag(statePtr, CHANNEL_LINEBUFFERED) +	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) { +	nextNewLine = memchr(src, '\n', srcLen); +    } -    consumedSomething = 1; -    while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) { -	consumedSomething = 0; -	stage = statePtr->outputStage; -	stageMax = statePtr->bufSize; -	stageLen = stageMax; +    while (srcLen + saved + endEncoding > 0) { +	ChannelBuffer *bufPtr; +	char *dst, safe[BUFFER_PADDING]; +	int result, srcRead, dstLen, dstWrote, srcLimit = srcLen; -	toWrite = stageLen; -	if (toWrite > srcLen) { -	    toWrite = srcLen; +	if (nextNewLine) { +	    srcLimit = nextNewLine - src;  	} - -	if (translate) { -	    if (savedLF) { -		/* -		 * A '\n' was left over from last call to TranslateOutputEOL() -		 * and we need to store it in the staging buffer. If the channel -		 * is line-based, we will need to flush the output buffer (after -		 * translating the staging buffer). -		 */ - -		*stage++ = '\n'; -		stageLen--; -		sawLF++; -	    } -	    if (TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite)) { -		sawLF++; -	    } - -	    stage -= savedLF; -	    stageLen += savedLF; -	    savedLF = 0; - -	    if (stageLen > stageMax) { -		savedLF = 1; -		stageLen = stageMax; -	    } -	} else { -	    memcpy(stage, src, toWrite); -	    stageLen = toWrite; +	 +	/* Get space to write into */ +	bufPtr = statePtr->curOutPtr; +	if (bufPtr == NULL) { +	    bufPtr = AllocChannelBuffer(statePtr->bufSize); +	    statePtr->curOutPtr = bufPtr;  	} -	src += toWrite; -	srcLen -= toWrite; - -	/* -	 * Loop over all UTF-8 characters in staging buffer, converting them -	 * to external encoding, storing them in output buffer. -	 */ - -	while (stageLen + saved + endEncoding > 0) { -	    bufPtr = statePtr->curOutPtr; -	    if (bufPtr == NULL) { -		bufPtr = AllocChannelBuffer(statePtr->bufSize); -		statePtr->curOutPtr = bufPtr; -	    } -	    dst = InsertPoint(bufPtr); -	    dstLen = SpaceLeft(bufPtr); - -	    if (saved != 0) { -		/* -		 * Here's some translated bytes left over from the last buffer -		 * that we need to stick at the beginning of this buffer. -		 */ - -		memcpy(dst, safe, (size_t) saved); -		bufPtr->nextAdded += saved; -		dst += saved; -		dstLen -= saved; -		saved = 0; -	    } - -	    result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen, -		    statePtr->outputEncodingFlags, -		    &statePtr->outputEncodingState, dst, -		    dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL); - +	if (saved) {  	    /* -	     * Fix for SF #506297, reported by Martin Forssen -	     * <ruric@users.sourceforge.net>. -	     * -	     * The encoding chosen in the script exposing the bug writes out -	     * three intro characters when TCL_ENCODING_START is set, but does -	     * not consume any input as TCL_ENCODING_END is cleared. As some -	     * output was generated the enclosing loop calls UtfToExternal -	     * again, again with START set. Three more characters in the out -	     * and still no use of input ... To break this infinite loop we -	     * remove TCL_ENCODING_START from the set of flags after the first -	     * call (no condition is required, the later calls remove an unset -	     * flag, which is a no-op). This causes the subsequent calls to -	     * UtfToExternal to consume and convert the actual input. +	     * Here's some translated bytes left over from the last buffer +	     * that we need to stick at the beginning of this buffer.  	     */ -	    statePtr->outputEncodingFlags &= ~TCL_ENCODING_START; +	    memcpy(InsertPoint(bufPtr), safe, (size_t) saved); +	    bufPtr->nextAdded += saved; +	    saved = 0; +	} +	PreserveChannelBuffer(bufPtr); +	dst = InsertPoint(bufPtr); +	dstLen = SpaceLeft(bufPtr); + +	result = Tcl_UtfToExternal(NULL, encoding, src, srcLimit, +		statePtr->outputEncodingFlags, +		&statePtr->outputEncodingState, dst, +		dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); + +	/* See chan-io-1.[89]. Tcl Bug 506297. */ +	statePtr->outputEncodingFlags &= ~TCL_ENCODING_START; +	 +	if ((result != TCL_OK) && (srcRead + dstWrote == 0)) { +	    /* We're reading from invalid/incomplete UTF-8 */ +	    ReleaseChannelBuffer(bufPtr); +	    if (total == 0) { +		Tcl_SetErrno(EINVAL); +		return -1; +	    } +	    break; +	} -	    /* -	     * The following code must be executed only when result is not 0. -	     */ +	bufPtr->nextAdded += dstWrote; +	src += srcRead; +	srcLen -= srcRead; +	total += dstWrote; +	dst += dstWrote; +	dstLen -= dstWrote; -	    if ((result != 0) && (stageRead + dstWrote == 0)) { -		/* -		 * We have an incomplete UTF-8 character at the end of the -		 * staging buffer. It will get moved to the beginning of the -		 * staging buffer followed by more bytes from src. -		 */ +	if (src == nextNewLine && dstLen > 0) { +	    static char crln[3] = "\r\n"; +	    char *nl = NULL; +	    int nlLen = 0; -		src -= stageLen; -		srcLen += stageLen; -		stageLen = 0; -		savedLF = 0; +	    switch (statePtr->outputTranslation) { +	    case TCL_TRANSLATE_LF: +		nl = crln + 1; +		nlLen = 1; +		break; +	    case TCL_TRANSLATE_CR: +		nl = crln; +		nlLen = 1; +		break; +	    case TCL_TRANSLATE_CRLF: +		nl = crln; +		nlLen = 2; +		break; +	    default: +		Tcl_Panic("unknown output translation requested");  		break;  	    } -	    bufPtr->nextAdded += dstWrote; -	    if (IsBufferOverflowing(bufPtr)) { -		/* -		 * When translating from UTF-8 to external encoding, we -		 * allowed the translation to produce a character that crossed -		 * the end of the output buffer, so that we would get a -		 * completely full buffer before flushing it. The extra bytes -		 * will be moved to the beginning of the next buffer. -		 */ +	 +	    result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen, +		statePtr->outputEncodingFlags, +		&statePtr->outputEncodingState, dst, +		dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); -		saved = -SpaceLeft(bufPtr); -		memcpy(safe, dst + dstLen, (size_t) saved); -		bufPtr->nextAdded = bufPtr->bufLength; -	    } -	    if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) { -		return -1; +	    if (srcRead != nlLen) { +		Tcl_Panic("Can This Happen?");  	    } +	    bufPtr->nextAdded += dstWrote; +	    src++; +	    srcLen--;  	    total += dstWrote; -	    stage += stageRead; -	    stageLen -= stageRead; -	    sawLF = 0; - -	    consumedSomething = 1; +	    dst += dstWrote; +	    dstLen -= dstWrote; +	    nextNewLine = memchr(src, '\n', srcLen); +	    needNlFlush = 1; +	} +	if (IsBufferOverflowing(bufPtr)) {  	    /* -	     * If all translated characters are written to the buffer, -	     * endEncoding is set to 0 because the escape sequence may be -	     * output. +	     * When translating from UTF-8 to external encoding, we +	     * allowed the translation to produce a character that crossed +	     * the end of the output buffer, so that we would get a +	     * completely full buffer before flushing it. The extra bytes +	     * will be moved to the beginning of the next buffer.  	     */ -	    if ((stageLen + saved == 0) && (result == 0)) { -		endEncoding = 0; -	    } -	} -    } - -    /* -     * If nothing was written and it happened because there was no progress in -     * the UTF conversion, we throw an error. -     */ - -    if (!consumedSomething && (total == 0)) { -	Tcl_SetErrno(EINVAL); -	return -1; -    } -    return total; -} - -/* - *--------------------------------------------------------------------------- - * - * TranslateOutputEOL -- - * - *	Helper function for WriteBytes() and WriteChars(). Converts the '\n' - *	characters in the source buffer into the appropriate EOL form - *	specified by the output translation mode. - * - *	EOL translation stops either when the source buffer is empty or the - *	output buffer is full. - * - *	When converting to CRLF mode and there is only 1 byte left in the - *	output buffer, this routine stores the '\r' in the last byte and then - *	stores the '\n' in the byte just past the end of the buffer. The - *	caller is responsible for passing in a buffer that is large enough to - *	hold the extra byte. - * - * Results: - *	The return value is 1 if a '\n' was translated from the source buffer, - *	or 0 otherwise -- this can be used by the caller to decide to flush a - *	line-based channel even though the channel buffer is not full. - * - *	*dstLenPtr is filled with how many bytes of the output buffer were - *	used. As mentioned above, this can be one more that the output - *	buffer's specified length if a CRLF was stored. - * - *	*srcLenPtr is filled with how many bytes of the source buffer were - *	consumed. - * - * Side effects: - *	It may be obvious, but bears mentioning that when converting in CRLF - *	mode (which requires two bytes of storage in the output buffer), the - *	number of bytes consumed from the source buffer will be less than the - *	number of bytes stored in the output buffer. - * - *--------------------------------------------------------------------------- - */ - -static int -TranslateOutputEOL( -    ChannelState *statePtr,	/* Channel being read, for translation and -				 * buffering modes. */ -    char *dst,			/* Output buffer filled with UTF-8 chars by -				 * applying appropriate EOL translation to -				 * source characters. */ -    const char *src,		/* Source UTF-8 characters. */ -    int *dstLenPtr,		/* On entry, the maximum length of output -				 * buffer in bytes. On exit, the number of -				 * bytes actually used in output buffer. */ -    int *srcLenPtr)		/* On entry, the length of source buffer. On -				 * exit, the number of bytes read from the -				 * source buffer. */ -{ -    char *dstEnd; -    int srcLen, newlineFound; - -    newlineFound = 0; -    srcLen = *srcLenPtr; - -    switch (statePtr->outputTranslation) { -    case TCL_TRANSLATE_LF: -	for (dstEnd = dst + srcLen; dst < dstEnd; ) { -	    if (*src == '\n') { -		newlineFound = 1; -	    } -	    *dst++ = *src++; +	    saved = -SpaceLeft(bufPtr); +	    memcpy(safe, dst + dstLen, (size_t) saved); +	    bufPtr->nextAdded = bufPtr->bufLength;  	} -	*dstLenPtr = srcLen; -	break; -    case TCL_TRANSLATE_CR: -	for (dstEnd = dst + srcLen; dst < dstEnd;) { -	    if (*src == '\n') { -		*dst++ = '\r'; -		newlineFound = 1; -		src++; -	    } else { -		*dst++ = *src++; -	    } -	} -	*dstLenPtr = srcLen; -	break; -    case TCL_TRANSLATE_CRLF: { -	/* -	 * Since this causes the number of bytes to grow, we start off trying -	 * to put 'srcLen' bytes into the output buffer, but allow it to store -	 * more bytes, as long as there's still source bytes and room in the -	 * output buffer. -	 */ - -	char *dstStart, *dstMax; -	const char *srcStart; -	dstStart = dst; -	dstMax = dst + *dstLenPtr; - -	srcStart = src; - -	if (srcLen < *dstLenPtr) { -	    dstEnd = dst + srcLen; -	} else { -	    dstEnd = dst + *dstLenPtr; -	} -	while (dst < dstEnd) { -	    if (*src == '\n') { -		if (dstEnd < dstMax) { -		    dstEnd++; -		} -		*dst++ = '\r'; -		newlineFound = 1; -	    } -	    *dst++ = *src++; +	if ((srcLen + saved == 0) && (result == TCL_OK)) { +	    endEncoding = 0;  	} -	*srcLenPtr = src - srcStart; -	*dstLenPtr = dst - dstStart; -	break; -    } -    default: -	break; -    } -    return newlineFound; -} - -/* - *--------------------------------------------------------------------------- - * - * CheckFlush -- - * - *	Helper function for WriteBytes() and WriteChars(). If the channel - *	buffer is ready to be flushed, flush it. - * - * Results: - *	The return value is -1 if there was a problem flushing the channel - *	buffer, or 0 otherwise. - * - * Side effects: - *	The buffer will be recycled if it is flushed. - * - *--------------------------------------------------------------------------- - */ -static int -CheckFlush( -    Channel *chanPtr,		/* Channel being read, for buffering mode. */ -    ChannelBuffer *bufPtr,	/* Channel buffer to possibly flush. */ -    int newlineFlag)		/* Non-zero if a the channel buffer contains a -				 * newline. */ -{ -    ChannelState *statePtr = chanPtr->state; -				/* State info for channel */ - -    /* -     * The current buffer is ready for output: -     * 1. if it is full. -     * 2. if it contains a newline and this channel is line-buffered. -     * 3. if it contains any output and this channel is unbuffered. -     */ - -    if ((statePtr->flags & BUFFER_READY) == 0) {  	if (IsBufferFull(bufPtr)) { -	    SetFlag(statePtr, BUFFER_READY); -	} else if (statePtr->flags & CHANNEL_LINEBUFFERED) { -	    if (newlineFlag != 0) { -		SetFlag(statePtr, BUFFER_READY); +	    if (FlushChannel(NULL, chanPtr, 0) != 0) { +		return -1; +	    } +	    flushed += statePtr->bufSize; +	    if (saved == 0 || src[-1] != '\n') { +		needNlFlush = 0;  	    } -	} else if (statePtr->flags & CHANNEL_UNBUFFERED) { -	    SetFlag(statePtr, BUFFER_READY);  	} +	ReleaseChannelBuffer(bufPtr);      } -    if (statePtr->flags & BUFFER_READY) { +    if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) || +	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) { +	SetFlag(statePtr, BUFFER_READY);  	if (FlushChannel(NULL, chanPtr, 0) != 0) {  	    return -1;  	}      } -    return 0; + +    return total;  }  /* @@ -3949,14 +4253,12 @@ Tcl_Gets(  				 * for managing the storage. */  {      Tcl_Obj *objPtr; -    int charsStored, length; -    char *string; +    int charsStored;      TclNewObj(objPtr);      charsStored = Tcl_GetsObj(chan, objPtr);      if (charsStored > 0) { -	string = TclGetStringFromObj(objPtr, &length); -	Tcl_DStringAppend(lineRead, string, length); +	TclDStringAppendObj(lineRead, objPtr);      }      TclDecrRefCount(objPtr);      return charsStored; @@ -4023,6 +4325,7 @@ Tcl_GetsObj(       */      chanPtr = statePtr->topChanPtr; +    Tcl_Preserve(chanPtr);      bufPtr = statePtr->inQueueHead;      encoding = statePtr->encoding; @@ -4046,16 +4349,7 @@ Tcl_GetsObj(       */      if (encoding == NULL) { -	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - -	if (tsdPtr->binaryEncoding == NULL) { -	    tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1"); -	    Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL); -	} -	encoding = tsdPtr->binaryEncoding; -	if (encoding == NULL) { -	    Tcl_Panic("attempted gets on binary channel where no iso8859-1 encoding available"); -	} +	encoding = GetBinaryEncoding();      }      /* @@ -4164,7 +4458,7 @@ Tcl_GetsObj(  	case TCL_TRANSLATE_AUTO:  	    eol = dst;  	    skip = 1; -	    if (statePtr->flags & INPUT_SAW_CR) { +	    if (GotFlag(statePtr, INPUT_SAW_CR)) {  		ResetFlag(statePtr, INPUT_SAW_CR);  		if ((eol < dstEnd) && (*eol == '\n')) {  		    /* @@ -4232,7 +4526,7 @@ Tcl_GetsObj(  	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);  	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;  	} -	if (statePtr->flags & CHANNEL_EOF) { +	if (GotFlag(statePtr, CHANNEL_EOF)) {  	    skip = 0;  	    eol = dstEnd;  	    if (eol == objPtr->bytes + oldLength) { @@ -4260,6 +4554,17 @@ Tcl_GetsObj(       */    gotEOL: +    /* +     * Regenerate the top channel, in case it was changed due to +     * self-modifying reflected transforms. +     */ + +    if (chanPtr != statePtr->topChanPtr) { +	Tcl_Release(chanPtr); +	chanPtr = statePtr->topChanPtr; +	Tcl_Preserve(chanPtr); +    } +      bufPtr = gs.bufPtr;      if (bufPtr == NULL) {  	Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL"); @@ -4288,13 +4593,22 @@ Tcl_GetsObj(       */    restore: +    /* +     * Regenerate the top channel, in case it was changed due to +     * self-modifying reflected transforms. +     */ +    if (chanPtr != statePtr->topChanPtr) { +	Tcl_Release(chanPtr); +	chanPtr = statePtr->topChanPtr; +	Tcl_Preserve(chanPtr); +    }      bufPtr = statePtr->inQueueHead; -    if (bufPtr == NULL) { -	Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL"); +    if (bufPtr != NULL) { +	bufPtr->nextRemoved = oldRemoved; +	bufPtr = bufPtr->nextPtr;      } -    bufPtr->nextRemoved = oldRemoved; -    for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { +    for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {  	bufPtr->nextRemoved = BUFFER_PADDING;      }      CommonGetsCleanup(chanPtr); @@ -4323,7 +4637,17 @@ Tcl_GetsObj(       */    done: +    /* +     * Regenerate the top channel, in case it was changed due to +     * self-modifying reflected transforms. +     */ +    if (chanPtr != statePtr->topChanPtr) { +	Tcl_Release(chanPtr); +	chanPtr = statePtr->topChanPtr; +	Tcl_Preserve(chanPtr); +    }      UpdateInterest(chanPtr); +    Tcl_Release(chanPtr);      return copiedTotal;  } @@ -4369,6 +4693,7 @@ TclGetsObjBinary(       */      chanPtr = statePtr->topChanPtr; +    Tcl_Preserve(chanPtr);      bufPtr = statePtr->inQueueHead; @@ -4389,7 +4714,11 @@ TclGetsObjBinary(      skip = 0;      eof = NULL;      inEofChar = statePtr->inEofChar; -    /* Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR */ + +    /* +     * Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR. +     */ +      eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';      while (1) { @@ -4412,8 +4741,8 @@ TclGetsObjBinary(  	     * device. Side effect is to allocate another channel buffer.  	     */ -	    if (statePtr->flags & CHANNEL_BLOCKED) { -		if (statePtr->flags & CHANNEL_NONBLOCKING) { +	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) { +		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {  		    goto restore;  		}  		ResetFlag(statePtr, CHANNEL_BLOCKED); @@ -4422,6 +4751,9 @@ TclGetsObjBinary(  		goto restore;  	    }  	    bufPtr = statePtr->inQueueTail; +	    if (bufPtr == NULL) { +		goto restore; +	    }  	}  	dst = (unsigned char *) RemovePoint(bufPtr); @@ -4464,7 +4796,7 @@ TclGetsObjBinary(  	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);  	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;  	} -	if (statePtr->flags & CHANNEL_EOF) { +	if (GotFlag(statePtr, CHANNEL_EOF)) {  	    skip = 0;  	    eol = dstEnd;  	    if ((dst == dstEnd) && (byteLen == oldLength)) { @@ -4534,12 +4866,12 @@ TclGetsObjBinary(    restore:      bufPtr = statePtr->inQueueHead; -    if (bufPtr == NULL) { -	Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL"); +    if (bufPtr) { +	bufPtr->nextRemoved = oldRemoved; +	bufPtr = bufPtr->nextPtr;      } -    bufPtr->nextRemoved = oldRemoved; -    for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { +    for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {  	bufPtr->nextRemoved = BUFFER_PADDING;      }      CommonGetsCleanup(chanPtr); @@ -4568,6 +4900,7 @@ TclGetsObjBinary(    done:      UpdateInterest(chanPtr); +    Tcl_Release(chanPtr);      return copiedTotal;  } @@ -4596,6 +4929,21 @@ FreeBinaryEncoding(  	tsdPtr->binaryEncoding = NULL;      }  } + +static Tcl_Encoding +GetBinaryEncoding() +{ +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + +    if (tsdPtr->binaryEncoding == NULL) { +	tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1"); +	Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL); +    } +    if (tsdPtr->binaryEncoding == NULL) { +	Tcl_Panic("binary encoding is not available"); +    } +    return tsdPtr->binaryEncoding; +}  /*   *--------------------------------------------------------------------------- @@ -4663,8 +5011,8 @@ FilterInputBytes(  	 */      read: -	if (statePtr->flags & CHANNEL_BLOCKED) { -	    if (statePtr->flags & CHANNEL_NONBLOCKING) { +	if (GotFlag(statePtr, CHANNEL_BLOCKED)) { +	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {  		gsPtr->charsWrote = 0;  		gsPtr->rawRead = 0;  		return -1; @@ -4678,6 +5026,11 @@ FilterInputBytes(  	}  	bufPtr = statePtr->inQueueTail;  	gsPtr->bufPtr = bufPtr; +	if (bufPtr == NULL) { +	    gsPtr->charsWrote = 0; +	    gsPtr->rawRead = 0; +	    return -1; +	}      }      /* @@ -4744,7 +5097,7 @@ FilterInputBytes(  		 * returning those UTF-8 characters because a EOL might be  		 * present in them.  		 */ -	    } else if (statePtr->flags & CHANNEL_EOF) { +	    } else if (GotFlag(statePtr, CHANNEL_EOF)) {  		/*  		 * There was a partial character followed by EOF on the  		 * device. Fall through, returning that nothing was found. @@ -4766,7 +5119,7 @@ FilterInputBytes(  		statePtr->inQueueTail = nextPtr;  	    }  	    extra = rawLen - gsPtr->rawRead; -	    memcpy(nextPtr->buf + BUFFER_PADDING - extra, +	    memcpy(nextPtr->buf + (BUFFER_PADDING - extra),  		    raw + gsPtr->rawRead, (size_t) extra);  	    nextPtr->nextRemoved -= extra;  	    bufPtr->nextAdded -= extra; @@ -4833,7 +5186,7 @@ PeekAhead(  		goto cleanup;  	    } -	    if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) { +	    if (!GotFlag(statePtr, CHANNEL_NONBLOCKING)) {  		blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);  		if (blockModeProc == NULL) {  		    /* @@ -4915,7 +5268,7 @@ CommonGetsCleanup(  	    extra = SpaceLeft(bufPtr);  	    if (extra > 0) {  		memcpy(InsertPoint(bufPtr), -			nextPtr->buf + BUFFER_PADDING - extra, +			nextPtr->buf + (BUFFER_PADDING - extra),  			(size_t) extra);  		bufPtr->nextAdded += extra;  		nextPtr->nextRemoved = BUFFER_PADDING; @@ -4967,7 +5320,7 @@ Tcl_Read(  	return -1;      } -    return DoRead(chanPtr, dst, bytesToRead); +    return DoRead(chanPtr, dst, bytesToRead, 0);  }  /* @@ -5025,15 +5378,16 @@ Tcl_ReadRaw(       * requests more bytes.       */ +    Tcl_Preserve(chanPtr);      for (copied = 0; copied < bytesToRead; copied += copiedNow) {  	copiedNow = CopyBuffer(chanPtr, bufPtr + copied,  		bytesToRead - copied);  	if (copiedNow == 0) { -	    if (statePtr->flags & CHANNEL_EOF) { +	    if (GotFlag(statePtr, CHANNEL_EOF)) {  		goto done;  	    } -	    if (statePtr->flags & CHANNEL_BLOCKED) { -		if (statePtr->flags & CHANNEL_NONBLOCKING) { +	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) { +		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {  		    goto done;  		}  		ResetFlag(statePtr, CHANNEL_BLOCKED); @@ -5047,9 +5401,9 @@ Tcl_ReadRaw(  	     * and only if we are sure to have data.  	     */ -	    if ((statePtr->flags & CHANNEL_NONBLOCKING) && +	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&  		    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && -		    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) { +		    !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {  		/*  		 * We bypass the driver; it would block as no data is  		 * available. @@ -5057,9 +5411,9 @@ Tcl_ReadRaw(  		nread = -1;  		result = EWOULDBLOCK; -	    } else { +	    } else  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - +	    {  		/*  		 * Now go to the driver to get as much as is possible to fill  		 * the remaining request. Do all the error handling by @@ -5069,12 +5423,9 @@ Tcl_ReadRaw(  		 * The case of 'bytesToRead == 0' at this point cannot happen.  		 */ -		nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData, -			bufPtr + copied, bytesToRead - copied, &result); - -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING +		nread = ChanRead(chanPtr, bufPtr + copied, +			bytesToRead - copied, &result);  	    } -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */  	    if (nread > 0) {  		/* @@ -5098,7 +5449,6 @@ Tcl_ReadRaw(  		    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);  		}  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ -  	    } else if (nread == 0) {  		SetFlag(statePtr, CHANNEL_EOF);  		statePtr->inputEncodingFlags |= TCL_ENCODING_END; @@ -5111,7 +5461,7 @@ Tcl_ReadRaw(  			 * over EAGAIN/WOULDBLOCK handling.  			 */ -			return copied; +			goto done;  		    }  		    SetFlag(statePtr, CHANNEL_BLOCKED); @@ -5119,14 +5469,17 @@ Tcl_ReadRaw(  		}  		Tcl_SetErrno(result); -		return -1; +		copied = -1; +		goto done;  	    } -	    return copied + nread; +	    copied += nread; +	    goto done;  	}      }    done: +    Tcl_Release(chanPtr);      return copied;  } @@ -5234,6 +5587,7 @@ DoReadChars(      chanPtr = statePtr->topChanPtr;      encoding = statePtr->encoding;      factor = UTF_EXPANSION_FACTOR; +    Tcl_Preserve(chanPtr);      if (appendFlag == 0) {  	if (encoding == NULL) { @@ -5274,9 +5628,8 @@ DoReadChars(  	    bufPtr = statePtr->inQueueHead;  	    if (IsBufferEmpty(bufPtr)) { -		ChannelBuffer *nextPtr; +		ChannelBuffer *nextPtr = bufPtr->nextPtr; -		nextPtr = bufPtr->nextPtr;  		RecycleBuffer(statePtr, bufPtr, 0);  		statePtr->inQueueHead = nextPtr;  		if (nextPtr == NULL) { @@ -5286,16 +5639,21 @@ DoReadChars(  	}  	if (copiedNow < 0) { -	    if (statePtr->flags & CHANNEL_EOF) { +	    if (GotFlag(statePtr, CHANNEL_EOF)) {  		break;  	    } -	    if (statePtr->flags & CHANNEL_BLOCKED) { -		if (statePtr->flags & CHANNEL_NONBLOCKING) { +	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) { +		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {  		    break;  		}  		ResetFlag(statePtr, CHANNEL_BLOCKED);  	    }  	    result = GetInput(chanPtr); +	    if (chanPtr != statePtr->topChanPtr) { +		Tcl_Release(chanPtr); +		chanPtr = statePtr->topChanPtr; +		Tcl_Preserve(chanPtr); +	    }  	    if (result != 0) {  		if (result == EAGAIN) {  		    break; @@ -5322,7 +5680,17 @@ DoReadChars(       */    done: +    /* +     * Regenerate the top channel, in case it was changed due to +     * self-modifying reflected transforms. +     */ +    if (chanPtr != statePtr->topChanPtr) { +	Tcl_Release(chanPtr); +	chanPtr = statePtr->topChanPtr; +	Tcl_Preserve(chanPtr); +    }      UpdateInterest(chanPtr); +    Tcl_Release(chanPtr);      return copied;  } @@ -5402,7 +5770,7 @@ ReadBytes(      }      dst += offset; -    if (statePtr->flags & INPUT_NEED_NL) { +    if (GotFlag(statePtr, INPUT_NEED_NL)) {  	ResetFlag(statePtr, INPUT_NEED_NL);  	if ((srcLen == 0) || (*src != '\n')) {  	    *dst = '\r'; @@ -5494,7 +5862,7 @@ ReadChars(      srcLen = BytesLeft(bufPtr);      toRead = charsToRead; -    if ((unsigned)toRead > (unsigned)srcLen) { +    if ((unsigned) toRead > (unsigned) srcLen) {  	toRead = srcLen;      } @@ -5583,7 +5951,7 @@ ReadChars(      }      oldState = statePtr->inputEncodingState; -    if (statePtr->flags & INPUT_NEED_NL) { +    if (GotFlag(statePtr, INPUT_NEED_NL)) {  	/*  	 * We want a '\n' because the last character we saw was '\r'.  	 */ @@ -5699,16 +6067,15 @@ ReadChars(       * '\n' in dst.       */ -    numChars -= (dstRead - dstWrote); +    numChars -= dstRead - dstWrote;      if ((unsigned) numChars > (unsigned) toRead) {  	/*  	 * Got too many chars.  	 */ -	const char *eof; +	const char *eof = Tcl_UtfAtIndex(dst, toRead); -	eof = Tcl_UtfAtIndex(dst, toRead);  	statePtr->inputEncodingState = oldState;  	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,  		statePtr->inputEncodingFlags, &statePtr->inputEncodingState, @@ -5776,9 +6143,8 @@ TranslateInputEOL(  	 * buffer.  	 */ -	const char *src, *srcMax; +	const char *src, *srcMax = srcStart + *srcLenPtr; -	srcMax = srcStart + *srcLenPtr;  	for (src = srcStart; src < srcMax; src++) {  	    if (*src == inEofChar) {  		eof = src; @@ -5849,7 +6215,7 @@ TranslateInputEOL(  	srcEnd = srcStart + dstLen;  	srcMax = srcStart + *srcLenPtr; -	if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) { +	if (GotFlag(statePtr, INPUT_SAW_CR) && (src < srcMax)) {  	    if (*src == '\n') {  		src++;  	    } @@ -5954,7 +6320,7 @@ Tcl_Ungets(       * bit. We want to discover these conditions anew in each operation.       */ -    if (statePtr->flags & CHANNEL_STICKY_EOF) { +    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {  	goto done;      }      ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF); @@ -6080,7 +6446,7 @@ DiscardInputQueued(       */      if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) { -	ckfree((char *) statePtr->saveInBufPtr); +	ReleaseChannelBuffer(statePtr->saveInBufPtr);  	statePtr->saveInBufPtr = NULL;      }  } @@ -6173,7 +6539,7 @@ GetInput(  	if ((bufPtr != NULL)  		&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) { -	    ckfree((char *) bufPtr); +	    ReleaseChannelBuffer(bufPtr);  	    bufPtr = NULL;  	} @@ -6211,38 +6577,36 @@ GetInput(       * platforms it is impossible to read from a device after EOF.       */ -    if (statePtr->flags & CHANNEL_EOF) { +    if (GotFlag(statePtr, CHANNEL_EOF)) {  	return 0;      }  #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING      /* -     * [SF Tcl Bug 943274]. Better emulation of non-blocking channels for -     * channels without BlockModeProc, by keeping track of true fileevents -     * generated by the OS == Data waiting and reading if and only if we are -     * sure to have data. +     * [Bug 943274]: Better emulation of non-blocking channels for channels +     * without BlockModeProc, by keeping track of true fileevents generated by +     * the OS == Data waiting and reading if and only if we are sure to have +     * data.       */ -    if ((statePtr->flags & CHANNEL_NONBLOCKING) && +    if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&  	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && -	    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) { +	    !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {  	/*  	 * Bypass the driver, it would block, as no data is available  	 */  	nread = -1;  	result = EWOULDBLOCK; -    } else { +    } else  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ - -	nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData, -		InsertPoint(bufPtr), toRead, &result); - -#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING +    { +	PreserveChannelBuffer(bufPtr); +	nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);      } -#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */      if (nread > 0) { +	result = 0;  	bufPtr->nextAdded += nread;  	/* @@ -6259,15 +6623,14 @@ GetInput(  #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING  	if (nread <= toRead) {  	    /* -	     * [SF Tcl Bug 943274] We have read the available data, clear -	     * flag. +	     * [Bug 943274]: We have read the available data, clear flag.  	     */  	    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);  	}  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ -      } else if (nread == 0) { +	result = 0;  	SetFlag(statePtr, CHANNEL_EOF);  	statePtr->inputEncodingFlags |= TCL_ENCODING_END;      } else if (nread < 0) { @@ -6276,9 +6639,9 @@ GetInput(  	    result = EAGAIN;  	}  	Tcl_SetErrno(result); -	return result;      } -    return 0; +    ReleaseChannelBuffer(bufPtr); +    return result;  }  /* @@ -6382,8 +6745,8 @@ Tcl_Seek(       * point. Also clear CR related flags.       */ -    statePtr->flags &= -	~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR); +    ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | +	    INPUT_SAW_CR);      /*       * If the channel is in asynchronous output mode, switch it back to @@ -6393,14 +6756,14 @@ Tcl_Seek(       */      wasAsync = 0; -    if (statePtr->flags & CHANNEL_NONBLOCKING) { +    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {  	wasAsync = 1;  	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);  	if (result != 0) {  	    return Tcl_LongAsWide(-1);  	}  	ResetFlag(statePtr, CHANNEL_NONBLOCKING); -	if (statePtr->flags & BG_FLUSH_SCHEDULED) { +	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {  	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);  	}      } @@ -6427,23 +6790,10 @@ Tcl_Seek(      } else {  	/*  	 * Now seek to the new position in the channel as requested by the -	 * caller. Note that we prefer the wideSeekProc if that is available -	 * and non-NULL... +	 * caller.  	 */ -	if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) && -		chanPtr->typePtr->wideSeekProc != NULL) { -	    curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData, -		    offset, mode, &result); -	} else if (offset < Tcl_LongAsWide(LONG_MIN) || -		offset > Tcl_LongAsWide(LONG_MAX)) { -	    result = EOVERFLOW; -	    curPos = Tcl_LongAsWide(-1); -	} else { -	    curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) ( -		    chanPtr->instanceData, Tcl_WideAsLong(offset), mode, -		    &result)); -	} +	curPos = ChanSeek(chanPtr, offset, mode, &result);  	if (curPos == Tcl_LongAsWide(-1)) {  	    Tcl_SetErrno(result);  	} @@ -6538,29 +6888,18 @@ Tcl_Tell(      inputBuffered = Tcl_InputBuffered(chan);      outputBuffered = Tcl_OutputBuffered(chan); -    if ((inputBuffered != 0) && (outputBuffered != 0)) { -	Tcl_SetErrno(EFAULT); -	return Tcl_LongAsWide(-1); -    } -      /*       * Get the current position in the device and compute the position where       * the next character will be read or written. Note that we prefer the       * wideSeekProc if that is available and non-NULL...       */ -    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) && -	    chanPtr->typePtr->wideSeekProc != NULL) { -	curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData, -		Tcl_LongAsWide(0), SEEK_CUR, &result); -    } else { -	curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) ( -		chanPtr->instanceData, 0, SEEK_CUR, &result)); -    } +    curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);      if (curPos == Tcl_LongAsWide(-1)) {  	Tcl_SetErrno(result);  	return Tcl_LongAsWide(-1);      } +      if (inputBuffered != 0) {  	return curPos - inputBuffered;      } @@ -6594,19 +6933,18 @@ Tcl_SeekOld(  {      Tcl_WideInt wOffset, wResult; -    wOffset = Tcl_LongAsWide((long)offset); +    wOffset = Tcl_LongAsWide((long) offset);      wResult = Tcl_Seek(chan, wOffset, mode); -    return (int)Tcl_WideAsLong(wResult); +    return (int) Tcl_WideAsLong(wResult);  }  int  Tcl_TellOld(      Tcl_Channel chan)		/* The channel to return pos for. */  { -    Tcl_WideInt wResult; +    Tcl_WideInt wResult = Tcl_Tell(chan); -    wResult = Tcl_Tell(chan); -    return (int)Tcl_WideAsLong(wResult); +    return (int) Tcl_WideAsLong(wResult);  }  /* @@ -6647,7 +6985,7 @@ Tcl_TruncateChannel(  	return TCL_ERROR;      } -    if (!(chanPtr->state->flags & TCL_WRITABLE)) { +    if (!GotFlag(chanPtr->state, TCL_WRITABLE)) {  	/*  	 * We require that the file was opened of writing. Do that check now  	 * so that we only flush if we think we're going to succeed. @@ -6662,8 +7000,10 @@ Tcl_TruncateChannel(       * pre-read input data.       */ -    if (Tcl_Seek(chan, (Tcl_WideInt)0, SEEK_CUR) == Tcl_LongAsWide(-1)) { -	return TCL_ERROR; +    WillWrite(chanPtr); + +    if (WillRead(chanPtr) < 0) { +        return TCL_ERROR;      }      /* @@ -6733,8 +7073,7 @@ CheckChannelErrors(       * order to drain data from stacked channels.       */ -    if ((statePtr->flags & CHANNEL_CLOSED) && -	    ((flags & CHANNEL_RAW_MODE) == 0)) { +    if (GotFlag(statePtr, CHANNEL_CLOSED) && !(flags & CHANNEL_RAW_MODE)) {  	Tcl_SetErrno(EACCES);  	return -1;      } @@ -6756,7 +7095,7 @@ CheckChannelErrors(       * retrieving and transforming the data to copy.       */ -    if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) { +    if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {  	Tcl_SetErrno(EBUSY);  	return -1;      } @@ -6769,7 +7108,7 @@ CheckChannelErrors(  	 * discover these conditions anew in each operation.  	 */ -	if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) { +	if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {  	    ResetFlag(statePtr, CHANNEL_EOF);  	}  	ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); @@ -6801,8 +7140,8 @@ Tcl_Eof(      ChannelState *statePtr = ((Channel *) chan)->state;  				/* State of real channel structure. */ -    return ((statePtr->flags & CHANNEL_STICKY_EOF) || -	    ((statePtr->flags & CHANNEL_EOF) && +    return (GotFlag(statePtr, CHANNEL_STICKY_EOF) || +	    (GotFlag(statePtr, CHANNEL_EOF) &&  	    (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;  } @@ -6829,7 +7168,7 @@ Tcl_InputBlocked(      ChannelState *statePtr = ((Channel *) chan)->state;  				/* State of real channel structure. */ -    return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0; +    return GotFlag(statePtr, CHANNEL_BLOCKED) ? 1 : 0;  }  /* @@ -6982,22 +7321,13 @@ Tcl_SetChannelBufferSize(       */      if (sz < 1) { -      sz = 1; +	sz = 1;      } else if (sz > MAX_CHANNEL_BUFFER_SIZE) { -      sz = MAX_CHANNEL_BUFFER_SIZE; +	sz = MAX_CHANNEL_BUFFER_SIZE;      }      statePtr = ((Channel *) chan)->state;      statePtr->bufSize = sz; - -    if (statePtr->outputStage != NULL) { -	ckfree((char *) statePtr->outputStage); -	statePtr->outputStage = NULL; -    } -    if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) { -	statePtr->outputStage = (char *) -		ckalloc((unsigned) (statePtr->bufSize + 2)); -    }  }  /* @@ -7070,11 +7400,12 @@ Tcl_BadChannelOption(  	const char **argv;  	int argc, i;  	Tcl_DString ds; +        Tcl_Obj *errObj;  	Tcl_DStringInit(&ds);  	Tcl_DStringAppend(&ds, genericopt, -1);  	if (optionList && (*optionList)) { -	    Tcl_DStringAppend(&ds, " ", 1); +	    TclDStringAppendLiteral(&ds, " ");  	    Tcl_DStringAppend(&ds, optionList, -1);  	}  	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), @@ -7082,15 +7413,16 @@ Tcl_BadChannelOption(  	    Tcl_Panic("malformed option list in channel driver");  	}  	Tcl_ResetResult(interp); -	Tcl_AppendResult(interp, "bad option \"", optionName, -		"\": should be one of ", NULL); +	errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ", +                optionName);  	argc--;  	for (i = 0; i < argc; i++) { -	    Tcl_AppendResult(interp, "-", argv[i], ", ", NULL); +	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);  	} -	Tcl_AppendResult(interp, "or -", argv[i], NULL); +	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]); +        Tcl_SetObjResult(interp, errObj);  	Tcl_DStringFree(&ds); -	ckfree((char *) argv); +	ckfree(argv);      }      Tcl_SetErrno(EINVAL);      return TCL_ERROR; @@ -7152,9 +7484,9 @@ Tcl_GetChannelOption(       */      if (statePtr->csPtrR) { -      flags = statePtr->csPtrR->readFlags; +	flags = statePtr->csPtrR->readFlags;      } else if (statePtr->csPtrW) { -      flags = statePtr->csPtrW->writeFlags; +	flags = statePtr->csPtrW->writeFlags;      } else {  	flags = statePtr->flags;      } @@ -7314,8 +7646,8 @@ Tcl_GetChannelOption(  	 * and message.  	 */ -	return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData, -		interp, optionName, dsPtr); +	return chanPtr->typePtr->getOptionProc(chanPtr->instanceData, interp, +		optionName, dsPtr);      } else {  	/*  	 * No driver specific options case. @@ -7366,8 +7698,9 @@ Tcl_SetChannelOption(      if (statePtr->csPtrR || statePtr->csPtrW) {  	if (interp) { -	    Tcl_AppendResult(interp, "unable to set channel options: " -		    "background copy in progress", NULL); +	    Tcl_SetObjResult(interp, Tcl_NewStringObj( +                    "unable to set channel options: background copy in" +                    " progress", -1));  	}  	return TCL_ERROR;      } @@ -7406,8 +7739,7 @@ Tcl_SetChannelOption(      } else if (HaveOpt(7, "-buffering")) {  	len = strlen(newValue);  	if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) { -	    statePtr->flags &= -		    ~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED); +	    ResetFlag(statePtr, CHANNEL_UNBUFFERED | CHANNEL_LINEBUFFERED);  	} else if ((newValue[0] == 'l') &&  		(strncmp(newValue, "line", len) == 0)) {  	    ResetFlag(statePtr, CHANNEL_UNBUFFERED); @@ -7416,12 +7748,11 @@ Tcl_SetChannelOption(  		(strncmp(newValue, "none", len) == 0)) {  	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED);  	    SetFlag(statePtr, CHANNEL_UNBUFFERED); -	} else { -	    if (interp) { -		Tcl_AppendResult(interp, "bad value for -buffering: " -			"must be one of full, line, or none", NULL); -		return TCL_ERROR; -	    } +	} else if (interp) { +            Tcl_SetObjResult(interp, Tcl_NewStringObj( +                    "bad value for -buffering: must be one of" +                    " full, line, or none", -1)); +            return TCL_ERROR;  	}  	return TCL_OK;      } else if (HaveOpt(7, "-buffersize")) { @@ -7448,7 +7779,8 @@ Tcl_SetChannelOption(  	 * iso2022, the terminated escape sequence must write to the buffer.  	 */ -	if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL) +	if ((statePtr->encoding != NULL) +		&& !(statePtr->outputEncodingFlags & TCL_ENCODING_START)  		&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {  	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;  	    WriteChars(chanPtr, "", 0); @@ -7472,31 +7804,33 @@ Tcl_SetChannelOption(  	    int outIndex = (argc - 1);  	    int inValue = (int) argv[0][0];  	    int outValue = (int) argv[outIndex][0]; +  	    if (inValue & 0x80 || outValue & 0x80) {  		if (interp) { -		    Tcl_AppendResult(interp, "bad value for -eofchar: ", -			    "must be non-NUL ASCII character", NULL); +		    Tcl_SetObjResult(interp, Tcl_NewStringObj( +                            "bad value for -eofchar: must be non-NUL ASCII" +                            " character", -1));  		} -		ckfree((char *) argv); +		ckfree(argv);  		return TCL_ERROR;  	    } -	    if (statePtr->flags & TCL_READABLE) { +	    if (GotFlag(statePtr, TCL_READABLE)) {  		statePtr->inEofChar = inValue;  	    } -	    if (statePtr->flags & TCL_WRITABLE) { +	    if (GotFlag(statePtr, TCL_WRITABLE)) {  		statePtr->outEofChar = outValue;  	    }  	} else {  	    if (interp) { -		Tcl_AppendResult(interp, +		Tcl_SetObjResult(interp, Tcl_NewStringObj(  			"bad value for -eofchar: should be a list of zero," -			" one, or two elements", NULL); +			" one, or two elements", -1));  	    } -	    ckfree((char *) argv); +	    ckfree(argv);  	    return TCL_ERROR;  	}  	if (argv != NULL) { -	    ckfree((char *) argv); +	    ckfree(argv);  	}  	/* @@ -7505,9 +7839,7 @@ Tcl_SetChannelOption(  	 * ahead'. Ditto for blocked.  	 */ -	statePtr->flags &= -		~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED); - +	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);  	return TCL_OK;      } else if (HaveOpt(1, "-translation")) {  	const char *readMode, *writeMode; @@ -7517,23 +7849,24 @@ Tcl_SetChannelOption(  	}  	if (argc == 1) { -	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL; -	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL; +	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL; +	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;  	} else if (argc == 2) { -	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL; -	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL; +	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL; +	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;  	} else {  	    if (interp) { -		Tcl_AppendResult(interp, +		Tcl_SetObjResult(interp, Tcl_NewStringObj(  			"bad value for -translation: must be a one or two" -			" element list", NULL); +			" element list", -1));  	    } -	    ckfree((char *) argv); +	    ckfree(argv);  	    return TCL_ERROR;  	}  	if (readMode) {  	    TclEolTranslation translation; +  	    if (*readMode == '\0') {  		translation = statePtr->inputTranslation;  	    } else if (strcmp(readMode, "auto") == 0) { @@ -7553,12 +7886,11 @@ Tcl_SetChannelOption(  		translation = TCL_PLATFORM_TRANSLATION;  	    } else {  		if (interp) { -		    Tcl_AppendResult(interp, -			    "bad value for -translation: " -			    "must be one of auto, binary, cr, lf, crlf," -			    " or platform", NULL); +		    Tcl_SetObjResult(interp, Tcl_NewStringObj( +			    "bad value for -translation: must be one of " +                            "auto, binary, cr, lf, crlf, or platform", -1));  		} -		ckfree((char *) argv); +		ckfree(argv);  		return TCL_ERROR;  	    } @@ -7604,20 +7936,19 @@ Tcl_SetChannelOption(  		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;  	    } else {  		if (interp) { -		    Tcl_AppendResult(interp, -			    "bad value for -translation: " -			    "must be one of auto, binary, cr, lf, crlf," -			    " or platform", NULL); +		    Tcl_SetObjResult(interp, Tcl_NewStringObj( +			    "bad value for -translation: must be one of " +                            "auto, binary, cr, lf, crlf, or platform", -1));  		} -		ckfree((char *) argv); +		ckfree(argv);  		return TCL_ERROR;  	    }  	} -	ckfree((char *) argv); +	ckfree(argv);  	return TCL_OK;      } else if (chanPtr->typePtr->setOptionProc != NULL) { -	return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData, -		interp, optionName, newValue); +	return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp, +		optionName, newValue);      } else {  	return Tcl_BadChannelOption(interp, optionName, NULL);      } @@ -7638,17 +7969,6 @@ Tcl_SetChannelOption(  	statePtr->inQueueTail = NULL;      } -    /* -     * If encoding or bufsize changes, need to update output staging buffer. -     */ - -    if (statePtr->outputStage != NULL) { -	ckfree(statePtr->outputStage); -	statePtr->outputStage = NULL; -    } -    if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) { -	statePtr->outputStage = ckalloc((unsigned) (statePtr->bufSize + 2)); -    }      return TCL_OK;  } @@ -7699,7 +8019,7 @@ CleanupChannelHandlers(  		    TclChannelEventScriptInvoker, sPtr);  	    TclDecrRefCount(sPtr->scriptPtr); -	    ckfree((char *) sPtr); +	    ckfree(sPtr);  	} else {  	    prevPtr = sPtr;  	} @@ -7748,9 +8068,9 @@ Tcl_NotifyChannel(       */      if ((mask & TCL_READABLE) && -	    (statePtr->flags & CHANNEL_NONBLOCKING) && +	    GotFlag(statePtr, CHANNEL_NONBLOCKING) &&  	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && -	    !(statePtr->flags & CHANNEL_TIMER_FEV)) { +	    !GotFlag(statePtr, CHANNEL_TIMER_FEV)) {  	SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);      }  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ @@ -7767,14 +8087,14 @@ Tcl_NotifyChannel(       * their own events and pass them upward.       */ -    while (mask && (chanPtr->upChanPtr != (NULL))) { +    while (mask && (chanPtr->upChanPtr != NULL)) {  	Tcl_DriverHandlerProc *upHandlerProc;  	upChanPtr = chanPtr->upChanPtr;  	upTypePtr = upChanPtr->typePtr;  	upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);  	if (upHandlerProc != NULL) { -	    mask = (*upHandlerProc) (upChanPtr->instanceData, mask); +	    mask = upHandlerProc(upChanPtr->instanceData, mask);  	}  	/* @@ -7813,7 +8133,7 @@ Tcl_NotifyChannel(       * don't call any write handlers before the flush is complete.       */ -    if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) { +    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {  	FlushChannel(NULL, chanPtr, 1);  	mask &= ~TCL_WRITABLE;      } @@ -7835,7 +8155,7 @@ Tcl_NotifyChannel(  	if ((chPtr->mask & mask) != 0) {  	    nh.nextHandlerPtr = chPtr->nextPtr; -	    (*(chPtr->proc))(chPtr->clientData, mask); +	    chPtr->proc(chPtr->clientData, mask);  	    chPtr = nh.nextHandlerPtr;  	} else {  	    chPtr = chPtr->nextPtr; @@ -7883,12 +8203,17 @@ UpdateInterest(  				/* State info for channel */      int mask = statePtr->interestMask; +    if (chanPtr->typePtr == NULL) { +	/* Do not update interest on a closed channel */ +	return; +    } +      /*       * If there are flushed buffers waiting to be written, then we need to       * watch for the channel to become writable.       */ -    if (statePtr->flags & BG_FLUSH_SCHEDULED) { +    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {  	mask |= TCL_WRITABLE;      } @@ -7900,7 +8225,7 @@ UpdateInterest(       */      if (mask & TCL_READABLE) { -	if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA) +	if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)  		&& (statePtr->inQueueHead != NULL)  		&& IsBufferReady(statePtr->inQueueHead)) {  	    mask &= ~TCL_READABLE; @@ -7946,12 +8271,12 @@ UpdateInterest(  	    mask &= ~TCL_EXCEPTION;  	    if (!statePtr->timer) { -		statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, -			chanPtr); +		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, +                        ChannelTimerProc, chanPtr);  	    }  	}      } -    (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask); +    ChanWatch(chanPtr, mask);  }  /* @@ -7979,7 +8304,7 @@ ChannelTimerProc(      ChannelState *statePtr = chanPtr->state;  				/* State info for channel */ -    if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA) +    if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)  	    && (statePtr->interestMask & TCL_READABLE)  	    && (statePtr->inQueueHead != NULL)  	    && IsBufferReady(statePtr->inQueueHead)) { @@ -7988,7 +8313,8 @@ ChannelTimerProc(  	 * before UpdateInterest gets called by Tcl_NotifyChannel.  	 */ -	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr); +	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, +                ChannelTimerProc,chanPtr);  #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING  	/* @@ -7999,14 +8325,14 @@ ChannelTimerProc(  	 * similar test is done in "PeekAhead".  	 */ -	if ((statePtr->flags & CHANNEL_NONBLOCKING) && -	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) { +	if (GotFlag(statePtr, CHANNEL_NONBLOCKING) && +		(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {  	    SetFlag(statePtr, CHANNEL_TIMER_FEV);  	}  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */  	Tcl_Preserve(statePtr); -	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE); +	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);  #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING  	ResetFlag(statePtr, CHANNEL_TIMER_FEV); @@ -8070,7 +8396,7 @@ Tcl_CreateChannelHandler(  	}      }      if (chPtr == NULL) { -	chPtr = (ChannelHandler *) ckalloc(sizeof(ChannelHandler)); +	chPtr = ckalloc(sizeof(ChannelHandler));  	chPtr->mask = 0;  	chPtr->proc = proc;  	chPtr->clientData = clientData; @@ -8174,7 +8500,7 @@ Tcl_DeleteChannelHandler(      } else {  	prevChPtr->nextPtr = chPtr->nextPtr;      } -    ckfree((char *) chPtr); +    ckfree(chPtr);      /*       * Recompute the interest list for the channel, so that infinite loops @@ -8225,6 +8551,7 @@ DeleteScriptRecord(  	    if (esPtr == statePtr->scriptRecordPtr) {  		statePtr->scriptRecordPtr = esPtr->nextPtr;  	    } else { +		CLANG_ASSERT(prevEsPtr);  		prevEsPtr->nextPtr = esPtr->nextPtr;  	    } @@ -8232,7 +8559,7 @@ DeleteScriptRecord(  		    TclChannelEventScriptInvoker, esPtr);  	    TclDecrRefCount(esPtr->scriptPtr); -	    ckfree((char *) esPtr); +	    ckfree(esPtr);  	    break;  	} @@ -8281,12 +8608,12 @@ CreateScriptRecord(      makeCH = (esPtr == NULL);      if (makeCH) { -	esPtr = (EventScriptRecord *) ckalloc(sizeof(EventScriptRecord)); +	esPtr = ckalloc(sizeof(EventScriptRecord));      }      /*       * Initialize the structure before calling Tcl_CreateChannelHandler, -     * because a reflected channel caling 'chan postevent' aka +     * because a reflected channel calling 'chan postevent' aka       * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke       * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to       * see uninitialized memory and crash. See [Bug 2918110]. @@ -8349,6 +8676,7 @@ TclChannelEventScriptInvoker(       */      Tcl_Preserve(interp); +    Tcl_Preserve(chanPtr);      result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);      /* @@ -8363,8 +8691,9 @@ TclChannelEventScriptInvoker(  	if (chanPtr->typePtr != NULL) {  	    DeleteScriptRecord(interp, chanPtr, mask);  	} -	TclBackgroundException(interp, result); +	Tcl_BackgroundException(interp, result);      } +    Tcl_Release(chanPtr);      Tcl_Release(interp);  } @@ -8399,11 +8728,11 @@ Tcl_FileEventObjCmd(      Channel *chanPtr;		/* The channel to create the handler for. */      ChannelState *statePtr;	/* State info for channel */      Tcl_Channel chan;		/* The opaque type for the channel. */ -    char *chanName; +    const char *chanName;      int modeIndex;		/* Index of mode argument. */      int mask; -    static const char *modeOptions[] = {"readable", "writable", NULL}; -    static int maskArray[] = {TCL_READABLE, TCL_WRITABLE}; +    static const char *const modeOptions[] = {"readable", "writable", NULL}; +    static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};      if ((objc != 3) && (objc != 4)) {  	Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?"); @@ -8423,8 +8752,8 @@ Tcl_FileEventObjCmd(      chanPtr = (Channel *) chan;      statePtr = chanPtr->state;      if ((statePtr->flags & mask) == 0) { -	Tcl_AppendResult(interp, "channel is not ", -		(mask == TCL_READABLE) ? "readable" : "writable", NULL); +	Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s", +		(mask == TCL_READABLE) ? "readable" : "writable"));  	return TCL_ERROR;      } @@ -8434,6 +8763,7 @@ Tcl_FileEventObjCmd(      if (objc == 3) {  	EventScriptRecord *esPtr; +  	for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL;  		esPtr = esPtr->nextPtr) {  	    if ((esPtr->interp == interp) && (esPtr->mask == mask)) { @@ -8467,6 +8797,33 @@ Tcl_FileEventObjCmd(  /*   *----------------------------------------------------------------------   * + * ZeroTransferTimerProc -- + * + *	Timer handler scheduled by TclCopyChannel so that -command is + *	called asynchronously even when -size is 0. + * + * Results: + *	None. + * + * Side effects: + *	Calls CopyData for -command invocation. + * + *---------------------------------------------------------------------- + */ + +static void +ZeroTransferTimerProc( +    ClientData clientData) +{ +    /* calling CopyData with mask==0 still implies immediate invocation of the +     *  -command callback, and completion of the fcopy. +     */ +    CopyData(clientData, 0); +} + +/* + *---------------------------------------------------------------------- + *   * TclCopyChannel --   *   *	This routine copies data from one channel to another, either @@ -8486,13 +8843,25 @@ Tcl_FileEventObjCmd(   */  int -TclCopyChannel( +TclCopyChannelOld(      Tcl_Interp *interp,		/* Current interpreter. */      Tcl_Channel inChan,		/* Channel to read from. */      Tcl_Channel outChan,	/* Channel to write to. */      int toRead,			/* Amount of data to copy, or -1 for all. */      Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */  { +    return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, +            cmdPtr); +} + +int +TclCopyChannel( +    Tcl_Interp *interp,		/* Current interpreter. */ +    Tcl_Channel inChan,		/* Channel to read from. */ +    Tcl_Channel outChan,	/* Channel to write to. */ +    Tcl_WideInt toRead,		/* Amount of data to copy, or -1 for all. */ +    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */ +{      Channel *inPtr = (Channel *) inChan;      Channel *outPtr = (Channel *) outChan;      ChannelState *inStatePtr, *outStatePtr; @@ -8503,17 +8872,17 @@ TclCopyChannel(      inStatePtr = inPtr->state;      outStatePtr = outPtr->state; -    if (BUSY_STATE(inStatePtr,TCL_READABLE)) { +    if (BUSY_STATE(inStatePtr, TCL_READABLE)) {  	if (interp) { -	    Tcl_AppendResult(interp, "channel \"", -		    Tcl_GetChannelName(inChan), "\" is busy", NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                    "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));  	}  	return TCL_ERROR;      } -    if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) { +    if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {  	if (interp) { -	    Tcl_AppendResult(interp, "channel \"", -		    Tcl_GetChannelName(outChan), "\" is busy", NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                    "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));  	}  	return TCL_ERROR;      } @@ -8546,8 +8915,8 @@ TclCopyChannel(       * Make sure the output side is unbuffered.       */ -    outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED)) -	| CHANNEL_UNBUFFERED; +    outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED) +	    | CHANNEL_UNBUFFERED;      /*       * Allocate a new CopyState to maintain info about the current copy in @@ -8555,14 +8924,14 @@ TclCopyChannel(       * completed.       */ -    csPtr = (CopyState *) ckalloc(sizeof(CopyState) + inStatePtr->bufSize); +    csPtr = ckalloc(sizeof(CopyState) + inStatePtr->bufSize);      csPtr->bufSize = inStatePtr->bufSize;      csPtr->readPtr = inPtr;      csPtr->writePtr = outPtr;      csPtr->readFlags = readFlags;      csPtr->writeFlags = writeFlags;      csPtr->toRead = toRead; -    csPtr->total = 0; +    csPtr->total = (Tcl_WideInt) 0;      csPtr->interp = interp;      if (cmdPtr) {  	Tcl_IncrRefCount(cmdPtr); @@ -8573,6 +8942,16 @@ TclCopyChannel(      outStatePtr->csPtrW = csPtr;      /* +     * Special handling of -size 0 async transfers, so that the -command is +     * still called asynchronously. +     */ + +    if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { +        Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); +        return 0; +    } + +    /*       * Start copying data between the channels.       */ @@ -8607,7 +8986,7 @@ CopyData(      ChannelState *inStatePtr, *outStatePtr;      int result = TCL_OK, size, sizeb;      Tcl_WideInt total; -    char *buffer; +    const char *buffer;      int inBinary, outBinary, sameEncoding;  				/* Encoding control */      int underflow;		/* Input underflow */ @@ -8636,7 +9015,7 @@ CopyData(  	Tcl_IncrRefCount(bufObj);      } -    while (csPtr->toRead != 0) { +    while (csPtr->toRead != (Tcl_WideInt) 0) {  	/*  	 * Check for unreported background errors.  	 */ @@ -8660,24 +9039,26 @@ CopyData(  	     * underflow instead to prime the readable fileevent.  	     */ -	    size      = 0; +	    size = 0;  	    underflow = 1;  	} else {  	    /*  	     * Read up to bufSize bytes.  	     */ -	    if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) { +	    if ((csPtr->toRead == (Tcl_WideInt) -1) +                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {  		sizeb = csPtr->bufSize;  	    } else { -		sizeb = csPtr->toRead; +		sizeb = (int) csPtr->toRead;  	    }  	    if (inBinary || sameEncoding) { -		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb); +		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, +                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));  	    } else {  		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, -				   0 /* No append */); +			0 /* No append */);  	    }  	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */  	} @@ -8710,8 +9091,8 @@ CopyData(  	    if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) {  		break;  	    } -	    if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) && -		!(mask & TCL_READABLE)) { +	    if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) && +                !(mask & TCL_READABLE)) {  		if (mask & TCL_WRITABLE) {  		    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);  		} @@ -8739,9 +9120,9 @@ CopyData(  	}  	if (outBinary || sameEncoding) { -	    sizeb = DoWrite(outStatePtr->topChanPtr, buffer, sizeb); +	    sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);  	} else { -	    sizeb = DoWriteChars(outStatePtr->topChanPtr, buffer, sizeb); +	    sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);  	}  	/* @@ -8776,7 +9157,7 @@ CopyData(  	}  	/* -	 * (UP) Update the current byte count. Do it now so the count is valid +	 * Update the current byte count. Do it now so the count is valid  	 * before a return or break takes us out of the loop. The invariant at  	 * the top of the loop should be that csPtr->toRead holds the number  	 * of bytes left to copy. @@ -8802,7 +9183,7 @@ CopyData(  	 * therefore we don't need a writable handler.  	 */ -	if (!underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED)) { +	if (!underflow && GotFlag(outStatePtr, BG_FLUSH_SCHEDULED)) {  	    if (!(mask & TCL_WRITABLE)) {  		if (mask & TCL_READABLE) {  		    Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr); @@ -8853,6 +9234,7 @@ CopyData(      total = csPtr->total;      if (cmdPtr && interp) {  	int code; +  	/*  	 * Get a private copy of the command so we can mutate it by adding  	 * arguments. Note that StopCopy frees our saved reference to the @@ -8870,7 +9252,7 @@ CopyData(  	}  	code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);  	if (code != TCL_OK) { -	    TclBackgroundException(interp, code); +	    Tcl_BackgroundException(interp, code);  	    result = TCL_ERROR;  	}  	TclDecrRefCount(cmdPtr); @@ -8895,9 +9277,8 @@ CopyData(   *   * DoRead --   * - *	Reads a given number of bytes from a channel. - * - *	No encoding conversions are applied to the bytes being read. + *	Reads a given number of bytes from a channel. No encoding conversions + *	are applied to the bytes being read.   *   * Results:   *	The number of characters read, or -1 on error. Use Tcl_GetErrno() to @@ -8913,7 +9294,8 @@ static int  DoRead(      Channel *chanPtr,		/* The channel from which to read. */      char *bufPtr,		/* Where to store input read. */ -    int toRead)			/* Maximum number of bytes to read. */ +    int toRead,			/* Maximum number of bytes to read. */ +    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */  {      ChannelState *statePtr = chanPtr->state;  				/* State info for channel */ @@ -8929,7 +9311,8 @@ DoRead(       * operation.       */ -    if (!(statePtr->flags & CHANNEL_STICKY_EOF)) { +    Tcl_Preserve(chanPtr); +    if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {  	ResetFlag(statePtr, CHANNEL_EOF);      }      ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); @@ -8938,11 +9321,11 @@ DoRead(  	copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,  		toRead - copied);  	if (copiedNow == 0) { -	    if (statePtr->flags & CHANNEL_EOF) { +	    if (GotFlag(statePtr, CHANNEL_EOF)) {  		goto done;  	    } -	    if (statePtr->flags & CHANNEL_BLOCKED) { -		if (statePtr->flags & CHANNEL_NONBLOCKING) { +	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) { +		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {  		    goto done;  		}  		ResetFlag(statePtr, CHANNEL_BLOCKED); @@ -8954,7 +9337,10 @@ DoRead(  		}  		goto done;  	    } -	} +	} else if (allowShortReads) { +            copied += copiedNow; +            break; +        }      }      ResetFlag(statePtr, CHANNEL_BLOCKED); @@ -8966,6 +9352,7 @@ DoRead(    done:      UpdateInterest(chanPtr); +    Tcl_Release(chanPtr);      return copied;  } @@ -9096,7 +9483,7 @@ CopyAndTranslateBuffer(  	    curByte = *src;  	    if (curByte == '\n') {  		ResetFlag(statePtr, INPUT_SAW_CR); -	    } else if (statePtr->flags & INPUT_SAW_CR) { +	    } else if (GotFlag(statePtr, INPUT_SAW_CR)) {  		ResetFlag(statePtr, INPUT_SAW_CR);  		*dst = '\r';  		dst++; @@ -9139,7 +9526,7 @@ CopyAndTranslateBuffer(  		*dst = '\n';  		dst++;  	    } else { -		if ((curByte != '\n') || !(statePtr->flags & INPUT_SAW_CR)) { +		if ((curByte != '\n') || !GotFlag(statePtr, INPUT_SAW_CR)) {  		    *dst = (char) curByte;  		    dst++;  		} @@ -9289,162 +9676,6 @@ CopyBuffer(  /*   *----------------------------------------------------------------------   * - * DoWrite -- - * - *	Puts a sequence of characters into an output buffer, may queue the - *	buffer for output if it gets full, and also remembers whether the - *	current buffer is ready e.g. if it contains a newline and we are in - *	line buffering mode. - * - * Results: - *	The number of bytes written or -1 in case of error. If -1, - *	Tcl_GetErrno will return the error code. - * - * Side effects: - *	May buffer up output and may cause output to be produced on the - *	channel. - * - *---------------------------------------------------------------------- - */ - -static int -DoWrite( -    Channel *chanPtr,		/* The channel to buffer output for. */ -    const char *src,		/* Data to write. */ -    int srcLen)			/* Number of bytes to write. */ -{ -    ChannelState *statePtr = chanPtr->state; -				/* State info for channel */ -    ChannelBuffer *outBufPtr;	/* Current output buffer. */ -    int foundNewline;		/* Did we find a newline in output? */ -    char *dPtr; -    const char *sPtr;		/* Search variables for newline. */ -    int crsent;			/* In CRLF eol translation mode, remember the -				 * fact that a CR was output to the channel -				 * without its following NL. */ -    int i;			/* Loop index for newline search. */ -    int destCopied;		/* How many bytes were used in this -				 * destination buffer to hold the output? */ -    int totalDestCopied;	/* How many bytes total were copied to the -				 * channel buffer? */ -    int srcCopied;		/* How many bytes were copied from the source -				 * string? */ -    char *destPtr;		/* Where in line to copy to? */ - -    /* -     * If we are in network (or windows) translation mode, record the fact -     * that we have not yet sent a CR to the channel. -     */ - -    crsent = 0; - -    /* -     * Loop filling buffers and flushing them until all output has been -     * consumed. -     */ - -    srcCopied = 0; -    totalDestCopied = 0; - -    while (srcLen > 0) { -	/* -	 * Make sure there is a current output buffer to accept output. -	 */ - -	if (statePtr->curOutPtr == NULL) { -	    statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize); -	} - -	outBufPtr = statePtr->curOutPtr; - -	destCopied = SpaceLeft(outBufPtr); -	if (destCopied > srcLen) { -	    destCopied = srcLen; -	} - -	destPtr = InsertPoint(outBufPtr); -	switch (statePtr->outputTranslation) { -	case TCL_TRANSLATE_LF: -	    srcCopied = destCopied; -	    memcpy(destPtr, src, (size_t) destCopied); -	    break; -	case TCL_TRANSLATE_CR: -	    srcCopied = destCopied; -	    memcpy(destPtr, src, (size_t) destCopied); -	    for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) { -		if (*dPtr == '\n') { -		    *dPtr = '\r'; -		} -	    } -	    break; -	case TCL_TRANSLATE_CRLF: -	    for (srcCopied = 0, dPtr = destPtr, sPtr = src; -		    dPtr < destPtr + destCopied; -		    dPtr++, sPtr++, srcCopied++) { -		if (*sPtr == '\n') { -		    if (crsent) { -			*dPtr = '\n'; -			crsent = 0; -		    } else { -			*dPtr = '\r'; -			crsent = 1; -			sPtr--, srcCopied--; -		    } -		} else { -		    *dPtr = *sPtr; -		} -	    } -	    break; -	case TCL_TRANSLATE_AUTO: -	    Tcl_Panic("Tcl_Write: AUTO output translation mode not supported"); -	default: -	    Tcl_Panic("Tcl_Write: unknown output translation mode"); -	} - -	/* -	 * The current buffer is ready for output if it is full, or if it -	 * contains a newline and this channel is line-buffered, or if it -	 * contains any output and this channel is unbuffered. -	 */ - -	outBufPtr->nextAdded += destCopied; -	if (!(statePtr->flags & BUFFER_READY)) { -	    if (IsBufferFull(outBufPtr)) { -		SetFlag(statePtr, BUFFER_READY); -	    } else if (statePtr->flags & CHANNEL_LINEBUFFERED) { -		for (sPtr = src, i = 0, foundNewline = 0; -			(i < srcCopied) && (!foundNewline); -			i++, sPtr++) { -		    if (*sPtr == '\n') { -			foundNewline = 1; -			break; -		    } -		} -		if (foundNewline) { -		    SetFlag(statePtr, BUFFER_READY); -		} -	    } else if (statePtr->flags & CHANNEL_UNBUFFERED) { -		SetFlag(statePtr, BUFFER_READY); -	    } -	} - -	totalDestCopied += srcCopied; -	src += srcCopied; -	srcLen -= srcCopied; - -	if (statePtr->flags & BUFFER_READY) { -	    if (FlushChannel(NULL, chanPtr, 0) != 0) { -		return -1; -	    } -	} -    } /* Closes "while" */ - -    return totalDestCopied; -} - -/* - *---------------------------------------------------------------------- - *   * CopyEventProc --   *   *	This routine is invoked as a channel event handler for the background @@ -9465,7 +9696,7 @@ CopyEventProc(      ClientData clientData,      int mask)  { -    (void) CopyData((CopyState *) clientData, mask); +    (void) CopyData(clientData, mask);  }  /* @@ -9503,19 +9734,19 @@ StopCopy(       * Restore the old blocking mode and output buffering mode.       */ -    nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING); +    nonBlocking = csPtr->readFlags & CHANNEL_NONBLOCKING;      if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) {  	SetBlockMode(NULL, csPtr->readPtr,  		nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);      }      if (csPtr->readPtr != csPtr->writePtr) { -	nonBlocking = (csPtr->writeFlags & CHANNEL_NONBLOCKING); +	nonBlocking = csPtr->writeFlags & CHANNEL_NONBLOCKING;  	if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {  	    SetBlockMode(NULL, csPtr->writePtr,  		    nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);  	}      } -    outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); +    ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);      outStatePtr->flags |=  	    csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED); @@ -9530,7 +9761,7 @@ StopCopy(      }      inStatePtr->csPtrR = NULL;      outStatePtr->csPtrW = NULL; -    ckfree((char *) csPtr); +    ckfree(csPtr);  }  /* @@ -9559,16 +9790,19 @@ StackSetBlockMode(  {      int result = 0;      Tcl_DriverBlockModeProc *blockModeProc; +    ChannelState *statePtr = chanPtr->state;      /*       * Start at the top of the channel stack +     * TODO: Examine what can go wrong when blockModeProc calls +     * disturb the stacking state of the channel.       */ -    chanPtr = chanPtr->state->topChanPtr; +    chanPtr = statePtr->topChanPtr;      while (chanPtr != NULL) {  	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);  	if (blockModeProc != NULL) { -	    result = (*blockModeProc) (chanPtr->instanceData, mode); +	    result = blockModeProc(chanPtr->instanceData, mode);  	    if (result != 0) {  		Tcl_SetErrno(result);  		return result; @@ -9623,8 +9857,9 @@ SetBlockMode(  	     */  	    if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { -		Tcl_AppendResult(interp, "error setting blocking mode: ", -			Tcl_PosixError(interp), NULL); +		Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                        "error setting blocking mode: %s", +			Tcl_PosixError(interp)));  	    }  	} else {  	    /* @@ -9721,10 +9956,11 @@ Tcl_GetChannelNamesEx(  	}  	goto done;      } +      for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;  	    hPtr = Tcl_NextHashEntry(&hSearch)) { -  	statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state; +  	if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {  	    name = "stdin";  	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) { @@ -9870,11 +10106,8 @@ Tcl_IsChannelExisting(  	    name = statePtr->channelName;  	} -	/* Bug 2333466. Include \0 in the compare to prevent partial matching -	 * on prefixes. -	 */  	if ((*chanName == *name) && -		(memcmp(name, chanName, (size_t) chanNameLen+1) == 0)) { +		(memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) {  	    return 1;  	}      } @@ -9993,13 +10226,13 @@ Tcl_ChannelBlockModeProc(  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {  	return chanTypePtr->blockModeProc; -    } else { -	/* -	 * The v1 structure had the blockModeProc in a different place. -	 */ - -	return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);      } + +    /* +     * The v1 structure had the blockModeProc in a different place. +     */ + +    return (Tcl_DriverBlockModeProc *) chanTypePtr->version;  }  /* @@ -10241,9 +10474,8 @@ Tcl_ChannelFlushProc(  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {  	return chanTypePtr->flushProc; -    } else { -	return NULL;      } +    return NULL;  }  /* @@ -10269,9 +10501,8 @@ Tcl_ChannelHandlerProc(  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {  	return chanTypePtr->handlerProc; -    } else { -	return NULL;      } +    return NULL;  }  /* @@ -10297,9 +10528,8 @@ Tcl_ChannelWideSeekProc(  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {  	return chanTypePtr->wideSeekProc; -    } else { -	return NULL;      } +    return NULL;  }  /* @@ -10326,9 +10556,8 @@ Tcl_ChannelThreadActionProc(  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {  	return chanTypePtr->threadActionProc; -    } else { -	return NULL;      } +    return NULL;  }  /* @@ -10445,7 +10674,7 @@ FixLevelCode(      res = Tcl_ListObjGetElements(NULL, msg, &lc, &lv);      if (res != TCL_OK) { -	Tcl_Panic("Tcl_SetChannelError(Interp): Bad syntax of message"); +	Tcl_Panic("Tcl_SetChannelError: bad syntax of message");      }      explicitResult = (1 == (lc % 2)); @@ -10505,7 +10734,7 @@ FixLevelCode(  	lcn += 2;      } -    lvn = (Tcl_Obj **) ckalloc(lcn * sizeof(Tcl_Obj *)); +    lvn = ckalloc(lcn * sizeof(Tcl_Obj *));      /*       * New level/code information is spliced into the first occurence of @@ -10558,7 +10787,7 @@ FixLevelCode(      msg = Tcl_NewListObj(j, lvn); -    ckfree((char *) lvn); +    ckfree(lvn);      return msg;  } @@ -10642,9 +10871,8 @@ Tcl_ChannelTruncateProc(  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) {  	return chanTypePtr->truncateProc; -    } else { -	return NULL;      } +    return NULL;  }  /* @@ -10673,12 +10901,11 @@ DupChannelIntRep(  				 * currently have an internal rep.*/  {      ChannelState *statePtr  = GET_CHANNELSTATE(srcPtr); -    Interp       *interpPtr = GET_CHANNELINTERP(srcPtr);      SET_CHANNELSTATE(copyPtr, statePtr); -    SET_CHANNELINTERP(copyPtr, interpPtr); -    Tcl_Preserve((ClientData) statePtr); -    copyPtr->typePtr = &tclChannelType; +    SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr)); +    Tcl_Preserve(statePtr); +    copyPtr->typePtr = srcPtr->typePtr;  }  /* @@ -10704,48 +10931,39 @@ SetChannelFromAny(      register Tcl_Obj *objPtr)	/* The object to convert. */  {      ChannelState *statePtr; -    Interp       *interpPtr; -    if (objPtr->typePtr == &tclChannelType) { +    if (interp == NULL) { +	return TCL_ERROR; +    } +    if (objPtr->typePtr == &chanObjType) {  	/*  	 * The channel is valid until any call to DetachChannel occurs.  	 * Ensure consistency checks are done.  	 */ -	statePtr  = GET_CHANNELSTATE(objPtr); -	interpPtr = GET_CHANNELINTERP(objPtr); -	if (statePtr->flags & (CHANNEL_TAINTED|CHANNEL_CLOSED)) { + +	statePtr = GET_CHANNELSTATE(objPtr); +	if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {  	    ResetFlag(statePtr, CHANNEL_TAINTED); -	    Tcl_Release((ClientData) statePtr); -	    UpdateStringOfChannel(objPtr); +	    Tcl_Release(statePtr);  	    objPtr->typePtr = NULL; -	} else if (interpPtr != (Interp*) interp) { -	    Tcl_Release((ClientData) statePtr); -	    UpdateStringOfChannel(objPtr); +	} else if (interp != GET_CHANNELINTERP(objPtr)) { +	    Tcl_Release(statePtr);  	    objPtr->typePtr = NULL;  	}      } -    if (objPtr->typePtr != &tclChannelType) { -	Tcl_Channel chan; - -	/* -	 * We need a valid string with which to check for a valid channel, but -	 * make sure not to free internal rep until validated. [Bug 1847044] -	 */ -	if ((objPtr->typePtr != NULL) && (objPtr->bytes == NULL)) { -	    objPtr->typePtr->updateStringProc(objPtr); -	} +    if (objPtr->typePtr != &chanObjType) { +	Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL); -	chan = Tcl_GetChannel(interp, objPtr->bytes, NULL);  	if (chan == NULL) {  	    return TCL_ERROR;  	}  	TclFreeIntRep(objPtr); -	statePtr = ((Channel *)chan)->state; -	Tcl_Preserve((ClientData) statePtr); +	statePtr = ((Channel *) chan)->state; +	Tcl_Preserve(statePtr);  	SET_CHANNELSTATE(objPtr, statePtr);  	SET_CHANNELINTERP(objPtr, interp); -	objPtr->typePtr = &tclChannelType; +	objPtr->typePtr = &chanObjType;      }      return TCL_OK;  } @@ -10753,43 +10971,6 @@ SetChannelFromAny(  /*   *----------------------------------------------------------------------   * - * UpdateStringOfChannel -- - * - *	Update the string representation for an object whose internal - *	representation is "Channel". - * - * Results: - *	None. - * - * Side effects: - *	The object's string may be set by converting its Unicode represention - *	to UTF format. - * - *---------------------------------------------------------------------- - */ - -static void -UpdateStringOfChannel( -    Tcl_Obj *objPtr)		/* Object with string rep to update. */ -{ -    if (objPtr->bytes == NULL) { -	ChannelState *statePtr = GET_CHANNELSTATE(objPtr); -	const char *name = statePtr->channelName; -	if (name) { -	    size_t len = strlen(name); -	    objPtr->bytes = (char *) ckalloc(len + 1); -	    objPtr->length = len; -	    memcpy(objPtr->bytes, name, len); -	} else { -	    objPtr->bytes = tclEmptyStringRep; -	    objPtr->length = 0; -	} -    } -} - -/* - *---------------------------------------------------------------------- - *   * FreeChannelIntRep --   *   *	Release statePtr storage. @@ -10807,7 +10988,8 @@ static void  FreeChannelIntRep(      Tcl_Obj *objPtr)		/* Object with internal rep to free. */  { -    Tcl_Release((ClientData) GET_CHANNELSTATE(objPtr)); +    Tcl_Release(GET_CHANNELSTATE(objPtr)); +    objPtr->typePtr = NULL;  }  #if 0 @@ -10824,7 +11006,7 @@ DumpFlags(      char buf[20];      int i = 0; -#define ChanFlag(chr,bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_')) +#define ChanFlag(chr, bit)      (buf[i++] = ((flags & (bit)) ? (chr) : '_'))      ChanFlag('r', TCL_READABLE);      ChanFlag('w', TCL_WRITABLE); @@ -10859,5 +11041,7 @@ DumpFlags(   * mode: c   * c-basic-offset: 4   * fill-column: 78 + * tab-width: 8 + * indent-tabs-mode: nil   * End:   */ | 
