diff options
Diffstat (limited to 'generic/tclIO.c')
| -rw-r--r-- | generic/tclIO.c | 4403 | 
1 files changed, 2677 insertions, 1726 deletions
| diff --git a/generic/tclIO.c b/generic/tclIO.c index 689447b..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.109 2006/09/28 19:24:52 msofer 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. @@ -34,34 +134,40 @@ typedef struct ThreadSpecificData {  				 * indexed by ChannelState, as only one  				 * ChannelState exists per set of stacked  				 * channels. */ -#ifdef oldcode -    int channelExitHandlerCreated; -				/* Has a channel exit handler been created -				 * yet? */ -    int channelEventSourceCreated; -				/* Has the channel event source been created -				 * and registered with the notifier? */ -#endif      Tcl_Channel stdinChannel;	/* Static variable for the stdin channel. */      int stdinInitialized;      Tcl_Channel stdoutChannel;	/* Static variable for the stdout channel. */      int stdoutInitialized;      Tcl_Channel stderrChannel;	/* Static variable for the stderr channel. */      int stderrInitialized; +    Tcl_Encoding binaryEncoding;  } 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); @@ -69,8 +175,10 @@ static void		CleanupChannelHandlers(Tcl_Interp *interp,  			    Channel *chanPtr);  static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,  			    int errorCode); -static void		CommonGetsCleanup(Channel *chanPtr, -			    Tcl_Encoding encoding); +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);  static int		CopyBuffer(Channel *chanPtr, char *result, int space); @@ -86,18 +194,19 @@ 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); -static int		HaveVersion(Tcl_ChannelType *typePtr, +static int		HaveVersion(const Tcl_ChannelType *typePtr,  			    Tcl_ChannelTypeVersion minimumVersion);  static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,  			    GetsState *gsPtr); @@ -112,17 +221,241 @@ static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,  			    int mode);  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); +			    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 Tcl_Obj *	FixLevelCode(Tcl_Obj* msg); +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. + * The ANSI C "prototypes" for the macros are listed below, together with a + * short description of what the macro does. + * + * -------------------------------------------------------------------------- + * int BytesLeft(ChannelBuffer *bufPtr) + * + *	Returns the number of bytes of data remaining in the buffer. + * + * int SpaceLeft(ChannelBuffer *bufPtr) + * + *	Returns the number of bytes of space remaining at the end of the + *	buffer. + * + * int IsBufferReady(ChannelBuffer *bufPtr) + * + *	Returns whether a buffer has bytes available within it. + * + * int IsBufferEmpty(ChannelBuffer *bufPtr) + * + *	Returns whether a buffer is entirely empty. Note that this is not the + *	inverse of the above operation; trying to merge the two seems to lead + *	to occasional crashes... + * + * int IsBufferFull(ChannelBuffer *bufPtr) + * + *	Returns whether more data can be added to a buffer. + * + * int IsBufferOverflowing(ChannelBuffer *bufPtr) + * + *	Returns whether a buffer has more data in it than it should. + * + * char *InsertPoint(ChannelBuffer *bufPtr) + * + *	Returns a pointer to where characters should be added to the buffer. + * + * char *RemovePoint(ChannelBuffer *bufPtr) + * + *	Returns a pointer to where characters should be removed from the + *	buffer. + * -------------------------------------------------------------------------- + */ + +#define BytesLeft(bufPtr)	((bufPtr)->nextAdded - (bufPtr)->nextRemoved) + +#define SpaceLeft(bufPtr)	((bufPtr)->bufLength - (bufPtr)->nextAdded) + +#define IsBufferReady(bufPtr)	((bufPtr)->nextAdded > (bufPtr)->nextRemoved) + +#define IsBufferEmpty(bufPtr)	((bufPtr)->nextAdded == (bufPtr)->nextRemoved) + +#define IsBufferFull(bufPtr)	((bufPtr)->nextAdded >= (bufPtr)->bufLength) + +#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength) + +#define InsertPoint(bufPtr)	((bufPtr)->buf + (bufPtr)->nextAdded) + +#define RemovePoint(bufPtr)	((bufPtr)->buf + (bufPtr)->nextRemoved) + +/* + * For working with channel state flag bits. + */ + +#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 + * value (prefix matching rules). Arguments are the minimum length to match + * and the value to match against. (Can't use Tcl_GetIndexFromObj as this is + * used in a situation where no objects are available.) + */ + +#define HaveOpt(minLength, nameString) \ +	((len > (minLength)) && (optionName[1] == (nameString)[1]) \ +		&& (strncmp(optionName, (nameString), len) == 0)) + +/* + * The ChannelObjType type.  We actually store the ChannelState structure + * as that lives longest and we want to return the bottomChanPtr when + * requested (consistent with Tcl_GetChannel).  The setFromAny and + * updateString can be NULL as they should not be called. + */ + +static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); +static int		SetChannelFromAny(Tcl_Interp *interp, +			    Tcl_Obj *objPtr); +static void		FreeChannelIntRep(Tcl_Obj *objPtr); + +static const Tcl_ObjType chanObjType = { +    "channel",			/* name for this type */ +    FreeChannelIntRep,		/* freeIntRepProc */ +    DupChannelIntRep,		/* dupIntRepProc */ +    NULL,			/* updateStringProc */ +    NULL			/* setFromAnyProc SetChannelFromAny */ +}; + +#define GET_CHANNELSTATE(objPtr) \ +    ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1) +#define SET_CHANNELSTATE(objPtr, storePtr) \ +    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr)) +#define GET_CHANNELINTERP(objPtr) \ +    ((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2) +#define SET_CHANNELINTERP(objPtr, storePtr) \ +    ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr)) + +#define BUSY_STATE(st, fl) \ +     ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ +      (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) + +#define MAX_CHANNEL_BUFFER_SIZE (1024*1024) + +/* + *--------------------------------------------------------------------------- + * + * 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); +}  /*   *--------------------------------------------------------------------------- @@ -175,85 +508,116 @@ void  TclFinalizeIOSubsystem(void)  {      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); -    Channel *chanPtr;		/* Iterates over open channels. */ -    ChannelState *nextCSPtr;	/* Iterates over open channels. */ -    ChannelState *statePtr;	/* state of channel stack */ +    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 corresponding channels. +     * Walk all channel state structures known to this thread and close +     * corresponding channels.       */ -    for (statePtr = tsdPtr->firstCSPtr; statePtr != NULL; -	 statePtr = nextCSPtr) { -	chanPtr = statePtr->topChanPtr; - +    while (active) {  	/* -	 * Set the channel back into blocking mode to ensure that we wait for -	 * all data to flush out. +	 * Iterate through the open channel list, and find the first channel +	 * that isn't dead. We start from the head of the list each time, +	 * because the close action on one channel can close others.  	 */ -	(void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, -		"-blocking", "on"); - -	if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || -		(chanPtr == (Channel *) tsdPtr->stdoutChannel) || -		(chanPtr == (Channel *) tsdPtr->stderrChannel)) { -	    /* -	     * Decrement the refcount which was earlier artificially bumped up -	     * to keep the channel from being closed. -	     */ - -	    statePtr->refCount--; +	active = 0; +	for (statePtr = tsdPtr->firstCSPtr; +		statePtr != NULL; +		statePtr = statePtr->nextCSPtr) { +	    chanPtr = statePtr->topChanPtr; +            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; +	    }  	}  	/* -	 * Preserve statePtr from disappearing until we can get the -	 * nextCSPtr below. +	 * We've found a live (or bg-closing) channel. Close it.  	 */ -	Tcl_Preserve(statePtr); -	if (statePtr->refCount <= 0) { -	    /* -	     * Close it only if the refcount indicates that the channel is not -	     * referenced from any interpreter. If it is, that interpreter -	     * will close the channel when it gets destroyed. -	     */ -	    (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr); -	} else { +	if (active) { +  	    /* -	     * The refcount is greater than zero, so flush the channel. +	     * 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".  	     */ +            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) || +		    (chanPtr == (Channel *) tsdPtr->stderrChannel)) { +		/* +		 * Decrement the refcount which was earlier artificially +		 * bumped up to keep the channel from being closed. +		 */ -	    Tcl_Flush((Tcl_Channel) chanPtr); +		statePtr->refCount--; +	    } -	    /* -	     * Call the device driver to actually close the underlying device -	     * for this channel. -	     */ +	    if (statePtr->refCount <= 0) { +		/* +		 * Close it only if the refcount indicates that the channel is +		 * not referenced from any interpreter. If it is, that +		 * interpreter will close the channel when it gets destroyed. +		 */ -	    if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) { -		(chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL); +		(void) Tcl_Close(NULL, (Tcl_Channel) chanPtr);  	    } else { -		(chanPtr->typePtr->close2Proc)(chanPtr->instanceData, NULL, 0); -	    } +		/* +		 * The refcount is greater than zero, so flush the channel. +		 */ -	    /* -	     * Finally, we clean up the fields in the channel data structure -	     * since all of them have been deleted already. We mark the -	     * channel with CHANNEL_DEAD to prevent any further IO operations -	     * on it. -	     */ +		Tcl_Flush((Tcl_Channel) chanPtr); + +		/* +		 * Call the device driver to actually close the underlying +		 * device for this channel. +		 */ + +		(void) ChanClose(chanPtr, NULL); + +		/* +		 * Finally, we clean up the fields in the channel data +		 * structure since all of them have been deleted already. We +		 * mark the channel with CHANNEL_DEAD to prevent any further +		 * IO operations on it. +		 */ -	    chanPtr->instanceData = NULL; -	    statePtr->flags |= CHANNEL_DEAD; +		chanPtr->instanceData = NULL; +		SetFlag(statePtr, CHANNEL_DEAD); +	    }  	} -	/* -	 * We look for the next pointer now in case we had one closed on up -	 * during the current channel's closeproc (eg: rechan extension) -	 */ -	nextCSPtr = statePtr->nextCSPtr; -	Tcl_Release(statePtr);      }      TclpFinalizeSockets(); @@ -283,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; @@ -343,7 +708,7 @@ Tcl_GetStdChannel(  	     */  	    if (tsdPtr->stdinChannel != NULL) { -		(void) Tcl_RegisterChannel(NULL, tsdPtr->stdinChannel); +		Tcl_RegisterChannel(NULL, tsdPtr->stdinChannel);  	    }  	}  	channel = tsdPtr->stdinChannel; @@ -353,7 +718,7 @@ Tcl_GetStdChannel(  	    tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);  	    tsdPtr->stdoutInitialized = 1;  	    if (tsdPtr->stdoutChannel != NULL) { -		(void) Tcl_RegisterChannel(NULL, tsdPtr->stdoutChannel); +		Tcl_RegisterChannel(NULL, tsdPtr->stdoutChannel);  	    }  	}  	channel = tsdPtr->stdoutChannel; @@ -363,7 +728,7 @@ Tcl_GetStdChannel(  	    tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);  	    tsdPtr->stderrInitialized = 1;  	    if (tsdPtr->stderrChannel != NULL) { -		(void) Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel); +		Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel);  	    }  	}  	channel = tsdPtr->stderrChannel; @@ -399,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; @@ -439,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;      }  } @@ -483,14 +846,12 @@ GetChannelTable(      Tcl_HashTable *hTblPtr;	/* Hash table of channels. */      Tcl_Channel stdinChan, stdoutChan, stderrChan; -    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); +    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); - -	(void) Tcl_SetAssocData(interp, "tclIO", -		(Tcl_InterpDeleteProc *) DeleteChannelTable, -		(ClientData) hTblPtr); +	Tcl_SetAssocData(interp, "tclIO", +		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);  	/*  	 * If the interpreter is trusted (not "safe"), insert channels for @@ -555,10 +916,10 @@ DeleteChannelTable(       * refcount reaches zero.       */ -    hTblPtr = (Tcl_HashTable *) clientData; +    hTblPtr = clientData;      for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;  	    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) { -	chanPtr = (Channel *) Tcl_GetHashValue(hPtr); +	chanPtr = Tcl_GetHashValue(hPtr);  	statePtr = chanPtr->state;  	/* @@ -576,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;  	    } @@ -593,15 +954,17 @@ DeleteChannelTable(  	 */  	Tcl_DeleteHashEntry(hPtr); +	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);  }  /* @@ -633,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; @@ -715,7 +1082,7 @@ Tcl_RegisterChannel(  {      Tcl_HashTable *hTblPtr;	/* Hash table of channels. */      Tcl_HashEntry *hPtr;	/* Search variable. */ -    int new;			/* Is the hash entry new or does it exist? */ +    int isNew;			/* Is the hash entry new or does it exist? */      Channel *chanPtr;		/* The actual channel. */      ChannelState *statePtr;	/* State of the actual channel. */ @@ -733,15 +1100,15 @@ Tcl_RegisterChannel(      }      if (interp != NULL) {  	hTblPtr = GetChannelTable(interp); -	hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new); -	if (new == 0) { -	    if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { +	hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &isNew); +	if (!isNew) { +	    if (chan == Tcl_GetHashValue(hPtr)) {  		return;  	    }  	    Tcl_Panic("Tcl_RegisterChannel: duplicate channel names");  	} -	Tcl_SetHashValue(hPtr, (ClientData) chanPtr); +	Tcl_SetHashValue(hPtr, chanPtr);      }      statePtr->refCount++;  } @@ -781,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;      } @@ -816,26 +1184,25 @@ Tcl_UnregisterChannel(  	 */  	if ((statePtr->curOutPtr != NULL) && -		(statePtr->curOutPtr->nextAdded > -			statePtr->curOutPtr->nextRemoved)) { -	    statePtr->flags |= BUFFER_READY; +		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) { -		    statePtr->flags |= CHANNEL_CLOSED; -		    Tcl_Release((ClientData)statePtr); +		    SetFlag(statePtr, CHANNEL_CLOSED); +		    Tcl_Release(statePtr);  		    return TCL_ERROR;  		}  	    }  	} -	statePtr->flags |= CHANNEL_CLOSED; -	Tcl_Release((ClientData)statePtr); +	SetFlag(statePtr, CHANNEL_CLOSED); +	Tcl_Release(statePtr);      }      return TCL_OK;  } @@ -929,7 +1296,7 @@ DetachChannel(      statePtr = chanPtr->state;      if (interp != NULL) { -	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); +	hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);  	if (hTblPtr == NULL) {  	    return TCL_ERROR;  	} @@ -941,6 +1308,7 @@ DetachChannel(  	    return TCL_ERROR;  	}  	Tcl_DeleteHashEntry(hPtr); +	SetFlag(statePtr, CHANNEL_TAINTED);  	/*  	 * Remove channel handlers that refer to this interpreter, so that @@ -982,7 +1350,7 @@ Tcl_Channel  Tcl_GetChannel(      Tcl_Interp *interp,		/* Interpreter in which to find or create the  				 * channel. */ -    CONST char *chanName,	/* The name of the channel. */ +    const char *chanName,	/* The name of the channel. */      int *modePtr)		/* Where to store the mode in which the  				 * channel was opened? Will contain an ORed  				 * combination of TCL_READABLE and @@ -991,7 +1359,7 @@ Tcl_GetChannel(      Channel *chanPtr;		/* The actual channel. */      Tcl_HashTable *hTblPtr;	/* Hash table of channels. */      Tcl_HashEntry *hPtr;	/* Search variable. */ -    CONST char *name;		/* Translated name. */ +    const char *name;		/* Translated name. */      /*       * Substitute "stdin", etc. Note that even though we immediately find the @@ -1019,8 +1387,9 @@ 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;      } @@ -1030,16 +1399,64 @@ Tcl_GetChannel(       * compensate where necessary to retrieve the topmost channel again.       */ -    chanPtr = (Channel *) Tcl_GetHashValue(hPtr); +    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;  }  /* + *--------------------------------------------------------------------------- + * + * TclGetChannelFromObj -- + * + *	Finds an existing Tcl_Channel structure by name in a given + *	interpreter. This function is public because it is used by + *	channel-type-specific functions. + * + * Results: + *	A Tcl_Channel or NULL on failure. If failed, interp's result object + *	contains an error message. *modePtr is filled with the modes in which + *	the channel was opened. + * + * Side effects: + *	None. + * + *--------------------------------------------------------------------------- + */ + +int +TclGetChannelFromObj( +    Tcl_Interp *interp,		/* Interpreter in which to find or create the +				 * channel. */ +    Tcl_Obj *objPtr, +    Tcl_Channel *channelPtr, +    int *modePtr,		/* Where to store the mode in which the +				 * channel was opened? Will contain an ORed +				 * combination of TCL_READABLE and +				 * TCL_WRITABLE, if non-NULL. */ +    int flags) +{ +    ChannelState *statePtr; + +    if (SetChannelFromAny(interp, objPtr) != TCL_OK) { +	return TCL_ERROR; +    } + +    statePtr = GET_CHANNELSTATE(objPtr); +    *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr; + +    if (modePtr != NULL) { +	*modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE); +    } + +    return TCL_OK; +} + +/*   *----------------------------------------------------------------------   *   * Tcl_CreateChannel -- @@ -1057,8 +1474,8 @@ Tcl_GetChannel(  Tcl_Channel  Tcl_CreateChannel( -    Tcl_ChannelType *typePtr,	/* The channel type record. */ -    CONST char *chanName,	/* Name of channel to 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  				 * the channel is readable, writable. */ @@ -1066,7 +1483,8 @@ Tcl_CreateChannel(      Channel *chanPtr;		/* The channel structure newly created. */      ChannelState *statePtr;	/* The stack-level independent state info for  				 * the channel. */ -    CONST char *name; +    const char *name; +    char *tmp;      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      /* @@ -1079,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; @@ -1099,13 +1517,20 @@ Tcl_CreateChannel(       */      if (chanName != NULL) { -	char *tmp = ckalloc((unsigned) (strlen(chanName) + 1)); -	statePtr->channelName = tmp; +	unsigned len = strlen(chanName) + 1; + +	/* +         * Make sure we allocate at least 7 bytes, so it fits for "stdout" +         * later. +         */ + +	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;      /* @@ -1132,8 +1557,8 @@ Tcl_CreateChannel(       * Set the channel up initially in AUTO input translation mode to accept       * "\n", "\r" and "\r\n". Output translation mode is set to a platform       * specific default value. The eofChar is set to 0 for both input and -     * output, so that Tcl does not look for an in-file EOF indicator -     * (e.g. ^Z) and does not append an EOF indicator to files. +     * output, so that Tcl does not look for an in-file EOF indicator (e.g. +     * ^Z) and does not append an EOF indicator to files.       */      statePtr->inputTranslation	= TCL_TRANSLATE_AUTO; @@ -1155,13 +1580,9 @@ Tcl_CreateChannel(      statePtr->scriptRecordPtr	= NULL;      statePtr->bufSize		= CHANNELBUFFER_DEFAULT_SIZE;      statePtr->timer		= NULL; -    statePtr->csPtr		= 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. @@ -1207,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);      } @@ -1240,10 +1664,10 @@ Tcl_CreateChannel(   *	information about prevChan.   *   * Side effects: - *    A new channel structure is allocated and linked below the existing - *    channel. The channel operations and client data of the existing channel - *    are copied down to the newly created channel, and the current channel - *    has its operations replaced by the new typePtr. + *	A new channel structure is allocated and linked below the existing + *	channel. The channel operations and client data of the existing + *	channel are copied down to the newly created channel, and the current + *	channel has its operations replaced by the new typePtr.   *   *----------------------------------------------------------------------   */ @@ -1251,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. */ @@ -1262,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 @@ -1280,10 +1704,11 @@ 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 (Tcl_Channel) NULL; +	return NULL;      }      /* @@ -1301,11 +1726,11 @@ 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 (Tcl_Channel) NULL; +	return NULL;      }      /* @@ -1316,22 +1741,31 @@ Tcl_StackChannel(       */      if ((mask & TCL_WRITABLE) != 0) { -	CopyState *csPtr; +	CopyState *csPtrR = statePtr->csPtrR; +	CopyState *csPtrW = statePtr->csPtrW; -	csPtr = statePtr->csPtr; -	statePtr->csPtr = NULL; +	statePtr->csPtrR = NULL; +	statePtr->csPtrW = NULL; +	/* +	 * TODO: Examine what can go wrong if Tcl_Flush() call disturbs +	 * the stacking state of this channel during its operations. +	 */  	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { -	    statePtr->csPtr = csPtr; +	    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 (Tcl_Channel) NULL; +	    return NULL;  	} -	statePtr->csPtr = csPtr; +	statePtr->csPtrR = csPtrR; +	statePtr->csPtrW = csPtrW;      } +      /*       * Discard any input in the buffers. They are not yet read by the user of       * the channel, so they have to go through the new transformation before @@ -1364,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 @@ -1400,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;  } @@ -1434,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. @@ -1445,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; @@ -1460,14 +1897,17 @@ Tcl_UnstackChannel(  	 * CheckForChannelErrors inside.  	 */ -	if (statePtr->flags & TCL_WRITABLE) { -	    CopyState *csPtr; +	if (GotFlag(statePtr, TCL_WRITABLE)) { +	    CopyState *csPtrR = statePtr->csPtrR; +	    CopyState *csPtrW = statePtr->csPtrW; -	    csPtr = statePtr->csPtr; -	    statePtr->csPtr = NULL; +	    statePtr->csPtrR = NULL; +	    statePtr->csPtrW = NULL;  	    if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) { -		statePtr->csPtr = csPtr; +		statePtr->csPtrR = csPtrR; +		statePtr->csPtrW = csPtrW; +  		/*  		 * TIP #219, Tcl Channel Reflection API.  		 * Move error messages put by the driver into the chan/ip @@ -1475,15 +1915,17 @@ Tcl_UnstackChannel(  		 * to the regular message if nothing was found in the  		 * bypasses.  		 */ +  		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;  	    } -	    statePtr->csPtr = csPtr; +	    statePtr->csPtrR  = csPtrR; +	    statePtr->csPtrW = csPtrW;  	}  	/* @@ -1496,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; @@ -1529,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; @@ -1547,22 +1983,15 @@ 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;  	/*  	 * AK: Tcl_NotifyChannel may hold a reference to this block of memory  	 */ -	Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); -	UpdateInterest(downChanPtr); +	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC); +	UpdateInterest(statePtr->topChanPtr);  	if (result != 0) {  	    Tcl_SetErrno(result); @@ -1627,7 +2056,8 @@ Tcl_Channel  Tcl_GetStackedChannel(      Tcl_Channel chan)  { -    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */ +    Channel *chanPtr = (Channel *) chan; +				/* The actual channel. */      return (Tcl_Channel) chanPtr->downChanPtr;  } @@ -1654,7 +2084,8 @@ Tcl_Channel  Tcl_GetTopChannel(      Tcl_Channel chan)  { -    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */ +    Channel *chanPtr = (Channel *) chan; +				/* The actual channel. */      return (Tcl_Channel) chanPtr->state->topChanPtr;  } @@ -1679,7 +2110,8 @@ ClientData  Tcl_GetChannelInstanceData(      Tcl_Channel chan)		/* Channel for which to return client data. */  { -    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */ +    Channel *chanPtr = (Channel *) chan; +				/* The actual channel. */      return chanPtr->instanceData;  } @@ -1705,7 +2137,8 @@ Tcl_GetChannelThread(      Tcl_Channel chan)		/* The channel to return the managing thread  				 * for. */  { -    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */ +    Channel *chanPtr = (Channel *) chan; +				/* The actual channel. */      return chanPtr->state->managingThread;  } @@ -1726,7 +2159,7 @@ Tcl_GetChannelThread(   *----------------------------------------------------------------------   */ -Tcl_ChannelType * +const Tcl_ChannelType *  Tcl_GetChannelType(      Tcl_Channel chan)		/* The channel to return type for. */  { @@ -1781,13 +2214,13 @@ Tcl_GetChannelMode(   *----------------------------------------------------------------------   */ -CONST char * +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;  } @@ -1819,8 +2252,14 @@ Tcl_GetChannelHandle(      int result;      chanPtr = ((Channel *) chan)->state->bottomChanPtr; -    result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData, -	    direction, &handle); +    if (!chanPtr->typePtr->getHandleProc) { +        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);      if (handlePtr) {  	*handlePtr = handle;      } @@ -1859,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; +}  /*   *---------------------------------------------------------------------- @@ -1896,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;      } @@ -1909,7 +2376,7 @@ RecycleBuffer(       */      if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) { -	ckfree((char *) bufPtr); +	ReleaseChannelBuffer(bufPtr);  	return;      } @@ -1917,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; @@ -1933,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; @@ -1944,7 +2411,7 @@ RecycleBuffer(       * If we reached this code we return the buffer to the OS.       */ -    ckfree((char *) bufPtr); +    ReleaseChannelBuffer(bufPtr);      return;    keepBuffer: @@ -2006,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;  }  /* @@ -2022,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 @@ -2073,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 @@ -2081,10 +2550,10 @@ FlushChannel(  	 */  	if (((statePtr->curOutPtr != NULL) && -		(statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength)) -		|| ((statePtr->flags & BUFFER_READY) && +		IsBufferFull(statePtr->curOutPtr)) +		|| (GotFlag(statePtr, BUFFER_READY) &&  			(statePtr->outQueueHead == NULL))) { -	    statePtr->flags &= (~(BUFFER_READY)); +	    ResetFlag(statePtr, BUFFER_READY);  	    statePtr->curOutPtr->nextPtr = NULL;  	    if (statePtr->outQueueHead == NULL) {  		statePtr->outQueueHead = statePtr->curOutPtr; @@ -2101,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;  	}  	/* @@ -2111,16 +2580,21 @@ FlushChannel(  	 */  	if (bufPtr == NULL) { -	    break;	/* Out of the "while (1)". */ +	    break;		/* Out of the "while (1)". */  	}  	/*  	 * Produce the output on the channel.  	 */ -	toWrite = bufPtr->nextAdded - bufPtr->nextRemoved; -	written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData, -		bufPtr->buf + bufPtr->nextRemoved, toWrite, &errorCode); +	PreserveChannelBuffer(bufPtr); +	toWrite = BytesLeft(bufPtr); +	if (toWrite == 0) { +            written = 0; +	} else { +	    written = ChanWrite(chanPtr, RemovePoint(bufPtr), toWrite, +		    &errorCode); +	}  	/*  	 * If the write failed completely attempt to start the asynchronous @@ -2151,8 +2625,8 @@ FlushChannel(  		 * it's a tty channel (dup'ed underneath)  		 */ -		if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { -		    statePtr->flags |= BG_FLUSH_SCHEDULED; +		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) { +		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);  		    UpdateInterest(chanPtr);  		}  		errorCode = 0; @@ -2175,7 +2649,7 @@ FlushChannel(  		if (statePtr->unreportedError == 0) {  		    statePtr->unreportedError = errorCode; -		    statePtr->unreportedMsg   = msg; +		    statePtr->unreportedMsg = msg;  		    if (msg != NULL) {  			Tcl_IncrRefCount(msg);  		    } @@ -2187,7 +2661,7 @@ FlushChannel(  		    statePtr->chanMsg = NULL;  		    if (msg != NULL) { -			Tcl_DecrRefCount(msg); +			TclDecrRefCount(msg);  		    }  		}  	    } else { @@ -2199,18 +2673,12 @@ FlushChannel(  		 */  		Tcl_SetErrno(errorCode); -		if (interp != NULL) { -		    if (!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); -		    } +		if (interp != NULL && !TclChanCaughtErrorBypass(interp, +			(Tcl_Channel) chanPtr)) { +		    Tcl_SetObjResult(interp, +			    Tcl_NewStringObj(Tcl_PosixError(interp), -1));  		} +  		/*  		 * An unreportable bypassed message is kept, for the caller of  		 * Tcl_Seek, Tcl_Write, etc. @@ -2228,19 +2696,22 @@ FlushChannel(  	    wroteSome = 1;  	} -	bufPtr->nextRemoved += written; +	if (!IsBufferEmpty(bufPtr)) { +	    bufPtr->nextRemoved += written; +	}  	/*  	 * If this buffer is now empty, recycle it.  	 */ -	if (bufPtr->nextRemoved == bufPtr->nextAdded) { +	if (IsBufferEmpty(bufPtr)) {  	    statePtr->outQueueHead = bufPtr->nextPtr;  	    if (statePtr->outQueueHead == NULL) {  		statePtr->outQueueTail = NULL;  	    }  	    RecycleBuffer(statePtr, bufPtr, 0);  	} +	ReleaseChannelBuffer(bufPtr);      }	/* Closes "while (1)". */      /* @@ -2250,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) { -	    statePtr->flags &= (~(BG_FLUSH_SCHEDULED)); -	    (chanPtr->typePtr->watchProc)(chanPtr->instanceData, -		    statePtr->interestMask); +	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED); +	    ChanWatch(chanPtr, statePtr->interestMask);  	}      } @@ -2266,13 +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) || -	    (statePtr->curOutPtr->nextAdded == -		    statePtr->curOutPtr->nextRemoved))) { -	return CloseChannel(interp, chanPtr, errorCode); +	    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))) { +	errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE); +	goto done; +    } + +  done: +    Tcl_Release(chanPtr);      return errorCode;  } @@ -2326,7 +2813,7 @@ CloseChannel(       */      if (statePtr->curOutPtr != NULL) { -	ckfree((char *) statePtr->curOutPtr); +	ReleaseChannelBuffer(statePtr->curOutPtr);  	statePtr->curOutPtr = NULL;      } @@ -2343,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);      }      /* @@ -2358,9 +2845,9 @@ CloseChannel(      if (statePtr->chanMsg != NULL) {  	if (interp != NULL) { -	    Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg); +	    Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);  	} -	Tcl_DecrRefCount(statePtr->chanMsg); +	TclDecrRefCount(statePtr->chanMsg);  	statePtr->chanMsg = NULL;      } @@ -2375,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 @@ -2389,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; -	}      }      /* @@ -2408,17 +2886,18 @@ CloseChannel(      if (statePtr->unreportedError != 0) {  	errorCode = statePtr->unreportedError; -	/* TIP #219, Tcl Channel Reflection API. +	/* +	 * 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) { -	    Tcl_DecrRefCount(statePtr->chanMsg); +	    TclDecrRefCount(statePtr->chanMsg);  	    statePtr->chanMsg = NULL;  	}  	if (interp) { -	    Tcl_SetChannelErrorInterp(interp,statePtr->unreportedMsg); +	    Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);  	}      }      if (errorCode == 0) { @@ -2448,7 +2927,7 @@ CloseChannel(  	downChanPtr->upChanPtr = NULL;  	chanPtr->typePtr = NULL; -	Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); +	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);  	return Tcl_Close(interp, (Tcl_Channel) downChanPtr);      } @@ -2461,8 +2940,8 @@ CloseChannel(      chanPtr->typePtr = NULL; -    Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC); -    Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC); +    Tcl_EventuallyFree(statePtr, TCL_DYNAMIC); +    Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);      return errorCode;  } @@ -2502,8 +2981,7 @@ CutChannel(  				 * states - used to splice a channel out of  				 * the list on close. */      ChannelState *statePtr = ((Channel *) chan)->state; -				/* state of the channel stack. */ -    Tcl_DriverThreadActionProc *threadActionProc; +				/* State of the channel stack. */      /*       * Remove this channel from of the list of all channels (in the current @@ -2530,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 @@ -2542,14 +3016,13 @@ Tcl_CutChannel(      Tcl_Channel chan)		/* The channel being added. Must not be  				 * referenced in any interpreter. */  { -    Channel* chanPtr = ((Channel*) chan)->state->bottomChanPtr; +    Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ChannelState *prevCSPtr;	/* Preceding channel state in list of all  				 * states - used to splice a channel out of  				 * the list on close. */      ChannelState *statePtr = chanPtr->state; -				/* state of the channel stack. */ -    Tcl_DriverThreadActionProc *threadActionProc; +				/* State of the channel stack. */      /*       * Remove this channel from of the list of all channels (in the current @@ -2577,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);      }  } @@ -2620,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"); @@ -2641,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 @@ -2656,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"); @@ -2678,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);      }  } @@ -2723,6 +3180,7 @@ Tcl_Close(      ChannelState *statePtr;	/* State of real IO channel. */      int result;			/* Of calling FlushChannel. */      int flushcode; +    int stickyError;      if (chan == NULL) {  	return TCL_OK; @@ -2750,24 +3208,30 @@ 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;      } -    statePtr->flags |= CHANNEL_INCLOSE; +    SetFlag(statePtr, CHANNEL_INCLOSE);      /*       * When the channel has an escape sequence driven encoding such as       * iso2022, the terminated escape sequence must write to the buffer.       */ -    if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL) +    stickyError = 0; + +    if ((statePtr->encoding != NULL) +	    && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)  	    && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {  	statePtr->outputEncodingFlags |= TCL_ENCODING_END; -	WriteChars(chanPtr, "", 0); +	if (WriteChars(chanPtr, "", 0) < 0) { +	    stickyError = Tcl_GetErrno(); +	}  	/*  	 * TIP #219, Tcl Channel Reflection API. @@ -2777,9 +3241,9 @@ Tcl_Close(  	if (statePtr->chanMsg != NULL) {  	    if (interp != NULL) { -		Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg); +		Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);  	    } -	    Tcl_DecrRefCount(statePtr->chanMsg); +	    TclDecrRefCount(statePtr->chanMsg);  	    statePtr->chanMsg = NULL;  	}      } @@ -2793,19 +3257,18 @@ 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);      } -    statePtr->flags &= ~CHANNEL_INCLOSE; +    ResetFlag(statePtr, CHANNEL_INCLOSE);      /*       * Ensure that the last output buffer will be flushed.       */ -    if ((statePtr->curOutPtr != NULL) && -	    (statePtr->curOutPtr->nextAdded>statePtr->curOutPtr->nextRemoved)){ -	statePtr->flags |= BUFFER_READY; +    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { +	SetFlag(statePtr, BUFFER_READY);      }      /* @@ -2814,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; @@ -2826,7 +3289,7 @@ Tcl_Close(       * be flushed and closed asynchronously.       */ -    statePtr->flags |= CHANNEL_CLOSED; +    SetFlag(statePtr, CHANNEL_CLOSED);      flushcode = FlushChannel(interp, chanPtr, 0); @@ -2836,7 +3299,7 @@ Tcl_Close(       * them into the regular interpreter result.       *       * Notes: Due to the assertion of CHANNEL_CLOSED in the flags -     * "FlushChannel" has called "CloseChannel" and thus freed all the channel +     * FlushChannel() has called CloseChannel() and thus freed all the channel       * structures. We must not try to access "chan" anymore, hence the NULL       * argument in the call below. The only place which may still contain a       * message is the interpreter itself, and "CloseChannel" made sure to lift @@ -2847,9 +3310,374 @@ Tcl_Close(  	result = EINVAL;      } +    if (stickyError != 0) { +	Tcl_SetErrno(stickyError); +	if (interp != NULL) { +	    Tcl_SetObjResult(interp, +			     Tcl_NewStringObj(Tcl_PosixError(interp), -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; +    } +    return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * 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;  } @@ -2915,7 +3743,7 @@ Tcl_ClearChannelHandlers(      for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {  	chNext = chPtr->nextPtr; -	ckfree((char *) chPtr); +	ckfree(chPtr);      }      statePtr->chPtr = NULL; @@ -2923,7 +3751,8 @@ Tcl_ClearChannelHandlers(       * Cancel any pending copy operation.       */ -    StopCopy(statePtr->csPtr); +    StopCopy(statePtr->csPtrR); +    StopCopy(statePtr->csPtrW);      /*       * Must set the interest mask now to 0, otherwise infinite loops @@ -2941,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;  } @@ -2973,7 +3802,7 @@ Tcl_ClearChannelHandlers(  int  Tcl_Write(      Tcl_Channel chan,		/* The channel to buffer output for. */ -    CONST char *src,		/* Data to queue in output buffer. */ +    const char *src,		/* Data to queue in output buffer. */      int srcLen)			/* Length of data in bytes, or < 0 for  				 * strlen(). */  { @@ -2982,7 +3811,7 @@ Tcl_Write(       */      Channel *chanPtr; -    ChannelState *statePtr;	/* state info for channel */ +    ChannelState *statePtr;	/* State info for channel */      statePtr = ((Channel *) chan)->state;      chanPtr = statePtr->topChanPtr; @@ -2994,7 +3823,7 @@ Tcl_Write(      if (srcLen < 0) {  	srcLen = strlen(src);      } -    return DoWrite(chanPtr, src, srcLen); +    return WriteBytes(chanPtr, src, srcLen);  }  /* @@ -3024,12 +3853,13 @@ Tcl_Write(  int  Tcl_WriteRaw(      Tcl_Channel chan,		/* The channel to buffer output for. */ -    CONST char *src,		/* Data to queue in output buffer. */ +    const char *src,		/* Data to queue in output buffer. */      int srcLen)			/* Length of data in bytes, or < 0 for  				 * strlen(). */  {      Channel *chanPtr = ((Channel *) chan); -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      int errorCode, written;      if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) { @@ -3045,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);      } @@ -3081,81 +3909,45 @@ Tcl_WriteRaw(  int  Tcl_WriteChars(      Tcl_Channel chan,		/* The channel to buffer output for. */ -    CONST char *src,		/* UTF-8 characters to queue in output +    const char *src,		/* UTF-8 characters to queue in output  				 * buffer. */      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. -	 */ +    if (statePtr->encoding) { +	return WriteChars(chanPtr, src, len); +    } -	Tcl_Obj *objPtr; -	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. +     */ -	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;  }  /* @@ -3193,8 +3985,8 @@ Tcl_WriteObj(       */      Channel *chanPtr; -    ChannelState *statePtr;	/* state info for channel */ -    char *src; +    ChannelState *statePtr;	/* State info for channel */ +    const char *src;      int srcLen;      statePtr = ((Channel *) chan)->state; @@ -3207,106 +3999,54 @@ Tcl_WriteObj(  	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);  	return WriteBytes(chanPtr, src, srcLen);      } else { -	src = Tcl_GetStringFromObj(objPtr, &srcLen); +	src = TclGetStringFromObj(objPtr, &srcLen);  	return WriteChars(chanPtr, src, srcLen);      }  } -/* - *---------------------------------------------------------------------- - * - * 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; - -    total = 0; -    sawLF = 0; -    savedLF = 0; - -    /* -     * 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 = bufPtr->buf + bufPtr->nextAdded; -	dstMax = bufPtr->bufLength - bufPtr->nextAdded; -	dstLen = dstMax; - -	toWrite = dstLen; -	if (toWrite > srcLen) { -	    toWrite = srcLen; -	} - -	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 ((chanPtr->typePtr->seekProc != NULL) && +            ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ +        int ignore; -	if (dstLen > dstMax) { -	    savedLF = 1; -	    dstLen = dstMax; -	} -	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. @@ -3323,25 +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. */ +    const char *src,		/* UTF-8 string to write. */ +    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; -    Tcl_Encoding encoding; -    char safe[BUFFER_PADDING]; +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */ +    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. @@ -3349,338 +4084,145 @@ WriteChars(      endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0); -    /* -     * 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 (savedLF) { +	 +	/* Get space to write into */ +	bufPtr = statePtr->curOutPtr; +	if (bufPtr == NULL) { +	    bufPtr = AllocChannelBuffer(statePtr->bufSize); +	    statePtr->curOutPtr = bufPtr; +	} +	if (saved) {  	    /* -	     * 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). +	     * Here's some translated bytes left over from the last buffer +	     * that we need to stick at the beginning of this 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; -	} -	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 = bufPtr->buf + bufPtr->nextAdded; -	    dstLen = bufPtr->bufLength - bufPtr->nextAdded; - -	    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((VOID *) dst, (VOID *) safe, (size_t) saved); -		bufPtr->nextAdded += saved; -		dst += saved; -		dstLen -= saved; -		saved = 0; +	    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; +	} -	    result = Tcl_UtfToExternal(NULL, encoding, stage, stageLen, -		    statePtr->outputEncodingFlags, -		    &statePtr->outputEncodingState, dst, -		    dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL); - -	    /* 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. -	     */ - -	    statePtr->outputEncodingFlags &= ~TCL_ENCODING_START; - -	    /* -	     * 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 (bufPtr->nextAdded > bufPtr->bufLength) { -		/* -		 * 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. -		 */ - -		saved = bufPtr->nextAdded - bufPtr->bufLength; -		memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved); -		bufPtr->nextAdded = bufPtr->bufLength; -	    } -	    if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) { -		return -1; +	 +	    result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen, +		statePtr->outputEncodingFlags, +		&statePtr->outputEncodingState, dst, +		dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); + +	    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; -	    } +	    saved = -SpaceLeft(bufPtr); +	    memcpy(safe, dst + dstLen, (size_t) saved); +	    bufPtr->nextAdded = bufPtr->bufLength;  	} -    } - -    /* -     * 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++; -	} -	*dstLenPtr = srcLen; -	break; -    case TCL_TRANSLATE_CR: -	for (dstEnd = dst + srcLen; dst < dstEnd;) { -	    if (*src == '\n') { -		*dst++ = '\r'; -		newlineFound = 1; -		src++; -	    } else { -		*dst++ = *src++; -	    } +	if ((srcLen + saved == 0) && (result == TCL_OK)) { +	    endEncoding = 0;  	} -	*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; +	if (IsBufferFull(bufPtr)) { +	    if (FlushChannel(NULL, chanPtr, 0) != 0) { +		return -1;  	    } -	    *dst++ = *src++; -	} -	*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 (bufPtr->nextAdded == bufPtr->bufLength) { -	    statePtr->flags |= BUFFER_READY; -	} else if (statePtr->flags & CHANNEL_LINEBUFFERED) { -	    if (newlineFlag != 0) { -		statePtr->flags |= BUFFER_READY; +	    flushed += statePtr->bufSize; +	    if (saved == 0 || src[-1] != '\n') { +		needNlFlush = 0;  	    } -	} else if (statePtr->flags & CHANNEL_UNBUFFERED) { -	    statePtr->flags |= 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;  }  /* @@ -3711,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 = Tcl_GetStringFromObj(objPtr, &length); -	Tcl_DStringAppend(lineRead, string, length); +	TclDStringAppendObj(lineRead, objPtr);      }      TclDecrRefCount(objPtr);      return charsStored; @@ -3755,23 +4295,37 @@ Tcl_GetsObj(  {      GetsState gs;      Channel *chanPtr = (Channel *) chan; -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      ChannelBuffer *bufPtr;      int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;      Tcl_Encoding encoding;      char *dst, *dstEnd, *eol, *eof;      Tcl_EncodingState oldState; +    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { +	copiedTotal = -1; +	goto done; +    } + +    /* +     * A binary version of Tcl_GetsObj. This could also handle encodings that +     * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion +     * done on objPtr. +     */ + +    if ((statePtr->encoding == NULL) +	    && ((statePtr->inputTranslation == TCL_TRANSLATE_LF) +		    || (statePtr->inputTranslation == TCL_TRANSLATE_CR))) { +	return TclGetsObjBinary(chan, objPtr); +    } +      /*       * This operation should occur at the top of a channel stack.       */      chanPtr = statePtr->topChanPtr; - -    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) { -	copiedTotal = -1; -	goto done; -    } +    Tcl_Preserve(chanPtr);      bufPtr = statePtr->inQueueHead;      encoding = statePtr->encoding; @@ -3781,7 +4335,7 @@ Tcl_GetsObj(       * newline in the available input.       */ -    Tcl_GetStringFromObj(objPtr, &oldLength); +    TclGetStringFromObj(objPtr, &oldLength);      oldFlags = statePtr->inputEncodingFlags;      oldState = statePtr->inputEncodingState;      oldRemoved = BUFFER_PADDING; @@ -3795,7 +4349,7 @@ Tcl_GetsObj(       */      if (encoding == NULL) { -	encoding = Tcl_GetEncoding(NULL, "iso8859-1"); +	encoding = GetBinaryEncoding();      }      /* @@ -3872,19 +4426,22 @@ Tcl_GetsObj(  		    /*  		     * If a CR is at the end of the buffer, then check for a -		     * LF at the begining of the next buffer. +		     * LF at the begining of the next buffer, unless EOF char +		     * was found already.  		     */  		    if (eol >= dstEnd) {  			int offset; -			offset = eol - objPtr->bytes; -			dst = dstEnd; -			if (FilterInputBytes(chanPtr, &gs) != 0) { -			    goto restore; +			if (eol != eof) { +			    offset = eol - objPtr->bytes; +			    dst = dstEnd; +			    if (FilterInputBytes(chanPtr, &gs) != 0) { +				goto restore; +			    } +			    dstEnd = dst + gs.bytesWrote; +			    eol = objPtr->bytes + offset;  			} -			dstEnd = dst + gs.bytesWrote; -			eol = objPtr->bytes + offset;  			if (eol >= dstEnd) {  			    skip = 0;  			    goto gotEOL; @@ -3901,8 +4458,8 @@ Tcl_GetsObj(  	case TCL_TRANSLATE_AUTO:  	    eol = dst;  	    skip = 1; -	    if (statePtr->flags & INPUT_SAW_CR) { -		statePtr->flags &= ~INPUT_SAW_CR; +	    if (GotFlag(statePtr, INPUT_SAW_CR)) { +		ResetFlag(statePtr, INPUT_SAW_CR);  		if ((eol < dstEnd) && (*eol == '\n')) {  		    /*  		     * Skip the raw bytes that make up the '\n'. @@ -3912,10 +4469,10 @@ Tcl_GetsObj(  		    int rawRead;  		    bufPtr = gs.bufPtr; -		    Tcl_ExternalToUtf(NULL, gs.encoding, -			    bufPtr->buf + bufPtr->nextRemoved, gs.rawRead, -			    statePtr->inputEncodingFlags, &gs.state, tmp, -			    1 + TCL_UTF_MAX, &rawRead, NULL, NULL); +		    Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), +			    gs.rawRead, statePtr->inputEncodingFlags, +			    &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, NULL, +			    NULL);  		    bufPtr->nextRemoved += rawRead;  		    gs.rawRead -= rawRead;  		    gs.bytesWrote--; @@ -3930,18 +4487,21 @@ Tcl_GetsObj(  		    if (eol == dstEnd) {  			/*  			 * If buffer ended on \r, peek ahead to see if a \n is -			 * available. +			 * available, unless EOF char was found already.  			 */ -			int offset; +			if (eol != eof) { +			    int offset; + +			    offset = eol - objPtr->bytes; +			    dst = dstEnd; +			    PeekAhead(chanPtr, &dstEnd, &gs); +			    eol = objPtr->bytes + offset; +			} -			offset = eol - objPtr->bytes; -			dst = dstEnd; -			PeekAhead(chanPtr, &dstEnd, &gs); -			eol = objPtr->bytes + offset;  			if (eol >= dstEnd) {  			    eol--; -			    statePtr->flags |= INPUT_SAW_CR; +			    SetFlag(statePtr, INPUT_SAW_CR);  			    goto gotEOL;  			}  		    } @@ -3963,10 +4523,10 @@ Tcl_GetsObj(  	     */  	    dstEnd = eof; -	    statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF); +	    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) { @@ -3976,7 +4536,7 @@ Tcl_GetsObj(  		 */  		Tcl_SetObjLength(objPtr, oldLength); -		CommonGetsCleanup(chanPtr, encoding); +		CommonGetsCleanup(chanPtr);  		copiedTotal = -1;  		goto done;  	    } @@ -3994,14 +4554,24 @@ 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");      }      statePtr->inputEncodingState = gs.state; -    Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved, -	    gs.rawRead, statePtr->inputEncodingFlags, -	    &statePtr->inputEncodingState, dst, +    Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, +	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,  	    eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,  	    &gs.charsWrote);      bufPtr->nextRemoved += gs.rawRead; @@ -4011,8 +4581,8 @@ Tcl_GetsObj(       */      Tcl_SetObjLength(objPtr, eol - objPtr->bytes); -    CommonGetsCleanup(chanPtr, encoding); -    statePtr->flags &= ~CHANNEL_BLOCKED; +    CommonGetsCleanup(chanPtr); +    ResetFlag(statePtr, CHANNEL_BLOCKED);      copiedTotal = gs.totalChars + gs.charsWrote - skip;      goto done; @@ -4023,16 +4593,25 @@ 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, encoding); +    CommonGetsCleanup(chanPtr);      statePtr->inputEncodingState = oldState;      statePtr->inputEncodingFlags = oldFlags; @@ -4049,7 +4628,7 @@ Tcl_GetsObj(       * read would be able to consume the buffered data.       */ -    statePtr->flags |= CHANNEL_NEED_MORE_DATA; +    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);      copiedTotal = -1;      /* @@ -4058,13 +4637,317 @@ 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;  }  /*   *---------------------------------------------------------------------------   * + * TclGetsObjBinary -- + * + *	A variation of Tcl_GetsObj that works directly on the buffers until + *	end-of-line or end-of-file has been seen. Bytes read from the input + *	channel return as a ByteArray obj. + * + * Results: + *	Number of characters accumulated in the object or -1 if error, + *	blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error + *	code for the error or condition that occurred. + * + * Side effects: + *	Consumes input from the channel. + * + *	On reading EOF, leave channel pointing at EOF char. On reading EOL, + *	leave channel pointing after EOL, but don't return EOL in dst buffer. + * + *--------------------------------------------------------------------------- + */ + +static int +TclGetsObjBinary( +    Tcl_Channel chan,		/* Channel from which to read. */ +    Tcl_Obj *objPtr)		/* The line read will be appended to this +				 * object as UTF-8 characters. */ +{ +    Channel *chanPtr = (Channel *) chan; +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */ +    ChannelBuffer *bufPtr; +    int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved; +    int rawLen, byteLen, eolChar; +    unsigned char *dst, *dstEnd, *eol, *eof, *byteArray; + +    /* +     * This operation should occur at the top of a channel stack. +     */ + +    chanPtr = statePtr->topChanPtr; +    Tcl_Preserve(chanPtr); + +    bufPtr = statePtr->inQueueHead; + +    /* +     * Preserved so we can restore the channel's state in case we don't find a +     * newline in the available input. +     */ + +    byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen); +    oldFlags = statePtr->inputEncodingFlags; +    oldRemoved = BUFFER_PADDING; +    oldLength = byteLen; +    if (bufPtr != NULL) { +	oldRemoved = bufPtr->nextRemoved; +    } + +    rawLen = 0; +    skip = 0; +    eof = NULL; +    inEofChar = statePtr->inEofChar; + +    /* +     * Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR. +     */ + +    eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r'; + +    while (1) { +	/* +	 * Subtract the number of bytes that were removed from channel +	 * buffer during last call. +	 */ + +	if (bufPtr != NULL) { +	    bufPtr->nextRemoved += rawLen; +	    if (!IsBufferReady(bufPtr)) { +		bufPtr = bufPtr->nextPtr; +	    } +	} + +	if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) { +	    /* +	     * All channel buffers were exhausted and the caller still +	     * hasn't seen EOL. Need to read more bytes from the channel +	     * device. Side effect is to allocate another channel buffer. +	     */ + +	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) { +		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { +		    goto restore; +		} +		ResetFlag(statePtr, CHANNEL_BLOCKED); +	    } +	    if (GetInput(chanPtr) != 0) { +		goto restore; +	    } +	    bufPtr = statePtr->inQueueTail; +	    if (bufPtr == NULL) { +		goto restore; +	    } +	} + +	dst = (unsigned char *) RemovePoint(bufPtr); +	dstEnd = dst + BytesLeft(bufPtr); + +	/* +	 * Remember if EOF char is seen, then look for EOL anyhow, because the +	 * EOL might be before the EOF char. +	 * XXX - in the binary case, consider coincident search for eol/eof. +	 */ + +	if (inEofChar != '\0') { +	    for (eol = dst; eol < dstEnd; eol++) { +		if (*eol == inEofChar) { +		    dstEnd = eol; +		    eof = eol; +		    break; +		} +	    } +	} + +	/* +	 * On EOL, leave current file position pointing after the EOL, but +	 * don't store the EOL in the output string. +	 */ + +	for (eol = dst; eol < dstEnd; eol++) { +	    if (*eol == eolChar) { +		skip = 1; +		goto gotEOL; +	    } +	} +	if (eof != NULL) { +	    /* +	     * EOF character was seen. On EOF, leave current file position +	     * pointing at the EOF character, but don't store the EOF +	     * character in the output string. +	     */ + +	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); +	    statePtr->inputEncodingFlags |= TCL_ENCODING_END; +	} +	if (GotFlag(statePtr, CHANNEL_EOF)) { +	    skip = 0; +	    eol = dstEnd; +	    if ((dst == dstEnd) && (byteLen == oldLength)) { +		/* +		 * If we didn't append any bytes before encountering EOF, +		 * caller needs to see -1. +		 */ + +		byteArray = Tcl_SetByteArrayLength(objPtr, oldLength); +		CommonGetsCleanup(chanPtr); +		copiedTotal = -1; +		goto done; +	    } +	    goto gotEOL; +	} + +	/* +	 * Copy bytes from the channel buffer to the ByteArray. +	 * This may realloc space, so keep track of result. +	 */ + +	rawLen = dstEnd - dst; +	byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen); +	memcpy(byteArray + byteLen, dst, (size_t) rawLen); +	byteLen += rawLen; +    } + +    /* +     * Found EOL or EOF, but the output buffer may now contain too many bytes. +     * We need to know how many bytes correspond to the number we want, so we +     * can remove the correct number of bytes from the channel buffer. +     */ + +  gotEOL: +    if (bufPtr == NULL) { +	Tcl_Panic("TclGetsObjBinary: gotEOL reached with bufPtr==NULL"); +    } + +    rawLen = eol - dst; +    byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen); +    memcpy(byteArray + byteLen, dst, (size_t) rawLen); +    byteLen += rawLen; +    bufPtr->nextRemoved += rawLen + skip; + +    /* +     * Convert the buffer if there was an encoding. +     * XXX - unimplemented. +     */ + +    if (statePtr->encoding != NULL) { +    } + +    /* +     * Recycle all the emptied buffers. +     */ + +    CommonGetsCleanup(chanPtr); +    ResetFlag(statePtr, CHANNEL_BLOCKED); +    copiedTotal = byteLen; +    goto done; + +    /* +     * Couldn't get a complete line. This only happens if we get a error +     * reading from the channel or we are non-blocking and there wasn't an EOL +     * or EOF in the data available. +     */ + +  restore: +    bufPtr = statePtr->inQueueHead; +    if (bufPtr) { +	bufPtr->nextRemoved = oldRemoved; +	bufPtr = bufPtr->nextPtr; +    } + +    for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { +	bufPtr->nextRemoved = BUFFER_PADDING; +    } +    CommonGetsCleanup(chanPtr); + +    statePtr->inputEncodingFlags = oldFlags; +    byteArray = Tcl_SetByteArrayLength(objPtr, oldLength); + +    /* +     * We didn't get a complete line so we need to indicate to UpdateInterest +     * that the gets blocked. It will wait for more data instead of firing a +     * timer, avoiding a busy wait. This is where we are assuming that the +     * next operation is a gets. No more file events will be delivered on this +     * channel until new data arrives or some operation is performed on the +     * channel (e.g. gets, read, fconfigure) that changes the blocking state. +     * Note that this means a file event will not be delivered even though a +     * read would be able to consume the buffered data. +     */ + +    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); +    copiedTotal = -1; + +    /* +     * Update the notifier state so we don't block while there is still data +     * in the buffers. +     */ + +  done: +    UpdateInterest(chanPtr); +    Tcl_Release(chanPtr); +    return copiedTotal; +} + +/* + *--------------------------------------------------------------------------- + * + * FreeBinaryEncoding -- + * + *	Frees any "iso8859-1" Tcl_Encoding created by [gets] on a binary + *	channel in a thread as part of that thread's finalization. + * + * Results: + *	None. + * + *--------------------------------------------------------------------------- + */ + +static void +FreeBinaryEncoding( +    ClientData dummy)	/* Not used */ +{ +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + +    if (tsdPtr->binaryEncoding != NULL) { +	Tcl_FreeEncoding(tsdPtr->binaryEncoding); +	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; +} + +/* + *--------------------------------------------------------------------------- + *   * FilterInputBytes --   *   *	Helper function for Tcl_GetsObj. Produces UTF-8 characters from raw @@ -4091,13 +4974,13 @@ FilterInputBytes(      Channel *chanPtr,		/* Channel to read. */      GetsState *gsPtr)		/* Current state of gets operation. */  { -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      ChannelBuffer *bufPtr; -    char *raw, *rawStart, *rawEnd; -    char *dst; -    int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length; +    char *raw, *rawStart, *dst; +    int offset, toRead, dstNeeded, spaceLeft, result, rawLen;      Tcl_Obj *objPtr; -#define ENCODING_LINESIZE   20	/* Lower bound on how many bytes to convert at +#define ENCODING_LINESIZE 20	/* Lower bound on how many bytes to convert at  				 * a time. Since we don't know a priori how  				 * many bytes of storage this many source  				 * bytes will use, we actually need at least @@ -4114,7 +4997,7 @@ FilterInputBytes(      bufPtr = gsPtr->bufPtr;      if (bufPtr != NULL) {  	bufPtr->nextRemoved += gsPtr->rawRead; -	if (bufPtr->nextRemoved >= bufPtr->nextAdded) { +	if (!IsBufferReady(bufPtr)) {  	    bufPtr = bufPtr->nextPtr;  	}      } @@ -4128,13 +5011,13 @@ 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;  	    } -	    statePtr->flags &= ~CHANNEL_BLOCKED; +	    ResetFlag(statePtr, CHANNEL_BLOCKED);  	}  	if (GetInput(chanPtr) != 0) {  	    gsPtr->charsWrote = 0; @@ -4143,6 +5026,11 @@ FilterInputBytes(  	}  	bufPtr = statePtr->inQueueTail;  	gsPtr->bufPtr = bufPtr; +	if (bufPtr == NULL) { +	    gsPtr->charsWrote = 0; +	    gsPtr->rawRead = 0; +	    return -1; +	}      }      /* @@ -4151,10 +5039,9 @@ FilterInputBytes(       * string rep if we need more space.       */ -    rawStart = bufPtr->buf + bufPtr->nextRemoved; +    rawStart = RemovePoint(bufPtr);      raw = rawStart; -    rawEnd = bufPtr->buf + bufPtr->nextAdded; -    rawLen = rawEnd - rawStart; +    rawLen = BytesLeft(bufPtr);      dst = *gsPtr->dstPtr;      offset = dst - objPtr->bytes; @@ -4162,15 +5049,19 @@ FilterInputBytes(      if (toRead > rawLen) {  	toRead = rawLen;      } -    dstNeeded = toRead * TCL_UTF_MAX + 1; -    spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1; +    dstNeeded = toRead * TCL_UTF_MAX; +    spaceLeft = objPtr->length - offset;      if (dstNeeded > spaceLeft) { -	length = offset * 2; -	if (offset < dstNeeded) { +	int length = offset + ((offset < dstNeeded) ? dstNeeded : offset); + +	if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {  	    length = offset + dstNeeded; +	    if (Tcl_AttemptSetObjLength(objPtr, length) == 0) { +		dstNeeded = TCL_UTF_MAX - 1 + toRead; +		length = offset + dstNeeded; +		Tcl_SetObjLength(objPtr, length); +	    }  	} -	length += TCL_UTF_MAX + 1; -	Tcl_SetObjLength(objPtr, length);  	spaceLeft = length - offset;  	dst = objPtr->bytes + offset;  	*gsPtr->dstPtr = dst; @@ -4178,7 +5069,7 @@ FilterInputBytes(      gsPtr->state = statePtr->inputEncodingState;      result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,  	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, -	    dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote, +	    dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,  	    &gsPtr->charsWrote);      /* @@ -4199,14 +5090,14 @@ FilterInputBytes(  	int extra;  	nextPtr = bufPtr->nextPtr; -	if (bufPtr->nextAdded < bufPtr->bufLength) { +	if (!IsBufferFull(bufPtr)) {  	    if (gsPtr->rawRead > 0) {  		/*  		 * Some raw bytes were converted to UTF-8. Fall through,  		 * 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. @@ -4228,8 +5119,8 @@ FilterInputBytes(  		statePtr->inQueueTail = nextPtr;  	    }  	    extra = rawLen - gsPtr->rawRead; -	    memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra), -		    (VOID *) (raw + gsPtr->rawRead), (size_t) extra); +	    memcpy(nextPtr->buf + (BUFFER_PADDING - extra), +		    raw + gsPtr->rawRead, (size_t) extra);  	    nextPtr->nextRemoved -= extra;  	    bufPtr->nextAdded -= extra;  	} @@ -4268,7 +5159,8 @@ PeekAhead(  				 * UTF-8 characters. */      GetsState *gsPtr)		/* Current state of gets operation. */  { -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      ChannelBuffer *bufPtr;      Tcl_DriverBlockModeProc *blockModeProc;      int bytesLeft; @@ -4285,16 +5177,16 @@ PeekAhead(      blockModeProc = NULL;      if (bufPtr->nextPtr == NULL) { -	bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead); +	bytesLeft = BytesLeft(bufPtr) - gsPtr->rawRead;  	if (bytesLeft == 0) { -	    if (bufPtr->nextAdded < bufPtr->bufLength) { +	    if (!IsBufferFull(bufPtr)) {  		/*  		 * Don't peek ahead if last read was short read.  		 */  		goto cleanup;  	    } -	    if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) { +	    if (!GotFlag(statePtr, CHANNEL_NONBLOCKING)) {  		blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);  		if (blockModeProc == NULL) {  		    /* @@ -4342,16 +5234,16 @@ PeekAhead(  static void  CommonGetsCleanup( -    Channel *chanPtr, -    Tcl_Encoding encoding) +    Channel *chanPtr)  { -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      ChannelBuffer *bufPtr, *nextPtr;      bufPtr = statePtr->inQueueHead;      for ( ; bufPtr != NULL; bufPtr = nextPtr) {  	nextPtr = bufPtr->nextPtr; -	if (bufPtr->nextRemoved < bufPtr->nextAdded) { +	if (IsBufferReady(bufPtr)) {  	    break;  	}  	RecycleBuffer(statePtr, bufPtr, 0); @@ -4373,10 +5265,10 @@ CommonGetsCleanup(  	for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {  	    int extra; -	    extra = bufPtr->bufLength - bufPtr->nextAdded; +	    extra = SpaceLeft(bufPtr);  	    if (extra > 0) { -		memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded), -			(VOID *) (nextPtr->buf + BUFFER_PADDING - extra), +		memcpy(InsertPoint(bufPtr), +			nextPtr->buf + (BUFFER_PADDING - extra),  			(size_t) extra);  		bufPtr->nextAdded += extra;  		nextPtr->nextRemoved = BUFFER_PADDING; @@ -4384,9 +5276,6 @@ CommonGetsCleanup(  	    bufPtr = nextPtr;  	}      } -    if (statePtr->encoding == NULL) { -	Tcl_FreeEncoding(encoding); -    }  }  /* @@ -4418,7 +5307,8 @@ Tcl_Read(      int bytesToRead)		/* Maximum number of bytes to read. */  {      Channel *chanPtr = (Channel *) chan; -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      /*       * This operation should occur at the top of a channel stack. @@ -4430,7 +5320,7 @@ Tcl_Read(  	return -1;      } -    return DoRead(chanPtr, dst, bytesToRead); +    return DoRead(chanPtr, dst, bytesToRead, 0);  }  /* @@ -4462,9 +5352,9 @@ Tcl_ReadRaw(      int bytesToRead)		/* Maximum number of bytes to read. */  {      Channel *chanPtr = (Channel *) chan; -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ -    int nread, result; -    int copied, copiedNow; +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */ +    int nread, result, copied, copiedNow;      /*       * The check below does too much because it will reject a call to this @@ -4488,31 +5378,32 @@ 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;  		} -		statePtr->flags &= (~(CHANNEL_BLOCKED)); +		ResetFlag(statePtr, CHANNEL_BLOCKED);  	    }  #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 +	     * [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)) {  		/*  		 * We bypass the driver; it would block as no data is  		 * available. @@ -4520,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 @@ -4532,39 +5423,34 @@ 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) {  		/* -		 * If we get a short read, signal up that we may be -		 * BLOCKED. We should avoid calling the driver because -		 * on some platforms we will block in the low level -		 * reading code even though the channel is set into -		 * nonblocking mode. +		 * If we get a short read, signal up that we may be BLOCKED. +		 * We should avoid calling the driver because on some +		 * platforms we will block in the low level reading code even +		 * though the channel is set into nonblocking mode.  		 */  		if (nread < (bytesToRead - copied)) { -		    statePtr->flags |= CHANNEL_BLOCKED; +		    SetFlag(statePtr, CHANNEL_BLOCKED);  		}  #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING  		if (nread <= (bytesToRead - copied)) {  		    /* -		     * [SF Tcl Bug 943274] We have read the available data, -		     * clear flag. +		     * [Bug 943274] We have read the available data, clear +		     * flag.  		     */ -		    statePtr->flags &= ~CHANNEL_HAS_MORE_DATA; +		    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);  		}  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ -  	    } else if (nread == 0) { -		statePtr->flags |= CHANNEL_EOF; +		SetFlag(statePtr, CHANNEL_EOF);  		statePtr->inputEncodingFlags |= TCL_ENCODING_END;  	    } else if (nread < 0) { @@ -4575,22 +5461,25 @@ Tcl_ReadRaw(  			 * over EAGAIN/WOULDBLOCK handling.  			 */ -			return copied; +			goto done;  		    } -		    statePtr->flags |= CHANNEL_BLOCKED; +		    SetFlag(statePtr, CHANNEL_BLOCKED);  		    result = EAGAIN;  		}  		Tcl_SetErrno(result); -		return -1; +		copied = -1; +		goto done;  	    } -	    return copied + nread; +	    copied += nread; +	    goto done;  	}      }    done: +    Tcl_Release(chanPtr);      return copied;  } @@ -4629,7 +5518,8 @@ Tcl_ReadChars(  				 * of the object. */  {      Channel *chanPtr = (Channel *) chan; -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      /*       * This operation should occur at the top of a channel stack. @@ -4683,7 +5573,8 @@ DoReadChars(  				 * the data will replace the existing contents  				 * of the object. */  { -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      ChannelBuffer *bufPtr;      int offset, factor, copied, copiedNow, result;      Tcl_Encoding encoding; @@ -4696,6 +5587,7 @@ DoReadChars(      chanPtr = statePtr->topChanPtr;      encoding = statePtr->encoding;      factor = UTF_EXPANSION_FACTOR; +    Tcl_Preserve(chanPtr);      if (appendFlag == 0) {  	if (encoding == NULL) { @@ -4709,14 +5601,14 @@ DoReadChars(  	     * been pure Unicode).  	     */ -	    Tcl_GetString(objPtr); +	    TclGetString(objPtr);  	}  	offset = 0;      } else {  	if (encoding == NULL) {  	    Tcl_GetByteArrayFromObj(objPtr, &offset);  	} else { -	    Tcl_GetStringFromObj(objPtr, &offset); +	    TclGetStringFromObj(objPtr, &offset);  	}      } @@ -4735,10 +5627,9 @@ DoReadChars(  	     */  	    bufPtr = statePtr->inQueueHead; -	    if (bufPtr->nextRemoved == bufPtr->nextAdded) { -		ChannelBuffer *nextPtr; +	    if (IsBufferEmpty(bufPtr)) { +		ChannelBuffer *nextPtr = bufPtr->nextPtr; -		nextPtr = bufPtr->nextPtr;  		RecycleBuffer(statePtr, bufPtr, 0);  		statePtr->inQueueHead = nextPtr;  		if (nextPtr == NULL) { @@ -4748,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;  		} -		statePtr->flags &= ~CHANNEL_BLOCKED; +		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; @@ -4771,7 +5667,7 @@ DoReadChars(  	}      } -    statePtr->flags &= ~CHANNEL_BLOCKED; +    ResetFlag(statePtr, CHANNEL_BLOCKED);      if (encoding == NULL) {  	Tcl_SetByteArrayLength(objPtr, offset);      } else { @@ -4784,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;  } @@ -4840,8 +5746,8 @@ ReadBytes(      offset = *offsetPtr;      bufPtr = statePtr->inQueueHead; -    src = bufPtr->buf + bufPtr->nextRemoved; -    srcLen = bufPtr->nextAdded - bufPtr->nextRemoved; +    src = RemovePoint(bufPtr); +    srcLen = BytesLeft(bufPtr);      toRead = bytesToRead;      if ((unsigned) toRead > (unsigned) srcLen) { @@ -4864,8 +5770,8 @@ ReadBytes(      }      dst += offset; -    if (statePtr->flags & INPUT_NEED_NL) { -	statePtr->flags &= ~INPUT_NEED_NL; +    if (GotFlag(statePtr, INPUT_NEED_NL)) { +	ResetFlag(statePtr, INPUT_NEED_NL);  	if ((srcLen == 0) || (*src != '\n')) {  	    *dst = '\r';  	    *offsetPtr += 1; @@ -4902,6 +5808,8 @@ ReadBytes(   *	'charsToRead' can safely be a very large number because space is only   *	allocated to hold data read from the channel as needed.   * + *	'charsToRead' may *not* be 0. + *   * Results:   *	The return value is the number of characters appended to the object,   *	*offsetPtr is filled with the number of bytes that were appended, and @@ -4939,7 +5847,7 @@ ReadChars(  				 * UTF-8. On output, contains another guess  				 * based on the data seen so far. */  { -    int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded; +    int toRead, factor, offset, spaceLeft, srcLen, dstNeeded;      int srcRead, dstWrote, numChars, dstRead;      ChannelBuffer *bufPtr;      char *src, *dst; @@ -4950,11 +5858,11 @@ ReadChars(      offset = *offsetPtr;      bufPtr = statePtr->inQueueHead; -    src = bufPtr->buf + bufPtr->nextRemoved; -    srcLen = bufPtr->nextAdded - bufPtr->nextRemoved; +    src = RemovePoint(bufPtr); +    srcLen = BytesLeft(bufPtr);      toRead = charsToRead; -    if ((unsigned)toRead > (unsigned)srcLen) { +    if ((unsigned) toRead > (unsigned) srcLen) {  	toRead = srcLen;      } @@ -4964,8 +5872,8 @@ ReadChars(       * how many characters were produced by the previous pass.       */ -    dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR; -    spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1; +    dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; +    spaceLeft = objPtr->length - offset;      if (dstNeeded > spaceLeft) {  	/* @@ -4974,13 +5882,17 @@ ReadChars(  	 * larger.  	 */ -	length = offset * 2; -	if (offset < dstNeeded) { +	int length = offset + ((offset < dstNeeded) ? dstNeeded : offset); + +	if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {  	    length = offset + dstNeeded; +	    if (Tcl_AttemptSetObjLength(objPtr, length) == 0) { +		dstNeeded = TCL_UTF_MAX - 1 + toRead; +		length = offset + dstNeeded; +		Tcl_SetObjLength(objPtr, length); +	    }  	}  	spaceLeft = length - offset; -	length += TCL_UTF_MAX + 1; -	Tcl_SetObjLength(objPtr, length);      }      if (toRead == srcLen) {  	/* @@ -4994,60 +5906,57 @@ ReadChars(      dst = objPtr->bytes + offset;      /* -     * SF Tcl Bug 1462248 -     * The cause of the crash reported in the referenced bug is this: +     * [Bug 1462248]: The cause of the crash reported in this bug is this:       *       * - ReadChars, called with a single buffer, with a incomplete -     *   multi-byte character at the end (only the first byte of it). +     *	 multi-byte character at the end (only the first byte of it).       * - Encoding translation fails, asks for more data       * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set. -     * - ReadChar is called again, converts the first buffer, but due -     *   to TEE it does not check for incomplete multi-byte data, and the -     *   character just after the end of the first buffer is a valid -     *   completion of the multi-byte header in the actual buffer. The -     *   conversion reads more characters from the buffer then present. -     *   This causes nextRemoved to overshoot nextAdded and the next -     *   reads compute a negative srcLen, cause further translations to -     *   fail, causing copying of data into the next buffer using bad -     *   arguments, causing the mecpy for to eventually fail. +     * - ReadChar is called again, converts the first buffer, but due to TEE +     *	 it does not check for incomplete multi-byte data, and the character +     *	 just after the end of the first buffer is a valid completion of the +     *	 multi-byte header in the actual buffer. The conversion reads more +     *	 characters from the buffer then present. This causes nextRemoved to +     *	 overshoot nextAdded and the next reads compute a negative srcLen, +     *	 cause further translations to fail, causing copying of data into the +     *	 next buffer using bad arguments, causing the mecpy for to eventually +     *	 fail.       * -     * In the end it is a memory access bug spiraling out of control -     * if the conditions are _just so_. And ultimate cause is that TEE -     * is given to a conversion where it should not. TEE signals that -     * this is the last buffer. Except in our case it is not. +     * In the end it is a memory access bug spiraling out of control if the +     * conditions are _just so_. And ultimate cause is that TEE is given to a +     * conversion where it should not. TEE signals that this is the last +     * buffer. Except in our case it is not.       * -     * My solution is to suppress TEE if the first buffer is not the -     * last. We will eventually need it given that EOF has been -     * reached, but not right now. This is what the new flag -     * "endEncSuppressFlag" is for. +     * My solution is to suppress TEE if the first buffer is not the last. We +     * will eventually need it given that EOF has been reached, but not right +     * now. This is what the new flag "endEncSuppressFlag" is for.       * -     * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind -     * the actual buffer has been fixed as well, and fixes the problem -     * with the crash too, but this would still allow the generic -     * layer to accidentially break a multi-byte sequence if the -     * conditions are just right, because again the ExternalToUtf -     * would be successful where it should not. +     * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind the +     * actual buffer has been fixed as well, and fixes the problem with the +     * crash too, but this would still allow the generic layer to +     * accidentially break a multi-byte sequence if the conditions are just +     * right, because again the ExternalToUtf would be successful where it +     * should not.       */      if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) && -	(bufPtr->nextPtr != NULL)) { - -        /* TEE is set for a buffer which is not the last. Squash it -	 * for now, and restore it later, before yielding control to -	 * our caller. +	    (bufPtr->nextPtr != NULL)) { +	/* +	 * TEE is set for a buffer which is not the last. Squash it for now, +	 * and restore it later, before yielding control to our caller.  	 */ -        statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; -        encEndFlagSuppressed = 1; +	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; +	encEndFlagSuppressed = 1;      }      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'.  	 */ -	statePtr->flags &= ~INPUT_NEED_NL; +	ResetFlag(statePtr, INPUT_NEED_NL);  	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,  		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,  		dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars); @@ -5075,10 +5984,10 @@ ReadChars(      Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,  	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst, -	    dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars); +	    dstNeeded + 1, &srcRead, &dstWrote, &numChars);      if (encEndFlagSuppressed) { -        statePtr->inputEncodingFlags |= TCL_ENCODING_END; +	statePtr->inputEncodingFlags |= TCL_ENCODING_END;      }      if (srcRead == 0) { @@ -5096,9 +6005,7 @@ ReadChars(  		/*  		 * There isn't enough data in the buffers to complete the next  		 * character, so we need to wait for more data before the next -		 * file event can be delivered. -		 * -		 * SF #478856. +		 * file event can be delivered. [Bug 478856]  		 *  		 * The exception to this is if the input buffer was completely  		 * empty before we tried to convert its contents. Nothing in, @@ -5106,30 +6013,30 @@ ReadChars(  		 * conversion before the current one was complete.  		 */ -		statePtr->flags |= CHANNEL_NEED_MORE_DATA; +		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);  	    }  	    return -1;  	} -	/* Space is made at the beginning of the buffer to copy the -	 * previous unused bytes there. Check first if the buffer we -	 * are using actually has enough space at its beginning for -	 * the data we are copying. Because if not we will write over the -	 * buffer management information, especially the 'nextPtr'. +	/* +	 * Space is made at the beginning of the buffer to copy the previous +	 * unused bytes there. Check first if the buffer we are using actually +	 * has enough space at its beginning for the data we are copying. +	 * Because if not we will write over the buffer management +	 * information, especially the 'nextPtr'.  	 * -	 * Note that the BUFFER_PADDING (See AllocChannelBuffer) is -	 * used to prevent exactly this situation. I.e. it should -	 * never happen. Therefore it is ok to panic should it happen -	 * despite the precautions. +	 * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used to +	 * prevent exactly this situation. I.e. it should never happen. +	 * Therefore it is ok to panic should it happen despite the +	 * precautions.  	 */  	if (nextPtr->nextRemoved - srcLen < 0) { -	    Tcl_Panic ("Buffer Underflow, BUFFER_PADDING not enough"); +	    Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");  	}  	nextPtr->nextRemoved -= srcLen; -	memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src, -		(size_t) srcLen); +	memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);  	RecycleBuffer(statePtr, bufPtr, 0);  	statePtr->inQueueHead = nextPtr;  	return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr); @@ -5160,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, @@ -5213,7 +6119,7 @@ TranslateInputEOL(      char *dstStart,		/* Output buffer filled with chars by applying  				 * appropriate EOL translation to source  				 * characters. */ -    CONST char *srcStart,	/* Source characters. */ +    const char *srcStart,	/* Source characters. */      int *dstLenPtr,		/* On entry, the maximum length of output  				 * buffer in bytes; must be <= *srcLenPtr. On  				 * exit, the number of bytes actually used in @@ -5223,7 +6129,7 @@ TranslateInputEOL(  				 * source buffer. */  {      int dstLen, srcLen, inEofChar; -    CONST char *eof; +    const char *eof;      dstLen = *dstLenPtr; @@ -5237,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; @@ -5255,7 +6160,7 @@ TranslateInputEOL(      switch (statePtr->inputTranslation) {      case TCL_TRANSLATE_LF:  	if (dstStart != srcStart) { -	    memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen); +	    memcpy(dstStart, srcStart, (size_t) dstLen);  	}  	srcLen = dstLen;  	break; @@ -5263,7 +6168,7 @@ TranslateInputEOL(  	char *dst, *dstEnd;  	if (dstStart != srcStart) { -	    memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen); +	    memcpy(dstStart, srcStart, (size_t) dstLen);  	}  	dstEnd = dstStart + dstLen;  	for (dst = dstStart; dst < dstEnd; dst++) { @@ -5276,7 +6181,7 @@ TranslateInputEOL(      }      case TCL_TRANSLATE_CRLF: {  	char *dst; -	CONST char *src, *srcEnd, *srcMax; +	const char *src, *srcEnd, *srcMax;  	dst = dstStart;  	src = srcStart; @@ -5287,7 +6192,7 @@ TranslateInputEOL(  	    if (*src == '\r') {  		src++;  		if (src >= srcMax) { -		    statePtr->flags |= INPUT_NEED_NL; +		    SetFlag(statePtr, INPUT_NEED_NL);  		} else if (*src == '\n') {  		    *dst++ = *src++;  		} else { @@ -5303,24 +6208,24 @@ TranslateInputEOL(      }      case TCL_TRANSLATE_AUTO: {  	char *dst; -	CONST char *src, *srcEnd, *srcMax; +	const char *src, *srcEnd, *srcMax;  	dst = dstStart;  	src = srcStart;  	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++;  	    } -	    statePtr->flags &= ~INPUT_SAW_CR; +	    ResetFlag(statePtr, INPUT_SAW_CR);  	}  	for ( ; src < srcEnd; ) {  	    if (*src == '\r') {  		src++;  		if (src >= srcMax) { -		    statePtr->flags |= INPUT_SAW_CR; +		    SetFlag(statePtr, INPUT_SAW_CR);  		} else if (*src == '\n') {  		    if (srcEnd < srcMax) {  			srcEnd++; @@ -5348,9 +6253,9 @@ TranslateInputEOL(  	 * character in the output string.  	 */ -	statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF); +	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);  	statePtr->inputEncodingFlags |= TCL_ENCODING_END; -	statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL); +	ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);  	return 1;      } @@ -5378,7 +6283,7 @@ TranslateInputEOL(  int  Tcl_Ungets(      Tcl_Channel chan,		/* The channel for which to add the input. */ -    CONST char *str,		/* The input itself. */ +    const char *str,		/* The input itself. */      int len,			/* The length of the input. */      int atEnd)			/* If non-zero, add at end of queue; otherwise  				 * add at head of queue. */ @@ -5386,7 +6291,7 @@ Tcl_Ungets(      Channel *chanPtr;		/* The real IO channel. */      ChannelState *statePtr;	/* State of actual channel. */      ChannelBuffer *bufPtr;	/* Buffer to contain the data. */ -    int i, flags; +    int flags;      chanPtr = (Channel *) chan;      statePtr = chanPtr->state; @@ -5415,15 +6320,14 @@ 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;      } -    statePtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF)); +    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);      bufPtr = AllocChannelBuffer(len); -    for (i = 0; i < len; i++) { -	bufPtr->buf[bufPtr->nextAdded++] = str[i]; -    } +    memcpy(InsertPoint(bufPtr), str, (size_t) len); +    bufPtr->nextAdded += len;      if (statePtr->inQueueHead == NULL) {  	bufPtr->nextPtr = NULL; @@ -5488,10 +6392,8 @@ Tcl_Flush(       * Force current output buffer to be output also.       */ -    if ((statePtr->curOutPtr != NULL) -	    && (statePtr->curOutPtr->nextAdded > -		    statePtr->curOutPtr->nextRemoved)) { -	statePtr->flags |= BUFFER_READY; +    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { +	SetFlag(statePtr, BUFFER_READY);      }      result = FlushChannel(NULL, chanPtr, 0); @@ -5527,7 +6429,8 @@ DiscardInputQueued(      int discardSavedBuffers)	/* If non-zero, discard all buffers including  				 * last one. */  { -    ChannelBuffer *bufPtr, *nxtPtr;	/* Loop variables. */ +    ChannelBuffer *bufPtr, *nxtPtr; +				/* Loop variables. */      bufPtr = statePtr->inQueueHead;      statePtr->inQueueHead = NULL; @@ -5543,7 +6446,7 @@ DiscardInputQueued(       */      if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) { -	ckfree((char *) statePtr->saveInBufPtr); +	ReleaseChannelBuffer(statePtr->saveInBufPtr);  	statePtr->saveInBufPtr = NULL;      }  } @@ -5573,7 +6476,8 @@ GetInput(      int result;			/* Of calling driver. */      int nread;			/* How much was read from channel? */      ChannelBuffer *bufPtr;	/* New buffer to add to input queue. */ -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      /*       * Prevent reading from a dead channel -- a channel that has been closed @@ -5621,22 +6525,21 @@ GetInput(       */      bufPtr = statePtr->inQueueTail; -    if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) { -	toRead = bufPtr->bufLength - bufPtr->nextAdded; +    if ((bufPtr != NULL) && !IsBufferFull(bufPtr)) { +	toRead = SpaceLeft(bufPtr);      } else {  	bufPtr = statePtr->saveInBufPtr;  	statePtr->saveInBufPtr = NULL;  	/* -	 * Check the actual buffersize against the requested -	 * buffersize. Buffers which are smaller than requested are -	 * squashed. This is done to honor dynamic changes of the buffersize -	 * made by the user. +	 * Check the actual buffersize against the requested buffersize. +	 * Buffers which are smaller than requested are squashed. This is done +	 * to honor dynamic changes of the buffersize made by the user.  	 */  	if ((bufPtr != NULL)  		&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) { -	    ckfree((char *) bufPtr); +	    ReleaseChannelBuffer(bufPtr);  	    bufPtr = NULL;  	} @@ -5659,7 +6562,7 @@ GetInput(  	 * buffersize.  	 */ -	toRead = bufPtr->bufLength - bufPtr->nextAdded; +	toRead = SpaceLeft(bufPtr);  	if (statePtr->inQueueTail == NULL) {  	    statePtr->inQueueHead = bufPtr; @@ -5674,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, -		bufPtr->buf + bufPtr->nextAdded, 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;  	/* @@ -5716,32 +6617,31 @@ GetInput(  	 */  	if (nread < toRead) { -	    statePtr->flags |= CHANNEL_BLOCKED; +	    SetFlag(statePtr, CHANNEL_BLOCKED);  	}  #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING  	if (nread <= toRead) {  	    /* -	     * [SF Tcl Bug 943274] We have read the available data, clear -	     * flag. +	     * [Bug 943274]: We have read the available data, clear flag.  	     */ -	    statePtr->flags &= ~CHANNEL_HAS_MORE_DATA; +	    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);  	}  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ -      } else if (nread == 0) { -	statePtr->flags |= CHANNEL_EOF; +	result = 0; +	SetFlag(statePtr, CHANNEL_EOF);  	statePtr->inputEncodingFlags |= TCL_ENCODING_END;      } else if (nread < 0) {  	if ((result == EWOULDBLOCK) || (result == EAGAIN)) { -	    statePtr->flags |= CHANNEL_BLOCKED; +	    SetFlag(statePtr, CHANNEL_BLOCKED);  	    result = EAGAIN;  	}  	Tcl_SetErrno(result); -	return result;      } -    return 0; +    ReleaseChannelBuffer(bufPtr); +    return result;  }  /* @@ -5768,8 +6668,10 @@ Tcl_Seek(      Tcl_WideInt offset,		/* Offset to seek to. */      int mode)			/* Relative to which location to seek? */  { -    Channel *chanPtr = (Channel *) chan;	/* The real IO channel. */ -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    Channel *chanPtr = (Channel *) chan; +				/* The real IO channel. */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      int inputBuffered, outputBuffered;  				/* # bytes held in buffers. */      int result;			/* Of device driver operations. */ @@ -5843,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 @@ -5854,15 +6756,15 @@ 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);  	} -	statePtr->flags &= (~(CHANNEL_NONBLOCKING)); -	if (statePtr->flags & BG_FLUSH_SCHEDULED) { -	    statePtr->flags &= (~(BG_FLUSH_SCHEDULED)); +	ResetFlag(statePtr, CHANNEL_NONBLOCKING); +	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { +	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);  	}      } @@ -5871,10 +6773,8 @@ Tcl_Seek(       * as ready to flush before invoking FlushChannel.       */ -    if ((statePtr->curOutPtr != NULL) && -	    (statePtr->curOutPtr->nextAdded > -		    statePtr->curOutPtr->nextRemoved)) { -	statePtr->flags |= BUFFER_READY; +    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) { +	SetFlag(statePtr, BUFFER_READY);      }      /* @@ -5890,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);  	} @@ -5920,7 +6807,7 @@ Tcl_Seek(       */      if (wasAsync) { -	statePtr->flags |= CHANNEL_NONBLOCKING; +	SetFlag(statePtr, CHANNEL_NONBLOCKING);  	result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);  	if (result != 0) {  	    return Tcl_LongAsWide(-1); @@ -5953,8 +6840,10 @@ Tcl_WideInt  Tcl_Tell(      Tcl_Channel chan)		/* The channel to return pos for. */  { -    Channel *chanPtr = (Channel *) chan;	/* The real IO channel. */ -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    Channel *chanPtr = (Channel *) chan; +				/* The real IO channel. */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      int inputBuffered, outputBuffered;  				/* # bytes held in buffers. */      int result;			/* Of calling device driver. */ @@ -5999,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;      } @@ -6055,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);  }  /* @@ -6103,15 +6980,17 @@ Tcl_TruncateChannel(  	 * Feature not supported and it's not emulatable. Pretend it's  	 * returned an EINVAL, a very generic error!  	 */ +  	Tcl_SetErrno(EINVAL);  	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.  	 */ +  	Tcl_SetErrno(EINVAL);  	return TCL_ERROR;      } @@ -6121,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;      }      /* @@ -6180,7 +7061,7 @@ CheckChannelErrors(  	 */  	if (statePtr->chanMsg != NULL) { -	    Tcl_DecrRefCount(statePtr->chanMsg); +	    TclDecrRefCount(statePtr->chanMsg);  	}  	statePtr->chanMsg = statePtr->unreportedMsg;  	statePtr->unreportedMsg = NULL; @@ -6192,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;      } @@ -6215,7 +7095,7 @@ CheckChannelErrors(       * retrieving and transforming the data to copy.       */ -    if ((statePtr->csPtr != NULL) && ((flags & CHANNEL_RAW_MODE) == 0)) { +    if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {  	Tcl_SetErrno(EBUSY);  	return -1;      } @@ -6228,10 +7108,10 @@ CheckChannelErrors(  	 * discover these conditions anew in each operation.  	 */ -	if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) { -	    statePtr->flags &= ~CHANNEL_EOF; +	if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) { +	    ResetFlag(statePtr, CHANNEL_EOF);  	} -	statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); +	ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);      }      return 0; @@ -6260,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;  } @@ -6288,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;  }  /* @@ -6320,7 +7200,7 @@ Tcl_InputBuffered(      for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead; bufPtr != NULL;  	    bufPtr = bufPtr->nextPtr) { -	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); +	bytesBuffered += BytesLeft(bufPtr);      }      /* @@ -6329,7 +7209,7 @@ Tcl_InputBuffered(      for (bufPtr = statePtr->topChanPtr->inQueueHead; bufPtr != NULL;  	    bufPtr = bufPtr->nextPtr) { -	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); +	bytesBuffered += BytesLeft(bufPtr);      }      return bytesBuffered; @@ -6364,13 +7244,13 @@ Tcl_OutputBuffered(      for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL;  	    bufPtr = bufPtr->nextPtr) { -	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); +	bytesBuffered += BytesLeft(bufPtr);      }      if (statePtr->curOutPtr != NULL) {  	register ChannelBuffer *curOutPtr = statePtr->curOutPtr; -	if (curOutPtr->nextAdded > curOutPtr->nextRemoved) { -	    bytesBuffered += curOutPtr->nextAdded - curOutPtr->nextRemoved; +	if (IsBufferReady(curOutPtr)) { +	    bytesBuffered += BytesLeft(curOutPtr);  	}      } @@ -6400,13 +7280,13 @@ Tcl_ChannelBuffered(      Tcl_Channel chan)		/* The channel to query. */  {      Channel *chanPtr = (Channel *) chan; -				/* real channel structure. */ +				/* Real channel structure. */      ChannelBuffer *bufPtr; -    int bytesBuffered; +    int bytesBuffered = 0; -    for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead; bufPtr != NULL; +    for (bufPtr = chanPtr->inQueueHead; bufPtr != NULL;  	    bufPtr = bufPtr->nextPtr) { -	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved); +	bytesBuffered += BytesLeft(bufPtr);      }      return bytesBuffered; @@ -6437,28 +7317,17 @@ Tcl_SetChannelBufferSize(      ChannelState *statePtr;	/* State of real channel structure. */      /* -     * If the buffer size is smaller than 1 byte or larger than one MByte, do -     * not accept the requested size and leave the current buffer size. +     * Clip the buffer size to force it into the [1,1M] range       */      if (sz < 1) { -	return; -    } -    if (sz > (1024 * 1024)) { -	return; +	sz = 1; +    } else if (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)); -    }  }  /* @@ -6520,22 +7389,23 @@ Tcl_GetChannelBufferSize(  int  Tcl_BadChannelOption(      Tcl_Interp *interp,		/* Current interpreter (can be NULL).*/ -    CONST char *optionName,	/* 'bad option' name */ -    CONST char *optionList)	/* Specific options list to append to the +    const char *optionName,	/* 'bad option' name */ +    const char *optionList)	/* Specific options list to append to the  				 * standard generic options. Can be NULL for  				 * generic options only. */  {      if (interp != NULL) { -	CONST char *genericopt = +	const char *genericopt =  		"blocking buffering buffersize encoding eofchar translation"; -	CONST char **argv; +	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), @@ -6543,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; @@ -6581,13 +7452,14 @@ int  Tcl_GetChannelOption(      Tcl_Interp *interp,		/* For error reporting - can be NULL. */      Tcl_Channel chan,		/* Channel on which to get option. */ -    CONST char *optionName,	/* Option to get. */ +    const char *optionName,	/* Option to get. */      Tcl_DString *dsPtr)		/* Where to store value(s). */  {      size_t len;			/* Length of optionName string. */      char optionVal[128];	/* Buffer for sprintf. */      Channel *chanPtr = (Channel *) chan; -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      int flags;      /* @@ -6611,12 +7483,10 @@ Tcl_GetChannelOption(       * If we are in the middle of a background copy, use the saved flags.       */ -    if (statePtr->csPtr) { -	if (chanPtr == statePtr->csPtr->readPtr) { -	    flags = statePtr->csPtr->readFlags; -	} else { -	    flags = statePtr->csPtr->writeFlags; -	} +    if (statePtr->csPtrR) { +	flags = statePtr->csPtrR->readFlags; +    } else if (statePtr->csPtrW) { +	flags = statePtr->csPtrW->writeFlags;      } else {  	flags = statePtr->flags;      } @@ -6632,8 +7502,7 @@ Tcl_GetChannelOption(  	len = strlen(optionName);      } -    if ((len == 0) || ((len > 2) && (optionName[1] == 'b') && -	    (strncmp(optionName, "-blocking", len) == 0))) { +    if (len == 0 || HaveOpt(2, "-blocking")) {  	if (len == 0) {  	    Tcl_DStringAppendElement(dsPtr, "-blocking");  	} @@ -6643,8 +7512,7 @@ Tcl_GetChannelOption(  	    return TCL_OK;  	}      } -    if ((len == 0) || ((len > 7) && (optionName[1] == 'b') && -	    (strncmp(optionName, "-buffering", len) == 0))) { +    if (len == 0 || HaveOpt(7, "-buffering")) {  	if (len == 0) {  	    Tcl_DStringAppendElement(dsPtr, "-buffering");  	} @@ -6659,8 +7527,7 @@ Tcl_GetChannelOption(  	    return TCL_OK;  	}      } -    if ((len == 0) || ((len > 7) && (optionName[1] == 'b') && -	    (strncmp(optionName, "-buffersize", len) == 0))) { +    if (len == 0 || HaveOpt(7, "-buffersize")) {  	if (len == 0) {  	    Tcl_DStringAppendElement(dsPtr, "-buffersize");  	} @@ -6670,8 +7537,7 @@ Tcl_GetChannelOption(  	    return TCL_OK;  	}      } -    if ((len == 0) || ((len > 2) && (optionName[1] == 'e') && -	    (strncmp(optionName, "-encoding", len) == 0))) { +    if (len == 0 || HaveOpt(2, "-encoding")) {  	if (len == 0) {  	    Tcl_DStringAppendElement(dsPtr, "-encoding");  	} @@ -6685,8 +7551,7 @@ Tcl_GetChannelOption(  	    return TCL_OK;  	}      } -    if ((len == 0) || ((len > 2) && (optionName[1] == 'e') && -	    (strncmp(optionName, "-eofchar", len) == 0))) { +    if (len == 0 || HaveOpt(2, "-eofchar")) {  	if (len == 0) {  	    Tcl_DStringAppendElement(dsPtr, "-eofchar");  	} @@ -6729,8 +7594,7 @@ Tcl_GetChannelOption(  	    return TCL_OK;  	}      } -    if ((len == 0) || ((len > 1) && (optionName[1] == 't') && -	    (strncmp(optionName, "-translation", len) == 0))) { +    if (len == 0 || HaveOpt(1, "-translation")) {  	if (len == 0) {  	    Tcl_DStringAppendElement(dsPtr, "-translation");  	} @@ -6775,14 +7639,15 @@ Tcl_GetChannelOption(  	    return TCL_OK;  	}      } +      if (chanPtr->typePtr->getOptionProc != NULL) {  	/*  	 * Let the driver specific handle additional options and result code  	 * 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. @@ -6816,23 +7681,26 @@ int  Tcl_SetChannelOption(      Tcl_Interp *interp,		/* For error reporting - can be NULL. */      Tcl_Channel chan,		/* Channel on which to set mode. */ -    CONST char *optionName,	/* Which option to set? */ -    CONST char *newValue)	/* New value for option. */ +    const char *optionName,	/* Which option to set? */ +    const char *newValue)	/* New value for option. */  { -    Channel *chanPtr = (Channel *) chan;	/* The real IO channel. */ -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    Channel *chanPtr = (Channel *) chan; +				/* The real IO channel. */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      size_t len;			/* Length of optionName string. */      int argc; -    CONST char **argv; +    const char **argv;      /*       * If the channel is in the middle of a background copy, fail.       */ -    if (statePtr->csPtr) { +    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;      } @@ -6856,9 +7724,9 @@ Tcl_SetChannelOption(      len = strlen(optionName); -    if ((len > 2) && (optionName[1] == 'b') && -	    (strncmp(optionName, "-blocking", len) == 0)) { +    if (HaveOpt(2, "-blocking")) {  	int newMode; +  	if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {  	    return TCL_ERROR;  	} @@ -6868,37 +7736,33 @@ Tcl_SetChannelOption(  	    newMode = TCL_MODE_NONBLOCKING;  	}  	return SetBlockMode(interp, chanPtr, newMode); -    } else if ((len > 7) && (optionName[1] == 'b') && -	    (strncmp(optionName, "-buffering", len) == 0)) { +    } 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)) { -	    statePtr->flags &= (~(CHANNEL_UNBUFFERED)); -	    statePtr->flags |= CHANNEL_LINEBUFFERED; +	    ResetFlag(statePtr, CHANNEL_UNBUFFERED); +	    SetFlag(statePtr, CHANNEL_LINEBUFFERED);  	} else if ((newValue[0] == 'n') &&  		(strncmp(newValue, "none", len) == 0)) { -	    statePtr->flags &= (~(CHANNEL_LINEBUFFERED)); -	    statePtr->flags |= CHANNEL_UNBUFFERED; -	} else { -	    if (interp) { -		Tcl_AppendResult(interp, "bad value for -buffering: ", -			"must be one of full, line, or none", NULL); -		return TCL_ERROR; -	    } +	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED); +	    SetFlag(statePtr, CHANNEL_UNBUFFERED); +	} 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 ((len > 7) && (optionName[1] == 'b') && -	    (strncmp(optionName, "-buffersize", len) == 0)) { +    } else if (HaveOpt(7, "-buffersize")) {  	int newBufferSize; +  	if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {  	    return TCL_ERROR;  	}  	Tcl_SetChannelBufferSize(chan, newBufferSize); -    } else if ((len > 2) && (optionName[1] == 'e') && -	    (strncmp(optionName, "-encoding", len) == 0)) { +    } else if (HaveOpt(2, "-encoding")) {  	Tcl_Encoding encoding;  	if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) { @@ -6915,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); @@ -6926,79 +7791,82 @@ Tcl_SetChannelOption(  	statePtr->inputEncodingFlags = TCL_ENCODING_START;  	statePtr->outputEncodingState = NULL;  	statePtr->outputEncodingFlags = TCL_ENCODING_START; -	statePtr->flags &= ~CHANNEL_NEED_MORE_DATA; +	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);  	UpdateInterest(chanPtr); -    } else if ((len > 2) && (optionName[1] == 'e') && -	    (strncmp(optionName, "-eofchar", len) == 0)) { +    } else if (HaveOpt(2, "-eofchar")) {  	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {  	    return TCL_ERROR;  	}  	if (argc == 0) {  	    statePtr->inEofChar = 0;  	    statePtr->outEofChar = 0; -	} else if (argc == 1) { -	    if (statePtr->flags & TCL_WRITABLE) { -		statePtr->outEofChar = (int) argv[0][0]; +	} else if (argc == 1 || argc == 2) { +	    int outIndex = (argc - 1); +	    int inValue = (int) argv[0][0]; +	    int outValue = (int) argv[outIndex][0]; + +	    if (inValue & 0x80 || outValue & 0x80) { +		if (interp) { +		    Tcl_SetObjResult(interp, Tcl_NewStringObj( +                            "bad value for -eofchar: must be non-NUL ASCII" +                            " character", -1)); +		} +		ckfree(argv); +		return TCL_ERROR;  	    } -	    if (statePtr->flags & TCL_READABLE) { -		statePtr->inEofChar = (int) argv[0][0]; +	    if (GotFlag(statePtr, TCL_READABLE)) { +		statePtr->inEofChar = inValue;  	    } -	} else if (argc != 2) { -	    if (interp) { -		Tcl_AppendResult(interp, -			"bad value for -eofchar: should be a list of zero,", -			" one, or two elements", NULL); +	    if (GotFlag(statePtr, TCL_WRITABLE)) { +		statePtr->outEofChar = outValue;  	    } -	    ckfree((char *) argv); -	    return TCL_ERROR;  	} else { -	    if (statePtr->flags & TCL_READABLE) { -		statePtr->inEofChar = (int) argv[0][0]; -	    } -	    if (statePtr->flags & TCL_WRITABLE) { -		statePtr->outEofChar = (int) argv[1][0]; +	    if (interp) { +		Tcl_SetObjResult(interp, Tcl_NewStringObj( +			"bad value for -eofchar: should be a list of zero," +			" one, or two elements", -1));  	    } +	    ckfree(argv); +	    return TCL_ERROR;  	}  	if (argv != NULL) { -	    ckfree((char *) argv); +	    ckfree(argv);  	}  	/* -	 * [SF Tcl Bug 930851] Reset EOF and BLOCKED flags. Changing the -	 * character which signals eof can transform a current eof condition -	 * into a 'go ahead'. Ditto for blocked. +	 * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character +	 * which signals eof can transform a current eof condition into a 'go +	 * 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 ((len > 1) && (optionName[1] == 't') && -	    (strncmp(optionName, "-translation", len) == 0)) { -	CONST char *readMode, *writeMode; +    } else if (HaveOpt(1, "-translation")) { +	const char *readMode, *writeMode;  	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {  	    return TCL_ERROR;  	}  	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, -			"bad value for -translation: must be a one or two", -			" element list", NULL); +		Tcl_SetObjResult(interp, Tcl_NewStringObj( +			"bad value for -translation: must be a one or two" +			" 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) { @@ -7018,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;  	    } @@ -7035,8 +7902,7 @@ Tcl_SetChannelOption(  	    if (translation != statePtr->inputTranslation) {  		statePtr->inputTranslation = translation; -		statePtr->flags &= ~(INPUT_SAW_CR); -		statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA); +		ResetFlag(statePtr, INPUT_SAW_CR | CHANNEL_NEED_MORE_DATA);  		UpdateInterest(chanPtr);  	    }  	} @@ -7070,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);      } @@ -7096,28 +7961,14 @@ Tcl_SetChannelOption(  	RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);  	statePtr->saveInBufPtr = NULL;      } -    if (statePtr->inQueueHead != NULL) { -	if ((statePtr->inQueueHead->nextPtr == NULL) -		&& (statePtr->inQueueHead->nextAdded == -			statePtr->inQueueHead->nextRemoved)) { -	    RecycleBuffer(statePtr, statePtr->inQueueHead, 1); -	    statePtr->inQueueHead = NULL; -	    statePtr->inQueueTail = NULL; -	} +    if ((statePtr->inQueueHead != NULL) +	    && (statePtr->inQueueHead->nextPtr == NULL) +	    && IsBufferEmpty(statePtr->inQueueHead)) { +	RecycleBuffer(statePtr, statePtr->inQueueHead, 1); +	statePtr->inQueueHead = NULL; +	statePtr->inQueueTail = NULL;      } -    /* -     * If encoding or bufsize changes, need to update output staging buffer. -     */ - -    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)); -    }      return TCL_OK;  } @@ -7145,7 +7996,8 @@ CleanupChannelHandlers(      Tcl_Interp *interp,      Channel *chanPtr)  { -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      EventScriptRecord *sPtr, *prevPtr, *nextPtr;      /* @@ -7164,10 +8016,10 @@ CleanupChannelHandlers(  	    }  	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, -		    TclChannelEventScriptInvoker, (ClientData) sPtr); +		    TclChannelEventScriptInvoker, sPtr);  	    TclDecrRefCount(sPtr->scriptPtr); -	    ckfree((char *) sPtr); +	    ckfree(sPtr);  	} else {  	    prevPtr = sPtr;  	} @@ -7200,12 +8052,13 @@ Tcl_NotifyChannel(  				 * which events were detected. */  {      Channel *chanPtr = (Channel *) channel; -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      ChannelHandler *chPtr;      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      NextChannelHandler nh;      Channel *upChanPtr; -    Tcl_ChannelType *upTypePtr; +    const Tcl_ChannelType *upTypePtr;  #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING      /* @@ -7215,10 +8068,10 @@ Tcl_NotifyChannel(       */      if ((mask & TCL_READABLE) && -	    (statePtr->flags & CHANNEL_NONBLOCKING) && +	    GotFlag(statePtr, CHANNEL_NONBLOCKING) &&  	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) && -	    !(statePtr->flags & CHANNEL_TIMER_FEV)) { -	statePtr->flags |= CHANNEL_HAS_MORE_DATA; +	    !GotFlag(statePtr, CHANNEL_TIMER_FEV)) { +	SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);      }  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ @@ -7234,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);  	}  	/* @@ -7271,8 +8124,8 @@ Tcl_NotifyChannel(       * Preserve the channel struct in case the script closes it.       */ -    Tcl_Preserve((ClientData) channel); -    Tcl_Preserve((ClientData) statePtr); +    Tcl_Preserve(channel); +    Tcl_Preserve(statePtr);      /*       * If we are flushing in the background, be sure to call FlushChannel for @@ -7280,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;      } @@ -7302,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; @@ -7319,8 +8172,8 @@ Tcl_NotifyChannel(  	UpdateInterest(chanPtr);      } -    Tcl_Release((ClientData) statePtr); -    Tcl_Release((ClientData) channel); +    Tcl_Release(statePtr); +    Tcl_Release(channel);      tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;  } @@ -7346,15 +8199,21 @@ static void  UpdateInterest(      Channel *chanPtr)		/* Channel to update. */  { -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* 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;      } @@ -7366,10 +8225,9 @@ UpdateInterest(       */      if (mask & TCL_READABLE) { -	if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA) +	if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)  		&& (statePtr->inQueueHead != NULL) -		&& (statePtr->inQueueHead->nextRemoved < -			statePtr->inQueueHead->nextAdded)) { +		&& IsBufferReady(statePtr->inQueueHead)) {  	    mask &= ~TCL_READABLE;  	    /* @@ -7413,12 +8271,12 @@ UpdateInterest(  	    mask &= ~TCL_EXCEPTION;  	    if (!statePtr->timer) { -		statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, -			(ClientData) chanPtr); +		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, +                        ChannelTimerProc, chanPtr);  	    }  	}      } -    (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask); +    ChanWatch(chanPtr, mask);  }  /* @@ -7442,21 +8300,21 @@ static void  ChannelTimerProc(      ClientData clientData)  { -    Channel *chanPtr = (Channel *) clientData; -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    Channel *chanPtr = clientData; +    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) -	    && (statePtr->inQueueHead->nextRemoved < -		    statePtr->inQueueHead->nextAdded)) { +	    && IsBufferReady(statePtr->inQueueHead)) {  	/*  	 * Restart the timer in case a channel handler reenters the event loop  	 * before UpdateInterest gets called by Tcl_NotifyChannel.  	 */ -	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc, -		(ClientData) chanPtr); +	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, +                ChannelTimerProc,chanPtr);  #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING  	/* @@ -7467,20 +8325,20 @@ ChannelTimerProc(  	 * similar test is done in "PeekAhead".  	 */ -	if ((statePtr->flags & CHANNEL_NONBLOCKING) && -	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) { -	    statePtr->flags |= CHANNEL_TIMER_FEV; +	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((ClientData) statePtr); -	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE); +	Tcl_Preserve(statePtr); +	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);  #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING -	statePtr->flags &= ~CHANNEL_TIMER_FEV; +	ResetFlag(statePtr, CHANNEL_TIMER_FEV);  #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */ -	Tcl_Release((ClientData) statePtr); +	Tcl_Release(statePtr);      } else {  	statePtr->timer = NULL;  	UpdateInterest(chanPtr); @@ -7522,7 +8380,8 @@ Tcl_CreateChannelHandler(  {      ChannelHandler *chPtr;      Channel *chanPtr = (Channel *) chan; -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      /*       * Check whether this channel handler is not already registered. If it is @@ -7537,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; @@ -7595,7 +8454,8 @@ Tcl_DeleteChannelHandler(      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ChannelHandler *chPtr, *prevChPtr;      Channel *chanPtr = (Channel *) chan; -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      NextChannelHandler *nhPtr;      /* @@ -7640,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 @@ -7681,7 +8541,8 @@ DeleteScriptRecord(      int mask)			/* Events in mask must exactly match mask of  				 * script to delete. */  { -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      EventScriptRecord *esPtr, *prevEsPtr;      for (esPtr = statePtr->scriptRecordPtr, prevEsPtr = NULL; esPtr != NULL; @@ -7690,14 +8551,15 @@ DeleteScriptRecord(  	    if (esPtr == statePtr->scriptRecordPtr) {  		statePtr->scriptRecordPtr = esPtr->nextPtr;  	    } else { +		CLANG_ASSERT(prevEsPtr);  		prevEsPtr->nextPtr = esPtr->nextPtr;  	    }  	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, -		    TclChannelEventScriptInvoker, (ClientData) esPtr); +		    TclChannelEventScriptInvoker, esPtr);  	    TclDecrRefCount(esPtr->scriptPtr); -	    ckfree((char *) esPtr); +	    ckfree(esPtr);  	    break;  	} @@ -7730,8 +8592,10 @@ CreateScriptRecord(  				 * invoked. */      Tcl_Obj *scriptPtr)		/* Pointer to script object. */  { -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      EventScriptRecord *esPtr; +    int makeCH;      for (esPtr=statePtr->scriptRecordPtr; esPtr!=NULL; esPtr=esPtr->nextPtr) {  	if ((esPtr->interp == interp) && (esPtr->mask == mask)) { @@ -7740,18 +8604,34 @@ CreateScriptRecord(  	    break;  	}      } -    if (esPtr == NULL) { -	esPtr = (EventScriptRecord *) ckalloc(sizeof(EventScriptRecord)); -	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, -		TclChannelEventScriptInvoker, (ClientData) esPtr); -	esPtr->nextPtr = statePtr->scriptRecordPtr; -	statePtr->scriptRecordPtr = esPtr; + +    makeCH = (esPtr == NULL); + +    if (makeCH) { +	esPtr = ckalloc(sizeof(EventScriptRecord));      } + +    /* +     * Initialize the structure before calling Tcl_CreateChannelHandler, +     * 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]. +     */ +      esPtr->chanPtr = chanPtr;      esPtr->interp = interp;      esPtr->mask = mask;      Tcl_IncrRefCount(scriptPtr);      esPtr->scriptPtr = scriptPtr; + +    if (makeCH) { +	esPtr->nextPtr = statePtr->scriptRecordPtr; +	statePtr->scriptRecordPtr = esPtr; + +	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, +		TclChannelEventScriptInvoker, esPtr); +    }  }  /* @@ -7784,10 +8664,10 @@ TclChannelEventScriptInvoker(  				 * in. */      int result;			/* Result of call to eval script. */ -    esPtr	= (EventScriptRecord *) clientData; -    chanPtr	= esPtr->chanPtr; -    mask	= esPtr->mask; -    interp	= esPtr->interp; +    esPtr = clientData; +    chanPtr = esPtr->chanPtr; +    mask = esPtr->mask; +    interp = esPtr->interp;      /*       * We must preserve the interpreter so we can report errors on it later. @@ -7795,7 +8675,8 @@ TclChannelEventScriptInvoker(       * by Tcl_NotifyChannel before calling channel handlers.       */ -    Tcl_Preserve((ClientData) interp); +    Tcl_Preserve(interp); +    Tcl_Preserve(chanPtr);      result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);      /* @@ -7810,9 +8691,10 @@ TclChannelEventScriptInvoker(  	if (chanPtr->typePtr != NULL) {  	    DeleteScriptRecord(interp, chanPtr, mask);  	} -	Tcl_BackgroundError(interp); +	Tcl_BackgroundException(interp, result);      } -    Tcl_Release((ClientData) interp); +    Tcl_Release(chanPtr); +    Tcl_Release(interp);  }  /* @@ -7841,16 +8723,16 @@ Tcl_FileEventObjCmd(      Tcl_Interp *interp,		/* Interpreter in which the channel for which  				 * to create the handler is found. */      int objc,			/* Number of arguments. */ -    Tcl_Obj *CONST objv[])	/* Argument objects. */ +    Tcl_Obj *const objv[])	/* Argument objects. */  {      Channel *chanPtr;		/* The channel to create the handler for. */ -    ChannelState *statePtr;	/* state info for channel */ +    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?"); @@ -7862,16 +8744,16 @@ Tcl_FileEventObjCmd(      }      mask = maskArray[modeIndex]; -    chanName = Tcl_GetString(objv[1]); +    chanName = TclGetString(objv[1]);      chan = Tcl_GetChannel(interp, chanName, NULL); -    if (chan == (Tcl_Channel) NULL) { +    if (chan == NULL) {  	return TCL_ERROR;      }      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;      } @@ -7881,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)) { @@ -7895,7 +8778,7 @@ Tcl_FileEventObjCmd(       * If we are supposed to delete a stored script, do so.       */ -    if (*(Tcl_GetString(objv[3])) == '\0') { +    if (*(TclGetString(objv[3])) == '\0') {  	DeleteScriptRecord(interp, chanPtr, mask);  	return TCL_OK;      } @@ -7914,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 @@ -7933,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; @@ -7950,17 +8872,17 @@ TclCopyChannel(      inStatePtr = inPtr->state;      outStatePtr = outPtr->state; -    if (inStatePtr->csPtr) { +    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 (outStatePtr->csPtr) { +    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;      } @@ -7993,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 @@ -8002,21 +8924,32 @@ 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);      }      csPtr->cmdPtr = cmdPtr; -    inStatePtr->csPtr = csPtr; -    outStatePtr->csPtr = csPtr; + +    inStatePtr->csPtrR  = csPtr; +    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. @@ -8048,15 +8981,15 @@ CopyData(      int mask)			/* Current channel event flags. */  {      Tcl_Interp *interp; -    Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL; -    Tcl_Obj* msg = NULL; +    Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL;      Tcl_Channel inChan, outChan;      ChannelState *inStatePtr, *outStatePtr; -    int result = TCL_OK, size, total, sizeb; -    char *buffer; - -    int inBinary, outBinary, sameEncoding; /* Encoding control */ -    int underflow;		/* input underflow */ +    int result = TCL_OK, size, sizeb; +    Tcl_WideInt total; +    const char *buffer; +    int inBinary, outBinary, sameEncoding; +				/* Encoding control */ +    int underflow;		/* Input underflow */      inChan	= (Tcl_Channel) csPtr->readPtr;      outChan	= (Tcl_Channel) csPtr->writePtr; @@ -8082,69 +9015,89 @@ CopyData(  	Tcl_IncrRefCount(bufObj);      } -    while (csPtr->toRead != 0) { +    while (csPtr->toRead != (Tcl_WideInt) 0) {  	/*  	 * Check for unreported background errors.  	 */ -	Tcl_GetChannelError (inChan, &msg); +	Tcl_GetChannelError(inChan, &msg);  	if ((inStatePtr->unreportedError != 0) || (msg != NULL)) {  	    Tcl_SetErrno(inStatePtr->unreportedError);  	    inStatePtr->unreportedError = 0;  	    goto readError;  	} -	Tcl_GetChannelError (outChan, &msg); +	Tcl_GetChannelError(outChan, &msg);  	if ((outStatePtr->unreportedError != 0) || (msg != NULL)) {  	    Tcl_SetErrno(outStatePtr->unreportedError);  	    outStatePtr->unreportedError = 0;  	    goto writeError;  	} -	/* -	 * Read up to bufSize bytes. -	 */ +	if (cmdPtr && (mask == 0)) { +	    /* +	     * In async mode, we skip reading synchronously and fake an +	     * underflow instead to prime the readable fileevent. +	     */ -	if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) { -	    sizeb = csPtr->bufSize; +	    size = 0; +	    underflow = 1;  	} else { -	    sizeb = csPtr->toRead; -	} +	    /* +	     * Read up to bufSize bytes. +	     */ -	if (inBinary || sameEncoding) { -	    size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb); -	} else { -	    size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, 0 /* No append */); +	    if ((csPtr->toRead == (Tcl_WideInt) -1) +                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { +		sizeb = csPtr->bufSize; +	    } else { +		sizeb = (int) csPtr->toRead; +	    } + +	    if (inBinary || sameEncoding) { +		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, +                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); +	    } else { +		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, +			0 /* No append */); +	    } +	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */  	} -	underflow = (size >= 0) && (size < sizeb);	/* input underflow */  	if (size < 0) {  	readError: -	    TclNewObj(errObj); -	    Tcl_AppendStringsToObj(errObj, "error reading \"", -		    Tcl_GetChannelName(inChan), "\": ", NULL); +	    if (interp) { +		TclNewObj(errObj); +		Tcl_AppendStringsToObj(errObj, "error reading \"", +			Tcl_GetChannelName(inChan), "\": ", NULL); +		if (msg != NULL) { +		    Tcl_AppendObjToObj(errObj, msg); +		} else { +		    Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp), +			    NULL); +		} +	    }  	    if (msg != NULL) { -		Tcl_AppendObjToObj(errObj,msg); -	    } else { -		Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp), NULL); +		Tcl_DecrRefCount(msg);  	    }  	    break;  	} else if (underflow) {  	    /* -	     * We had an underflow on the read side. If we are at EOF, then -	     * the copying is done, otherwise set up a channel handler to -	     * detect when the channel becomes readable again. +	     * We had an underflow on the read side. If we are at EOF, and not +	     * in the synchronous part of an asynchronous fcopy, then the +	     * copying is done, otherwise set up a channel handler to detect +	     * when the channel becomes readable again.  	     */ -	    if ((size == 0) && Tcl_Eof(inChan)) { +	    if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) {  		break;  	    } -	    if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) { +	    if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) && +                !(mask & TCL_READABLE)) {  		if (mask & TCL_WRITABLE) { -		    Tcl_DeleteChannelHandler(outChan, CopyEventProc, -			    (ClientData) csPtr); +		    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);  		}  		Tcl_CreateChannelHandler(inChan, TCL_READABLE, CopyEventProc, -			(ClientData) csPtr); +			csPtr);  	    }  	    if (size == 0) {  		if (bufObj != NULL) { @@ -8163,29 +9116,42 @@ CopyData(  	    buffer = csPtr->buffer;  	    sizeb = size;  	} else { -	    buffer = Tcl_GetStringFromObj(bufObj, &sizeb); +	    buffer = TclGetStringFromObj(bufObj, &sizeb);  	}  	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);  	} -	if (inBinary || sameEncoding) { -	    /* Both read and write counted bytes */ -	    size = sizeb; -	} /* else : Read counted characters, write counted bytes, i.e. size != sizeb */ +	/* +	 * [Bug 2895565]. At this point 'size' still contains the number of +	 * bytes or characters which have been read. We keep this to later to +	 * update the totals and toRead information, see marker (UP) below. We +	 * must not overwrite it with 'sizeb', which is the number of written +	 * bytes or characters, and both EOL translation and encoding +	 * conversion may have changed this number unpredictably in relation +	 * to 'size' (It can be smaller or larger, in the latter case able to +	 * drive toRead below -1, causing infinite looping). Completely +	 * unsuitable for updating totals and toRead. +	 */  	if (sizeb < 0) {  	writeError: -	    TclNewObj(errObj); -	    Tcl_AppendStringsToObj(errObj, "error writing \"", -		    Tcl_GetChannelName(outChan), "\": ", NULL); +	    if (interp) { +		TclNewObj(errObj); +		Tcl_AppendStringsToObj(errObj, "error writing \"", +			Tcl_GetChannelName(outChan), "\": ", NULL); +		if (msg != NULL) { +		    Tcl_AppendObjToObj(errObj, msg); +		} else { +		    Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp), +			    NULL); +		} +	    }  	    if (msg != NULL) { -		Tcl_AppendObjToObj(errObj,msg); -	    } else { -		Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp), NULL); +		Tcl_DecrRefCount(msg);  	    }  	    break;  	} @@ -8217,14 +9183,13 @@ 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, -			    (ClientData) csPtr); +		    Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);  		}  		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, -			CopyEventProc, (ClientData) csPtr); +			CopyEventProc, csPtr);  	    }  	    if (bufObj != NULL) {  		TclDecrRefCount(bufObj); @@ -8238,7 +9203,7 @@ CopyData(  	 * don't starve the rest of the system.  	 */ -	if (cmdPtr) { +	if (cmdPtr && (csPtr->toRead != 0)) {  	    /*  	     * The first time we enter this code, there won't be a channel  	     * handler established yet, so do it here. @@ -8246,7 +9211,7 @@ CopyData(  	    if (mask == 0) {  		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, CopyEventProc, -			(ClientData) csPtr); +			csPtr);  	    }  	    if (bufObj != NULL) {  		TclDecrRefCount(bufObj); @@ -8268,6 +9233,8 @@ 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 @@ -8277,18 +9244,19 @@ CopyData(  	cmdPtr = Tcl_DuplicateObj(cmdPtr);  	Tcl_IncrRefCount(cmdPtr);  	StopCopy(csPtr); -	Tcl_Preserve((ClientData) interp); +	Tcl_Preserve(interp); -	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total)); +	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewWideIntObj(total));  	if (errObj) {  	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);  	} -	if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) { -	    Tcl_BackgroundError(interp); +	code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); +	if (code != TCL_OK) { +	    Tcl_BackgroundException(interp, code);  	    result = TCL_ERROR;  	}  	TclDecrRefCount(cmdPtr); -	Tcl_Release((ClientData) interp); +	Tcl_Release(interp);      } else {  	StopCopy(csPtr);  	if (interp) { @@ -8297,7 +9265,7 @@ CopyData(  		result = TCL_ERROR;  	    } else {  		Tcl_ResetResult(interp); -		Tcl_SetObjResult(interp, Tcl_NewIntObj(total)); +		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));  	    }  	}      } @@ -8309,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 @@ -8327,9 +9294,11 @@ 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 */ +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      int copied;			/* How many characters were copied into the  				 * result string? */      int copiedNow;		/* How many characters were copied from the @@ -8342,23 +9311,24 @@ DoRead(       * operation.       */ -    if (!(statePtr->flags & CHANNEL_STICKY_EOF)) { -	statePtr->flags &= ~CHANNEL_EOF; +    Tcl_Preserve(chanPtr); +    if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) { +	ResetFlag(statePtr, CHANNEL_EOF);      } -    statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); +    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);      for (copied = 0; copied < toRead; copied += copiedNow) {  	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;  		} -		statePtr->flags &= (~(CHANNEL_BLOCKED)); +		ResetFlag(statePtr, CHANNEL_BLOCKED);  	    }  	    result = GetInput(chanPtr);  	    if (result != 0) { @@ -8367,10 +9337,13 @@ DoRead(  		}  		goto done;  	    } -	} +	} else if (allowShortReads) { +            copied += copiedNow; +            break; +        }      } -    statePtr->flags &= (~(CHANNEL_BLOCKED)); +    ResetFlag(statePtr, CHANNEL_BLOCKED);      /*       * Update the notifier state so we don't block while there is still data @@ -8379,6 +9352,7 @@ DoRead(    done:      UpdateInterest(chanPtr); +    Tcl_Release(chanPtr);      return copied;  } @@ -8427,7 +9401,7 @@ CopyAndTranslateBuffer(  	return 0;      }      bufPtr = statePtr->inQueueHead; -    bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved; +    bytesInBuffer = BytesLeft(bufPtr);      copied = 0;      switch (statePtr->inputTranslation) { @@ -8443,8 +9417,7 @@ CopyAndTranslateBuffer(  	if (bytesInBuffer < space) {  	    space = bytesInBuffer;  	} -	memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved), -		(size_t) space); +	memcpy(result, RemovePoint(bufPtr), (size_t) space);  	bufPtr->nextRemoved += space;  	copied = space;  	break; @@ -8463,8 +9436,7 @@ CopyAndTranslateBuffer(  	if (bytesInBuffer < space) {  	    space = bytesInBuffer;  	} -	memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved), -		(size_t) space); +	memcpy(result, RemovePoint(bufPtr), (size_t) space);  	bufPtr->nextRemoved += space;  	copied = space; @@ -8487,22 +9459,21 @@ CopyAndTranslateBuffer(  	    if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==  		    (INPUT_SAW_CR | CHANNEL_EOF)) {  		result[0] = '\r'; -		statePtr->flags &= ~INPUT_SAW_CR; +		ResetFlag(statePtr, INPUT_SAW_CR);  		return 1;  	    }  	    return 0;  	}  	/* -	 * Copy the current chunk and replace "\r\n" with "\n" -	 * (but not standalone "\r"!). +	 * Copy the current chunk and replace "\r\n" with "\n" (but not +	 * standalone "\r"!).  	 */  	if (bytesInBuffer < space) {  	    space = bytesInBuffer;  	} -	memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved), -		(size_t) space); +	memcpy(result, RemovePoint(bufPtr), (size_t) space);  	bufPtr->nextRemoved += space;  	copied = space; @@ -8511,14 +9482,14 @@ CopyAndTranslateBuffer(  	for (src = result; src < end; src++) {  	    curByte = *src;  	    if (curByte == '\n') { -		statePtr->flags &= ~INPUT_SAW_CR; -	    } else if (statePtr->flags & INPUT_SAW_CR) { -		statePtr->flags &= ~INPUT_SAW_CR; +		ResetFlag(statePtr, INPUT_SAW_CR); +	    } else if (GotFlag(statePtr, INPUT_SAW_CR)) { +		ResetFlag(statePtr, INPUT_SAW_CR);  		*dst = '\r';  		dst++;  	    }  	    if (curByte == '\r') { -		statePtr->flags |= INPUT_SAW_CR; +		SetFlag(statePtr, INPUT_SAW_CR);  	    } else {  		*dst = (char) curByte;  		dst++; @@ -8542,8 +9513,7 @@ CopyAndTranslateBuffer(  	if (bytesInBuffer < space) {  	    space = bytesInBuffer;  	} -	memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved), -		(size_t) space); +	memcpy(result, RemovePoint(bufPtr), (size_t) space);  	bufPtr->nextRemoved += space;  	copied = space; @@ -8552,15 +9522,15 @@ CopyAndTranslateBuffer(  	for (src = result; src < end; src++) {  	    curByte = *src;  	    if (curByte == '\r') { -		statePtr->flags |= INPUT_SAW_CR; +		SetFlag(statePtr, INPUT_SAW_CR);  		*dst = '\n';  		dst++;  	    } else { -		if ((curByte != '\n') || !(statePtr->flags & INPUT_SAW_CR)) { +		if ((curByte != '\n') || !GotFlag(statePtr, INPUT_SAW_CR)) {  		    *dst = (char) curByte;  		    dst++;  		} -		statePtr->flags &= ~INPUT_SAW_CR; +		ResetFlag(statePtr, INPUT_SAW_CR);  	    }  	}  	copied = dst - result; @@ -8584,7 +9554,7 @@ CopyAndTranslateBuffer(  		 * caller.  		 */ -		statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF); +		SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);  		statePtr->inputEncodingFlags |= TCL_ENCODING_END;  		copied = i;  		break; @@ -8596,7 +9566,7 @@ CopyAndTranslateBuffer(       * If the current buffer is empty recycle it.       */ -    if (bufPtr->nextRemoved == bufPtr->nextAdded) { +    if (IsBufferEmpty(bufPtr)) {  	statePtr->inQueueHead = bufPtr->nextPtr;  	if (statePtr->inQueueHead == NULL) {  	    statePtr->inQueueTail = NULL; @@ -8655,7 +9625,7 @@ CopyBuffer(  	return 0;      }      bufPtr = chanPtr->inQueueHead; -    bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved; +    bytesInBuffer = BytesLeft(bufPtr);      copied = 0; @@ -8674,8 +9644,7 @@ CopyBuffer(  	space = bytesInBuffer;      } -    memcpy((VOID *) result, (VOID *) (bufPtr->buf + bufPtr->nextRemoved), -	    (size_t) space); +    memcpy(result, RemovePoint(bufPtr), (size_t) space);      bufPtr->nextRemoved += space;      copied = space; @@ -8689,7 +9658,7 @@ CopyBuffer(       * If the current buffer is empty recycle it.       */ -    if (bufPtr->nextRemoved == bufPtr->nextAdded) { +    if (IsBufferEmpty(bufPtr)) {  	chanPtr->inQueueHead = bufPtr->nextPtr;  	if (chanPtr->inQueueHead == NULL) {  	    chanPtr->inQueueTail = NULL; @@ -8707,161 +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 = outBufPtr->bufLength - outBufPtr->nextAdded; -	if (destCopied > srcLen) { -	    destCopied = srcLen; -	} - -	destPtr = outBufPtr->buf + outBufPtr->nextAdded; -	switch (statePtr->outputTranslation) { -	case TCL_TRANSLATE_LF: -	    srcCopied = destCopied; -	    memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied); -	    break; -	case TCL_TRANSLATE_CR: -	    srcCopied = destCopied; -	    memcpy((VOID *) destPtr, (VOID *) 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 (outBufPtr->nextAdded == outBufPtr->bufLength) { -		statePtr->flags |= 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) { -		    statePtr->flags |= BUFFER_READY; -		} -	    } else if (statePtr->flags & CHANNEL_UNBUFFERED) { -		statePtr->flags |= 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 @@ -8882,7 +9696,7 @@ CopyEventProc(      ClientData clientData,      int mask)  { -    (void) CopyData((CopyState *) clientData, mask); +    (void) CopyData(clientData, mask);  }  /* @@ -8920,34 +9734,34 @@ 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);      if (csPtr->cmdPtr) {  	Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc, -		(ClientData) csPtr); +		csPtr);  	if (csPtr->readPtr != csPtr->writePtr) {  	    Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr, -		    CopyEventProc, (ClientData) csPtr); +		    CopyEventProc, csPtr);  	}  	TclDecrRefCount(csPtr->cmdPtr);      } -    inStatePtr->csPtr = NULL; -    outStatePtr->csPtr = NULL; -    ckfree((char *) csPtr); +    inStatePtr->csPtrR = NULL; +    outStatePtr->csPtrW = NULL; +    ckfree(csPtr);  }  /* @@ -8976,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; @@ -9021,8 +9838,9 @@ SetBlockMode(      int mode)			/* One of TCL_MODE_BLOCKING or  				 * TCL_MODE_NONBLOCKING. */  { -    ChannelState *statePtr = chanPtr->state;	/* state info for channel */      int result = 0; +    ChannelState *statePtr = chanPtr->state; +				/* State info for channel */      result = StackSetBlockMode(chanPtr, mode);      if (result != 0) { @@ -9038,9 +9856,10 @@ SetBlockMode(  	     * We still need the interp as the destination of the move.  	     */ -	    if (!TclChanCaughtErrorBypass (interp, (Tcl_Channel) chanPtr)) { -		Tcl_AppendResult(interp, "error setting blocking mode: ", -			Tcl_PosixError(interp), NULL); +	    if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { +		Tcl_SetObjResult(interp, Tcl_ObjPrintf( +                        "error setting blocking mode: %s", +			Tcl_PosixError(interp)));  	    }  	} else {  	    /* @@ -9055,9 +9874,9 @@ SetBlockMode(  	return TCL_ERROR;      }      if (mode == TCL_MODE_BLOCKING) { -	statePtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED)); +	ResetFlag(statePtr, CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED);      } else { -	statePtr->flags |= CHANNEL_NONBLOCKING; +	SetFlag(statePtr, CHANNEL_NONBLOCKING);      }      return TCL_OK;  } @@ -9106,12 +9925,12 @@ Tcl_GetChannelNames(  int  Tcl_GetChannelNamesEx(      Tcl_Interp *interp,		/* Interp for error reporting. */ -    CONST char *pattern)	/* Pattern to filter on. */ +    const char *pattern)	/* Pattern to filter on. */  {      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ChannelState *statePtr; -    CONST char *name;		/* name for channel */ -    Tcl_Obj *resultPtr;		/* pointer to result object */ +    const char *name;		/* Name for channel */ +    Tcl_Obj *resultPtr;		/* Pointer to result object */      Tcl_HashTable *hTblPtr;	/* Hash table of channels. */      Tcl_HashEntry *hPtr;	/* Search variable. */      Tcl_HashSearch hSearch;	/* Search variable. */ @@ -9137,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) { @@ -9205,7 +10025,7 @@ Tcl_IsChannelRegistered(      chanPtr = ((Channel *) chan)->state->bottomChanPtr;      statePtr = chanPtr->state; -    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); +    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);      if (hTblPtr == NULL) {  	return 0;      } @@ -9266,11 +10086,11 @@ Tcl_IsChannelShared(  int  Tcl_IsChannelExisting( -    CONST char *chanName)	/* The name of the channel to look for. */ +    const char *chanName)	/* The name of the channel to look for. */  {      ChannelState *statePtr;      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); -    CONST char *name; +    const char *name;      int chanNameLen;      chanNameLen = strlen(chanName); @@ -9287,7 +10107,7 @@ Tcl_IsChannelExisting(  	}  	if ((*chanName == *name) && -		(memcmp(name, chanName, (size_t) chanNameLen) == 0)) { +		(memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) {  	    return 1;  	}      } @@ -9311,9 +10131,9 @@ Tcl_IsChannelExisting(   *----------------------------------------------------------------------   */ -CONST char * +const char *  Tcl_ChannelName( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */  {      return chanTypePtr->typeName;  } @@ -9336,7 +10156,8 @@ Tcl_ChannelName(  Tcl_ChannelTypeVersion  Tcl_ChannelVersion( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {  	return TCL_CHANNEL_VERSION_2; @@ -9375,12 +10196,12 @@ Tcl_ChannelVersion(  static int  HaveVersion( -    Tcl_ChannelType *chanTypePtr, +    const Tcl_ChannelType *chanTypePtr,      Tcl_ChannelTypeVersion minimumVersion)  {      Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr); -    return ((int)actualVersion) >= ((int)minimumVersion); +    return (PTR2INT(actualVersion)) >= (PTR2INT(minimumVersion));  }  /* @@ -9400,17 +10221,18 @@ HaveVersion(  Tcl_DriverBlockModeProc *  Tcl_ChannelBlockModeProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      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;  }  /* @@ -9431,7 +10253,8 @@ Tcl_ChannelBlockModeProc(  Tcl_DriverCloseProc *  Tcl_ChannelCloseProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      return chanTypePtr->closeProc;  } @@ -9454,7 +10277,8 @@ Tcl_ChannelCloseProc(  Tcl_DriverClose2Proc *  Tcl_ChannelClose2Proc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      return chanTypePtr->close2Proc;  } @@ -9477,7 +10301,8 @@ Tcl_ChannelClose2Proc(  Tcl_DriverInputProc *  Tcl_ChannelInputProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      return chanTypePtr->inputProc;  } @@ -9500,7 +10325,8 @@ Tcl_ChannelInputProc(  Tcl_DriverOutputProc *  Tcl_ChannelOutputProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      return chanTypePtr->outputProc;  } @@ -9523,7 +10349,8 @@ Tcl_ChannelOutputProc(  Tcl_DriverSeekProc *  Tcl_ChannelSeekProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      return chanTypePtr->seekProc;  } @@ -9546,7 +10373,8 @@ Tcl_ChannelSeekProc(  Tcl_DriverSetOptionProc *  Tcl_ChannelSetOptionProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      return chanTypePtr->setOptionProc;  } @@ -9569,7 +10397,8 @@ Tcl_ChannelSetOptionProc(  Tcl_DriverGetOptionProc *  Tcl_ChannelGetOptionProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      return chanTypePtr->getOptionProc;  } @@ -9592,7 +10421,8 @@ Tcl_ChannelGetOptionProc(  Tcl_DriverWatchProc *  Tcl_ChannelWatchProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      return chanTypePtr->watchProc;  } @@ -9615,7 +10445,8 @@ Tcl_ChannelWatchProc(  Tcl_DriverGetHandleProc *  Tcl_ChannelGetHandleProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      return chanTypePtr->getHandleProc;  } @@ -9638,13 +10469,13 @@ Tcl_ChannelGetHandleProc(  Tcl_DriverFlushProc *  Tcl_ChannelFlushProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {  	return chanTypePtr->flushProc; -    } else { -	return NULL;      } +    return NULL;  }  /* @@ -9665,13 +10496,13 @@ Tcl_ChannelFlushProc(  Tcl_DriverHandlerProc *  Tcl_ChannelHandlerProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {  	return chanTypePtr->handlerProc; -    } else { -	return NULL;      } +    return NULL;  }  /* @@ -9692,13 +10523,13 @@ Tcl_ChannelHandlerProc(  Tcl_DriverWideSeekProc *  Tcl_ChannelWideSeekProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {  	return chanTypePtr->wideSeekProc; -    } else { -	return NULL;      } +    return NULL;  }  /* @@ -9720,13 +10551,13 @@ Tcl_ChannelWideSeekProc(  Tcl_DriverThreadActionProc *  Tcl_ChannelThreadActionProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {  	return chanTypePtr->threadActionProc; -    } else { -	return NULL;      } +    return NULL;  }  /* @@ -9754,7 +10585,7 @@ Tcl_SetChannelErrorInterp(      Interp *iPtr = (Interp *) interp;      if (iPtr->chanMsg != NULL) { -	Tcl_DecrRefCount(iPtr->chanMsg); +	TclDecrRefCount(iPtr->chanMsg);  	iPtr->chanMsg = NULL;      } @@ -9787,10 +10618,10 @@ Tcl_SetChannelError(      Tcl_Channel chan,		/* Channel to store the data into. */      Tcl_Obj *msg)		/* Error message to store. */  { -    ChannelState* statePtr = ((Channel*) chan)->state; +    ChannelState *statePtr = ((Channel *) chan)->state;      if (statePtr->chanMsg != NULL) { -	Tcl_DecrRefCount(statePtr->chanMsg); +	TclDecrRefCount(statePtr->chanMsg);  	statePtr->chanMsg = NULL;      } @@ -9824,15 +10655,10 @@ static Tcl_Obj *  FixLevelCode(      Tcl_Obj *msg)  { -    int lc; -    Tcl_Obj **lv; -    int explicitResult; -    int numOptions; -    int lcn; -    Tcl_Obj **lvn; +    int explicitResult, numOptions, lc, lcn; +    Tcl_Obj **lv, **lvn;      int res, i, j, val, lignore, cignore; -    Tcl_Obj *newlevel = NULL; -    Tcl_Obj *newcode = NULL; +    int newlevel = -1, newcode = -1;      /* ASSERT msg != NULL */ @@ -9841,14 +10667,14 @@ FixLevelCode(       *       * Syntax = (option value)... ?message?       * -     * Bad syntax causes a panic. Because the other side uses +     * Bad message syntax causes a panic, because the other side uses       * Tcl_GetReturnOptions and list construction functions to marshall the -     * information. +     * information. Hence an error means that we've got serious breakage.       */      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)); @@ -9872,19 +10698,19 @@ FixLevelCode(  	     * !"error", !integer, integer != 1 (numeric code for error)  	     */ -	    res = Tcl_GetIntFromObj(NULL, lv[i+1], &val); +	    res = TclGetIntFromObj(NULL, lv[i+1], &val);  	    if (((res == TCL_OK) && (val != 1)) || ((res != TCL_OK) &&  		    (0 != strcmp(TclGetString(lv[i+1]), "error")))) { -		newcode = Tcl_NewIntObj(1); +		newcode = 1;  	    }  	} else if (0 == strcmp(TclGetString(lv[i]), "-level")) {  	    /*  	     * !integer, integer != 0  	     */ -	    res = Tcl_GetIntFromObj(NULL, lv [i+1], &val); +	    res = TclGetIntFromObj(NULL, lv [i+1], &val);  	    if ((res != TCL_OK) || (val != 0)) { -		newlevel = Tcl_NewIntObj(0); +		newlevel = 0;  	    }  	}      } @@ -9893,7 +10719,7 @@ FixLevelCode(       * -code, -level are either not present or ok. Nothing to do.       */ -    if (!newlevel && !newcode) { +    if ((newlevel < 0) && (newcode < 0)) {  	return msg;      } @@ -9901,14 +10727,14 @@ FixLevelCode(      if (explicitResult) {  	lcn ++;      } -    if (newlevel) { +    if (newlevel >= 0) {  	lcn += 2;      } -    if (newcode) { +    if (newcode >= 0) {  	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 @@ -9920,20 +10746,20 @@ FixLevelCode(      lignore = cignore = 0;      for (i=0, j=0; i<numOptions; i+=2) {  	if (0 == strcmp(TclGetString(lv[i]), "-level")) { -	    if (newlevel) { +	    if (newlevel >= 0) {  		lvn[j++] = lv[i]; -		lvn[j++] = newlevel; -		newlevel = NULL; +		lvn[j++] = Tcl_NewIntObj(newlevel); +		newlevel = -1;  		lignore = 1;  		continue;  	    } else if (lignore) {  		continue;  	    }  	} else if (0 == strcmp(TclGetString(lv[i]), "-code")) { -	    if (newcode) { +	    if (newcode >= 0) {  		lvn[j++] = lv[i]; -		lvn[j++] = newcode; -		newcode = NULL; +		lvn[j++] = Tcl_NewIntObj(newcode); +		newcode = -1;  		cignore = 1;  		continue;  	    } else if (cignore) { @@ -9948,6 +10774,12 @@ FixLevelCode(  	lvn[j++] = lv[i];  	lvn[j++] = lv[i+1];      } +    if (newlevel >= 0) { +	Tcl_Panic("Defined newlevel not used in rewrite"); +    } +    if (newcode >= 0) { +	Tcl_Panic("Defined newcode not used in rewrite"); +    }      if (explicitResult) {  	lvn[j++] = lv[i]; @@ -9955,7 +10787,7 @@ FixLevelCode(      msg = Tcl_NewListObj(j, lvn); -    ckfree((char *) lvn); +    ckfree(lvn);      return msg;  } @@ -10034,13 +10866,130 @@ Tcl_GetChannelError(  Tcl_DriverTruncateProc *  Tcl_ChannelTruncateProc( -    Tcl_ChannelType *chanTypePtr)	/* Pointer to channel type. */ +    const Tcl_ChannelType *chanTypePtr) +				/* Pointer to channel type. */  {      if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) {  	return chanTypePtr->truncateProc; -    } else { -	return NULL;      } +    return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * DupChannelIntRep -- + * + *	Initialize the internal representation of a new Tcl_Obj to a copy of + *	the internal representation of an existing string object. + * + * Results: + *	None. + * + * Side effects: + *	copyPtr's internal rep is set to a copy of srcPtr's internal + *	representation. + * + *---------------------------------------------------------------------- + */ + +static void +DupChannelIntRep( +    register Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have +				 * an internal rep of type "Channel". */ +    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not +				 * currently have an internal rep.*/ +{ +    ChannelState *statePtr  = GET_CHANNELSTATE(srcPtr); + +    SET_CHANNELSTATE(copyPtr, statePtr); +    SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr)); +    Tcl_Preserve(statePtr); +    copyPtr->typePtr = srcPtr->typePtr; +} + +/* + *---------------------------------------------------------------------- + * + * SetChannelFromAny -- + * + *	Create an internal representation of type "Channel" for an object. + * + * Results: + *	This operation always succeeds and returns TCL_OK. + * + * Side effects: + *	Any old internal reputation for objPtr is freed and the internal + *	representation is set to "Channel". + * + *---------------------------------------------------------------------- + */ + +static int +SetChannelFromAny( +    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */ +    register Tcl_Obj *objPtr)	/* The object to convert. */ +{ +    ChannelState *statePtr; + +    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); +	if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) { +	    ResetFlag(statePtr, CHANNEL_TAINTED); +	    Tcl_Release(statePtr); +	    objPtr->typePtr = NULL; +	} else if (interp != GET_CHANNELINTERP(objPtr)) { +	    Tcl_Release(statePtr); +	    objPtr->typePtr = NULL; +	} +    } +    if (objPtr->typePtr != &chanObjType) { +	Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL); + +	if (chan == NULL) { +	    return TCL_ERROR; +	} + +	TclFreeIntRep(objPtr); +	statePtr = ((Channel *) chan)->state; +	Tcl_Preserve(statePtr); +	SET_CHANNELSTATE(objPtr, statePtr); +	SET_CHANNELINTERP(objPtr, interp); +	objPtr->typePtr = &chanObjType; +    } +    return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * FreeChannelIntRep -- + * + *	Release statePtr storage. + * + * Results: + *	None. + * + * Side effects: + *	May cause state to be freed. + * + *---------------------------------------------------------------------- + */ + +static void +FreeChannelIntRep( +    Tcl_Obj *objPtr)		/* Object with internal rep to free. */ +{ +    Tcl_Release(GET_CHANNELSTATE(objPtr)); +    objPtr->typePtr = NULL;  }  #if 0 @@ -10057,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); @@ -10092,5 +11041,7 @@ DumpFlags(   * mode: c   * c-basic-offset: 4   * fill-column: 78 + * tab-width: 8 + * indent-tabs-mode: nil   * End:   */ | 
