/* 

  * tclIO.c --

  *

  *	This file provides the generic portions (those that are the same on

  *	all platforms and for all channel types) of Tcl's IO facilities.

  *

  * Copyright (c) 1998-2000 Ajuba Solutions

  * Copyright (c) 1995-1997 Sun Microsystems, Inc.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  *

  * 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.61.2.23 2007/05/24 19:31:55 dgp Exp $

  */

 #include "tclInt.h"

 #include "tclPort.h"

 #include "tclIO.h"

 #include <assert.h>

 #if defined(__SYMBIAN32__) && defined(__WINSCW__)

 #include "tclSymbianGlobals.h"

 #define dataKey getdataKey(3)

 #endif 

 #ifndef TCL_INHERIT_STD_CHANNELS

 #define TCL_INHERIT_STD_CHANNELS 1

 #endif

 /*

  * 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.

  *

  * Notice that different structures with the same name appear in other

  * files.  The structure defined below is used in this file only.

  */

 typedef struct ThreadSpecificData {

     /*

      * This variable holds the list of nested ChannelHandlerEventProc 

      * invocations.

      */

     NextChannelHandler *nestedHandlerPtr;

     /*

      * List of all channels currently open, indexed by ChannelState,

      * as only one ChannelState exists per set of stacked channels.

      */

     ChannelState *firstCSPtr;

 #ifdef oldcode

     /*

      * Has a channel exit handler been created yet?

      */

     int channelExitHandlerCreated;

     /*

      * Has the channel event source been created and registered with the

      * notifier?

      */

     int channelEventSourceCreated;

 #endif

     /*

      * Static variables to hold channels for stdin, stdout and stderr.

      */

     Tcl_Channel stdinChannel;

     int stdinInitialized;

     Tcl_Channel stdoutChannel;

     int stdoutInitialized;

     Tcl_Channel stderrChannel;

     int stderrInitialized;

 } ThreadSpecificData;

 #if !defined(__SYMBIAN32__) || !defined(__WINSCW__)

 static Tcl_ThreadDataKey dataKey;

 #endif

 /*

  * Static functions in this file:

  */

 static ChannelBuffer *	AllocChannelBuffer _ANSI_ARGS_((int length));

 static void		ChannelTimerProc _ANSI_ARGS_((

 				ClientData clientData));

 static int		CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr,

 				int direction));

 static int		CheckFlush _ANSI_ARGS_((Channel *chanPtr,

 				ChannelBuffer *bufPtr, int newlineFlag));

 static int		CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,

 				ChannelState *statePtr));

 static void		CheckForStdChannelsBeingClosed _ANSI_ARGS_((

 				Tcl_Channel chan));

 static void		CleanupChannelHandlers _ANSI_ARGS_((

 				Tcl_Interp *interp, Channel *chanPtr));

 static int		CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,

 				Channel *chanPtr, int errorCode));

 static void		CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,

 				Tcl_Encoding encoding));

 static int		CopyAndTranslateBuffer _ANSI_ARGS_((

 				ChannelState *statePtr, char *result,

 				int space));

 static int		CopyBuffer _ANSI_ARGS_((

 				Channel *chanPtr, char *result, int space));

 static int		CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));

 static void		CopyEventProc _ANSI_ARGS_((ClientData clientData,

 				int mask));

 static void		CreateScriptRecord _ANSI_ARGS_((

 				Tcl_Interp *interp, Channel *chanPtr,

 				int mask, Tcl_Obj *scriptPtr));

 static void		DeleteChannelTable _ANSI_ARGS_((

 				ClientData clientData, Tcl_Interp *interp));

 static void		DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,

 				Channel *chanPtr, int mask));

 static int              DetachChannel _ANSI_ARGS_((Tcl_Interp *interp,

 				Tcl_Channel chan));

 static void		DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,

 				int discardSavedBuffers));

 static void		DiscardOutputQueued _ANSI_ARGS_((

 				ChannelState *chanPtr));

 static int		DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,

 				int slen));

 static int		DoWrite _ANSI_ARGS_((Channel *chanPtr, CONST char *src,

 				int srcLen));

 static int		DoReadChars _ANSI_ARGS_ ((Channel* chan,

 				Tcl_Obj* objPtr, int toRead, int appendFlag));

 static int		DoWriteChars _ANSI_ARGS_ ((Channel* chan,

 				CONST char* src, int len));

 static int		FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,

 				GetsState *statePtr));

 static int		FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,

 				Channel *chanPtr, int calledFromAsyncFlush));

 static Tcl_HashTable *	GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));

 static int		GetInput _ANSI_ARGS_((Channel *chanPtr));

 static int		HaveVersion _ANSI_ARGS_((Tcl_ChannelType *typePtr,

 				Tcl_ChannelTypeVersion minimumVersion));

 static void		PeekAhead _ANSI_ARGS_((Channel *chanPtr,

 				char **dstEndPtr, GetsState *gsPtr));

 static int		ReadBytes _ANSI_ARGS_((ChannelState *statePtr,

 				Tcl_Obj *objPtr, int charsLeft,

 				int *offsetPtr));

 static int		ReadChars _ANSI_ARGS_((ChannelState *statePtr,

 				Tcl_Obj *objPtr, int charsLeft,

 				int *offsetPtr, int *factorPtr));

 static void		RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr,

 				ChannelBuffer *bufPtr, int mustDiscard));

 static int		StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr,

 				int mode));

 static int		SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,

 				Channel *chanPtr, int mode));

 static void		StopCopy _ANSI_ARGS_((CopyState *csPtr));

 static int		TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr,

 				char *dst, CONST char *src,

 				int *dstLenPtr, int *srcLenPtr));

 static int		TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr,

 				char *dst, CONST char *src,

 				int *dstLenPtr, int *srcLenPtr));

 static void		UpdateInterest _ANSI_ARGS_((Channel *chanPtr));

 static int		WriteBytes _ANSI_ARGS_((Channel *chanPtr,

 				CONST char *src, int srcLen));

 static int		WriteChars _ANSI_ARGS_((Channel *chanPtr,

 				CONST char *src, int srcLen));

 /*

  *---------------------------------------------------------------------------

  *

  * TclInitIOSubsystem --

  *

  *	Initialize all resources used by this subsystem on a per-process

  *	basis.  

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Depends on the memory subsystems.

  *

  *---------------------------------------------------------------------------

  */

 void

 TclInitIOSubsystem()

 {

     /*

      * By fetching thread local storage we take care of

      * allocating it for each thread.

      */

     (void) TCL_TSD_INIT(&dataKey);

 }   

 /*

  *-------------------------------------------------------------------------

  *

  * TclFinalizeIOSubsystem --

  *

  *	Releases all resources used by this subsystem on a per-thread

  *	basis.  Closes all extant channels that have not already been 

  *	closed because they were not owned by any interp.  

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Depends on encoding and memory subsystems.

  *

  *-------------------------------------------------------------------------

  */

 	/* ARGSUSED */

 void

 TclFinalizeIOSubsystem(void)

 {

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     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 */

     /*

      * Walk all channel state structures known to this thread and

      * close corresponding channels.

      */

     while (active) {

 	/*

 	 * 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.

 	 */

 	active = 0;

 	for (statePtr = tsdPtr->firstCSPtr;

 	     statePtr != NULL;

 	     statePtr = statePtr->nextCSPtr) {

 	    chanPtr = statePtr->topChanPtr;

 	    if (!(statePtr->flags & CHANNEL_DEAD)) {

 		active = 1;

 		break;

 	    }

 	}

 	/*

 	 * We've found a live channel.  Close it.

 	 */

 	if (active) {

 	    /*

 	     * 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.

 		 */

 		statePtr->refCount--;

 	    }

 	    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 {

 		/*

 		 * The refcount is greater than zero, so flush the channel.

 		 */

 		Tcl_Flush((Tcl_Channel) chanPtr);

 		/*

 		 * Call the device driver to actually close the underlying 

 		 * device for this channel.

 		 */

 		if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {

 		    (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);

 		} else {

 		    (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,

 						   NULL, 0);

 		}

 		/*

 		 * 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;

 	    }

 	}

     }

     TclpFinalizeSockets();

     TclpFinalizePipes();

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetStdChannel --

  *

  *	This function is used to change the channels that are used

  *	for stdin/stdout/stderr in new interpreters.

  *

  * Results:

  *	None

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_SetStdChannel(channel, type)

     Tcl_Channel channel;

     int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */

 {

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     switch (type) {

 	case TCL_STDIN:

 	    tsdPtr->stdinInitialized = 1;

 	    tsdPtr->stdinChannel = channel;

 	    break;

 	case TCL_STDOUT:

 	    tsdPtr->stdoutInitialized = 1;

 	    tsdPtr->stdoutChannel = channel;

 	    break;

 	case TCL_STDERR:

 	    tsdPtr->stderrInitialized = 1;

 	    tsdPtr->stderrChannel = channel;

 	    break;

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetStdChannel --

  *

  *	Returns the specified standard channel.

  *

  * Results:

  *	Returns the specified standard channel, or NULL.

  *

  * Side effects:

  *	May cause the creation of a standard channel and the underlying

  *	file.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Channel

 Tcl_GetStdChannel(type)

     int type;			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */

 {

     Tcl_Channel channel = NULL;

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     /*

      * If the channels were not created yet, create them now and

      * store them in the static variables. 

      */

     switch (type) {

 	case TCL_STDIN:

 	    if (!tsdPtr->stdinInitialized) {

 		tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);

 		tsdPtr->stdinInitialized = 1;

 		/*

                  * Artificially bump the refcount to ensure that the channel

                  * is only closed on exit.

                  *

                  * NOTE: Must only do this if stdinChannel is not NULL. It

                  * can be NULL in situations where Tcl is unable to connect

                  * to the standard input.

                  */

                 if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {

                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,

                             tsdPtr->stdinChannel);

                 }

 	    }

 	    channel = tsdPtr->stdinChannel;

 	    break;

 	case TCL_STDOUT:

 	    if (!tsdPtr->stdoutInitialized) {

 		tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);

 		tsdPtr->stdoutInitialized = 1;

                 if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {

                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,

                             tsdPtr->stdoutChannel);

                 }

 	    }

 	    channel = tsdPtr->stdoutChannel;

 	    break;

 	case TCL_STDERR:

 	    if (!tsdPtr->stderrInitialized) {

 		tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);

 		tsdPtr->stderrInitialized = 1;

                 if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {

                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,

                             tsdPtr->stderrChannel);

                 }

 	    }

 	    channel = tsdPtr->stderrChannel;

 	    break;

     }

     return channel;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_CreateCloseHandler

  *

  *	Creates a close callback which will be called when the channel is

  *	closed.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Causes the callback to be called in the future when the channel

  *	will be closed.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_CreateCloseHandler(chan, proc, clientData)

     Tcl_Channel chan;		/* The channel for which to create the

                                  * close callback. */

     Tcl_CloseProc *proc;	/* The callback routine to call when the

                                  * channel will be closed. */

     ClientData clientData;	/* Arbitrary data to pass to the

                                  * close callback. */

 {

     ChannelState *statePtr;

     CloseCallback *cbPtr;

     statePtr = ((Channel *) chan)->state;

     cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));

     cbPtr->proc = proc;

     cbPtr->clientData = clientData;

     cbPtr->nextPtr = statePtr->closeCbPtr;

     statePtr->closeCbPtr = cbPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_DeleteCloseHandler --

  *

  *	Removes a callback that would have been called on closing

  *	the channel. If there is no matching callback then this

  *	function has no effect.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The callback will not be called in the future when the channel

  *	is eventually closed.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_DeleteCloseHandler(chan, proc, clientData)

     Tcl_Channel chan;		/* The channel for which to cancel the

                                  * close callback. */

     Tcl_CloseProc *proc;	/* The procedure for the callback to

                                  * remove. */

     ClientData clientData;	/* The callback data for the callback

                                  * to remove. */

 {

     ChannelState *statePtr;

     CloseCallback *cbPtr, *cbPrevPtr;

     statePtr = ((Channel *) chan)->state;

     for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;

 	 cbPtr != (CloseCallback *) NULL;

 	 cbPtr = cbPtr->nextPtr) {

         if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {

             if (cbPrevPtr == (CloseCallback *) NULL) {

                 statePtr->closeCbPtr = cbPtr->nextPtr;

             }

             ckfree((char *) cbPtr);

             break;

         } else {

             cbPrevPtr = cbPtr;

         }

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * GetChannelTable --

  *

  *	Gets and potentially initializes the channel table for an

  *	interpreter. If it is initializing the table it also inserts

  *	channels for stdin, stdout and stderr if the interpreter is

  *	trusted.

  *

  * Results:

  *	A pointer to the hash table created, for use by the caller.

  *

  * Side effects:

  *	Initializes the channel table for an interpreter. May create

  *	channels for stdin, stdout and stderr.

  *

  *----------------------------------------------------------------------

  */

 static Tcl_HashTable *

 GetChannelTable(interp)

     Tcl_Interp *interp;

 {

     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */

     Tcl_Channel stdinChan, stdoutChan, stderrChan;

     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);

     if (hTblPtr == (Tcl_HashTable *) NULL) {

         hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));

         Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);

         (void) Tcl_SetAssocData(interp, "tclIO",

                 (Tcl_InterpDeleteProc *) DeleteChannelTable,

                 (ClientData) hTblPtr);

         /*

          * If the interpreter is trusted (not "safe"), insert channels

          * for stdin, stdout and stderr (possibly creating them in the

          * process).

          */

         if (Tcl_IsSafe(interp) == 0) {

             stdinChan = Tcl_GetStdChannel(TCL_STDIN);

             if (stdinChan != NULL) {

                 Tcl_RegisterChannel(interp, stdinChan);

             }

             stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);

             if (stdoutChan != NULL) {

                 Tcl_RegisterChannel(interp, stdoutChan);

             }

             stderrChan = Tcl_GetStdChannel(TCL_STDERR);

             if (stderrChan != NULL) {

                 Tcl_RegisterChannel(interp, stderrChan);

             }

         }

     }

     return hTblPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * DeleteChannelTable --

  *

  *	Deletes the channel table for an interpreter, closing any open

  *	channels whose refcount reaches zero. This procedure is invoked

  *	when an interpreter is deleted, via the AssocData cleanup

  *	mechanism.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Deletes the hash table of channels. May close channels. May flush

  *	output on closed channels. Removes any channeEvent handlers that were

  *	registered in this interpreter.

  *

  *----------------------------------------------------------------------

  */

 static void

 DeleteChannelTable(clientData, interp)

     ClientData clientData;	/* The per-interpreter data structure. */

     Tcl_Interp *interp;		/* The interpreter being deleted. */

 {

     Tcl_HashTable *hTblPtr;	/* The hash table. */

     Tcl_HashSearch hSearch;	/* Search variable. */

     Tcl_HashEntry *hPtr;	/* Search variable. */

     Channel *chanPtr;		/* Channel being deleted. */

     ChannelState *statePtr;	/* State of Channel being deleted. */

     EventScriptRecord *sPtr, *prevPtr, *nextPtr;

     				/* Variables to loop over all channel events

                                  * registered, to delete the ones that refer

                                  * to the interpreter being deleted. */

     /*

      * Delete all the registered channels - this will close channels whose

      * refcount reaches zero.

      */

     hTblPtr = (Tcl_HashTable *) clientData;

     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);

 	 hPtr != (Tcl_HashEntry *) NULL;

 	 hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {

         chanPtr = (Channel *) Tcl_GetHashValue(hPtr);

 	statePtr = chanPtr->state;

         /*

          * Remove any fileevents registered in this interpreter.

          */

         for (sPtr = statePtr->scriptRecordPtr,

                  prevPtr = (EventScriptRecord *) NULL;

 	     sPtr != (EventScriptRecord *) NULL;

 	     sPtr = nextPtr) {

             nextPtr = sPtr->nextPtr;

             if (sPtr->interp == interp) {

                 if (prevPtr == (EventScriptRecord *) NULL) {

                     statePtr->scriptRecordPtr = nextPtr;

                 } else {

                     prevPtr->nextPtr = nextPtr;

                 }

                 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,

                         TclChannelEventScriptInvoker, (ClientData) sPtr);

 		Tcl_DecrRefCount(sPtr->scriptPtr);

                 ckfree((char *) sPtr);

             } else {

                 prevPtr = sPtr;

             }

         }

         /*

          * Cannot call Tcl_UnregisterChannel because that procedure calls

          * Tcl_GetAssocData to get the channel table, which might already

          * be inaccessible from the interpreter structure. Instead, we

          * emulate the behavior of Tcl_UnregisterChannel directly here.

          */

         Tcl_DeleteHashEntry(hPtr);

         statePtr->refCount--;

         if (statePtr->refCount <= 0) {

             if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {

                 (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);

             }

         }

     }

     Tcl_DeleteHashTable(hTblPtr);

     ckfree((char *) hTblPtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * CheckForStdChannelsBeingClosed --

  *

  *	Perform special handling for standard channels being closed. When

  *	given a standard channel, if the refcount is now 1, it means that

  *	the last reference to the standard channel is being explicitly

  *	closed. Now bump the refcount artificially down to 0, to ensure the

  *	normal handling of channels being closed will occur. Also reset the

  *	static pointer to the channel to NULL, to avoid dangling references.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Manipulates the refcount on standard channels. May smash the global

  *	static pointer to a standard channel.

  *

  *----------------------------------------------------------------------

  */

 static void

 CheckForStdChannelsBeingClosed(chan)

     Tcl_Channel chan;

 {

     ChannelState *statePtr = ((Channel *) chan)->state;

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {

         if (statePtr->refCount < 2) {

             statePtr->refCount = 0;

             tsdPtr->stdinChannel = NULL;

             return;

         }

     } else if ((chan == tsdPtr->stdoutChannel)

 	    && (tsdPtr->stdoutInitialized)) {

         if (statePtr->refCount < 2) {

             statePtr->refCount = 0;

             tsdPtr->stdoutChannel = NULL;

             return;

         }

     } else if ((chan == tsdPtr->stderrChannel)

 	    && (tsdPtr->stderrInitialized)) {

         if (statePtr->refCount < 2) {

             statePtr->refCount = 0;

             tsdPtr->stderrChannel = NULL;

             return;

         }

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_IsStandardChannel --

  *

  *	Test if the given channel is a standard channel.  No attempt

  *	is made to check if the channel or the standard channels

  *	are initialized or otherwise valid.

  *

  * Results:

  *	Returns 1 if true, 0 if false.

  *

  * Side effects:

  *      None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int 

 Tcl_IsStandardChannel(chan)

     Tcl_Channel chan;		/* Channel to check. */

 {

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     if ((chan == tsdPtr->stdinChannel) 

 	|| (chan == tsdPtr->stdoutChannel)

 	|| (chan == tsdPtr->stderrChannel)) {

 	return 1;

     } else {

 	return 0;

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_RegisterChannel --

  *

  *	Adds an already-open channel to the channel table of an interpreter.

  *	If the interpreter passed as argument is NULL, it only increments

  *	the channel refCount.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	May increment the reference count of a channel.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_RegisterChannel(interp, chan)

     Tcl_Interp *interp;		/* Interpreter in which to add the channel. */

     Tcl_Channel chan;		/* The channel to add to this interpreter

                                  * channel table. */

 {

     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */

     Tcl_HashEntry *hPtr;	/* Search variable. */

     int new;			/* Is the hash entry new or does it exist? */

     Channel *chanPtr;		/* The actual channel. */

     ChannelState *statePtr;	/* State of the actual channel. */

     /*

      * Always (un)register bottom-most channel in the stack.  This makes

      * management of the channel list easier because no manipulation is

      * necessary during (un)stack operation.

      */

     chanPtr = ((Channel *) chan)->state->bottomChanPtr;

     statePtr = chanPtr->state;

     if (statePtr->channelName == (CONST char *) NULL) {

         panic("Tcl_RegisterChannel: channel without name");

     }

     if (interp != (Tcl_Interp *) NULL) {

         hTblPtr = GetChannelTable(interp);

         hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);

         if (new == 0) {

             if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {

                 return;

             }

 	    panic("Tcl_RegisterChannel: duplicate channel names");

         }

         Tcl_SetHashValue(hPtr, (ClientData) chanPtr);

     }

     statePtr->refCount++;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_UnregisterChannel --

  *

  *	Deletes the hash entry for a channel associated with an interpreter.

  *	If the interpreter given as argument is NULL, it only decrements the

  *	reference count.  (This all happens in the Tcl_DetachChannel helper

  *	function).

  *	

  *	Finally, if the reference count of the channel drops to zero,

  *	it is deleted.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	Calls Tcl_DetachChannel which deletes the hash entry for a channel 

  *	associated with an interpreter.

  *	

  *	May delete the channel, which can have a variety of consequences,

  *	especially if we are forced to close the channel.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_UnregisterChannel(interp, chan)

     Tcl_Interp *interp;		/* Interpreter in which channel is defined. */

     Tcl_Channel chan;		/* Channel to delete. */

 {

     ChannelState *statePtr;	/* State of the real channel. */

     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;

     if (statePtr->flags & CHANNEL_INCLOSE) {

         if (interp != (Tcl_Interp*) NULL) {

 	    Tcl_AppendResult(interp, 

 	     "Illegal recursive call to close through close-handler of channel",

 	     (char *) NULL);

 	}

         return TCL_ERROR;

     }

     if (DetachChannel(interp, chan) != TCL_OK) {

         return TCL_OK;

     }

     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;

     /*

      * Perform special handling for standard channels being closed. If the

      * refCount is now 1 it means that the last reference to the standard

      * channel is being explicitly closed, so bump the refCount down

      * artificially to 0. This will ensure that the channel is actually

      * closed, below. Also set the static pointer to NULL for the channel.

      */

     CheckForStdChannelsBeingClosed(chan);

     /*

      * If the refCount reached zero, close the actual channel.

      */

     if (statePtr->refCount <= 0) {

         /*

          * Ensure that if there is another buffer, it gets flushed

          * whether or not we are doing a background flush.

          */

         if ((statePtr->curOutPtr != NULL) &&

                 (statePtr->curOutPtr->nextAdded >

                         statePtr->curOutPtr->nextRemoved)) {

             statePtr->flags |= BUFFER_READY;

         }

 	Tcl_Preserve((ClientData)statePtr);

         if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {

 	    /* We don't want to re-enter Tcl_Close */

 	    if (!(statePtr->flags & CHANNEL_CLOSED)) {

 		if (Tcl_Close(interp, chan) != TCL_OK) {

 		    statePtr->flags |= CHANNEL_CLOSED;

 		    Tcl_Release((ClientData)statePtr);

 		    return TCL_ERROR;

 		}

 	    }

         }

         statePtr->flags |= CHANNEL_CLOSED;

 	Tcl_Release((ClientData)statePtr);

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_DetachChannel --

  *

  *	Deletes the hash entry for a channel associated with an interpreter.

  *	If the interpreter given as argument is NULL, it only decrements the

  *	reference count.  Even if the ref count drops to zero, the 

  *	channel is NOT closed or cleaned up.  This allows a channel to

  *	be detached from an interpreter and left in the same state it

  *	was in when it was originally returned by 'Tcl_OpenFileChannel',

  *	for example.

  *	

  *	This function cannot be used on the standard channels, and

  *	will return TCL_ERROR if that is attempted.

  *	

  *	This function should only be necessary for special purposes

  *	in which you need to generate a pristine channel from one

  *	that has already been used.  All ordinary purposes will almost

  *	always want to use Tcl_UnregisterChannel instead.

  *	

  *	Provided the channel is not attached to any other interpreter,

  *	it can then be closed with Tcl_Close, rather than with 

  *	Tcl_UnregisterChannel.

  *

  * Results:

  *	A standard Tcl result.  If the channel is not currently registered

  *	with the given interpreter, TCL_ERROR is returned, otherwise

  *	TCL_OK.  However no error messages are left in the interp's result.

  *

  * Side effects:

  *	Deletes the hash entry for a channel associated with an 

  *	interpreter.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_DetachChannel(interp, chan)

     Tcl_Interp *interp;		/* Interpreter in which channel is defined. */

     Tcl_Channel chan;		/* Channel to delete. */

 {

     if (Tcl_IsStandardChannel(chan)) {

         return TCL_ERROR;

     }

     return DetachChannel(interp, chan);

 }

 /*

  *----------------------------------------------------------------------

  *

  * DetachChannel --

  *

  *	Deletes the hash entry for a channel associated with an interpreter.

  *	If the interpreter given as argument is NULL, it only decrements the

  *	reference count.  Even if the ref count drops to zero, the 

  *	channel is NOT closed or cleaned up.  This allows a channel to

  *	be detached from an interpreter and left in the same state it

  *	was in when it was originally returned by 'Tcl_OpenFileChannel',

  *	for example.

  *

  * Results:

  *	A standard Tcl result.  If the channel is not currently registered

  *	with the given interpreter, TCL_ERROR is returned, otherwise

  *	TCL_OK.  However no error messages are left in the interp's result.

  *

  * Side effects:

  *	Deletes the hash entry for a channel associated with an 

  *	interpreter.

  *

  *----------------------------------------------------------------------

  */

 static int

 DetachChannel(interp, chan)

     Tcl_Interp *interp;		/* Interpreter in which channel is defined. */

     Tcl_Channel chan;		/* Channel to delete. */

 {

     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */

     Tcl_HashEntry *hPtr;	/* Search variable. */

     Channel *chanPtr;		/* The real IO channel. */

     ChannelState *statePtr;	/* State of the real channel. */

     /*

      * Always (un)register bottom-most channel in the stack.  This makes

      * management of the channel list easier because no manipulation is

      * necessary during (un)stack operation.

      */

     chanPtr = ((Channel *) chan)->state->bottomChanPtr;

     statePtr = chanPtr->state;

     if (interp != (Tcl_Interp *) NULL) {

 	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);

 	if (hTblPtr == (Tcl_HashTable *) NULL) {

 	    return TCL_ERROR;

 	}

 	hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);

 	if (hPtr == (Tcl_HashEntry *) NULL) {

 	    return TCL_ERROR;

 	}

 	if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {

 	    return TCL_ERROR;

 	}

 	Tcl_DeleteHashEntry(hPtr);

 	/*

 	 * Remove channel handlers that refer to this interpreter, so that they

 	 * will not be present if the actual close is delayed and more events

 	 * happen on the channel. This may occur if the channel is shared

 	 * between several interpreters, or if the channel has async

 	 * flushing active.

 	 */

 	CleanupChannelHandlers(interp, chanPtr);

     }

     statePtr->refCount--;

     return TCL_OK;

 }

 /*

  *---------------------------------------------------------------------------

  *

  * Tcl_GetChannel --

  *

  *	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.

  *

  *---------------------------------------------------------------------------

  */

 EXPORT_C Tcl_Channel

 Tcl_GetChannel(interp, chanName, modePtr)

     Tcl_Interp *interp;		/* Interpreter in which to find or create

                                  * 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

                                  * TCL_WRITABLE, if non-NULL. */

 {

     Channel *chanPtr;		/* The actual channel. */

     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */

     Tcl_HashEntry *hPtr;	/* Search variable. */

     CONST char *name;		/* Translated name. */

     /*

      * Substitute "stdin", etc.  Note that even though we immediately

      * find the channel using Tcl_GetStdChannel, we still need to look

      * it up in the specified interpreter to ensure that it is present

      * in the channel table.  Otherwise, safe interpreters would always

      * have access to the standard channels.

      */

     name = chanName;

     if ((chanName[0] == 's') && (chanName[1] == 't')) {

 	chanPtr = NULL;

 	if (strcmp(chanName, "stdin") == 0) {

 	    chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN);

 	} else if (strcmp(chanName, "stdout") == 0) {

 	    chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT);

 	} else if (strcmp(chanName, "stderr") == 0) {

 	    chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR);

 	}

 	if (chanPtr != NULL) {

 	    name = chanPtr->state->channelName;

 	}

     }

     hTblPtr = GetChannelTable(interp);

     hPtr = Tcl_FindHashEntry(hTblPtr, name);

     if (hPtr == (Tcl_HashEntry *) NULL) {

         Tcl_AppendResult(interp, "can not find channel named \"",

                 chanName, "\"", (char *) NULL);

         return NULL;

     }

     /*

      * Always return bottom-most channel in the stack.  This one lives

      * the longest - other channels may go away unnoticed.

      * The other APIs compensate where necessary to retrieve the

      * topmost channel again.

      */

     chanPtr = (Channel *) Tcl_GetHashValue(hPtr);

     chanPtr = chanPtr->state->bottomChanPtr;

     if (modePtr != NULL) {

         *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));

     }

     return (Tcl_Channel) chanPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_CreateChannel --

  *

  *	Creates a new entry in the hash table for a Tcl_Channel

  *	record.

  *

  * Results:

  *	Returns the new Tcl_Channel.

  *

  * Side effects:

  *	Creates a new Tcl_Channel instance and inserts it into the

  *	hash table.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Channel

 Tcl_CreateChannel(typePtr, chanName, instanceData, mask)

     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. */

 {

     Channel *chanPtr;		/* The channel structure newly created. */

     ChannelState *statePtr;	/* The stack-level independent state info

 				 * for the channel. */

     CONST char *name;

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     /*

      * With the change of the Tcl_ChannelType structure to use a version in

      * 8.3.2+, we have to make sure that our assumption that the structure

      * remains a binary compatible size is true.

      *

      * If this assertion fails on some system, then it can be removed

      * only if the user recompiles code with older channel drivers in

      * the new system as well.

      */

     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((unsigned) sizeof(Channel));

     statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState));

     chanPtr->state = statePtr;

     chanPtr->instanceData	= instanceData;

     chanPtr->typePtr		= typePtr;

     /*

      * Set all the bits that are part of the stack-independent state

      * information for the channel.

      */

     if (chanName != (char *) NULL) {

 	char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));

         statePtr->channelName = tmp;

         strcpy(tmp, chanName);

     } else {

         panic("Tcl_CreateChannel: NULL channel name");

     }

     statePtr->flags		= mask;

     /*

      * Set the channel to system default encoding.

      */

     statePtr->encoding = NULL;

     name = Tcl_GetEncodingName(NULL);

     if (strcmp(name, "binary") != 0) {

     	statePtr->encoding = Tcl_GetEncoding(NULL, name);

     }

     statePtr->inputEncodingState	= NULL;

     statePtr->inputEncodingFlags	= TCL_ENCODING_START;

     statePtr->outputEncodingState	= NULL;

     statePtr->outputEncodingFlags	= TCL_ENCODING_START;

     /*

      * 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.

      */

     statePtr->inputTranslation	= TCL_TRANSLATE_AUTO;

     statePtr->outputTranslation	= TCL_PLATFORM_TRANSLATION;

     statePtr->inEofChar		= 0;

     statePtr->outEofChar	= 0;

     statePtr->unreportedError	= 0;

     statePtr->refCount		= 0;

     statePtr->closeCbPtr	= (CloseCallback *) NULL;

     statePtr->curOutPtr		= (ChannelBuffer *) NULL;

     statePtr->outQueueHead	= (ChannelBuffer *) NULL;

     statePtr->outQueueTail	= (ChannelBuffer *) NULL;

     statePtr->saveInBufPtr	= (ChannelBuffer *) NULL;

     statePtr->inQueueHead	= (ChannelBuffer *) NULL;

     statePtr->inQueueTail	= (ChannelBuffer *) NULL;

     statePtr->chPtr		= (ChannelHandler *) NULL;

     statePtr->interestMask	= 0;

     statePtr->scriptRecordPtr	= (EventScriptRecord *) NULL;

     statePtr->bufSize		= CHANNELBUFFER_DEFAULT_SIZE;

     statePtr->timer		= NULL;

     statePtr->csPtr		= 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

      */

     statePtr->topChanPtr	= chanPtr;

     statePtr->bottomChanPtr	= chanPtr;

     chanPtr->downChanPtr	= (Channel *) NULL;

     chanPtr->upChanPtr		= (Channel *) NULL;

     chanPtr->inQueueHead        = (ChannelBuffer*) NULL;

     chanPtr->inQueueTail        = (ChannelBuffer*) NULL;

     /*

      * Link the channel into the list of all channels; create an on-exit

      * handler if there is not one already, to close off all the channels

      * in the list on exit.

      *

      * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.

      *

      * TIP #218.

      * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel

      *     We need Tcl_SpliceChannel, for the threadAction calls.

      *     There is no real reason to duplicate all of this.

      * NOTE: All drivers using thread actions now have to perform their TSD

      *       manipulation only in their thread action proc. Doing it when

      *       creating their instance structures will collide with the thread

      *       action activity and lead to damaged lists.

      */

     statePtr->nextCSPtr = (ChannelState *) NULL;

     Tcl_SpliceChannel ((Tcl_Channel) chanPtr);

     /*

      * Install this channel in the first empty standard channel slot, if

      * the channel was previously closed explicitly.

      */

 #if TCL_INHERIT_STD_CHANNELS

     if ((tsdPtr->stdinChannel == NULL) &&

 	    (tsdPtr->stdinInitialized == 1)) {

 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);

         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);

     } else if ((tsdPtr->stdoutChannel == NULL) &&

 	    (tsdPtr->stdoutInitialized == 1)) {

 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);

         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);

     } else if ((tsdPtr->stderrChannel == NULL) &&

 	    (tsdPtr->stderrInitialized == 1)) {

 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);

         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);

     }

 #endif

     return (Tcl_Channel) chanPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_StackChannel --

  *

  *	Replaces an entry in the hash table for a Tcl_Channel

  *	record. The replacement is a new channel with same name,

  *	it supercedes the replaced channel. Input and output of

  *	the superceded channel is now going through the newly

  *	created channel and allows the arbitrary filtering/manipulation

  *	of the dataflow.

  *

  *	Andreas Kupries <a.kupries@westend.com>, 12/13/1998

  *	"Trf-Patch for filtering channels"

  *

  * Results:

  *	Returns the new Tcl_Channel, which actually contains the

  *      saved 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Channel

 Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)

     Tcl_Interp	    *interp;	   /* The interpreter we are working in */

     Tcl_ChannelType *typePtr;	   /* The channel type record for the new

 				    * channel. */

     ClientData	     instanceData; /* Instance specific data for the new

 				    * channel. */

     int		     mask;	   /* TCL_READABLE & TCL_WRITABLE to indicate

 				    * if the channel is readable, writable. */

     Tcl_Channel	     prevChan;	   /* The channel structure to replace */

 {

     ThreadSpecificData	*tsdPtr = TCL_TSD_INIT(&dataKey);

     Channel		*chanPtr, *prevChanPtr;

     ChannelState	*statePtr;

     /*

      * Find the given channel in the list of all channels.

      * If we don't find it, then it was never registered correctly.

      *

      * This operation should occur at the top of a channel stack.

      */

     statePtr    = (ChannelState *) tsdPtr->firstCSPtr;

     prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;

     while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {

 	statePtr = statePtr->nextCSPtr;

     }

     if (statePtr == NULL) {

 	if (interp) {

 	    Tcl_AppendResult(interp, "couldn't find state for channel \"",

 		    Tcl_GetChannelName(prevChan), "\"", (char *) NULL);

 	}

         return (Tcl_Channel) NULL;

     }

     /*

      * Here we check if the given "mask" matches the "flags"

      * of the already existing channel.

      *

      *	  | - | R | W | RW |

      *	--+---+---+---+----+	<=>  0 != (chan->mask & prevChan->mask)

      *	- |   |   |   |    |

      *	R |   | + |   | +  |	The superceding channel is allowed to

      *	W |   |   | + | +  |	restrict the capabilities of the

      *	RW|   | + | + | +  |	superceded one !

      *	--+---+---+---+----+

      */

     if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {

 	if (interp) {

 	    Tcl_AppendResult(interp,

 		    "reading and writing both disallowed for channel \"",

 		    Tcl_GetChannelName(prevChan), "\"", (char *) NULL);

 	}

         return (Tcl_Channel) NULL;

     }

     /*

      * Flush the buffers. This ensures that any data still in them

      * at this time is not handled by the new transformation. Restrict

      * this to writable channels. Take care to hide a possible bg-copy

      * in progress from Tcl_Flush and the CheckForChannelErrors inside.

      */

     if ((mask & TCL_WRITABLE) != 0) {

         CopyState *csPtr;

         csPtr           = statePtr->csPtr;

 	statePtr->csPtr = (CopyState*) NULL;

 	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {

 	    statePtr->csPtr = csPtr;

 	    if (interp) {

 		Tcl_AppendResult(interp, "could not flush channel \"",

 			Tcl_GetChannelName(prevChan), "\"", (char *) NULL);

 	    }

 	    return (Tcl_Channel) NULL;

 	}

 	statePtr->csPtr = csPtr;

     }

     /*

      * 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 reading. As the buffers contain the

      * untransformed form their contents are not only useless but actually

      * distorts our view of the system.

      *

      * To preserve the information without having to read them again and

      * to avoid problems with the location in the channel (seeking might

      * be impossible) we move the buffers from the common state structure

      * into the channel itself. We use the buffers in the channel below

      * the new transformation to hold the data. In the future this allows

      * us to write transformations which pre-read data and push the unused

      * part back when they are going away.

      */

     if (((mask & TCL_READABLE) != 0) &&

 	(statePtr->inQueueHead != (ChannelBuffer*) NULL)) {

       /*

        * Remark: It is possible that the channel buffers contain data from

        * some earlier push-backs.

        */

       statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;

       prevChanPtr->inQueueHead       = statePtr->inQueueHead;

       if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) {

 	prevChanPtr->inQueueTail = statePtr->inQueueTail;

       }

       statePtr->inQueueHead          = (ChannelBuffer*) NULL;

       statePtr->inQueueTail          = (ChannelBuffer*) NULL;

     }

     chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));

     /*

      * Save some of the current state into the new structure,

      * reinitialize the parts which will stay with the transformation.

      *

      * Remarks:

      */

     chanPtr->state		= statePtr;

     chanPtr->instanceData	= instanceData;

     chanPtr->typePtr		= typePtr;

     chanPtr->downChanPtr	= prevChanPtr;

     chanPtr->upChanPtr		= (Channel *) NULL;

     chanPtr->inQueueHead        = (ChannelBuffer*) NULL;

     chanPtr->inQueueTail        = (ChannelBuffer*) NULL;

     /*

      * Place new block at the head of a possibly existing list of previously

      * stacked channels.

      */

     prevChanPtr->upChanPtr	= chanPtr;

     statePtr->topChanPtr	= chanPtr;

     return (Tcl_Channel) chanPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_UnstackChannel --

  *

  *	Unstacks an entry in the hash table for a Tcl_Channel

  *	record. This is the reverse to 'Tcl_StackChannel'.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	If TCL_ERROR is returned, the posix error code will be set

  *	with Tcl_SetErrno.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_UnstackChannel (interp, chan)

     Tcl_Interp *interp; /* The interpreter we are working in */

     Tcl_Channel chan;   /* The channel to unstack */

 {

     Channel      *chanPtr  = (Channel *) chan;

     ChannelState *statePtr = chanPtr->state;

     int result = 0;

     /*

      * This operation should occur at the top of a channel stack.

      */

     chanPtr = statePtr->topChanPtr;

     if (chanPtr->downChanPtr != (Channel *) 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.

 	 */

 	Channel *downChanPtr = chanPtr->downChanPtr;

 	/*

 	 * Flush the buffers. This ensures that any data still in them

 	 * at this time _is_ handled by the transformation we are unstacking

 	 * right now. Restrict this to writable channels. Take care to hide

 	 * a possible bg-copy in progress from Tcl_Flush and the

 	 * CheckForChannelErrors inside.

 	 */

 	if (statePtr->flags & TCL_WRITABLE) {

 	    CopyState*    csPtr;

 	    csPtr           = statePtr->csPtr;

 	    statePtr->csPtr = (CopyState*) NULL;

 	    if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {

 	        statePtr->csPtr = csPtr;

 		if (interp) {

 		    Tcl_AppendResult(interp, "could not flush channel \"",

 			    Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",

 			    (char *) NULL);

 		}

 		return TCL_ERROR;

 	    }

 	    statePtr->csPtr = csPtr;

 	}

 	/*

 	 * Anything in the input queue and the push-back buffers of

 	 * the transformation going away is transformed data, but not

 	 * yet read. As unstacking means that the caller does not want

 	 * to see transformed data any more we have to discard these

 	 * bytes. To avoid writing an analogue to 'DiscardInputQueued'

 	 * we move the information in the push back buffers to the

 	 * input queue and then call 'DiscardInputQueued' on that.

 	 */

 	if (((statePtr->flags & TCL_READABLE)  != 0) &&

 	    ((statePtr->inQueueHead != (ChannelBuffer*) NULL) ||

 	     (chanPtr->inQueueHead  != (ChannelBuffer*) NULL))) {

 	    if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) &&

 		(chanPtr->inQueueHead  != (ChannelBuffer*) NULL)) {

 	        statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;

 		statePtr->inQueueTail = chanPtr->inQueueTail;

 	        statePtr->inQueueHead = statePtr->inQueueTail;

 	    } else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {

 	        statePtr->inQueueHead = chanPtr->inQueueHead;

 		statePtr->inQueueTail = chanPtr->inQueueTail;

 	    }

 	    chanPtr->inQueueHead          = (ChannelBuffer*) NULL;

 	    chanPtr->inQueueTail          = (ChannelBuffer*) NULL;

 	    DiscardInputQueued (statePtr, 0);

 	}

 	statePtr->topChanPtr	= downChanPtr;

 	downChanPtr->upChanPtr	= (Channel *) NULL;

 	/*

 	 * Leave this link intact for closeproc

 	 *  chanPtr->downChanPtr	= (Channel *) NULL;

 	 */

 	/*

 	 * 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);

 	}

 	chanPtr->typePtr	= NULL;

 	/*

 	 * AK: Tcl_NotifyChannel may hold a reference to this block of memory

 	 */

 	Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);

 	UpdateInterest(downChanPtr);

 	if (result != 0) {

 	    Tcl_SetErrno(result);

 	    return TCL_ERROR;

 	}

     } else {

         /*

 	 * This channel does not cover another one.

 	 * Simply do a close, if necessary.

 	 */

         if (statePtr->refCount <= 0) {

             if (Tcl_Close(interp, chan) != TCL_OK) {

                 return TCL_ERROR;

             }

 	}

     }

     return TCL_OK;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetStackedChannel --

  *

  *	Determines whether the specified channel is stacked upon another.

  *

  * Results:

  *	NULL if the channel is not stacked upon another one, or a reference

  *	to the channel it is stacked upon. This reference can be used in

  *	queries, but modification is not allowed.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Channel

 Tcl_GetStackedChannel(chan)

     Tcl_Channel chan;

 {

     Channel *chanPtr = (Channel *) chan;	/* The actual channel. */

     return (Tcl_Channel) chanPtr->downChanPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetTopChannel --

  *

  *	Returns the top channel of a channel stack.

  *

  * Results:

  *	NULL if the channel is not stacked upon another one, or a reference

  *	to the channel it is stacked upon. This reference can be used in

  *	queries, but modification is not allowed.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Channel

 Tcl_GetTopChannel(chan)

     Tcl_Channel chan;

 {

     Channel *chanPtr = (Channel *) chan;	/* The actual channel. */

     return (Tcl_Channel) chanPtr->state->topChanPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetChannelInstanceData --

  *

  *	Returns the client data associated with a channel.

  *

  * Results:

  *	The client data.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C ClientData

 Tcl_GetChannelInstanceData(chan)

     Tcl_Channel chan;		/* Channel for which to return client data. */

 {

     Channel *chanPtr = (Channel *) chan;	/* The actual channel. */

     return chanPtr->instanceData;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetChannelThread --

  *

  *	Given a channel structure, returns the thread managing it.

  *	TIP #10

  *

  * Results:

  *	Returns the id of the thread managing the channel.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_ThreadId

 Tcl_GetChannelThread(chan)

     Tcl_Channel chan;		/* The channel to return managing thread for. */

 {

     Channel *chanPtr = (Channel *) chan;	/* The actual channel. */

     return chanPtr->state->managingThread;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetChannelType --

  *

  *	Given a channel structure, returns the channel type structure.

  *

  * Results:

  *	Returns a pointer to the channel type structure.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_ChannelType *

 Tcl_GetChannelType(chan)

     Tcl_Channel chan;		/* The channel to return type for. */

 {

     Channel *chanPtr = (Channel *) chan;	/* The actual channel. */

     return chanPtr->typePtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetChannelMode --

  *

  *	Computes a mask indicating whether the channel is open for

  *	reading and writing.

  *

  * Results:

  *	An OR-ed combination of TCL_READABLE and TCL_WRITABLE.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_GetChannelMode(chan)

     Tcl_Channel chan;		/* The channel for which the mode is

                                  * being computed. */

 {

     ChannelState *statePtr = ((Channel *) chan)->state;

 					/* State of actual channel. */

     return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetChannelName --

  *

  *	Returns the string identifying the channel name.

  *

  * Results:

  *	The string containing the channel name. This memory is

  *	owned by the generic layer and should not be modified by

  *	the caller.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char *

 Tcl_GetChannelName(chan)

     Tcl_Channel chan;		/* The channel for which to return the name. */

 {

     ChannelState *statePtr;	/* State of actual channel. */

     statePtr = ((Channel *) chan)->state;

     return statePtr->channelName;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetChannelHandle --

  *

  *	Returns an OS handle associated with a channel.

  *

  * Results:

  *	Returns TCL_OK and places the handle in handlePtr, or returns

  *	TCL_ERROR on failure.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_GetChannelHandle(chan, direction, handlePtr)

     Tcl_Channel chan;		/* The channel to get file from. */

     int direction;		/* TCL_WRITABLE or TCL_READABLE. */

     ClientData *handlePtr;	/* Where to store handle */

 {

     Channel *chanPtr;		/* The actual channel. */

     ClientData handle;

     int result;

     chanPtr = ((Channel *) chan)->state->bottomChanPtr;

     result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,

 	    direction, &handle);

     if (handlePtr) {

 	*handlePtr = handle;

     }

     return result;

 }

 /*

  *---------------------------------------------------------------------------

  *

  * AllocChannelBuffer --

  *

  *	A channel buffer has BUFFER_PADDING bytes extra at beginning to

  *	hold any bytes of a native-encoding character that got split by

  *	the end of the previous buffer and need to be moved to the

  *	beginning of the next buffer to make a contiguous string so it

  *	can be converted to UTF-8.

  *

  *	A channel buffer has BUFFER_PADDING bytes extra at the end to

  *	hold any bytes of a native-encoding character (generated from a

  *	UTF-8 character) that overflow past the end of the buffer and

  *	need to be moved to the next buffer.

  *

  * Results:

  *	A newly allocated channel buffer.

  *

  * Side effects:

  *	None.

  *

  *---------------------------------------------------------------------------

  */

 static ChannelBuffer *

 AllocChannelBuffer(length)

     int length;			/* Desired length of channel buffer. */

 {

     ChannelBuffer *bufPtr;

     int n;

     n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;

     bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);

     bufPtr->nextAdded	= BUFFER_PADDING;

     bufPtr->nextRemoved	= BUFFER_PADDING;

     bufPtr->bufLength	= length + BUFFER_PADDING;

     bufPtr->nextPtr	= (ChannelBuffer *) NULL;

     return bufPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * RecycleBuffer --

  *

  *	Helper function to recycle input and output buffers. Ensures

  *	that two input buffers are saved (one in the input queue and

  *	another in the saveInBufPtr field) and that curOutPtr is set

  *	to a buffer. Only if these conditions are met is the buffer

  *	freed to the OS.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	May free a buffer to the OS.

  *

  *----------------------------------------------------------------------

  */

 static void

 RecycleBuffer(statePtr, bufPtr, mustDiscard)

     ChannelState *statePtr;	/* ChannelState in which to recycle buffers. */

     ChannelBuffer *bufPtr;	/* The buffer to recycle. */

     int mustDiscard;		/* If nonzero, free the buffer to the

                                  * OS, always. */

 {

     /*

      * Do we have to free the buffer to the OS?

      */

     if (mustDiscard) {

         ckfree((char *) bufPtr);

         return;

     }

     /*

      * Only save buffers which are at least as big as the requested

      * buffersize for the channel. This is to honor dynamic changes

      * of the buffersize made by the user.

      */

     if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {

         ckfree((char *) bufPtr);

         return;

     }

     /*

      * Only save buffers for the input queue if the channel is readable.

      */

     if (statePtr->flags & TCL_READABLE) {

         if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {

             statePtr->inQueueHead = bufPtr;

             statePtr->inQueueTail = bufPtr;

             goto keepit;

         }

         if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) {

             statePtr->saveInBufPtr = bufPtr;

             goto keepit;

         }

     }

     /*

      * Only save buffers for the output queue if the channel is writable.

      */

     if (statePtr->flags & TCL_WRITABLE) {

         if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {

             statePtr->curOutPtr = bufPtr;

             goto keepit;

         }

     }

     /*

      * If we reached this code we return the buffer to the OS.

      */

     ckfree((char *) bufPtr);

     return;

     keepit:

     bufPtr->nextRemoved = BUFFER_PADDING;

     bufPtr->nextAdded = BUFFER_PADDING;

     bufPtr->nextPtr = (ChannelBuffer *) NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * DiscardOutputQueued --

  *

  *	Discards all output queued in the output queue of a channel.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Recycles buffers.

  *

  *----------------------------------------------------------------------

  */

 static void

 DiscardOutputQueued(statePtr)

     ChannelState *statePtr;	/* ChannelState for which to discard output. */

 {

     ChannelBuffer *bufPtr;

     while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {

         bufPtr = statePtr->outQueueHead;

         statePtr->outQueueHead = bufPtr->nextPtr;

         RecycleBuffer(statePtr, bufPtr, 0);

     }

     statePtr->outQueueHead = (ChannelBuffer *) NULL;

     statePtr->outQueueTail = (ChannelBuffer *) NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * CheckForDeadChannel --

  *

  *	This function checks is a given channel is Dead.

  *      (A channel that has been closed but not yet deallocated.)

  *

  * Results:

  *	True (1) if channel is Dead, False (0) if channel is Ok

  *

  * Side effects:

  *      None

  *

  *----------------------------------------------------------------------

  */

 static int

 CheckForDeadChannel(interp, statePtr)

     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",

 		    (char *) NULL);   

 	}

 	return 1;

     }

     return 0;

 }

 /*

  *----------------------------------------------------------------------

  *

  * 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.

  *

  * Results:

  *	0 if successful, else the error code that was returned by the

  *	channel type operation.

  *

  * Side effects:

  *	May produce output on a channel. May block indefinitely if the

  *	channel is synchronous. May schedule an async flush on the channel.

  *	May recycle memory for buffers in the output queue.

  *

  *----------------------------------------------------------------------

  */

 static int

 FlushChannel(interp, chanPtr, calledFromAsyncFlush)

     Tcl_Interp *interp;			/* For error reporting during close. */

     Channel *chanPtr;			/* The channel to flush on. */

     int calledFromAsyncFlush;		/* If nonzero then we are being

                                          * called from an asynchronous

                                          * flush callback. */

 {

     ChannelState *statePtr = chanPtr->state;

 					/* State of the channel stack. */

     ChannelBuffer *bufPtr;		/* Iterates over buffered output

                                          * queue. */

     int toWrite;			/* Amount of output data in current

                                          * buffer available to be written. */

     int written;			/* Amount of output data actually

                                          * written in current round. */

     int errorCode = 0;			/* Stores POSIX error codes from

                                          * channel driver operations. */

     int wroteSome = 0;			/* Set to one if any data was

 					 * written to the driver. */

     /*

      * Prevent writing on a dead channel -- a channel that has been closed

      * but not yet deallocated. This can occur if the exit handler for the

      * channel deallocation runs before all channels are deregistered in

      * all interpreters.

      */

     if (CheckForDeadChannel(interp, statePtr)) return -1;

     /*

      * Loop over the queued buffers and attempt to flush as

      * much as possible of the queued output to the channel.

      */

     while (1) {

         /*

          * If the queue is empty and there is a ready current buffer, OR if

          * the current buffer is full, then move the current buffer to the

          * queue.

          */

         if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&

                 (statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength))

                 || ((statePtr->flags & BUFFER_READY) &&

                         (statePtr->outQueueHead == (ChannelBuffer *) NULL))) {

             statePtr->flags &= (~(BUFFER_READY));

             statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;

             if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {

                 statePtr->outQueueHead = statePtr->curOutPtr;

             } else {

                 statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;

             }

             statePtr->outQueueTail = statePtr->curOutPtr;

             statePtr->curOutPtr = (ChannelBuffer *) NULL;

         }

         bufPtr = statePtr->outQueueHead;

         /*

          * If we are not being called from an async flush and an async

          * flush is active, we just return without producing any output.

          */

         if ((!calledFromAsyncFlush) &&

                 (statePtr->flags & BG_FLUSH_SCHEDULED)) {

             return 0;

         }

         /*

          * If the output queue is still empty, break out of the while loop.

          */

         if (bufPtr == (ChannelBuffer *) NULL) {

             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);

 	/*

          * If the write failed completely attempt to start the asynchronous

          * flush mechanism and break out of this loop - do not attempt to

          * write any more output at this time.

          */

         if (written < 0) {

             /*

              * If the last attempt to write was interrupted, simply retry.

              */

             if (errorCode == EINTR) {

                 errorCode = 0;

                 continue;

             }

             /*

              * If the channel is non-blocking and we would have blocked,

              * start a background flushing handler and break out of the loop.

              */

             if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {

 		/*

 		 * This used to check for CHANNEL_NONBLOCKING, and panic

 		 * if the channel was blocking.  However, it appears

 		 * that setting stdin to -blocking 0 has some effect on

 		 * the stdout when it's a tty channel (dup'ed underneath)

 		 */

 		if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {

 		    statePtr->flags |= BG_FLUSH_SCHEDULED;

 		    UpdateInterest(chanPtr);

 		}

 		errorCode = 0;

 		break;

             }

             /*

              * Decide whether to report the error upwards or defer it.

              */

             if (calledFromAsyncFlush) {

                 if (statePtr->unreportedError == 0) {

                     statePtr->unreportedError = errorCode;

                 }

             } else {

                 Tcl_SetErrno(errorCode);

 		if (interp != NULL) {

 		    /*

 		     * 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);

 		}

             }

             /*

              * When we get an error we throw away all the output

              * currently queued.

              */

             DiscardOutputQueued(statePtr);

             continue;

         } else {

 	    wroteSome = 1;

 	}

         bufPtr->nextRemoved += written;

         /*

          * If this buffer is now empty, recycle it.

          */

         if (bufPtr->nextRemoved == bufPtr->nextAdded) {

             statePtr->outQueueHead = bufPtr->nextPtr;

             if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {

                 statePtr->outQueueTail = (ChannelBuffer *) NULL;

             }

             RecycleBuffer(statePtr, bufPtr, 0);

         }

     }	/* Closes "while (1)". */

     /*

      * If we wrote some data while flushing in the background, we are done.

      * We can't finish the background flush until we run out of data and

      * the channel becomes writable again.  This ensures that all of the

      * pending data has been flushed at the system level.

      */

     if (statePtr->flags & BG_FLUSH_SCHEDULED) {

 	if (wroteSome) {

 	    return errorCode;

 	} else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {

 	    statePtr->flags &= (~(BG_FLUSH_SCHEDULED));

 	    (chanPtr->typePtr->watchProc)(chanPtr->instanceData,

 		    statePtr->interestMask);

 	}

     }

     /*

      * If the channel is flagged as closed, delete it when the refCount

      * drops to zero, the output queue is empty and there is no output

      * in the current output buffer.

      */

     if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&

             (statePtr->outQueueHead == (ChannelBuffer *) NULL) &&

             ((statePtr->curOutPtr == (ChannelBuffer *) NULL) ||

                     (statePtr->curOutPtr->nextAdded ==

                             statePtr->curOutPtr->nextRemoved))) {

 	return CloseChannel(interp, chanPtr, errorCode);

     }

     return errorCode;

 }

 /*

  *----------------------------------------------------------------------

  *

  * CloseChannel --

  *

  *	Utility procedure to close a channel and free associated resources.

  *

  *	If the channel was stacked, then the it will copy the necessary

  *	elements of the NEXT channel into the TOP channel, in essence

  *	unstacking the channel.  The NEXT channel will then be freed.

  *

  *	If the channel was not stacked, then we will free all the bits

  *	for the TOP channel, including the data structure itself.

  *

  * Results:

  *	1 if the channel was stacked, 0 otherwise.

  *

  * Side effects:

  *	May close the actual channel; may free memory.

  *	May change the value of errno.

  *

  *----------------------------------------------------------------------

  */

 static int

 CloseChannel(interp, chanPtr, errorCode)

     Tcl_Interp *interp;			/* For error reporting. */

     Channel *chanPtr;			/* The channel to close. */

     int errorCode;			/* Status of operation so far. */

 {

     int result = 0;			/* Of calling driver close

                                          * operation. */

     ChannelState *statePtr;		/* state of the channel stack. */

     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

     if (chanPtr == NULL) {

         return result;

     }

     statePtr = chanPtr->state;

     /*

      * No more input can be consumed so discard any leftover input.

      */

     DiscardInputQueued(statePtr, 1);

     /*

      * Discard a leftover buffer in the current output buffer field.

      */

     if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {

         ckfree((char *) statePtr->curOutPtr);

         statePtr->curOutPtr = (ChannelBuffer *) NULL;

     }

     /*

      * The caller guarantees that there are no more buffers

      * queued for output.

      */

     if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {

         panic("TclFlush, closed channel: queued output left");

     }

     /*

      * If the EOF character is set in the channel, append that to the

      * output device.

      */

     if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {

         int dummy;

         char c;

         c = (char) statePtr->outEofChar;

         (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);

     }

     /*

      * Remove this channel from of the list of all channels.

      */

     Tcl_CutChannel((Tcl_Channel) chanPtr);

     /*

      * 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);

     }

     /*

      * Some resources can be cleared only if the bottom channel

      * in a stack is closed. All the other channels in the stack

      * are not allowed to remove.

      */

     if (chanPtr == statePtr->bottomChanPtr) {

 	if (statePtr->channelName != (char *) NULL) {

 	    ckfree((char *) statePtr->channelName);

 	    statePtr->channelName = NULL;

 	}

 	Tcl_FreeEncoding(statePtr->encoding);

 	if (statePtr->outputStage != NULL) {

 	    ckfree((char *) statePtr->outputStage);

 	    statePtr->outputStage = (char *) NULL;

 	}

     }

     /*

      * 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;

     }

     if (errorCode == 0) {

         errorCode = result;

         if (errorCode != 0) {

             Tcl_SetErrno(errorCode);

         }

     }

     /*

      * Cancel any outstanding timer.

      */

     Tcl_DeleteTimerHandler(statePtr->timer);

     /*

      * Mark the channel as deleted by clearing the type structure.

      */

     if (chanPtr->downChanPtr != (Channel *) NULL) {

 	Channel *downChanPtr = chanPtr->downChanPtr;

 	statePtr->nextCSPtr	= tsdPtr->firstCSPtr;

 	tsdPtr->firstCSPtr	= statePtr;

 	statePtr->topChanPtr	= downChanPtr;

 	downChanPtr->upChanPtr	= (Channel *) NULL;

 	chanPtr->typePtr	= NULL;

 	Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);

 	return Tcl_Close(interp, (Tcl_Channel) downChanPtr);

     }

     /*

      * There is only the TOP Channel, so we free the remaining

      * pointers we have and then ourselves.  Since this is the

      * last of the channels in the stack, make sure to free the

      * ChannelState structure associated with it.  We use

      * Tcl_EventuallyFree to allow for any last

      */

     chanPtr->typePtr = NULL;

     Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);

     Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);

     return errorCode;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_CutChannel --

  *

  *	Removes a channel from the (thread-)global list of all channels

  *	(in that thread).  This is actually the statePtr for the stack

  *	of channel.

  *

  * Results:

  *	Nothing.

  *

  * Side effects:

  *	Resets the field 'nextCSPtr' of the specified channel state to NULL.

  *

  * NOTE:

  *	The channel to cut out of the list must not be referenced

  *	in any interpreter. This is something this procedure cannot

  *	check (despite the refcount) because the caller usually wants

  *	fiddle with the channel (like transfering it to a different

  *	thread) and thus keeps the refcount artifically high to prevent

  *	its destruction.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_CutChannel(chan)

     Tcl_Channel chan;			/* The channel being removed. Must

                                          * not be referenced in any

                                          * interpreter. */

 {

     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 = ((Channel *) chan)->state;

 					/* state of the channel stack. */

     Tcl_DriverThreadActionProc *threadActionProc;

     /*

      * Remove this channel from of the list of all channels

      * (in the current thread).

      */

     if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {

         tsdPtr->firstCSPtr = statePtr->nextCSPtr;

     } else {

         for (prevCSPtr = tsdPtr->firstCSPtr;

 	     prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);

 	     prevCSPtr = prevCSPtr->nextCSPtr) {

             /* Empty loop body. */

         }

         if (prevCSPtr == (ChannelState *) NULL) {

             panic("FlushChannel: damaged channel list");

         }

         prevCSPtr->nextCSPtr = statePtr->nextCSPtr;

     }

     statePtr->nextCSPtr = (ChannelState *) NULL;

     /* TIP #218, Channel Thread Actions */

     threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));

     if (threadActionProc != NULL) {

         (*threadActionProc) (Tcl_GetChannelInstanceData(chan),

 			     TCL_CHANNEL_THREAD_REMOVE);

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SpliceChannel --

  *

  *	Adds a channel to the (thread-)global list of all channels

  *	(in that thread). Expects that the field 'nextChanPtr' in

  *	the channel is set to NULL.

  *

  * Results:

  *	Nothing.

  *

  * Side effects:

  *	Nothing.

  *

  * NOTE:

  *	The channel to splice into the list must not be referenced in any

  *	interpreter. This is something this procedure cannot check

  *	(despite the refcount) because the caller usually wants figgle

  *	with the channel (like transfering it to a different thread)

  *	and thus keeps the refcount artifically high to prevent its

  *	destruction.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_SpliceChannel(chan)

     Tcl_Channel chan;			/* The channel being added. Must

                                          * not be referenced in any

                                          * interpreter. */

 {

     ThreadSpecificData	*tsdPtr = TCL_TSD_INIT(&dataKey);

     ChannelState	*statePtr = ((Channel *) chan)->state;

     Tcl_DriverThreadActionProc *threadActionProc;

     if (statePtr->nextCSPtr != (ChannelState *) NULL) {

         panic("Tcl_SpliceChannel: trying to add channel used in different list");

     }

     statePtr->nextCSPtr	= tsdPtr->firstCSPtr;

     tsdPtr->firstCSPtr	= statePtr;

     /*

      * TIP #10. Mark the current thread as the new one managing this

      *          channel. Note: 'Tcl_GetCurrentThread' returns sensible

      *          values even for a non-threaded core.

      */

     statePtr->managingThread = Tcl_GetCurrentThread ();

     /* TIP #218, Channel Thread Actions */

     threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));

     if (threadActionProc != NULL) {

         (*threadActionProc) (Tcl_GetChannelInstanceData(chan),

 			     TCL_CHANNEL_THREAD_INSERT);

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_Close --

  *

  *	Closes a channel.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	Closes the channel if this is the last reference.

  *

  * NOTE:

  *	Tcl_Close removes the channel as far as the user is concerned.

  *	However, it may continue to exist for a while longer if it has

  *	a background flush scheduled. The device itself is eventually

  *	closed and the channel record removed, in CloseChannel, above.

  *

  *----------------------------------------------------------------------

  */

 	/* ARGSUSED */

 EXPORT_C int

 Tcl_Close(interp, chan)

     Tcl_Interp *interp;			/* Interpreter for errors. */

     Tcl_Channel chan;			/* The channel being closed. Must

                                          * not be referenced in any

                                          * interpreter. */

 {

     CloseCallback *cbPtr;		/* Iterate over close callbacks

                                          * for this channel. */

     Channel *chanPtr;			/* The real IO channel. */

     ChannelState *statePtr;		/* State of real IO channel. */

     int result;				/* Of calling FlushChannel. */

     if (chan == (Tcl_Channel) NULL) {

         return TCL_OK;

     }

     /*

      * Perform special handling for standard channels being closed. If the

      * refCount is now 1 it means that the last reference to the standard

      * channel is being explicitly closed, so bump the refCount down

      * artificially to 0. This will ensure that the channel is actually

      * closed, below. Also set the static pointer to NULL for the channel.

      */

     CheckForStdChannelsBeingClosed(chan);

     /*

      * This operation should occur at the top of a channel stack.

      */

     chanPtr	= (Channel *) chan;

     statePtr	= chanPtr->state;

     chanPtr	= statePtr->topChanPtr;

     if (statePtr->refCount > 0) {

         panic("called Tcl_Close on channel with refCount > 0");

     }

     if (statePtr->flags & CHANNEL_INCLOSE) {

 	if (interp) {

             Tcl_AppendResult(interp,

 	    "Illegal recursive call to close through close-handler of channel",

 	    (char *) NULL);

 	}

         return TCL_ERROR;

     }

     statePtr->flags |= 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)

 	    && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {

         statePtr->outputEncodingFlags |= TCL_ENCODING_END;

         WriteChars(chanPtr, "", 0);

     }

     Tcl_ClearChannelHandlers(chan);

     /*

      * Invoke the registered close callbacks and delete their records.

      */

     while (statePtr->closeCbPtr != (CloseCallback *) NULL) {

         cbPtr = statePtr->closeCbPtr;

         statePtr->closeCbPtr = cbPtr->nextPtr;

         (cbPtr->proc) (cbPtr->clientData);

         ckfree((char *) cbPtr);

     }

     statePtr->flags &= ~CHANNEL_INCLOSE;

     /*

      * Ensure that the last output buffer will be flushed.

      */

     if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&

 	    (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {

         statePtr->flags |= BUFFER_READY;

     }

     /*

      * If this channel supports it, close the read side, since we don't need it

      * anymore and this will help avoid deadlocks on some channel types.

      */

     if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {

 	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,

 		TCL_CLOSE_READ);