/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclio.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclio.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclio.c revision 44 by dashley, Fri Oct 14 02:09:58 2016 UTC projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclio.c revision 220 by dashley, Sun Jul 22 15:58:07 2018 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclio.c,v 1.1.1.1 2001/06/13 04:42:01 dtashley Exp $ */  
   
 /*  
  * 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 Scriptics Corporation  
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.  
  *  
  * 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.1.1.1 2001/06/13 04:42:01 dtashley Exp $  
  */  
   
 #include "tclInt.h"  
 #include "tclPort.h"  
   
 /*  
  * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not  
  * compile on systems where neither is defined. We want both defined so  
  * that we can test safely for both. In the code we still have to test for  
  * both because there may be systems on which both are defined and have  
  * different values.  
  */  
   
 #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))  
 #   define EWOULDBLOCK EAGAIN  
 #endif  
 #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))  
 #   define EAGAIN EWOULDBLOCK  
 #endif  
 #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))  
     error one of EWOULDBLOCK or EAGAIN must be defined  
 #endif  
   
 /*  
  * 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. */  
     int toRead;                 /* Number of bytes to copy, or -1. */  
     int 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;  
   
 /*  
  * struct ChannelBuffer:  
  *  
  * Buffers data being sent to or from a channel.  
  */  
   
 typedef struct ChannelBuffer {  
     int nextAdded;              /* The next position into which a character  
                                  * will be put in the buffer. */  
     int nextRemoved;            /* Position of next byte to be removed  
                                  * from the buffer. */  
     int bufLength;              /* How big is the buffer? */  
     struct ChannelBuffer *nextPtr;  
                                 /* Next buffer in chain. */  
     char buf[4];                /* Placeholder for real buffer. The real  
                                  * buffer occuppies this space + bufSize-4  
                                  * bytes. This must be the last field in  
                                  * the structure. */  
 } ChannelBuffer;  
   
 #define CHANNELBUFFER_HEADER_SIZE       (sizeof(ChannelBuffer) - 4)  
   
 /*  
  * How much extra space to allocate in buffer to hold bytes from previous  
  * buffer (when converting to UTF-8) or to hold bytes that will go to  
  * next buffer (when converting from UTF-8).  
  */  
   
 #define BUFFER_PADDING      16  
   
 /*  
  * The following defines the *default* buffer size for channels.  
  */  
   
 #define CHANNELBUFFER_DEFAULT_SIZE      (1024 * 4)  
   
 /*  
  * 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;  
   
 /*  
  * The following structure describes the information saved from a call to  
  * "fileevent". This is used later when the event being waited for to  
  * invoke the saved script in the interpreter designed in this record.  
  */  
   
 typedef struct EventScriptRecord {  
     struct Channel *chanPtr;    /* The channel for which this script is  
                                  * registered. This is used only when an  
                                  * error occurs during evaluation of the  
                                  * script, to delete the handler. */  
     Tcl_Obj *scriptPtr;         /* Script to invoke. */  
     Tcl_Interp *interp;         /* In what interpreter to invoke script? */  
     int mask;                   /* Events must overlap current mask for the  
                                  * stored script to be invoked. */  
     struct EventScriptRecord *nextPtr;  
                                 /* Next in chain of records. */  
 } EventScriptRecord;  
   
 /*  
  * struct Channel:  
  *  
  * One of these structures is allocated for each open channel. It contains data  
  * specific to the channel but which belongs to the generic part of the Tcl  
  * channel mechanism, and it points at an instance specific (and type  
  * specific) * instance data, and at a channel type structure.  
  */  
   
 typedef struct Channel {  
     char *channelName;          /* The name of the channel instance in Tcl  
                                  * commands. Storage is owned by the generic IO  
                                  * code,  is dynamically allocated. */  
     int flags;                  /* ORed combination of the flags defined  
                                  * below. */  
     Tcl_Encoding encoding;      /* Encoding to apply when reading or writing  
                                  * data on this channel.  NULL means no  
                                  * encoding is applied to data. */  
     Tcl_EncodingState inputEncodingState;  
                                 /* Current encoding state, used when converting  
                                  * input data bytes to UTF-8. */  
     int inputEncodingFlags;     /* Encoding flags to pass to conversion  
                                  * routine when converting input data bytes to  
                                  * UTF-8.  May be TCL_ENCODING_START before  
                                  * converting first byte and TCL_ENCODING_END  
                                  * when EOF is seen. */  
     Tcl_EncodingState outputEncodingState;  
                                 /* Current encoding state, used when converting  
                                  * UTF-8 to output data bytes. */  
     int outputEncodingFlags;    /* Encoding flags to pass to conversion  
                                  * routine when converting UTF-8 to output  
                                  * data bytes.  May be TCL_ENCODING_START  
                                  * before converting first byte and  
                                  * TCL_ENCODING_END when EOF is seen. */  
     Tcl_EolTranslation inputTranslation;  
                                 /* What translation to apply for end of line  
                                  * sequences on input? */      
     Tcl_EolTranslation outputTranslation;  
                                 /* What translation to use for generating  
                                  * end of line sequences in output? */  
     int inEofChar;              /* If nonzero, use this as a signal of EOF  
                                  * on input. */  
     int outEofChar;             /* If nonzero, append this to the channel  
                                  * when it is closed if it is open for  
                                  * writing. */  
     int unreportedError;        /* Non-zero if an error report was deferred  
                                  * because it happened in the background. The  
                                  * value is the POSIX error code. */  
     ClientData instanceData;    /* Instance-specific data provided by  
                                  * creator of channel. */  
   
     Tcl_ChannelType *typePtr;   /* Pointer to channel type structure. */  
     int refCount;               /* How many interpreters hold references to  
                                  * this IO channel? */  
     CloseCallback *closeCbPtr;  /* Callbacks registered to be called when the  
                                  * channel is closed. */  
     char *outputStage;          /* Temporary staging buffer used when  
                                  * translating EOL before converting from  
                                  * UTF-8 to external form. */  
     ChannelBuffer *curOutPtr;   /* Current output buffer being filled. */  
     ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */  
     ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */  
   
     ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates  
                                  * need to allocate a new buffer for "gets"  
                                  * that crosses buffer boundaries. */  
     ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */  
     ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */  
   
     struct ChannelHandler *chPtr;/* List of channel handlers registered  
                                   * for this channel. */  
     int interestMask;           /* Mask of all events this channel has  
                                  * handlers for. */  
     struct Channel *nextChanPtr;/* Next in list of channels currently open. */  
     EventScriptRecord *scriptRecordPtr;  
                                 /* Chain of all scripts registered for  
                                  * event handlers ("fileevent") on this  
                                  * channel. */  
     int bufSize;                /* What size buffers to allocate? */  
     Tcl_TimerToken timer;       /* Handle to wakeup timer for this channel. */  
     CopyState *csPtr;           /* State of background copy, or NULL. */  
     struct Channel* supercedes; /* Refers to channel this one was stacked upon.  
                                    This reference is NULL for normal channels.  
                                    See Tcl_StackChannel. */  
   
 } Channel;  
       
 /*  
  * Values for the flags field in Channel. Any ORed combination of the  
  * following flags can be stored in the field. These flags record various  
  * options and state bits about the channel. In addition to the flags below,  
  * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.  
  */  
   
 #define CHANNEL_NONBLOCKING     (1<<3)  /* Channel is currently in  
                                          * nonblocking mode. */  
 #define CHANNEL_LINEBUFFERED    (1<<4)  /* Output to the channel must be  
                                          * flushed after every newline. */  
 #define CHANNEL_UNBUFFERED      (1<<5)  /* Output to the channel must always  
                                          * be flushed immediately. */  
 #define BUFFER_READY            (1<<6)  /* Current output buffer (the  
                                          * curOutPtr field in the  
                                          * channel structure) should be  
                                          * output as soon as possible even  
                                          * though it may not be full. */  
 #define BG_FLUSH_SCHEDULED      (1<<7)  /* A background flush of the  
                                          * queued output buffers has been  
                                          * scheduled. */  
 #define CHANNEL_CLOSED          (1<<8)  /* Channel has been closed. No  
                                          * further Tcl-level IO on the  
                                          * channel is allowed. */  
 #define CHANNEL_EOF             (1<<9)  /* EOF occurred on this channel.  
                                          * This bit is cleared before every  
                                          * input operation. */  
 #define CHANNEL_STICKY_EOF      (1<<10) /* EOF occurred on this channel because  
                                          * we saw the input eofChar. This bit  
                                          * prevents clearing of the EOF bit  
                                          * before every input operation. */  
 #define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred  
                                          * on this channel. This bit is  
                                          * cleared before every input or  
                                          * output operation. */  
 #define INPUT_SAW_CR            (1<<12) /* Channel is in CRLF eol input  
                                          * translation mode and the last  
                                          * byte seen was a "\r". */  
 #define INPUT_NEED_NL           (1<<15) /* Saw a '\r' at end of last buffer,  
                                          * and there should be a '\n' at  
                                          * beginning of next buffer. */  
 #define CHANNEL_DEAD            (1<<13) /* The channel has been closed by  
                                          * the exit handler (on exit) but  
                                          * not deallocated. When any IO  
                                          * operation sees this flag on a  
                                          * channel, it does not call driver  
                                          * level functions to avoid referring  
                                          * to deallocated data. */  
 #define CHANNEL_NEED_MORE_DATA  (1<<14) /* The last input operation failed  
                                          * because there was not enough data  
                                          * to complete the operation.  This  
                                          * flag is set when gets fails to  
                                          * get a complete line or when read  
                                          * fails to get a complete character.  
                                          * When set, file events will not be  
                                          * delivered for buffered data until  
                                          * the state of the channel changes. */  
   
 /*  
  * 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;  
   
 /*  
  * 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.  
      */  
     Channel *firstChanPtr;  
 #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;  
   
 static Tcl_ThreadDataKey dataKey;  
   
   
 /*  
  * Static functions in this file:  
  */  
   
 static ChannelBuffer *  AllocChannelBuffer _ANSI_ARGS_((int length));  
 static void             ChannelEventScriptInvoker _ANSI_ARGS_((  
                             ClientData clientData, int flags));  
 static void             ChannelTimerProc _ANSI_ARGS_((  
                             ClientData clientData));  
 static int              CheckChannelErrors _ANSI_ARGS_((Channel *chanPtr,  
                             int direction));  
 static int              CheckFlush _ANSI_ARGS_((Channel *chanPtr,  
                             ChannelBuffer *bufPtr, int newlineFlag));  
 static int              CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,  
                             Channel *chan));  
 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_((  
                             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 void             DiscardInputQueued _ANSI_ARGS_((  
                             Channel *chanPtr, int discardSavedBuffers));  
 static void             DiscardOutputQueued _ANSI_ARGS_((  
                             Channel *chanPtr));  
 static int              DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,  
                             int slen));  
 static int              DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,  
                             int srcLen));  
 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 void             PeekAhead _ANSI_ARGS_((Channel *chanPtr,  
                             char **dstEndPtr, GetsState *gsPtr));  
 static int              ReadBytes _ANSI_ARGS_((Channel *chanPtr,  
                             Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));  
 static int              ReadChars _ANSI_ARGS_((Channel *chanPtr,  
                             Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,  
                             int *factorPtr));  
 static void             RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,  
                             ChannelBuffer *bufPtr, int mustDiscard));  
 static int              SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,  
                             Channel *chanPtr, int mode));  
 static void             StopCopy _ANSI_ARGS_((CopyState *csPtr));  
 static int              TranslateInputEOL _ANSI_ARGS_((Channel *chanPtr,  
                             char *dst, CONST char *src, int *dstLenPtr,  
                             int *srcLenPtr));  
 static int              TranslateOutputEOL _ANSI_ARGS_((Channel *chanPtr,  
                             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-process  
  *      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()  
 {  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
     Channel *chanPtr;                   /* Iterates over open channels. */  
     Channel *nextChanPtr;               /* Iterates over open channels. */  
   
   
     for (chanPtr = tsdPtr->firstChanPtr; chanPtr != (Channel *) NULL;  
              chanPtr = nextChanPtr) {  
         nextChanPtr = chanPtr->nextChanPtr;  
   
         /*  
          * 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.  
              */  
   
             chanPtr->refCount--;  
         }  
   
         if (chanPtr->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((Tcl_Interp *) 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,  
                         (Tcl_Interp *) NULL);  
             } else {  
                 (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,  
                         (Tcl_Interp *) 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 = (ClientData) NULL;  
             chanPtr->flags |= CHANNEL_DEAD;  
         }  
     }  
 }  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 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.  
  *  
  *----------------------------------------------------------------------  
  */  
 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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 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. */  
 {  
     Channel *chanPtr;  
     CloseCallback *cbPtr;  
   
     chanPtr = (Channel *) chan;  
   
     cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));  
     cbPtr->proc = proc;  
     cbPtr->clientData = clientData;  
   
     cbPtr->nextPtr = chanPtr->closeCbPtr;  
     chanPtr->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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 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. */  
 {  
     Channel *chanPtr;  
     CloseCallback *cbPtr, *cbPrevPtr;  
   
     chanPtr = (Channel *) chan;  
     for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;  
              cbPtr != (CloseCallback *) NULL;  
              cbPtr = cbPtr->nextPtr) {  
         if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {  
             if (cbPrevPtr == (CloseCallback *) NULL) {  
                 chanPtr->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. */  
     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);  
   
         /*  
          * Remove any fileevents registered in this interpreter.  
          */  
           
         for (sPtr = chanPtr->scriptRecordPtr,  
                  prevPtr = (EventScriptRecord *) NULL;  
                  sPtr != (EventScriptRecord *) NULL;  
                  sPtr = nextPtr) {  
             nextPtr = sPtr->nextPtr;  
             if (sPtr->interp == interp) {  
                 if (prevPtr == (EventScriptRecord *) NULL) {  
                     chanPtr->scriptRecordPtr = nextPtr;  
                 } else {  
                     prevPtr->nextPtr = nextPtr;  
                 }  
   
                 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,  
                         ChannelEventScriptInvoker, (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);  
         chanPtr->refCount--;  
         if (chanPtr->refCount <= 0) {  
             if (!(chanPtr->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;  
 {  
     Channel *chanPtr = (Channel *) chan;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {  
         if (chanPtr->refCount < 2) {  
             chanPtr->refCount = 0;  
             tsdPtr->stdinChannel = NULL;  
             return;  
         }  
     } else if ((chan == tsdPtr->stdoutChannel) && (tsdPtr->stdoutInitialized)) {  
         if (chanPtr->refCount < 2) {  
             chanPtr->refCount = 0;  
             tsdPtr->stdoutChannel = NULL;  
             return;  
         }  
     } else if ((chan == tsdPtr->stderrChannel) && (tsdPtr->stderrInitialized)) {  
         if (chanPtr->refCount < 2) {  
             chanPtr->refCount = 0;  
             tsdPtr->stderrChannel = NULL;  
             return;  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 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. */  
   
     chanPtr = (Channel *) chan;  
   
     if (chanPtr->channelName == (char *) NULL) {  
         panic("Tcl_RegisterChannel: channel without name");  
     }  
     if (interp != (Tcl_Interp *) NULL) {  
         hTblPtr = GetChannelTable(interp);  
         hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);  
         if (new == 0) {  
             if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {  
                 return;  
             }  
   
             /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998  
              * "Trf-Patch for filtering channels"  
              *  
              * This is the change to 'Tcl_RegisterChannel'.  
              *  
              * Explanation:  
              *          The moment a channel is stacked upon another he  
              *          takes the identity of the channel he supercedes,  
              *          i.e. he gets the *same* name. Because of this we  
              *          cannot check for duplicate names anymore, they  
              *          have to be allowed now.  
              */  
   
             /* panic("Tcl_RegisterChannel: duplicate channel names"); */  
         }  
         Tcl_SetHashValue(hPtr, (ClientData) chanPtr);  
     }  
     chanPtr->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.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      Deletes the hash entry for a channel associated with an interpreter.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_UnregisterChannel(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. */  
   
     chanPtr = (Channel *) chan;  
       
     if (interp != (Tcl_Interp *) NULL) {  
         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);  
         if (hTblPtr == (Tcl_HashTable *) NULL) {  
             return TCL_OK;  
         }  
         hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);  
         if (hPtr == (Tcl_HashEntry *) NULL) {  
             return TCL_OK;  
         }  
         if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {  
             return TCL_OK;  
         }  
         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);  
     }  
   
     chanPtr->refCount--;  
       
     /*  
      * 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 (chanPtr->refCount <= 0) {  
   
         /*  
          * Ensure that if there is another buffer, it gets flushed  
          * whether or not we are doing a background flush.  
          */  
   
         if ((chanPtr->curOutPtr != NULL) &&  
                 (chanPtr->curOutPtr->nextAdded >  
                         chanPtr->curOutPtr->nextRemoved)) {  
             chanPtr->flags |= BUFFER_READY;  
         }  
         chanPtr->flags |= CHANNEL_CLOSED;  
         if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {  
             if (Tcl_Close(interp, chan) != TCL_OK) {  
                 return TCL_ERROR;  
             }  
         }  
     }  
     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.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 Tcl_Channel  
 Tcl_GetChannel(interp, chanName, modePtr)  
     Tcl_Interp *interp;         /* Interpreter in which to find or create  
                                  * the channel. */  
     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. */  
     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->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;  
     }  
   
     chanPtr = (Channel *) Tcl_GetHashValue(hPtr);  
     if (modePtr != NULL) {  
         *modePtr = (chanPtr->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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tcl_Channel  
 Tcl_CreateChannel(typePtr, chanName, instanceData, mask)  
     Tcl_ChannelType *typePtr;   /* The channel type record. */  
     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. */  
     CONST char *name;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));  
       
     if (chanName != (char *) NULL) {  
         chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));  
         strcpy(chanPtr->channelName, chanName);  
     } else {  
         panic("Tcl_CreateChannel: NULL channel name");  
     }  
   
     chanPtr->flags = mask;  
   
     /*  
      * Set the channel to system default encoding.  
      */  
   
     chanPtr->encoding = NULL;  
     name = Tcl_GetEncodingName(NULL);  
     if (strcmp(name, "binary") != 0) {  
         chanPtr->encoding = Tcl_GetEncoding(NULL, name);  
     }  
     chanPtr->inputEncodingState = NULL;  
     chanPtr->inputEncodingFlags = TCL_ENCODING_START;  
     chanPtr->outputEncodingState = NULL;  
     chanPtr->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.  
      */  
   
     chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;  
     chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;  
     chanPtr->inEofChar = 0;  
     chanPtr->outEofChar = 0;  
   
     chanPtr->unreportedError = 0;  
     chanPtr->instanceData = instanceData;  
     chanPtr->typePtr = typePtr;  
     chanPtr->refCount = 0;  
     chanPtr->closeCbPtr = (CloseCallback *) NULL;  
     chanPtr->curOutPtr = (ChannelBuffer *) NULL;  
     chanPtr->outQueueHead = (ChannelBuffer *) NULL;  
     chanPtr->outQueueTail = (ChannelBuffer *) NULL;  
     chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;  
     chanPtr->inQueueHead = (ChannelBuffer *) NULL;  
     chanPtr->inQueueTail = (ChannelBuffer *) NULL;  
     chanPtr->chPtr = (ChannelHandler *) NULL;  
     chanPtr->interestMask = 0;  
     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;  
     chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;  
     chanPtr->timer = NULL;  
     chanPtr->csPtr = NULL;  
     chanPtr->supercedes = (Channel*) NULL;  
   
     chanPtr->outputStage = NULL;  
     if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {  
         chanPtr->outputStage = (char *)  
                 ckalloc((unsigned) (chanPtr->bufSize + 2));  
     }  
   
     /*  
      * 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.  
      */  
   
     chanPtr->nextChanPtr = tsdPtr->firstChanPtr;  
     tsdPtr->firstChanPtr = chanPtr;  
   
     /*  
      * Install this channel in the first empty standard channel slot, if  
      * the channel was previously closed explicitly.  
      */  
   
     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);  
     }  
     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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 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, *pt;  
     int                 interest = 0;  
   
     /*  
      * AK, 06/30/1999  
      *  
      * Tcl_StackChannel differs from Tcl_ReplaceChannel of the  
      * original "Trf" patch. Instead of seeing the  
      * newly created structure as the *new* channel to cover the specified  
      * one use it to *save* the current state of the specified channel and  
      * then reinitialize the current structure for the given transformation.  
      *  
      * Advantages:  
      * - No splicing into the (thread-)global list of channels (or the per-  
      *   interp hash-tables).  
      * - Users of the C-API still have valid channel references even after  
      *   the call to this procedure.  
      *  
      * Disadvantages:  
      * - Untested code.  
      */  
   
     /*  
      * Find the given channel in the list of all channels.  
      */  
   
     pt     = (Channel*) tsdPtr->firstChanPtr;  
   
     while (pt != (Channel *) prevChan) {  
         pt = pt->nextChanPtr;  
     }  
   
     /*  
      * 'pt == prevChan' now (or NULL, if not found).  
      */  
   
     if (!pt) {  
         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 & Tcl_GetChannelMode (prevChan)) == 0) {  
         return (Tcl_Channel) NULL;  
     }  
   
     chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));  
   
     /*  
      * If there is some interest in the channel, remove it, break  
      * down the whole chain. It will be reconstructed later.  
      */  
   
     interest = pt->interestMask;  
   
     pt->interestMask = 0;  
   
     if (interest) {  
         (pt->typePtr->watchProc) (pt->instanceData, 0);  
     }  
   
     /*  
      * Save some of the current state into the new structure,  
      * reinitialize the parts which will stay with the transformation.  
      *  
      * Remarks:  
      * - We cannot discard the buffers, and they cannot be used from the  
      *   transformation placed later into the 'pt' structure. Save them,  
      *   and believe that Tcl_SetChannelOption (buffering, none) will do  
      *   the right thing.  
      * - encoding and EOL-translation control information is initialized  
      *   to values for 'binary'. This is later reinforced via  
      *   Tcl_SetChanneloption to get the handling of flags and the event  
      *   system right.  
      * - The 'interestMask' of the saved channel is cleared, but the  
      *   transformations WatchProc is used to establish the connection  
      *   between transformation and underlying channel. This should  
      *   reestablish the correct mask.  
      * - TTO = Transform Takes Over.   The hidden channel no longer  
      *         needs to perform this function.  
      */  
   
     chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);  
     strcpy (chanPtr->channelName, pt->channelName);  
   
     chanPtr->flags               = pt->flags;           /* Save */  
   
     chanPtr->encoding            = (Tcl_Encoding) NULL; /* == 'binary' */  
     chanPtr->inputEncodingState  = (Tcl_EncodingState) NULL;  
     chanPtr->inputEncodingFlags  = TCL_ENCODING_START;  
     chanPtr->outputEncodingState = (Tcl_EncodingState) NULL;  
     chanPtr->outputEncodingFlags = TCL_ENCODING_START;  
   
     chanPtr->inputTranslation    = TCL_TRANSLATE_LF; /* == 'binary' */  
     chanPtr->outputTranslation   = TCL_TRANSLATE_LF; /* == 'binary' */  
     chanPtr->inEofChar           = pt->inEofChar;         /* Save */  
     chanPtr->outEofChar          = pt->outEofChar;        /* Save */  
   
     chanPtr->unreportedError     = pt->unreportedError;   /* Save */  
     chanPtr->instanceData        = pt->instanceData;      /* Save */  
     chanPtr->typePtr             = pt->typePtr;           /* Save */  
     chanPtr->refCount            = 0;   /* None, as the structure is covered */  
     chanPtr->closeCbPtr          = (CloseCallback*) NULL; /* TTO */  
   
     chanPtr->outputStage         = (char*) NULL;  
     chanPtr->curOutPtr           = pt->curOutPtr;    /* Save */  
     chanPtr->outQueueHead        = pt->outQueueHead; /* Save */  
     chanPtr->outQueueTail        = pt->outQueueTail; /* Save */  
     chanPtr->saveInBufPtr        = pt->saveInBufPtr; /* Save */  
     chanPtr->inQueueHead         = pt->inQueueHead;  /* Save */  
     chanPtr->inQueueTail         = pt->inQueueTail;  /* Save */  
   
     chanPtr->chPtr               = (ChannelHandler *) NULL;  /* TTO */  
     chanPtr->interestMask        = 0;  
     chanPtr->nextChanPtr         = (Channel*) NULL;     /* Is not in list! */  
     chanPtr->scriptRecordPtr     = (EventScriptRecord *) NULL; /* TTO */  
     chanPtr->bufSize             = CHANNELBUFFER_DEFAULT_SIZE;  
     chanPtr->timer               = (Tcl_TimerToken) NULL;      /* TTO */  
     chanPtr->csPtr               = (CopyState*) NULL;          /* TTO */  
   
     /*  
      * Place new block at the head of a possibly existing list of previously  
      * stacked channels, then do the missing initializations of translation  
      * and buffer system.  
      */  
   
     chanPtr->supercedes          = pt->supercedes;  
   
     Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,  
         "-translation", "binary");  
     Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,  
         "-buffering",   "none");  
   
     /*  
      * Save accomplished, now reinitialize the (old) structure for the  
      * transformation.  
      *  
      * - The information about encoding and eol-translation is taken  
      *   without change.  There is no need to fiddle with  
      *   refCount et. al.  
      *  
      * Don't forget to use the same blocking mode as the old channel.  
      */  
   
     pt->flags               = mask | (chanPtr->flags & CHANNEL_NONBLOCKING);  
   
     /*  
      * EDITORS NOTE:  all the lines with "take it as is" should get  
      * deleted once this code has been debugged.  
      */  
   
     /* pt->encoding,            take it as is */  
     /* pt->inputEncodingState,  take it as is */  
     /* pt->inputEncodingFlags,  take it as is */  
     /* pt->outputEncodingState, take it as is */  
     /* pt->outputEncodingFlags, take it as is */  
   
     /* pt->inputTranslation,    take it as is */  
     /* pt->outputTranslation,   take it as is */  
   
     /*  
      * No special EOF character, that condition is determined by the  
      * old channel  
      */  
   
     pt->inEofChar           = 0;  
     pt->outEofChar          = 0;  
   
     pt->unreportedError     = 0; /* No errors yet */  
     pt->instanceData        = instanceData; /* Transformation state */  
     pt->typePtr             = typePtr;      /* Transformation type */  
     /* pt->refCount,            take it as it is */  
     /* pt->closeCbPtr,          take it as it is */  
   
     /* pt->outputStage,         take it as it is */  
     pt->curOutPtr           = (ChannelBuffer *) NULL;  
     pt->outQueueHead        = (ChannelBuffer *) NULL;  
     pt->outQueueTail        = (ChannelBuffer *) NULL;  
     pt->saveInBufPtr        = (ChannelBuffer *) NULL;  
     pt->inQueueHead         = (ChannelBuffer *) NULL;  
     pt->inQueueTail         = (ChannelBuffer *) NULL;  
   
     /* pt->chPtr,               take it as it is */  
     /* pt->interestMask,        take it as it is */  
     /* pt->nextChanPtr,         take it as it is */  
     /* pt->scriptRecordPtr,     take it as it is */  
     pt->bufSize             = CHANNELBUFFER_DEFAULT_SIZE;  
     /* pt->timer,               take it as it is */  
     /* pt->csPtr,               take it as it is */  
   
     /*  
      * Have the transformation reference the new structure containing  
      * the saved channel.  
      */  
   
     pt->supercedes          = chanPtr;  
   
     /*  
      * Don't forget to reinitialize the output buffer used for encodings.  
      */  
   
     if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {  
         chanPtr->outputStage = (char *)  
             ckalloc((unsigned) (chanPtr->bufSize + 2));  
     }  
   
     /*  
      * Event handling: If the information in the old channel shows  
      * that there was interest in some events call the 'WatchProc'  
      * of the transformation to establish the proper connection  
      * between them.  
      */  
   
     if (interest) {  
         (pt->typePtr->watchProc) (pt->instanceData, interest);  
     }  
   
     /*  
      * The superceded channel is effectively unregistered  
      * We cannot decrement its reference count because that  
      * can cause it to get garbage collected out from under us.  
      * Don't add the following code:  
      *  
      * chanPtr->supercedes->refCount --;  
      */  
   
     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'.  
  *      The old, superceded channel is uncovered and re-registered  
  *      in the appropriate data structures.  
  *  
  * Results:  
  *      Returns the old Tcl_Channel, i.e. the one which was stacked over.  
  *  
  * Side effects:  
  *      See above.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_UnstackChannel (interp, chan)  
     Tcl_Interp* interp; /* The interpreter we are working in */  
     Tcl_Channel chan;   /* The channel to unstack */  
 {  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
     Channel* chanPtr = (Channel*) chan;  
   
     if (chanPtr->supercedes != (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.  
          */  
   
         Tcl_DString       dsTrans; /* storage to save option information */  
         Tcl_DString       dsBuf;   /* storage to save option information */  
         Channel           top;     /* Save area for current transformation */  
         Channel*          chanDownPtr = chanPtr->supercedes;  
         int               interest;     /* interest mask of transformation  
                                          * before destruct. */  
         int               saveInputEncodingFlags;  /* Save area for encoding */  
         int               saveOutputEncodingFlags; /* related information */  
         Tcl_EncodingState saveInputEncodingState;  
         Tcl_EncodingState saveOutputEncodingState;  
         Tcl_Encoding      saveEncoding;  
   
         /*  
          * Event handling: Disallow the delivery of events from the  
          * old, now uncovered channel to the transformation.  
          *  
          * This is done before everything else to avoid problems  
          * after our heavy-duty shuffling of pointers around.  
          */  
   
         interest = chanPtr->interestMask;  
         (chanPtr->typePtr->watchProc) (chanPtr->instanceData, 0);  
   
         /* 1. Swap the information in the top channel (the transformation)  
          *    and the channel below, with some exceptions. This additionally  
          *    cuts the top channel out of the chain. Without the latter  
          *    a Tcl_Close on the transformation would be impossible, as that  
          *    procedure will free the structure, making 'top' unusable.  
          *  
          * chanPtr     -> top channel, transformation.  
          * chanDownPtr -> channel immediately below the transformation.  
          */  
   
         memcpy ((void*) &top,        (void*) chanPtr,     sizeof (Channel));  
         memcpy ((void*) chanPtr,     (void*) chanDownPtr, sizeof (Channel));  
         top.supercedes = (Channel*) NULL;  
         memcpy ((void*) chanDownPtr, (void*) &top,        sizeof (Channel));  
   
         /* Now:  
          * chanPtr     -> channel immediately below the transformation, now top  
          * chanDownPtr -> transformation, cut loose.  
          *  
          * Handle the exceptions mentioned above, i.e. move the information  
          * from the transformation into the new top, and reinitialize it to  
          * safe values in the transformation.  
          */  
   
         chanPtr->refCount        = chanDownPtr->refCount;  
         chanPtr->closeCbPtr      = chanDownPtr->closeCbPtr;  
         chanPtr->chPtr           = chanDownPtr->chPtr;  
         chanPtr->nextChanPtr     = chanDownPtr->nextChanPtr;  
         chanPtr->scriptRecordPtr = chanDownPtr->scriptRecordPtr;  
         chanPtr->timer           = chanDownPtr->timer;  
         chanPtr->csPtr           = chanDownPtr->csPtr;  
   
         chanDownPtr->refCount        = 0;  
         chanDownPtr->closeCbPtr      = (CloseCallback*) NULL;  
         chanDownPtr->chPtr           = (ChannelHandler*) NULL;  
         chanDownPtr->nextChanPtr     = (Channel*) NULL;  
         chanDownPtr->scriptRecordPtr = (EventScriptRecord*) NULL;  
         chanDownPtr->timer           = (Tcl_TimerToken) NULL;  
         chanDownPtr->csPtr           = (CopyState*) NULL;  
   
         /* The now uncovered channel still has encoding and eol-translation  
          * deactivated, i.e. switched to 'binary'. *Don't* touch this until  
          * after the transformation is closed for good, as it may write  
          * information into it during that (-> flushing of data waiting in  
          * internal buffers!) and rely on these settings. Thanks to Matt  
          * Newman <matt@sensus.org> for finding this goof.  
          *  
          * But we also have to protect the state of the encoding from removal  
          * during the close. So we save it in some local variables.  
          * Additionally the current value of the options is lost after we  
          * close, we have to save them now.  
          */  
   
         saveEncoding            = chanDownPtr->encoding;  
         saveInputEncodingState  = chanDownPtr->inputEncodingState;  
         saveInputEncodingFlags  = chanDownPtr->inputEncodingFlags;  
         saveOutputEncodingState = chanDownPtr->outputEncodingState;  
         saveOutputEncodingFlags = chanDownPtr->outputEncodingFlags;  
   
         Tcl_DStringInit (&dsTrans);  
         Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,  
                 "-translation", &dsTrans);  
   
         Tcl_DStringInit (&dsBuf);  
         Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,  
                 "-buffering", &dsBuf);  
   
         /*  
          * Prevent the accidential removal of the encoding during  
          * the destruction of the transformation channel.  
          */  
   
         chanDownPtr->encoding            = (Tcl_Encoding) NULL;  
         chanDownPtr->inputEncodingState  = (Tcl_EncodingState) NULL;  
         chanDownPtr->inputEncodingFlags  = TCL_ENCODING_START;  
         chanDownPtr->outputEncodingState = (Tcl_EncodingState) NULL;  
         chanDownPtr->outputEncodingFlags = TCL_ENCODING_START;  
   
         /*  
          * A little trick: Add the transformation structure to the  
          * per-thread list of existing channels (which it never were  
          * part of so far), or Tcl_Close/FlushChannel will panic  
          * ("damaged channel list").  
          *  
          * Afterward do a regular close upon the transformation.  
          * This may cause flushing of data into the old channel (if the  
          * transformation remembered its own channel in itself).  
          *  
          * We know that its refCount dropped to 0.  
          */  
   
         chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr;  
         tsdPtr->firstChanPtr     = chanDownPtr;  
   
         Tcl_Close (interp, (Tcl_Channel)chanDownPtr);  
   
         /*  
          * Now it is possible to wind down the transformation (in 'top'),  
          * especially to copy the current encoding and translation control  
          * information down.  
          */  
           
         /*  
          * Move the currently active encoding from the save area  
          * to the now uncovered channel. We assume here that this  
          * channel uses 'encoding binary' (==> encoding == NULL, etc.  
          * This allows us to simply copy the pointers without having to  
          * think about refcounts and deallocation of the old encoding.  
          *  
          * And don't forget to reenable the EOL-translation used by the  
          * transformation. Using a DString to do this *is* a bit awkward,  
          * but still the best way to handle the complexities here, like  
          * flag manipulation and event system.  
          */  
   
         chanPtr->encoding            = saveEncoding;  
         chanPtr->inputEncodingState  = saveInputEncodingState;  
         chanPtr->inputEncodingFlags  = saveInputEncodingFlags;  
         chanPtr->outputEncodingState = saveOutputEncodingState;  
         chanPtr->outputEncodingFlags = saveOutputEncodingFlags;  
   
         Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,  
                 "-translation", dsTrans.string);  
   
         Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,  
                 "-buffering", dsBuf.string);  
   
         Tcl_DStringFree (&dsTrans);  
         Tcl_DStringFree (&dsBuf);  
   
         /*  
          * Event handling: If the information from the now destroyed  
          * transformation shows that there was interest in some events  
          * call the 'WatchProc' of the now uncovered channel to renew  
          * that interest with underlying channels or the driver.  
          */  
   
         if (interest) {  
             chanPtr->interestMask = 0;  
             (chanPtr->typePtr->watchProc) (chanPtr->instanceData,  
                 interest);  
             chanPtr->interestMask = interest;  
         }  
   
     } else {  
         /* This channel does not cover another one.  
          * Simply do a close, if necessary.  
          */  
   
         if (chanPtr->refCount == 0) {  
             Tcl_Close (interp, chan);  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetStackedChannel --  
  *  
  *      Determines wether 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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tcl_Channel  
 Tcl_GetStackedChannel(chan)  
     Tcl_Channel chan;  
 {  
   Channel* chanPtr = (Channel*) chan;  
   return (Tcl_Channel) chanPtr->supercedes;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetChannelMode(chan)  
     Tcl_Channel chan;           /* The channel for which the mode is  
                                  * being computed. */  
 {  
     Channel *chanPtr;           /* The actual channel. */  
   
     chanPtr = (Channel *) chan;  
     return (chanPtr->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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 char *  
 Tcl_GetChannelName(chan)  
     Tcl_Channel chan;           /* The channel for which to return the name. */  
 {  
     Channel *chanPtr;           /* The actual channel. */  
   
     chanPtr = (Channel *) chan;  
     return chanPtr->channelName;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetChannelType --  
  *  
  *      Given a channel structure, returns the channel type structure.  
  *  
  * Results:  
  *      Returns a pointer to the channel type structure.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tcl_ChannelType *  
 Tcl_GetChannelType(chan)  
     Tcl_Channel chan;           /* The channel to return type for. */  
 {  
     Channel *chanPtr;           /* The actual channel. */  
   
     chanPtr = (Channel *) chan;  
     return chanPtr->typePtr;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 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;  
     result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,  
             direction, &handle);  
     if (handlePtr) {  
         *handlePtr = handle;  
     }  
     return result;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetChannelInstanceData --  
  *  
  *      Returns the client data associated with a channel.  
  *  
  * Results:  
  *      The client data.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 ClientData  
 Tcl_GetChannelInstanceData(chan)  
     Tcl_Channel chan;           /* Channel for which to return client data. */  
 {  
     Channel *chanPtr;           /* The actual channel. */  
   
     chanPtr = (Channel *) chan;  
     return chanPtr->instanceData;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * 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(chanPtr, bufPtr, mustDiscard)  
     Channel *chanPtr;           /* Channel for 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 for the input queue if the channel is readable.  
      */  
       
     if (chanPtr->flags & TCL_READABLE) {  
         if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {  
             chanPtr->inQueueHead = bufPtr;  
             chanPtr->inQueueTail = bufPtr;  
             goto keepit;  
         }  
         if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {  
             chanPtr->saveInBufPtr = bufPtr;  
             goto keepit;  
         }  
     }  
   
     /*  
      * Only save buffers for the output queue if the channel is writable.  
      */  
   
     if (chanPtr->flags & TCL_WRITABLE) {  
         if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {  
             chanPtr->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(chanPtr)  
     Channel *chanPtr;           /* The channel for which to discard output. */  
 {  
     ChannelBuffer *bufPtr;  
       
     while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {  
         bufPtr = chanPtr->outQueueHead;  
         chanPtr->outQueueHead = bufPtr->nextPtr;  
         RecycleBuffer(chanPtr, bufPtr, 0);  
     }  
     chanPtr->outQueueHead = (ChannelBuffer *) NULL;  
     chanPtr->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, chanPtr)  
     Tcl_Interp *interp;         /* For error reporting (can be NULL) */  
     Channel    *chanPtr;        /* The channel to check. */  
 {  
     if (chanPtr->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. */  
 {  
     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,chanPtr)) 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 (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&  
                 (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufLength))  
                 || ((chanPtr->flags & BUFFER_READY) &&  
                         (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {  
             chanPtr->flags &= (~(BUFFER_READY));  
             chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;  
             if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {  
                 chanPtr->outQueueHead = chanPtr->curOutPtr;  
             } else {  
                 chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;  
             }  
             chanPtr->outQueueTail = chanPtr->curOutPtr;  
             chanPtr->curOutPtr = (ChannelBuffer *) NULL;  
         }  
         bufPtr = chanPtr->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) &&  
                 (chanPtr->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,  
                 (char *) 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 (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {  
                     chanPtr->flags |= BG_FLUSH_SCHEDULED;  
                     UpdateInterest(chanPtr);  
                 }  
                 errorCode = 0;  
                 break;  
             }  
   
             /*  
              * Decide whether to report the error upwards or defer it.  
              */  
   
             if (calledFromAsyncFlush) {  
                 if (chanPtr->unreportedError == 0) {  
                     chanPtr->unreportedError = errorCode;  
                 }  
             } else {  
                 Tcl_SetErrno(errorCode);  
                 if (interp != NULL) {  
                     Tcl_SetResult(interp,  
                             Tcl_PosixError(interp), TCL_VOLATILE);  
                 }  
             }  
   
             /*  
              * When we get an error we throw away all the output  
              * currently queued.  
              */  
   
             DiscardOutputQueued(chanPtr);  
             continue;  
         } else {  
             wroteSome = 1;  
         }  
   
         bufPtr->nextRemoved += written;  
   
         /*  
          * If this buffer is now empty, recycle it.  
          */  
   
         if (bufPtr->nextRemoved == bufPtr->nextAdded) {  
             chanPtr->outQueueHead = bufPtr->nextPtr;  
             if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {  
                 chanPtr->outQueueTail = (ChannelBuffer *) NULL;  
             }  
             RecycleBuffer(chanPtr, 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 (chanPtr->flags & BG_FLUSH_SCHEDULED) {  
         if (wroteSome) {  
             return errorCode;  
         } else if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {  
             chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));  
             (chanPtr->typePtr->watchProc)(chanPtr->instanceData,  
                     chanPtr->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 ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&  
             (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&  
             ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||  
                     (chanPtr->curOutPtr->nextAdded ==  
                             chanPtr->curOutPtr->nextRemoved))) {  
         return CloseChannel(interp, chanPtr, errorCode);  
     }  
     return errorCode;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * CloseChannel --  
  *  
  *      Utility procedure to close a channel and free its associated  
  *      resources.  
  *  
  * Results:  
  *      0 on success or a POSIX error code if the operation failed.  
  *  
  * Side effects:  
  *      May close the actual channel; may free memory.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 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. */  
     Channel *prevChanPtr;               /* Preceding channel in list of  
                                          * all channels - used to splice a  
                                          * channel out of the list on close. */  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     if (chanPtr == NULL) {  
         return result;  
     }  
       
     /*  
      * No more input can be consumed so discard any leftover input.  
      */  
   
     DiscardInputQueued(chanPtr, 1);  
   
     /*  
      * Discard a leftover buffer in the current output buffer field.  
      */  
   
     if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {  
         ckfree((char *) chanPtr->curOutPtr);  
         chanPtr->curOutPtr = (ChannelBuffer *) NULL;  
     }  
       
     /*  
      * The caller guarantees that there are no more buffers  
      * queued for output.  
      */  
   
     if (chanPtr->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 ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {  
         int dummy;  
         char c;  
   
         c = (char) chanPtr->outEofChar;  
         (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);  
     }  
   
     /*  
      * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so  
      * that close callbacks can not do input or output (assuming they  
      * squirreled the channel away in their clientData). This also  
      * prevents infinite loops if the callback calls any C API that  
      * could call FlushChannel.  
      */  
   
     chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));  
           
     /*  
      * Splice this channel out of the list of all channels.  
      */  
   
     if (chanPtr == tsdPtr->firstChanPtr) {  
         tsdPtr->firstChanPtr = chanPtr->nextChanPtr;  
     } else {  
         for (prevChanPtr = tsdPtr->firstChanPtr;  
                  (prevChanPtr != (Channel *) NULL) &&  
                      (prevChanPtr->nextChanPtr != chanPtr);  
                  prevChanPtr = prevChanPtr->nextChanPtr) {  
             /* Empty loop body. */  
         }  
         if (prevChanPtr == (Channel *) NULL) {  
             panic("FlushChannel: damaged channel list");  
         }  
         prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;  
     }  
   
     /*  
      * 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);  
     }  
       
     if (chanPtr->channelName != (char *) NULL) {  
         ckfree(chanPtr->channelName);  
     }  
     Tcl_FreeEncoding(chanPtr->encoding);  
     if (chanPtr->outputStage != NULL) {  
         ckfree((char *) chanPtr->outputStage);  
     }  
       
     /*  
      * If we are being called synchronously, report either  
      * any latent error on the channel or the current error.  
      */  
           
     if (chanPtr->unreportedError != 0) {  
         errorCode = chanPtr->unreportedError;  
     }  
     if (errorCode == 0) {  
         errorCode = result;  
         if (errorCode != 0) {  
             Tcl_SetErrno(errorCode);  
         }  
     }  
   
     /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998  
      * "Trf-Patch for filtering channels"  
      *  
      * This is the change to 'CloseChannel'.  
      *  
      * Explanation  
      *          Closing a filtering channel closes the one it  
      *          superceded too. This basically ripples through  
      *          the whole chain of filters until it reaches  
      *          the underlying normal channel.  
      *  
      *          This is done by reintegrating the superceded  
      *          channel into the (thread) global list of open  
      *          channels and then invoking a regular close.  
      *          There is no need to handle the complexities of  
      *          this process by ourselves.  
      *  
      *          *Note*  
      *          This has to be done after the call to the  
      *          'closeProc' of the filtering channel to allow  
      *          that one to flush internal buffers into  
      *          the underlying channel.  
      */  
   
     if (chanPtr->supercedes != (Channel*) NULL) {  
         /*  
          * Insert the channel we were stacked upon back into  
          * the list of open channels, then do a regular close.  
          */  
   
         chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;  
         tsdPtr->firstChanPtr             = chanPtr->supercedes;  
         chanPtr->supercedes->refCount --; /* is deregistered */  
         Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);  
     }  
   
     /*  
      * Cancel any outstanding timer.  
      */  
   
     Tcl_DeleteTimerHandler(chanPtr->timer);  
   
     /*  
      * Mark the channel as deleted by clearing the type structure.  
      */  
   
     chanPtr->typePtr = NULL;  
   
     Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);  
   
     return errorCode;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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 */  
 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. */  
 {  
     ChannelHandler *chPtr, *chNext;     /* Iterate over channel handlers. */  
     CloseCallback *cbPtr;               /* Iterate over close callbacks  
                                          * for this channel. */  
     EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */  
     Channel *chanPtr;                   /* The real IO channel. */  
     int result;                         /* Of calling FlushChannel. */  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
     NextChannelHandler *nhPtr;  
   
     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);  
   
     chanPtr = (Channel *) chan;  
     if (chanPtr->refCount > 0) {  
         panic("called Tcl_Close on channel with refCount > 0");  
     }  
   
     /*  
      * Remove any references to channel handlers for this channel that  
      * may be about to be invoked.  
      */  
   
     for (nhPtr = tsdPtr->nestedHandlerPtr;  
              nhPtr != (NextChannelHandler *) NULL;  
              nhPtr = nhPtr->nestedHandlerPtr) {  
         if (nhPtr->nextHandlerPtr &&  
                 (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {  
             nhPtr->nextHandlerPtr = NULL;  
         }  
     }  
   
     /*  
      * Remove all the channel handler records attached to the channel  
      * itself.  
      */  
           
     for (chPtr = chanPtr->chPtr;  
              chPtr != (ChannelHandler *) NULL;  
              chPtr = chNext) {  
         chNext = chPtr->nextPtr;  
         ckfree((char *) chPtr);  
     }  
     chanPtr->chPtr = (ChannelHandler *) NULL;  
       
       
     /*  
      * Cancel any pending copy operation.  
      */  
   
     StopCopy(chanPtr->csPtr);  
   
     /*  
      * Must set the interest mask now to 0, otherwise infinite loops  
      * will occur if Tcl_DoOneEvent is called before the channel is  
      * finally deleted in FlushChannel. This can happen if the channel  
      * has a background flush active.  
      */  
           
     chanPtr->interestMask = 0;  
       
     /*  
      * Remove any EventScript records for this channel.  
      */  
   
     for (ePtr = chanPtr->scriptRecordPtr;  
              ePtr != (EventScriptRecord *) NULL;  
              ePtr = eNextPtr) {  
         eNextPtr = ePtr->nextPtr;  
         Tcl_DecrRefCount(ePtr->scriptPtr);  
         ckfree((char *) ePtr);  
     }  
     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;  
           
     /*  
      * Invoke the registered close callbacks and delete their records.  
      */  
   
     while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {  
         cbPtr = chanPtr->closeCbPtr;  
         chanPtr->closeCbPtr = cbPtr->nextPtr;  
         (cbPtr->proc) (cbPtr->clientData);  
         ckfree((char *) cbPtr);  
     }  
   
     /*  
      * Ensure that the last output buffer will be flushed.  
      */  
       
     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&  
            (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {  
         chanPtr->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);  
     } else {  
         result = 0;  
     }  
   
     /*  
      * 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.  
      */  
   
     chanPtr->flags |= CHANNEL_CLOSED;  
     if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {  
         return TCL_ERROR;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Write --  
  *  
  *      Puts 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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Write(chan, src, srcLen)  
     Tcl_Channel chan;                   /* The channel to buffer output for. */  
     char *src;                          /* Data to queue in output buffer. */  
     int srcLen;                         /* Length of data in bytes, or < 0 for  
                                          * strlen(). */  
 {  
     Channel *chanPtr;  
   
     chanPtr = (Channel *) chan;  
     if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {  
         return -1;  
     }  
     if (srcLen < 0) {  
         srcLen = strlen(src);  
     }  
     return DoWrite(chanPtr, src, srcLen);  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * Tcl_WriteChars --  
  *  
  *      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.  
  *  
  * 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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_WriteChars(chan, src, len)  
     Tcl_Channel chan;           /* 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(). */  
 {  
     Channel *chanPtr;  
   
     chanPtr = (Channel *) chan;  
     if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {  
         return -1;  
     }  
     if (len < 0) {  
         len = strlen(src);  
     }  
     if (chanPtr->encoding == NULL) {  
         /*  
          * Inefficient way to convert UTF-8 to byte-array, but the    
          * code parallels the way it is done for objects.  
          */  
   
         Tcl_Obj *objPtr;  
         int result;  
   
         objPtr = Tcl_NewStringObj(src, len);  
         src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);  
         result = WriteBytes(chanPtr, src, len);  
         Tcl_DecrRefCount(objPtr);  
         return result;  
     }  
     return WriteChars(chanPtr, src, len);  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * Tcl_WriteObj --  
  *  
  *      Takes the Tcl object and queues its contents for output.  If the  
  *      encoding of the channel is NULL, takes the byte-array representation  
  *      of the object and queues those bytes for output.  Otherwise, takes  
  *      the characters in the UTF-8 (string) representation of the object  
  *      and converts them for output using the channel's current encoding.    
  *      May flush internal buffers to output if one becomes full or is ready  
  *      for some other reason, e.g. if it contains a newline and the channel  
  *      is 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.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_WriteObj(chan, objPtr)  
     Tcl_Channel chan;           /* The channel to buffer output for. */  
     Tcl_Obj *objPtr;            /* The object to write. */  
 {  
     Channel *chanPtr;  
     char *src;  
     int srcLen;  
   
     chanPtr = (Channel *) chan;  
     if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {  
         return -1;  
     }  
     if (chanPtr->encoding == NULL) {  
         src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);  
         return WriteBytes(chanPtr, src, srcLen);  
     } else {  
         src = Tcl_GetStringFromObj(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(chanPtr, src, srcLen)  
     Channel *chanPtr;           /* The channel to buffer output for. */  
     CONST char *src;            /* Bytes to write. */  
     int srcLen;                 /* Number of bytes to write. */  
 {  
     ChannelBuffer *bufPtr;  
     char *dst;  
     int dstLen, dstMax, sawLF, savedLF, total, 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 = chanPtr->curOutPtr;  
         if (bufPtr == NULL) {  
             bufPtr = AllocChannelBuffer(chanPtr->bufSize);  
             chanPtr->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.  
              */  
   
             *dst++ = '\n';  
             dstLen--;  
             sawLF++;  
         }  
         sawLF += TranslateOutputEOL(chanPtr, dst, src, &dstLen, &toWrite);  
         dstLen += savedLF;  
         savedLF = 0;  
   
         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;  
     }  
     return total;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * WriteChars --  
  *  
  *      Convert UTF-8 bytes to the channel's external encoding and  
  *      write the 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.  
  *  
  * 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  
 WriteChars(chanPtr, src, srcLen)  
     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. */  
 {  
     ChannelBuffer *bufPtr;  
     char *dst, *stage;  
     int saved, savedLF, sawLF, total, toWrite, flags;  
     int dstWrote, dstLen, stageLen, stageMax, stageRead;  
     Tcl_Encoding encoding;  
     char safe[BUFFER_PADDING];  
       
     total = 0;  
     sawLF = 0;  
     savedLF = 0;  
     saved = 0;  
     encoding = chanPtr->encoding;  
   
     /*  
      * Loop over all UTF-8 characters in src, storing them in staging buffer  
      * with proper EOL translation.  
      */  
   
     while (srcLen + savedLF > 0) {  
         stage = chanPtr->outputStage;  
         stageMax = chanPtr->bufSize;  
         stageLen = stageMax;  
   
         toWrite = stageLen;  
         if (toWrite > srcLen) {  
             toWrite = srcLen;  
         }  
   
         if (savedLF) {  
             /*  
              * A '\n' was left over from last call to TranslateOutputEOL()  
              * and we need to store it in the staging buffer.  If the  
              * channel is line-based, we will need to flush the output  
              * buffer (after translating the staging buffer).  
              */  
               
             *stage++ = '\n';  
             stageLen--;  
             sawLF++;  
         }  
         sawLF += TranslateOutputEOL(chanPtr, stage, src, &stageLen, &toWrite);  
   
         stage -= savedLF;  
         stageLen += savedLF;  
         savedLF = 0;  
   
         if (stageLen > stageMax) {  
             savedLF = 1;  
             stageLen = stageMax;  
         }  
         src += toWrite;  
         srcLen -= toWrite;  
   
         flags = chanPtr->outputEncodingFlags;  
         if (srcLen == 0) {  
             flags |= TCL_ENCODING_END;  
         }  
   
         /*  
          * Loop over all UTF-8 characters in staging buffer, converting them  
          * to external encoding, storing them in output buffer.  
          */  
   
         while (stageLen + saved > 0) {  
             bufPtr = chanPtr->curOutPtr;  
             if (bufPtr == NULL) {  
                 bufPtr = AllocChannelBuffer(chanPtr->bufSize);  
                 chanPtr->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;  
             }  
   
             Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,  
                     &chanPtr->outputEncodingState, dst,  
                     dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);  
             if (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.  
                  */  
   
                 src -= stageLen;  
                 srcLen += stageLen;  
                 stageLen = 0;  
                 savedLF = 0;  
                 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;  
             }  
   
             total += dstWrote;  
             stage += stageRead;  
             stageLen -= stageRead;  
             sawLF = 0;  
         }  
     }  
     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(chanPtr, dst, src, dstLenPtr, srcLenPtr)  
     Channel *chanPtr;           /* 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 (chanPtr->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++;  
                 }  
             }  
             *dstLenPtr = srcLen;  
             break;  
         }  
         case TCL_TRANSLATE_CRLF: {  
             /*  
              * Since this causes the number of bytes to grow, we  
              * start off trying to put 'srcLen' bytes into the  
              * output buffer, but allow it to store more bytes, as  
              * long as there's still source bytes and room in the  
              * output buffer.  
              */  
   
             char *dstStart, *dstMax;  
             CONST char *srcStart;  
               
             dstStart = dst;  
             dstMax = dst + *dstLenPtr;  
   
             srcStart = src;  
               
             if (srcLen < *dstLenPtr) {  
                 dstEnd = dst + srcLen;  
             } else {  
                 dstEnd = dst + *dstLenPtr;  
             }  
             while (dst < dstEnd) {  
                 if (*src == '\n') {  
                     if (dstEnd < dstMax) {  
                         dstEnd++;  
                     }  
                     *dst++ = '\r';  
                     newlineFound = 1;  
                 }  
                 *dst++ = *src++;  
             }  
             *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(chanPtr, bufPtr, newlineFlag)  
     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. */  
 {  
     /*  
      * 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 ((chanPtr->flags & BUFFER_READY) == 0) {  
         if (bufPtr->nextAdded == bufPtr->bufLength) {  
             chanPtr->flags |= BUFFER_READY;  
         } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {  
             if (newlineFlag != 0) {  
                 chanPtr->flags |= BUFFER_READY;  
             }  
         } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {  
             chanPtr->flags |= BUFFER_READY;  
         }  
     }  
     if (chanPtr->flags & BUFFER_READY) {  
         if (FlushChannel(NULL, chanPtr, 0) != 0) {  
             return -1;  
         }  
     }  
     return 0;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * Tcl_Gets --  
  *  
  *      Reads a complete line of input from the channel into a Tcl_DString.  
  *  
  * Results:  
  *      Length of line read (in characters) or -1 if error, EOF, or blocked.  
  *      If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the  
  *      error or condition that occurred.  
  *  
  * Side effects:  
  *      May flush output on the channel.  May cause input to be consumed  
  *      from the channel.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Gets(chan, lineRead)  
     Tcl_Channel chan;           /* Channel from which to read. */  
     Tcl_DString *lineRead;      /* The line read will be appended to this  
                                  * DString as UTF-8 characters.  The caller  
                                  * must have initialized it and is responsible  
                                  * for managing the storage. */  
 {  
     Tcl_Obj *objPtr;  
     int charsStored, length;  
     char *string;  
   
     objPtr = Tcl_NewObj();  
     charsStored = Tcl_GetsObj(chan, objPtr);  
     if (charsStored > 0) {  
         string = Tcl_GetStringFromObj(objPtr, &length);  
         Tcl_DStringAppend(lineRead, string, length);  
     }  
     Tcl_DecrRefCount(objPtr);  
     return charsStored;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * Tcl_GetsObj --  
  *  
  *      Accumulate input from the input channel until end-of-line or  
  *      end-of-file has been seen.  Bytes read from the input channel  
  *      are converted to UTF-8 using the encoding specified by the  
  *      channel.  
  *  
  * 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.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetsObj(chan, objPtr)  
     Tcl_Channel chan;           /* Channel from which to read. */  
     Tcl_Obj *objPtr;            /* The line read will be appended to this  
                                  * object as UTF-8 characters. */  
 {  
     GetsState gs;  
     Channel *chanPtr;  
     int inEofChar, skip, copiedTotal;  
     ChannelBuffer *bufPtr;  
     Tcl_Encoding encoding;  
     char *dst, *dstEnd, *eol, *eof;  
     Tcl_EncodingState oldState;  
     int oldLength, oldFlags, oldRemoved;  
   
     chanPtr = (Channel *) chan;  
     if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {  
         copiedTotal = -1;  
         goto done;  
     }  
   
     bufPtr = chanPtr->inQueueHead;  
     encoding = chanPtr->encoding;  
   
     /*  
      * Preserved so we can restore the channel's state in case we don't  
      * find a newline in the available input.  
      */  
   
     Tcl_GetStringFromObj(objPtr, &oldLength);  
     oldFlags = chanPtr->inputEncodingFlags;  
     oldState = chanPtr->inputEncodingState;  
     oldRemoved = BUFFER_PADDING;  
     if (bufPtr != NULL) {  
         oldRemoved = bufPtr->nextRemoved;  
     }  
   
     /*  
      * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't  
      * produce ByteArray objects.  To avoid circularity problems,  
      * "iso8859-1" is builtin to Tcl.  
      */  
   
     if (encoding == NULL) {  
         encoding = Tcl_GetEncoding(NULL, "iso8859-1");  
     }  
   
     /*  
      * Object used by FilterInputBytes to keep track of how much data has  
      * been consumed from the channel buffers.  
      */  
   
     gs.objPtr           = objPtr;  
     gs.dstPtr           = &dst;  
     gs.encoding         = encoding;  
     gs.bufPtr           = bufPtr;  
     gs.state            = oldState;  
     gs.rawRead          = 0;  
     gs.bytesWrote       = 0;  
     gs.charsWrote       = 0;  
     gs.totalChars       = 0;  
   
     dst = objPtr->bytes + oldLength;  
     dstEnd = dst;  
   
     skip = 0;  
     eof = NULL;  
     inEofChar = chanPtr->inEofChar;  
   
     while (1) {  
         if (dst >= dstEnd) {  
             if (FilterInputBytes(chanPtr, &gs) != 0) {  
                 goto restore;  
             }  
             dstEnd = dst + gs.bytesWrote;  
         }  
           
         /*  
          * Remember if EOF char is seen, then look for EOL anyhow, because  
          * the EOL might be before the EOF char.  
          */  
   
         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.  
          */  
   
         eol = dst;  
         switch (chanPtr->inputTranslation) {  
             case TCL_TRANSLATE_LF: {  
                 for (eol = dst; eol < dstEnd; eol++) {  
                     if (*eol == '\n') {  
                         skip = 1;  
                         goto goteol;  
                     }  
                 }  
                 break;  
             }  
             case TCL_TRANSLATE_CR: {  
                 for (eol = dst; eol < dstEnd; eol++) {  
                     if (*eol == '\r') {  
                         skip = 1;  
                         goto goteol;  
                     }  
                 }  
                 break;  
             }  
             case TCL_TRANSLATE_CRLF: {  
                 for (eol = dst; eol < dstEnd; eol++) {  
                     if (*eol == '\r') {  
                         eol++;  
                         if (eol >= dstEnd) {  
                             int offset;  
                               
                             offset = eol - objPtr->bytes;  
                             dst = dstEnd;  
                             if (FilterInputBytes(chanPtr, &gs) != 0) {  
                                 goto restore;  
                             }  
                             dstEnd = dst + gs.bytesWrote;  
                             eol = objPtr->bytes + offset;  
                             if (eol >= dstEnd) {  
                                 skip = 0;  
                                 goto goteol;  
                             }  
                         }  
                         if (*eol == '\n') {  
                             eol--;  
                             skip = 2;  
                             goto goteol;  
                         }  
                     }  
                 }  
                 break;  
             }  
             case TCL_TRANSLATE_AUTO: {  
                 skip = 1;  
                 if (chanPtr->flags & INPUT_SAW_CR) {  
                     chanPtr->flags &= ~INPUT_SAW_CR;  
                     if (*eol == '\n') {  
                         /*  
                          * Skip the raw bytes that make up the '\n'.  
                          */  
   
                         char tmp[1 + TCL_UTF_MAX];  
                         int rawRead;  
   
                         bufPtr = gs.bufPtr;  
                         Tcl_ExternalToUtf(NULL, gs.encoding,  
                                 bufPtr->buf + bufPtr->nextRemoved,  
                                 gs.rawRead, chanPtr->inputEncodingFlags,  
                                 &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,  
                                 NULL, NULL);  
                         bufPtr->nextRemoved += rawRead;  
                         gs.rawRead -= rawRead;  
                         gs.bytesWrote--;  
                         gs.charsWrote--;  
                         memmove(dst, dst + 1, (size_t) (dstEnd - dst));  
                         dstEnd--;  
                     }  
                 }  
                 for (eol = dst; eol < dstEnd; eol++) {  
                     if (*eol == '\r') {  
                         eol++;  
                         if (eol == dstEnd) {  
                             /*  
                              * If buffer ended on \r, peek ahead to see if a  
                              * \n is available.  
                              */  
   
                             int offset;  
                               
                             offset = eol - objPtr->bytes;  
                             dst = dstEnd;  
                             PeekAhead(chanPtr, &dstEnd, &gs);  
                             eol = objPtr->bytes + offset;  
                             if (eol >= dstEnd) {  
                                 eol--;  
                                 chanPtr->flags |= INPUT_SAW_CR;  
                                 goto goteol;  
                             }  
                         }  
                         if (*eol == '\n') {  
                             skip++;  
                         }  
                         eol--;  
                         goto goteol;  
                     } else if (*eol == '\n') {  
                         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.  
              */  
   
             dstEnd = eof;  
             chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);  
             chanPtr->inputEncodingFlags |= TCL_ENCODING_END;  
         }  
         if (chanPtr->flags & CHANNEL_EOF) {  
             skip = 0;  
             eol = dstEnd;  
             if (eol == objPtr->bytes) {  
                 /*  
                  * If we didn't produce any bytes before encountering EOF,  
                  * caller needs to see -1.  
                  */  
   
                 Tcl_SetObjLength(objPtr, 0);  
                 CommonGetsCleanup(chanPtr, encoding);  
                 copiedTotal = -1;  
                 goto done;  
             }  
             goto goteol;  
         }  
         dst = dstEnd;  
     }  
   
     /*  
      * Found EOL or EOF, but the output buffer may now contain too many  
      * UTF-8 characters.  We need to know how many raw bytes correspond to  
      * the number of UTF-8 characters we want, plus how many raw bytes  
      * correspond to the character(s) making up EOL (if any), so we can  
      * remove the correct number of bytes from the channel buffer.  
      */  
       
     goteol:  
     bufPtr = gs.bufPtr;  
     chanPtr->inputEncodingState = gs.state;  
     Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,  
             gs.rawRead, chanPtr->inputEncodingFlags,  
             &chanPtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,  
             &gs.rawRead, NULL, &gs.charsWrote);  
     bufPtr->nextRemoved += gs.rawRead;  
   
     /*  
      * Recycle all the emptied buffers.  
      */  
   
     Tcl_SetObjLength(objPtr, eol - objPtr->bytes);  
     CommonGetsCleanup(chanPtr, encoding);  
     chanPtr->flags &= ~CHANNEL_BLOCKED;  
     copiedTotal = gs.totalChars + gs.charsWrote - skip;  
     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 = chanPtr->inQueueHead;  
     bufPtr->nextRemoved = oldRemoved;  
   
     for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {  
         bufPtr->nextRemoved = BUFFER_PADDING;  
     }  
     CommonGetsCleanup(chanPtr, encoding);  
   
     chanPtr->inputEncodingState = oldState;  
     chanPtr->inputEncodingFlags = oldFlags;  
     Tcl_SetObjLength(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.  
      */  
   
     chanPtr->flags |= CHANNEL_NEED_MORE_DATA;  
     copiedTotal = -1;  
   
     done:  
     /*  
      * Update the notifier state so we don't block while there is still  
      * data in the buffers.  
      */  
   
     UpdateInterest(chanPtr);  
     return copiedTotal;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * FilterInputBytes --  
  *  
  *      Helper function for Tcl_GetsObj.  Produces UTF-8 characters from  
  *      raw bytes read from the channel.    
  *  
  *      Consumes available bytes from channel buffers.  When channel  
  *      buffers are exhausted, reads more bytes from channel device into  
  *      a new channel buffer.  It is the caller's responsibility to  
  *      free the channel buffers that have been exhausted.  
  *  
  * Results:  
  *      The return value is -1 if there was an error reading from the  
  *      channel, 0 otherwise.  
  *  
  * Side effects:  
  *      Status object keeps track of how much data from channel buffers  
  *      has been consumed and where UTF-8 bytes should be stored.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static int  
 FilterInputBytes(chanPtr, gsPtr)  
     Channel *chanPtr;           /* Channel to read. */  
     GetsState *gsPtr;           /* Current state of gets operation. */  
 {  
     ChannelBuffer *bufPtr;  
     char *raw, *rawStart, *rawEnd;  
     char *dst;  
     int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;  
     Tcl_Obj *objPtr;  
 #define ENCODING_LINESIZE   30  /* 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  
                                  * ENCODING_LINESIZE * TCL_MAX_UTF bytes of  
                                  * room. */  
   
     objPtr = gsPtr->objPtr;  
   
     /*  
      * Subtract the number of bytes that were removed from channel buffer  
      * during last call.  
      */  
   
     bufPtr = gsPtr->bufPtr;  
     if (bufPtr != NULL) {  
         bufPtr->nextRemoved += gsPtr->rawRead;  
         if (bufPtr->nextRemoved >= bufPtr->nextAdded) {  
             bufPtr = bufPtr->nextPtr;  
         }  
     }  
     gsPtr->totalChars += gsPtr->charsWrote;  
   
     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.  
          */  
           
         read:  
         if (chanPtr->flags & CHANNEL_BLOCKED) {  
             if (chanPtr->flags & CHANNEL_NONBLOCKING) {  
                 gsPtr->charsWrote = 0;  
                 gsPtr->rawRead = 0;  
                 return -1;  
             }  
             chanPtr->flags &= ~CHANNEL_BLOCKED;  
         }  
         if (GetInput(chanPtr) != 0) {  
             gsPtr->charsWrote = 0;  
             gsPtr->rawRead = 0;  
             return -1;  
         }  
         bufPtr = chanPtr->inQueueTail;  
         gsPtr->bufPtr = bufPtr;  
     }  
   
     /*  
      * Convert some of the bytes from the channel buffer to UTF-8.  Space in  
      * objPtr's string rep is used to hold the UTF-8 characters.  Grow the  
      * string rep if we need more space.  
      */  
   
     rawStart = bufPtr->buf + bufPtr->nextRemoved;  
     raw = rawStart;  
     rawEnd = bufPtr->buf + bufPtr->nextAdded;  
     rawLen = rawEnd - rawStart;  
   
     dst = *gsPtr->dstPtr;  
     offset = dst - objPtr->bytes;  
     toRead = ENCODING_LINESIZE;  
     if (toRead > rawLen) {  
         toRead = rawLen;  
     }  
     dstNeeded = toRead * TCL_UTF_MAX + 1;  
     spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;  
     if (dstNeeded > spaceLeft) {  
         length = offset * 2;  
         if (offset < dstNeeded) {  
             length = offset + dstNeeded;  
         }  
         length += TCL_UTF_MAX + 1;  
         Tcl_SetObjLength(objPtr, length);  
         spaceLeft = length - offset;  
         dst = objPtr->bytes + offset;  
         *gsPtr->dstPtr = dst;  
     }  
     gsPtr->state = chanPtr->inputEncodingState;  
     result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,  
             chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,  
             dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,  
             &gsPtr->charsWrote);  
     if (result == TCL_CONVERT_MULTIBYTE) {  
         /*  
          * The last few bytes in this channel buffer were the start of a  
          * multibyte sequence.  If this buffer was full, then move them to  
          * the next buffer so the bytes will be contiguous.    
          */  
   
         ChannelBuffer *nextPtr;  
         int extra;  
           
         nextPtr = bufPtr->nextPtr;  
         if (bufPtr->nextAdded < bufPtr->bufLength) {  
             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 (chanPtr->flags & CHANNEL_EOF) {  
                 /*  
                  * There was a partial character followed by EOF on the  
                  * device.  Fall through, returning that nothing was found.  
                  */  
   
                  bufPtr->nextRemoved = bufPtr->nextAdded;  
             } else {  
                 /*  
                  * There are no more cached raw bytes left.  See if we can  
                  * get some more.  
                  */  
   
                 goto read;  
             }  
         } else {  
             if (nextPtr == NULL) {  
                 nextPtr = AllocChannelBuffer(chanPtr->bufSize);  
                 bufPtr->nextPtr = nextPtr;  
                 chanPtr->inQueueTail = nextPtr;  
             }  
             extra = rawLen - gsPtr->rawRead;  
             memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),  
                     (VOID *) (raw + gsPtr->rawRead), (size_t) extra);  
             nextPtr->nextRemoved -= extra;  
             bufPtr->nextAdded -= extra;  
         }  
     }  
   
     gsPtr->bufPtr = bufPtr;  
     return 0;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * PeekAhead --  
  *  
  *      Helper function used by Tcl_GetsObj().  Called when we've seen a  
  *      \r at the end of the UTF-8 string and want to look ahead one  
  *      character to see if it is a \n.  
  *  
  * Results:  
  *      *gsPtr->dstPtr is filled with a pointer to the start of the range of  
  *      UTF-8 characters that were found by peeking and *dstEndPtr is filled  
  *      with a pointer to the bytes just after the end of the range.  
  *  
  * Side effects:  
  *      If no more raw bytes were available in one of the channel buffers,  
  *      tries to perform a non-blocking read to get more bytes from the  
  *      channel device.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static void  
 PeekAhead(chanPtr, dstEndPtr, gsPtr)  
     Channel *chanPtr;           /* The channel to read. */  
     char **dstEndPtr;           /* Filled with pointer to end of new range  
                                  * of UTF-8 characters. */  
     GetsState *gsPtr;           /* Current state of gets operation. */  
 {  
     ChannelBuffer *bufPtr;  
     Tcl_DriverBlockModeProc *blockModeProc;  
     int bytesLeft;  
   
     bufPtr = gsPtr->bufPtr;  
   
     /*  
      * If there's any more raw input that's still buffered, we'll peek into  
      * that.  Otherwise, only get more data from the channel driver if it  
      * looks like there might actually be more data.  The assumption is that  
      * if the channel buffer is filled right up to the end, then there  
      * might be more data to read.  
      */  
   
     blockModeProc = NULL;  
     if (bufPtr->nextPtr == NULL) {  
         bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);  
         if (bytesLeft == 0) {  
             if (bufPtr->nextAdded < bufPtr->bufLength) {  
                 /*  
                  * Don't peek ahead if last read was short read.  
                  */  
                   
                 goto cleanup;  
             }  
             if ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) {  
                 blockModeProc = chanPtr->typePtr->blockModeProc;  
                 if (blockModeProc == NULL) {  
                     /*  
                      * Don't peek ahead if cannot set non-blocking mode.  
                      */  
   
                     goto cleanup;  
                 }  
                 (*blockModeProc)(chanPtr->instanceData, TCL_MODE_NONBLOCKING);  
             }  
         }  
     }  
     if (FilterInputBytes(chanPtr, gsPtr) == 0) {  
         *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;  
     }  
     if (blockModeProc != NULL) {  
         (*blockModeProc)(chanPtr->instanceData, TCL_MODE_BLOCKING);  
     }  
     return;  
   
     cleanup:  
     bufPtr->nextRemoved += gsPtr->rawRead;  
     gsPtr->rawRead = 0;  
     gsPtr->totalChars += gsPtr->charsWrote;  
     gsPtr->bytesWrote = 0;  
     gsPtr->charsWrote = 0;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * CommonGetsCleanup --  
  *  
  *      Helper function for Tcl_GetsObj() to restore the channel after  
  *      a "gets" operation.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Encoding may be freed.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static void  
 CommonGetsCleanup(chanPtr, encoding)  
     Channel *chanPtr;  
     Tcl_Encoding encoding;  
 {  
     ChannelBuffer *bufPtr, *nextPtr;  
       
     bufPtr = chanPtr->inQueueHead;  
     for ( ; bufPtr != NULL; bufPtr = nextPtr) {  
         nextPtr = bufPtr->nextPtr;  
         if (bufPtr->nextRemoved < bufPtr->nextAdded) {  
             break;  
         }  
         RecycleBuffer(chanPtr, bufPtr, 0);  
     }  
     chanPtr->inQueueHead = bufPtr;  
     if (bufPtr == NULL) {  
         chanPtr->inQueueTail = NULL;  
     } else {  
         /*  
          * If any multi-byte characters were split across channel buffer  
          * boundaries, the split-up bytes were moved to the next channel  
          * buffer by FilterInputBytes().  Move the bytes back to their  
          * original buffer because the caller could change the channel's  
          * encoding which could change the interpretation of whether those  
          * bytes really made up multi-byte characters after all.  
          */  
           
         nextPtr = bufPtr->nextPtr;  
         for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {  
             int extra;  
   
             extra = bufPtr->bufLength - bufPtr->nextAdded;  
             if (extra > 0) {  
                 memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),  
                         (VOID *) (nextPtr->buf + BUFFER_PADDING - extra),  
                         (size_t) extra);  
                 bufPtr->nextAdded += extra;  
                 nextPtr->nextRemoved = BUFFER_PADDING;  
             }  
             bufPtr = nextPtr;  
         }  
     }  
     if (chanPtr->encoding == NULL) {  
         Tcl_FreeEncoding(encoding);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Read --  
  *  
  *      Reads a given number of bytes from a channel.  EOL and EOF  
  *      translation is done on the bytes being read, so the the number  
  *      of bytes consumed from the channel may not be equal to the  
  *      number of bytes stored in the destination buffer.  
  *  
  *      No encoding conversions are applied to the bytes being read.  
  *  
  * Results:  
  *      The number of bytes read, or -1 on error. Use Tcl_GetErrno()  
  *      to retrieve the error code for the error that occurred.  
  *  
  * Side effects:  
  *      May cause input to be buffered.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Read(chan, dst, bytesToRead)  
     Tcl_Channel chan;           /* The channel from which to read. */  
     char *dst;                  /* Where to store input read. */  
     int bytesToRead;            /* Maximum number of bytes to read. */  
 {  
     Channel *chanPtr;            
       
     chanPtr = (Channel *) chan;  
     if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {  
         return -1;  
     }  
   
     return DoRead(chanPtr, dst, bytesToRead);  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * Tcl_ReadChars --  
  *  
  *      Reads from the channel until the requested number of characters  
  *      have been seen, EOF is seen, or the channel would block.  EOL  
  *      and EOF translation is done.  If reading binary data, the raw  
  *      bytes are wrapped in a Tcl byte array object.  Otherwise, the raw  
  *      bytes are converted to UTF-8 using the channel's current encoding  
  *      and stored in a Tcl string object.  
  *  
  * Results:  
  *      The number of characters read, or -1 on error. Use Tcl_GetErrno()  
  *      to retrieve the error code for the error that occurred.  
  *  
  * Side effects:  
  *      May cause input to be buffered.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 int  
 Tcl_ReadChars(chan, objPtr, toRead, appendFlag)  
     Tcl_Channel chan;           /* The channel to read. */  
     Tcl_Obj *objPtr;            /* Input data is stored in this object. */  
     int toRead;                 /* Maximum number of characters to store,  
                                  * or -1 to read all available data (up to EOF  
                                  * or when channel blocks). */  
     int appendFlag;             /* If non-zero, data read from the channel  
                                  * will be appended to the object.  Otherwise,  
                                  * the data will replace the existing contents  
                                  * of the object. */  
   
 {  
     Channel *chanPtr;  
     int offset, factor, copied, copiedNow, result;  
     ChannelBuffer *bufPtr;  
     Tcl_Encoding encoding;  
 #define UTF_EXPANSION_FACTOR    1024  
       
     chanPtr = (Channel *) chan;  
     if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {  
         copied = -1;  
         goto done;  
     }  
   
     encoding = chanPtr->encoding;  
     factor = UTF_EXPANSION_FACTOR;  
   
     if (appendFlag == 0) {  
         if (encoding == NULL) {  
             Tcl_SetByteArrayLength(objPtr, 0);  
         } else {  
             Tcl_SetObjLength(objPtr, 0);  
         }  
         offset = 0;  
     } else {  
         if (encoding == NULL) {  
             Tcl_GetByteArrayFromObj(objPtr, &offset);  
         } else {  
             Tcl_GetStringFromObj(objPtr, &offset);  
         }  
     }  
   
     for (copied = 0; (unsigned) toRead > 0; ) {  
         copiedNow = -1;  
         if (chanPtr->inQueueHead != NULL) {  
             if (encoding == NULL) {  
                 copiedNow = ReadBytes(chanPtr, objPtr, toRead, &offset);  
             } else {  
                 copiedNow = ReadChars(chanPtr, objPtr, toRead, &offset,  
                         &factor);  
             }  
   
             /*  
              * If the current buffer is empty recycle it.  
              */  
   
             bufPtr = chanPtr->inQueueHead;  
             if (bufPtr->nextRemoved == bufPtr->nextAdded) {  
                 ChannelBuffer *nextPtr;  
   
                 nextPtr = bufPtr->nextPtr;  
                 RecycleBuffer(chanPtr, bufPtr, 0);  
                 chanPtr->inQueueHead = nextPtr;  
                 if (nextPtr == NULL) {  
                     chanPtr->inQueueTail = nextPtr;  
                 }  
             }  
         }  
         if (copiedNow < 0) {  
             if (chanPtr->flags & CHANNEL_EOF) {  
                 break;  
             }  
             if (chanPtr->flags & CHANNEL_BLOCKED) {  
                 if (chanPtr->flags & CHANNEL_NONBLOCKING) {  
                     break;  
                 }  
                 chanPtr->flags &= ~CHANNEL_BLOCKED;  
             }  
             result = GetInput(chanPtr);  
             if (result != 0) {  
                 if (result == EAGAIN) {  
                     break;  
                 }  
                 copied = -1;  
                 goto done;  
             }  
         } else {  
             copied += copiedNow;  
             toRead -= copiedNow;  
         }  
     }  
     chanPtr->flags &= ~CHANNEL_BLOCKED;  
     if (encoding == NULL) {  
         Tcl_SetByteArrayLength(objPtr, offset);  
     } else {  
         Tcl_SetObjLength(objPtr, offset);  
     }  
   
     done:  
     /*  
      * Update the notifier state so we don't block while there is still  
      * data in the buffers.  
      */  
   
     UpdateInterest(chanPtr);  
     return copied;  
 }  
 /*  
  *---------------------------------------------------------------------------  
  *  
  * ReadBytes --  
  *  
  *      Reads from the channel until the requested number of bytes have  
  *      been seen, EOF is seen, or the channel would block.  Bytes from  
  *      the channel are stored in objPtr as a ByteArray object.  EOL  
  *      and EOF translation are done.  
  *  
  *      'bytesToRead' can safely be a very large number because  
  *      space is only allocated to hold data read from the channel  
  *      as needed.  
  *  
  * Results:  
  *      The return value is the number of bytes appended to the object  
  *      and *offsetPtr is filled with the total number of bytes in the  
  *      object (greater than the return value if there were already bytes  
  *      in the object).  
  *  
  * Side effects:  
  *      None.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static int  
 ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)  
     Channel *chanPtr;           /* The channel to read. */  
     int bytesToRead;            /* Maximum number of characters to store,  
                                  * or < 0 to get all available characters.  
                                  * Characters are obtained from the first  
                                  * buffer in the queue -- even if this number  
                                  * is larger than the number of characters  
                                  * available in the first buffer, only the  
                                  * characters from the first buffer are  
                                  * returned. */  
     Tcl_Obj *objPtr;            /* Input data is appended to this ByteArray  
                                  * object.  Its length is how much space  
                                  * has been allocated to hold data, not how  
                                  * many bytes of data have been stored in the  
                                  * object. */  
     int *offsetPtr;             /* On input, contains how many bytes of  
                                  * objPtr have been used to hold data.  On  
                                  * output, filled with how many bytes are now  
                                  * being used. */  
 {  
     int toRead, srcLen, srcRead, dstWrote, offset, length;  
     ChannelBuffer *bufPtr;  
     char *src, *dst;  
   
     offset = *offsetPtr;  
   
     bufPtr = chanPtr->inQueueHead;  
     src = bufPtr->buf + bufPtr->nextRemoved;  
     srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;  
   
     toRead = bytesToRead;  
     if ((unsigned) toRead > (unsigned) srcLen) {  
         toRead = srcLen;  
     }  
   
     dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);  
     if (toRead > length - offset - 1) {  
         /*  
          * Double the existing size of the object or make enough room to  
          * hold all the characters we may get from the source buffer,  
          * whichever is larger.  
          */  
   
         length = offset * 2;  
         if (offset < toRead) {  
             length = offset + toRead + 1;  
         }  
         dst = (char *) Tcl_SetByteArrayLength(objPtr, length);  
     }  
     dst += offset;  
   
     if (chanPtr->flags & INPUT_NEED_NL) {  
         chanPtr->flags &= ~INPUT_NEED_NL;  
         if ((srcLen == 0) || (*src != '\n')) {  
             *dst = '\r';  
             *offsetPtr += 1;  
             return 1;  
         }  
         *dst++ = '\n';  
         src++;  
         srcLen--;  
         toRead--;  
     }  
   
     srcRead = srcLen;  
     dstWrote = toRead;  
     if (TranslateInputEOL(chanPtr, dst, src, &dstWrote, &srcRead) != 0) {  
         if (dstWrote == 0) {  
             return -1;  
         }  
     }  
     bufPtr->nextRemoved += srcRead;  
     *offsetPtr += dstWrote;  
     return dstWrote;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * ReadChars --  
  *  
  *      Reads from the channel until the requested number of UTF-8  
  *      characters have been seen, EOF is seen, or the channel would  
  *      block.  Raw bytes from the channel are converted to UTF-8  
  *      and stored in objPtr.  EOL and EOF translation is done.  
  *  
  *      'charsToRead' can safely be a very large number because  
  *      space is only allocated to hold data read from the channel  
  *      as needed.  
  *  
  * 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 *factorPtr is filled with the expansion  
  *      factor used to guess how many bytes of UTF-8 to allocate to  
  *      hold N source bytes.  
  *  
  * Side effects:  
  *      None.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static int  
 ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)  
     Channel *chanPtr;           /* The channel to read. */  
     int charsToRead;            /* Maximum number of characters to store,  
                                  * or -1 to get all available characters.  
                                  * Characters are obtained from the first  
                                  * buffer in the queue -- even if this number  
                                  * is larger than the number of characters  
                                  * available in the first buffer, only the  
                                  * characters from the first buffer are  
                                  * returned. */  
     Tcl_Obj *objPtr;            /* Input data is appended to this object.  
                                  * objPtr->length is how much space has been  
                                  * allocated to hold data, not how many bytes  
                                  * of data have been stored in the object. */  
     int *offsetPtr;             /* On input, contains how many bytes of  
                                  * objPtr have been used to hold data.  On  
                                  * output, filled with how many bytes are now  
                                  * being used. */  
     int *factorPtr;             /* On input, contains a guess of how many  
                                  * bytes need to be allocated to hold the  
                                  * result of converting N source bytes to  
                                  * UTF-8.  On output, contains another guess  
                                  * based on the data seen so far. */  
 {  
     int toRead, factor, offset, spaceLeft, length;  
     int srcLen, srcRead, dstNeeded, dstRead, dstWrote, numChars;  
     ChannelBuffer *bufPtr;  
     char *src, *dst;  
     Tcl_EncodingState oldState;  
   
     factor = *factorPtr;  
     offset = *offsetPtr;  
   
     bufPtr = chanPtr->inQueueHead;  
     src = bufPtr->buf + bufPtr->nextRemoved;  
     srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;  
   
     toRead = charsToRead;  
     if ((unsigned) toRead > (unsigned) srcLen) {  
         toRead = srcLen;  
     }  
   
     /*  
      * 'factor' is how much we guess that the bytes in the source buffer  
      * will expand when converted to UTF-8 chars.  This guess comes from  
      * analyzing how many characters were produced by the previous  
      * pass.  
      */  
   
     dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;  
     spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;  
   
     if (dstNeeded > spaceLeft) {  
         /*  
          * Double the existing size of the object or make enough room to  
          * hold all the characters we want from the source buffer,  
          * whichever is larger.  
          */  
   
         length = offset * 2;  
         if (offset < dstNeeded) {  
             length = offset + dstNeeded;  
         }  
         spaceLeft = length - offset;  
         length += TCL_UTF_MAX + 1;  
         Tcl_SetObjLength(objPtr, length);  
     }  
     if (toRead == srcLen) {  
         /*  
          * Want to convert the whole buffer in one pass.  If we have  
          * enough space, convert it using all available space in object  
          * rather than using the factor.  
          */  
   
         dstNeeded = spaceLeft;  
     }  
     dst = objPtr->bytes + offset;  
   
     oldState = chanPtr->inputEncodingState;  
     if (chanPtr->flags & INPUT_NEED_NL) {  
         /*  
          * We want a '\n' because the last character we saw was '\r'.  
          */  
           
         chanPtr->flags &= ~INPUT_NEED_NL;  
         Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,  
                 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,  
                 dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);  
         if ((dstWrote > 0) && (*dst == '\n')) {  
             /*  
              * The next char was a '\n'.  Consume it and produce a '\n'.  
              */  
               
             bufPtr->nextRemoved += srcRead;  
         } else {  
             /*  
              * The next char was not a '\n'.  Produce a '\r'.  
              */  
   
             *dst = '\r';  
         }  
         chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;  
         *offsetPtr += 1;  
         return 1;  
     }  
   
     Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,  
             chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState, dst,  
             dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);  
     if (srcRead == 0) {  
         /*  
          * Not enough bytes in src buffer to make a complete char.  Copy  
          * the bytes to the next buffer to make a new contiguous string,  
          * then tell the caller to fill the buffer with more bytes.  
          */  
   
         ChannelBuffer *nextPtr;  
           
         nextPtr = bufPtr->nextPtr;  
         if (nextPtr == NULL) {  
             /*  
              * 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.  
              */  
   
             chanPtr->flags |= CHANNEL_NEED_MORE_DATA;  
             return -1;  
         }  
         nextPtr->nextRemoved -= srcLen;  
         memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,  
                 (size_t) srcLen);  
         RecycleBuffer(chanPtr, bufPtr, 0);  
         chanPtr->inQueueHead = nextPtr;  
         return ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr);  
     }  
   
     dstRead = dstWrote;  
     if (TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead) != 0) {  
         /*  
          * Hit EOF char.  How many bytes of src correspond to where the  
          * EOF was located in dst?  
          */  
           
         if (dstWrote == 0) {  
             return -1;  
         }  
         chanPtr->inputEncodingState = oldState;  
         Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,  
                 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,  
                 dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);  
         TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);  
     }  
   
     /*  
      * The number of characters that we got may be less than the number  
      * that we started with because "\r\n" sequences may have been  
      * turned into just '\n' in dst.  
      */  
   
     numChars -= (dstRead - dstWrote);  
   
     if ((unsigned) numChars > (unsigned) toRead) {  
         /*  
          * Got too many chars.  
          */  
   
         char *eof;  
   
         eof = Tcl_UtfAtIndex(dst, toRead);  
         chanPtr->inputEncodingState = oldState;  
         Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,  
                 chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,  
                 dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);  
         dstRead = dstWrote;  
         TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);  
         numChars -= (dstRead - dstWrote);  
     }  
     chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;  
   
     bufPtr->nextRemoved += srcRead;  
     if (dstWrote > srcRead + 1) {  
         *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;  
     }  
     *offsetPtr += dstWrote;  
     return numChars;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TranslateInputEOL --  
  *  
  *      Perform input EOL and EOF translation on the source buffer,  
  *      leaving the translated result in the destination buffer.    
  *  
  * Results:  
  *      The return value is 1 if the EOF character was found when copying  
  *      bytes to the destination buffer, 0 otherwise.    
  *  
  * Side effects:  
  *      None.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static int  
 TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)  
     Channel *chanPtr;           /* Channel being read, for EOL translation  
                                  * and EOF character. */  
     char *dstStart;             /* Output buffer filled with chars by  
                                  * applying appropriate EOL translation to  
                                  * 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  
                                  * output buffer. */  
     int *srcLenPtr;             /* On entry, the length of source buffer.  
                                  * On exit, the number of bytes read from  
                                  * the source buffer. */  
 {  
     int dstLen, srcLen, inEofChar;  
     CONST char *eof;  
   
     dstLen = *dstLenPtr;  
   
     eof = NULL;  
     inEofChar = chanPtr->inEofChar;  
     if (inEofChar != '\0') {  
         /*  
          * Find EOF in translated buffer then compress out the EOL.  The  
          * source buffer may be much longer than the destination buffer --  
          * we only want to return EOF if the EOF has been copied to the  
          * destination buffer.  
          */  
   
         CONST char *src, *srcMax;  
   
         srcMax = srcStart + *srcLenPtr;  
         for (src = srcStart; src < srcMax; src++) {  
             if (*src == inEofChar) {  
                 eof = src;  
                 srcLen = src - srcStart;  
                 if (srcLen < dstLen) {  
                     dstLen = srcLen;  
                 }  
                 *srcLenPtr = srcLen;  
                 break;  
             }  
         }  
     }  
     switch (chanPtr->inputTranslation) {  
         case TCL_TRANSLATE_LF: {  
             if (dstStart != srcStart) {  
                 memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);  
             }  
             srcLen = dstLen;  
             break;  
         }  
         case TCL_TRANSLATE_CR: {  
             char *dst, *dstEnd;  
               
             if (dstStart != srcStart) {  
                 memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);  
             }  
             dstEnd = dstStart + dstLen;  
             for (dst = dstStart; dst < dstEnd; dst++) {  
                 if (*dst == '\r') {  
                     *dst = '\n';  
                 }  
             }  
             srcLen = dstLen;  
             break;  
         }  
         case TCL_TRANSLATE_CRLF: {  
             char *dst;  
             CONST char *src, *srcEnd, *srcMax;  
               
             dst = dstStart;  
             src = srcStart;  
             srcEnd = srcStart + dstLen;  
             srcMax = srcStart + *srcLenPtr;  
   
             for ( ; src < srcEnd; ) {  
                 if (*src == '\r') {  
                     src++;  
                     if (src >= srcMax) {  
                         chanPtr->flags |= INPUT_NEED_NL;  
                     } else if (*src == '\n') {  
                         *dst++ = *src++;  
                     } else {  
                         *dst++ = '\r';  
                     }  
                 } else {  
                     *dst++ = *src++;  
                 }  
             }  
             srcLen = src - srcStart;  
             dstLen = dst - dstStart;  
             break;  
         }  
         case TCL_TRANSLATE_AUTO: {  
             char *dst;  
             CONST char *src, *srcEnd, *srcMax;  
   
             dst = dstStart;  
             src = srcStart;  
             srcEnd = srcStart + dstLen;  
             srcMax = srcStart + *srcLenPtr;  
   
             if ((chanPtr->flags & INPUT_SAW_CR) && (src < srcMax)) {  
                 if (*src == '\n') {  
                     src++;  
                 }  
                 chanPtr->flags &= ~INPUT_SAW_CR;  
             }  
             for ( ; src < srcEnd; ) {  
                 if (*src == '\r') {  
                     src++;  
                     if (src >= srcMax) {  
                         chanPtr->flags |= INPUT_SAW_CR;  
                     } else if (*src == '\n') {  
                         if (srcEnd < srcMax) {  
                             srcEnd++;  
                         }  
                         src++;  
                     }  
                     *dst++ = '\n';  
                 } else {  
                     *dst++ = *src++;  
                 }  
             }  
             srcLen = src - srcStart;  
             dstLen = dst - dstStart;  
             break;  
         }  
         default: {              /* lint. */  
             return 0;  
         }  
     }  
     *dstLenPtr = dstLen;  
   
     if ((eof != NULL) && (srcStart + srcLen >= eof)) {  
         /*  
          * EOF character was seen in EOL translated range.  Leave current  
          * file position pointing at the EOF character, but don't store the  
          * EOF character in the output string.  
          */  
   
         chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);  
         chanPtr->inputEncodingFlags |= TCL_ENCODING_END;  
         chanPtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);  
         return 1;  
     }  
   
     *srcLenPtr = srcLen;  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Ungets --  
  *  
  *      Causes the supplied string to be added to the input queue of  
  *      the channel, at either the head or tail of the queue.  
  *  
  * Results:  
  *      The number of bytes stored in the channel, or -1 on error.  
  *  
  * Side effects:  
  *      Adds input to the input queue of a channel.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Ungets(chan, str, len, atEnd)  
     Tcl_Channel chan;           /* The channel for which to add the input. */  
     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. */      
 {  
     Channel *chanPtr;           /* The real IO channel. */  
     ChannelBuffer *bufPtr;      /* Buffer to contain the data. */  
     int i, flags;  
   
     chanPtr = (Channel *) chan;  
       
     /*  
      * CheckChannelErrors clears too many flag bits in this one case.  
      */  
       
     flags = chanPtr->flags;  
     if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {  
         len = -1;  
         goto done;  
     }  
     chanPtr->flags = flags;  
   
     /*  
      * If we have encountered a sticky EOF, just punt without storing.  
      * (sticky EOF is set if we have seen the input eofChar, to prevent  
      * reading beyond the eofChar). Otherwise, clear the EOF flags, and  
      * clear the BLOCKED bit. We want to discover these conditions anew  
      * in each operation.  
      */  
   
     if (chanPtr->flags & CHANNEL_STICKY_EOF) {  
         goto done;  
     }  
     chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));  
   
     bufPtr = AllocChannelBuffer(len);  
     for (i = 0; i < len; i++) {  
         bufPtr->buf[i] = str[i];  
     }  
     bufPtr->nextAdded += len;  
   
     if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {  
         bufPtr->nextPtr = (ChannelBuffer *) NULL;  
         chanPtr->inQueueHead = bufPtr;  
         chanPtr->inQueueTail = bufPtr;  
     } else if (atEnd) {  
         bufPtr->nextPtr = (ChannelBuffer *) NULL;  
         chanPtr->inQueueTail->nextPtr = bufPtr;  
         chanPtr->inQueueTail = bufPtr;  
     } else {  
         bufPtr->nextPtr = chanPtr->inQueueHead;  
         chanPtr->inQueueHead = bufPtr;  
     }  
   
     done:  
     /*  
      * Update the notifier state so we don't block while there is still  
      * data in the buffers.  
      */  
   
     UpdateInterest(chanPtr);  
     return len;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Flush --  
  *  
  *      Flushes output data on a channel.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      May flush output queued on this channel.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Flush(chan)  
     Tcl_Channel chan;                   /* The Channel to flush. */  
 {  
     int result;                         /* Of calling FlushChannel. */  
     Channel *chanPtr;                   /* The actual channel. */  
   
     chanPtr = (Channel *) chan;  
     if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {  
         return -1;  
     }  
   
     /*  
      * Force current output buffer to be output also.  
      */  
       
     if ((chanPtr->curOutPtr != NULL)  
             && (chanPtr->curOutPtr->nextAdded > 0)) {  
         chanPtr->flags |= BUFFER_READY;  
     }  
       
     result = FlushChannel(NULL, chanPtr, 0);  
     if (result != 0) {  
         return TCL_ERROR;  
     }  
   
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * DiscardInputQueued --  
  *  
  *      Discards any input read from the channel but not yet consumed  
  *      by Tcl reading commands.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      May discard input from the channel. If discardLastBuffer is zero,  
  *      leaves one buffer in place for back-filling.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 DiscardInputQueued(chanPtr, discardSavedBuffers)  
     Channel *chanPtr;           /* Channel on which to discard  
                                  * the queued input. */  
     int discardSavedBuffers;    /* If non-zero, discard all buffers including  
                                  * last one. */  
 {  
     ChannelBuffer *bufPtr, *nxtPtr;     /* Loop variables. */  
   
     bufPtr = chanPtr->inQueueHead;  
     chanPtr->inQueueHead = (ChannelBuffer *) NULL;  
     chanPtr->inQueueTail = (ChannelBuffer *) NULL;  
     for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {  
         nxtPtr = bufPtr->nextPtr;  
         RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);  
     }  
   
     /*  
      * If discardSavedBuffers is nonzero, must also discard any previously  
      * saved buffer in the saveInBufPtr field.  
      */  
       
     if (discardSavedBuffers) {  
         if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {  
             ckfree((char *) chanPtr->saveInBufPtr);  
             chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;  
         }  
     }  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * GetInput --  
  *  
  *      Reads input data from a device into a channel buffer.    
  *  
  * Results:  
  *      The return value is the Posix error code if an error occurred while  
  *      reading from the file, or 0 otherwise.    
  *  
  * Side effects:  
  *      Reads from the underlying device.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static int  
 GetInput(chanPtr)  
     Channel *chanPtr;           /* Channel to read input from. */  
 {  
     int toRead;                 /* How much to read? */  
     int result;                 /* Of calling driver. */  
     int nread;                  /* How much was read from channel? */  
     ChannelBuffer *bufPtr;      /* New buffer to add to input queue. */  
   
     /*  
      * Prevent reading from a dead channel -- a channel that has been closed  
      * but not yet deallocated, which can happen if the exit handler for  
      * channel cleanup has run but the channel is still registered in some  
      * interpreter.  
      */  
       
     if (CheckForDeadChannel(NULL, chanPtr)) {  
         return EINVAL;  
     }  
   
     /*  
      * See if we can fill an existing buffer. If we can, read only  
      * as much as will fit in it. Otherwise allocate a new buffer,  
      * add it to the input queue and attempt to fill it to the max.  
      */  
   
     bufPtr = chanPtr->inQueueTail;  
     if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {  
         toRead = bufPtr->bufLength - bufPtr->nextAdded;  
     } else {  
         bufPtr = chanPtr->saveInBufPtr;  
         chanPtr->saveInBufPtr = NULL;  
         if (bufPtr == NULL) {  
             bufPtr = AllocChannelBuffer(chanPtr->bufSize);  
         }  
         bufPtr->nextPtr = (ChannelBuffer *) NULL;  
   
         toRead = chanPtr->bufSize;  
         if (chanPtr->inQueueTail == NULL) {  
             chanPtr->inQueueHead = bufPtr;  
         } else {  
             chanPtr->inQueueTail->nextPtr = bufPtr;  
         }  
         chanPtr->inQueueTail = bufPtr;  
     }  
         
     /*  
      * If EOF is set, we should avoid calling the driver because on some  
      * platforms it is impossible to read from a device after EOF.  
      */  
   
     if (chanPtr->flags & CHANNEL_EOF) {  
         return 0;  
     }  
   
     nread = (*chanPtr->typePtr->inputProc)(chanPtr->instanceData,  
             bufPtr->buf + bufPtr->nextAdded, toRead, &result);  
   
     if (nread > 0) {  
         bufPtr->nextAdded += nread;  
   
         /*  
          * 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 < toRead) {  
             chanPtr->flags |= CHANNEL_BLOCKED;  
         }  
     } else if (nread == 0) {  
         chanPtr->flags |= CHANNEL_EOF;  
         chanPtr->inputEncodingFlags |= TCL_ENCODING_END;  
     } else if (nread < 0) {  
         if ((result == EWOULDBLOCK) || (result == EAGAIN)) {  
             chanPtr->flags |= CHANNEL_BLOCKED;  
             result = EAGAIN;  
         }  
         Tcl_SetErrno(result);  
         return result;  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Seek --  
  *  
  *      Implements seeking on Tcl Channels. This is a public function  
  *      so that other C facilities may be implemented on top of it.  
  *  
  * Results:  
  *      The new access point or -1 on error. If error, use Tcl_GetErrno()  
  *      to retrieve the POSIX error code for the error that occurred.  
  *  
  * Side effects:  
  *      May flush output on the channel. May discard queued input.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Seek(chan, offset, mode)  
     Tcl_Channel chan;           /* The channel on which to seek. */  
     int offset;                 /* Offset to seek to. */  
     int mode;                   /* Relative to which location to seek? */  
 {  
     Channel *chanPtr;           /* The real IO channel. */  
     ChannelBuffer *bufPtr;  
     int inputBuffered, outputBuffered;  
     int result;                 /* Of device driver operations. */  
     int curPos;                 /* Position on the device. */  
     int wasAsync;               /* Was the channel nonblocking before the  
                                  * seek operation? If so, must restore to  
                                  * nonblocking mode after the seek. */  
   
     chanPtr = (Channel *) chan;  
     if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {  
         return -1;  
     }  
   
     /*  
      * Disallow seek on dead channels -- channels that have been closed but  
      * not yet been deallocated. Such channels can be found if the exit  
      * handler for channel cleanup has run but the channel is still  
      * registered in an interpreter.  
      */  
   
     if (CheckForDeadChannel(NULL,chanPtr)) return -1;  
   
     /*  
      * Disallow seek on channels whose type does not have a seek procedure  
      * defined. This means that the channel does not support seeking.  
      */  
   
     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {  
         Tcl_SetErrno(EINVAL);  
         return -1;  
     }  
   
     /*  
      * Compute how much input and output is buffered. If both input and  
      * output is buffered, cannot compute the current position.  
      */  
   
     for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;  
              bufPtr != (ChannelBuffer *) NULL;  
              bufPtr = bufPtr->nextPtr) {  
         inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);  
     }  
     for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;  
              bufPtr != (ChannelBuffer *) NULL;  
              bufPtr = bufPtr->nextPtr) {  
         outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);  
     }  
     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&  
            (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {  
         chanPtr->flags |= BUFFER_READY;  
         outputBuffered +=  
             (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);  
     }  
   
     if ((inputBuffered != 0) && (outputBuffered != 0)) {  
         Tcl_SetErrno(EFAULT);  
         return -1;  
     }  
   
     /*  
      * If we are seeking relative to the current position, compute the  
      * corrected offset taking into account the amount of unread input.  
      */  
   
     if (mode == SEEK_CUR) {  
         offset -= inputBuffered;  
     }  
   
     /*  
      * Discard any queued input - this input should not be read after  
      * the seek.  
      */  
   
     DiscardInputQueued(chanPtr, 0);  
   
     /*  
      * Reset EOF and BLOCKED flags. We invalidate them by moving the  
      * access point. Also clear CR related flags.  
      */  
   
     chanPtr->flags &=  
         (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));  
       
     /*  
      * If the channel is in asynchronous output mode, switch it back  
      * to synchronous mode and cancel any async flush that may be  
      * scheduled. After the flush, the channel will be put back into  
      * asynchronous output mode.  
      */  
   
     wasAsync = 0;  
     if (chanPtr->flags & CHANNEL_NONBLOCKING) {  
         wasAsync = 1;  
         result = 0;  
         if (chanPtr->typePtr->blockModeProc != NULL) {  
             result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,  
                     TCL_MODE_BLOCKING);  
         }  
         if (result != 0) {  
             Tcl_SetErrno(result);  
             return -1;  
         }  
         chanPtr->flags &= (~(CHANNEL_NONBLOCKING));  
         if (chanPtr->flags & BG_FLUSH_SCHEDULED) {  
             chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));  
         }  
     }  
       
     /*  
      * If the flush fails we cannot recover the original position. In  
      * that case the seek is not attempted because we do not know where  
      * the access position is - instead we return the error. FlushChannel  
      * has already called Tcl_SetErrno() to report the error upwards.  
      * If the flush succeeds we do the seek also.  
      */  
       
     if (FlushChannel(NULL, chanPtr, 0) != 0) {  
         curPos = -1;  
     } else {  
   
         /*  
          * Now seek to the new position in the channel as requested by the  
          * caller.  
          */  
   
         curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,  
                 (long) offset, mode, &result);  
         if (curPos == -1) {  
             Tcl_SetErrno(result);  
         }  
     }  
       
     /*  
      * Restore to nonblocking mode if that was the previous behavior.  
      *  
      * NOTE: Even if there was an async flush active we do not restore  
      * it now because we already flushed all the queued output, above.  
      */  
       
     if (wasAsync) {  
         chanPtr->flags |= CHANNEL_NONBLOCKING;  
         result = 0;  
         if (chanPtr->typePtr->blockModeProc != NULL) {  
             result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,  
                     TCL_MODE_NONBLOCKING);  
         }  
         if (result != 0) {  
             Tcl_SetErrno(result);  
             return -1;  
         }  
     }  
   
     return curPos;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Tell --  
  *  
  *      Returns the position of the next character to be read/written on  
  *      this channel.  
  *  
  * Results:  
  *      A nonnegative integer on success, -1 on failure. If failed,  
  *      use Tcl_GetErrno() to retrieve the POSIX error code for the  
  *      error that occurred.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Tell(chan)  
     Tcl_Channel chan;                   /* The channel to return pos for. */  
 {  
     Channel *chanPtr;                   /* The actual channel to tell on. */  
     ChannelBuffer *bufPtr;  
     int inputBuffered, outputBuffered;  
     int result;                         /* Of calling device driver. */  
     int curPos;                         /* Position on device. */  
   
     chanPtr = (Channel *) chan;  
     if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {  
         return -1;  
     }  
   
     /*  
      * Disallow tell on dead channels -- channels that have been closed but  
      * not yet been deallocated. Such channels can be found if the exit  
      * handler for channel cleanup has run but the channel is still  
      * registered in an interpreter.  
      */  
   
     if (CheckForDeadChannel(NULL,chanPtr)) {  
         return -1;  
     }  
   
     /*  
      * Disallow tell on channels whose type does not have a seek procedure  
      * defined. This means that the channel does not support seeking.  
      */  
   
     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {  
         Tcl_SetErrno(EINVAL);  
         return -1;  
     }  
   
     /*  
      * Compute how much input and output is buffered. If both input and  
      * output is buffered, cannot compute the current position.  
      */  
   
     for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;  
              bufPtr != (ChannelBuffer *) NULL;  
              bufPtr = bufPtr->nextPtr) {  
         inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);  
     }  
     for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;  
              bufPtr != (ChannelBuffer *) NULL;  
              bufPtr = bufPtr->nextPtr) {  
         outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);  
     }  
     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&  
            (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {  
         chanPtr->flags |= BUFFER_READY;  
         outputBuffered +=  
             (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);  
     }  
   
     if ((inputBuffered != 0) && (outputBuffered != 0)) {  
         Tcl_SetErrno(EFAULT);  
         return -1;  
     }  
   
     /*  
      * Get the current position in the device and compute the position  
      * where the next character will be read or written.  
      */  
   
     curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,  
             (long) 0, SEEK_CUR, &result);  
     if (curPos == -1) {  
         Tcl_SetErrno(result);  
         return -1;  
     }  
     if (inputBuffered != 0) {  
         return (curPos - inputBuffered);  
     }  
     return (curPos + outputBuffered);  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * CheckChannelErrors --  
  *  
  *      See if the channel is in an ready state and can perform the  
  *      desired operation.  
  *  
  * Results:  
  *      The return value is 0 if the channel is OK, otherwise the  
  *      return value is -1 and errno is set to indicate the error.  
  *  
  * Side effects:  
  *      May clear the EOF and/or BLOCKED bits if reading from channel.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static int  
 CheckChannelErrors(chanPtr, direction)  
     Channel *chanPtr;       /* Channel to check. */  
     int direction;          /* Test if channel supports desired operation:  
                              * TCL_READABLE, TCL_WRITABLE. */  
 {  
     /*  
      * Check for unreported error.  
      */  
   
     if (chanPtr->unreportedError != 0) {  
         Tcl_SetErrno(chanPtr->unreportedError);  
         chanPtr->unreportedError = 0;  
         return -1;  
     }  
   
     /*  
      * Fail if the channel is not opened for desired operation.  
      */  
   
     if ((chanPtr->flags & direction) == 0) {  
         Tcl_SetErrno(EACCES);  
         return -1;  
     }  
   
     /*  
      * Fail if the channel is in the middle of a background copy.  
      */  
   
     if (chanPtr->csPtr != NULL) {  
         Tcl_SetErrno(EBUSY);  
         return -1;  
     }  
   
     if (direction == TCL_READABLE) {  
         /*  
          * If we have not encountered a sticky EOF, clear the EOF bit  
          * (sticky EOF is set if we have seen the input eofChar, to prevent  
          * reading beyond the eofChar). Also, always clear the BLOCKED bit.  
          * We want to discover these conditions anew in each operation.  
          */  
           
         if ((chanPtr->flags & CHANNEL_STICKY_EOF) == 0) {  
             chanPtr->flags &= ~CHANNEL_EOF;  
         }  
         chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);  
     }  
   
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Eof --  
  *  
  *      Returns 1 if the channel is at EOF, 0 otherwise.  
  *  
  * Results:  
  *      1 or 0, always.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Eof(chan)  
     Tcl_Channel chan;                   /* Does this channel have EOF? */  
 {  
     Channel *chanPtr;           /* The real channel structure. */  
   
     chanPtr = (Channel *) chan;  
     return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||  
             ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))  
         ? 1 : 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_InputBlocked --  
  *  
  *      Returns 1 if input is blocked on this channel, 0 otherwise.  
  *  
  * Results:  
  *      0 or 1, always.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_InputBlocked(chan)  
     Tcl_Channel chan;                   /* Is this channel blocked? */  
 {  
     Channel *chanPtr;           /* The real channel structure. */  
   
     chanPtr = (Channel *) chan;  
     return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_InputBuffered --  
  *  
  *      Returns the number of bytes of input currently buffered in the  
  *      internal buffer of a channel.  
  *  
  * Results:  
  *      The number of input bytes buffered, or zero if the channel is not  
  *      open for reading.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_InputBuffered(chan)  
     Tcl_Channel chan;                   /* The channel to query. */  
 {  
     Channel *chanPtr;  
     int bytesBuffered;  
     ChannelBuffer *bufPtr;  
   
     chanPtr = (Channel *) chan;  
     for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;  
              bufPtr != (ChannelBuffer *) NULL;  
              bufPtr = bufPtr->nextPtr) {  
         bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);  
     }  
     return bytesBuffered;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_SetChannelBufferSize --  
  *  
  *      Sets the size of buffers to allocate to store input or output  
  *      in the channel. The size must be between 10 bytes and 1 MByte.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Sets the size of buffers subsequently allocated for this channel.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_SetChannelBufferSize(chan, sz)  
     Tcl_Channel chan;                   /* The channel whose buffer size  
                                          * to set. */  
     int sz;                             /* The size to set. */  
 {  
     Channel *chanPtr;  
       
     /*  
      * If the buffer size is smaller than 10 bytes or larger than one MByte,  
      * do not accept the requested size and leave the current buffer size.  
      */  
       
     if (sz < 10) {  
         return;  
     }  
     if (sz > (1024 * 1024)) {  
         return;  
     }  
   
     chanPtr = (Channel *) chan;  
     chanPtr->bufSize = sz;  
   
     if (chanPtr->outputStage != NULL) {  
         ckfree((char *) chanPtr->outputStage);  
         chanPtr->outputStage = NULL;  
     }  
     if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {  
         chanPtr->outputStage = (char *)  
                 ckalloc((unsigned) (chanPtr->bufSize + 2));  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetChannelBufferSize --  
  *  
  *      Retrieves the size of buffers to allocate for this channel.  
  *  
  * Results:  
  *      The size.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetChannelBufferSize(chan)  
     Tcl_Channel chan;           /* The channel for which to find the  
                                  * buffer size. */  
 {  
     Channel *chanPtr;  
   
     chanPtr = (Channel *) chan;  
     return chanPtr->bufSize;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_BadChannelOption --  
  *  
  *      This procedure generates a "bad option" error message in an  
  *      (optional) interpreter.  It is used by channel drivers when  
  *      a invalid Set/Get option is requested. Its purpose is to concatenate  
  *      the generic options list to the specific ones and factorize  
  *      the generic options error message string.  
  *  
  * Results:  
  *      TCL_ERROR.  
  *  
  * Side effects:  
  *      An error message is generated in interp's result object to  
  *      indicate that a command was invoked with the a bad option  
  *      The message has the form  
  *              bad option "blah": should be one of  
  *              <...generic options...>+<...specific options...>  
  *      "blah" is the optionName argument and "<specific options>"  
  *      is a space separated list of specific option words.  
  *      The function takes good care of inserting minus signs before  
  *      each option, commas after, and an "or" before the last option.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_BadChannelOption(interp, optionName, optionList)  
     Tcl_Interp *interp;                 /* Current interpreter. (can be NULL)*/  
     char *optionName;                   /* 'bad option' name */  
     char *optionList;                   /* Specific options list to append  
                                          * to the standard generic options.  
                                          * can be NULL for generic options  
                                          * only.  
                                          */  
 {  
     if (interp) {  
         CONST char *genericopt =  
                 "blocking buffering buffersize encoding eofchar translation";  
         char **argv;  
         int  argc, i;  
         Tcl_DString ds;  
   
         Tcl_DStringInit(&ds);  
         Tcl_DStringAppend(&ds, (char *) genericopt, -1);  
         if (optionList && (*optionList)) {  
             Tcl_DStringAppend(&ds, " ", 1);  
             Tcl_DStringAppend(&ds, optionList, -1);  
         }  
         if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),  
                   &argc, &argv) != TCL_OK) {  
             panic("malformed option list in channel driver");  
         }  
         Tcl_ResetResult(interp);  
         Tcl_AppendResult(interp, "bad option \"", optionName,  
                  "\": should be one of ", (char *) NULL);  
         argc--;  
         for (i = 0; i < argc; i++) {  
             Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);  
         }  
         Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);  
         Tcl_DStringFree(&ds);  
         ckfree((char *) argv);  
     }  
     Tcl_SetErrno(EINVAL);  
     return TCL_ERROR;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetChannelOption --  
  *  
  *      Gets a mode associated with an IO channel. If the optionName arg  
  *      is non NULL, retrieves the value of that option. If the optionName  
  *      arg is NULL, retrieves a list of alternating option names and  
  *      values for the given channel.  
  *  
  * Results:  
  *      A standard Tcl result. Also sets the supplied DString to the  
  *      string value of the option(s) returned.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetChannelOption(interp, chan, optionName, dsPtr)  
     Tcl_Interp *interp;         /* For error reporting - can be NULL. */  
     Tcl_Channel chan;           /* Channel on which to get option. */  
     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;  
     int flags;  
   
     /*  
      * If we are in the middle of a background copy, use the saved flags.  
      */  
   
     if (chanPtr->csPtr) {  
         if (chanPtr == chanPtr->csPtr->readPtr) {  
             flags = chanPtr->csPtr->readFlags;  
         } else {  
             flags = chanPtr->csPtr->writeFlags;  
         }  
     } else {  
         flags = chanPtr->flags;  
     }  
   
     /*  
      * Disallow options on dead channels -- channels that have been closed but  
      * not yet been deallocated. Such channels can be found if the exit  
      * handler for channel cleanup has run but the channel is still  
      * registered in an interpreter.  
      */  
   
     if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;  
   
     /*  
      * If the optionName is NULL it means that we want a list of all  
      * options and values.  
      */  
       
     if (optionName == (char *) NULL) {  
         len = 0;  
     } else {  
         len = strlen(optionName);  
     }  
       
     if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&  
             (strncmp(optionName, "-blocking", len) == 0))) {  
         if (len == 0) {  
             Tcl_DStringAppendElement(dsPtr, "-blocking");  
         }  
         Tcl_DStringAppendElement(dsPtr,  
                 (flags & CHANNEL_NONBLOCKING) ? "0" : "1");  
         if (len > 0) {  
             return TCL_OK;  
         }  
     }  
     if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&  
             (strncmp(optionName, "-buffering", len) == 0))) {  
         if (len == 0) {  
             Tcl_DStringAppendElement(dsPtr, "-buffering");  
         }  
         if (flags & CHANNEL_LINEBUFFERED) {  
             Tcl_DStringAppendElement(dsPtr, "line");  
         } else if (flags & CHANNEL_UNBUFFERED) {  
             Tcl_DStringAppendElement(dsPtr, "none");  
         } else {  
             Tcl_DStringAppendElement(dsPtr, "full");  
         }  
         if (len > 0) {  
             return TCL_OK;  
         }  
     }  
     if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&  
             (strncmp(optionName, "-buffersize", len) == 0))) {  
         if (len == 0) {  
             Tcl_DStringAppendElement(dsPtr, "-buffersize");  
         }  
         TclFormatInt(optionVal, chanPtr->bufSize);  
         Tcl_DStringAppendElement(dsPtr, optionVal);  
         if (len > 0) {  
             return TCL_OK;  
         }  
     }  
     if ((len == 0) ||  
             ((len > 2) && (optionName[1] == 'e') &&  
                     (strncmp(optionName, "-encoding", len) == 0))) {  
         if (len == 0) {  
             Tcl_DStringAppendElement(dsPtr, "-encoding");  
         }  
         if (chanPtr->encoding == NULL) {  
             Tcl_DStringAppendElement(dsPtr, "binary");  
         } else {  
             Tcl_DStringAppendElement(dsPtr,  
                     Tcl_GetEncodingName(chanPtr->encoding));  
         }  
         if (len > 0) {  
             return TCL_OK;  
         }  
     }  
     if ((len == 0) ||  
             ((len > 2) && (optionName[1] == 'e') &&  
                     (strncmp(optionName, "-eofchar", len) == 0))) {  
         if (len == 0) {  
             Tcl_DStringAppendElement(dsPtr, "-eofchar");  
         }  
         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==  
                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {  
             Tcl_DStringStartSublist(dsPtr);  
         }  
         if (flags & TCL_READABLE) {  
             if (chanPtr->inEofChar == 0) {  
                 Tcl_DStringAppendElement(dsPtr, "");  
             } else {  
                 char buf[4];  
   
                 sprintf(buf, "%c", chanPtr->inEofChar);  
                 Tcl_DStringAppendElement(dsPtr, buf);  
             }  
         }  
         if (flags & TCL_WRITABLE) {  
             if (chanPtr->outEofChar == 0) {  
                 Tcl_DStringAppendElement(dsPtr, "");  
             } else {  
                 char buf[4];  
   
                 sprintf(buf, "%c", chanPtr->outEofChar);  
                 Tcl_DStringAppendElement(dsPtr, buf);  
             }  
         }  
         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==  
                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {  
             Tcl_DStringEndSublist(dsPtr);  
         }  
         if (len > 0) {  
             return TCL_OK;  
         }  
     }  
     if ((len == 0) ||  
             ((len > 1) && (optionName[1] == 't') &&  
                     (strncmp(optionName, "-translation", len) == 0))) {  
         if (len == 0) {  
             Tcl_DStringAppendElement(dsPtr, "-translation");  
         }  
         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==  
                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {  
             Tcl_DStringStartSublist(dsPtr);  
         }  
         if (flags & TCL_READABLE) {  
             if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {  
                 Tcl_DStringAppendElement(dsPtr, "auto");  
             } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {  
                 Tcl_DStringAppendElement(dsPtr, "cr");  
             } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {  
                 Tcl_DStringAppendElement(dsPtr, "crlf");  
             } else {  
                 Tcl_DStringAppendElement(dsPtr, "lf");  
             }  
         }  
         if (flags & TCL_WRITABLE) {  
             if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {  
                 Tcl_DStringAppendElement(dsPtr, "auto");  
             } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {  
                 Tcl_DStringAppendElement(dsPtr, "cr");  
             } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {  
                 Tcl_DStringAppendElement(dsPtr, "crlf");  
             } else {  
                 Tcl_DStringAppendElement(dsPtr, "lf");  
             }  
         }  
         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==  
                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {  
             Tcl_DStringEndSublist(dsPtr);  
         }  
         if (len > 0) {  
             return TCL_OK;  
         }  
     }  
     if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {  
         /*  
          * let the driver specific handle additional options  
          * and result code and message.  
          */  
   
         return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,  
                   interp, optionName, dsPtr);  
     } else {  
         /*  
          * no driver specific options case.  
          */  
   
         if (len == 0) {  
             return TCL_OK;  
         }  
         return Tcl_BadChannelOption(interp, optionName, NULL);  
     }  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * Tcl_SetChannelOption --  
  *  
  *      Sets an option on a channel.  
  *  
  * Results:  
  *      A standard Tcl result.  On error, sets interp's result object  
  *      if interp is not NULL.  
  *  
  * Side effects:  
  *      May modify an option on a device.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 int  
 Tcl_SetChannelOption(interp, chan, optionName, newValue)  
     Tcl_Interp *interp;         /* For error reporting - can be NULL. */  
     Tcl_Channel chan;           /* Channel on which to set mode. */  
     char *optionName;           /* Which option to set? */  
     char *newValue;             /* New value for option. */  
 {  
     int newMode;                /* New (numeric) mode to sert. */  
     Channel *chanPtr;           /* The real IO channel. */  
     size_t len;                 /* Length of optionName string. */  
     int argc;  
     char **argv;  
       
     chanPtr = (Channel *) chan;  
   
     /*  
      * If the channel is in the middle of a background copy, fail.  
      */  
   
     if (chanPtr->csPtr) {  
         if (interp) {  
             Tcl_AppendResult(interp,  
                  "unable to set channel options: background copy in progress",  
                  (char *) NULL);  
         }  
         return TCL_ERROR;  
     }  
   
   
     /*  
      * Disallow options on dead channels -- channels that have been closed but  
      * not yet been deallocated. Such channels can be found if the exit  
      * handler for channel cleanup has run but the channel is still  
      * registered in an interpreter.  
      */  
   
     if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;  
       
     len = strlen(optionName);  
   
     if ((len > 2) && (optionName[1] == 'b') &&  
             (strncmp(optionName, "-blocking", len) == 0)) {  
         if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {  
             return TCL_ERROR;  
         }  
         if (newMode) {  
             newMode = TCL_MODE_BLOCKING;  
         } else {  
             newMode = TCL_MODE_NONBLOCKING;  
         }  
         return SetBlockMode(interp, chanPtr, newMode);  
     } else if ((len > 7) && (optionName[1] == 'b') &&  
             (strncmp(optionName, "-buffering", len) == 0)) {  
         len = strlen(newValue);  
         if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {  
             chanPtr->flags &=  
                 (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));  
         } else if ((newValue[0] == 'l') &&  
                 (strncmp(newValue, "line", len) == 0)) {  
             chanPtr->flags &= (~(CHANNEL_UNBUFFERED));  
             chanPtr->flags |= CHANNEL_LINEBUFFERED;  
         } else if ((newValue[0] == 'n') &&  
                 (strncmp(newValue, "none", len) == 0)) {  
             chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));  
             chanPtr->flags |= CHANNEL_UNBUFFERED;  
         } else {  
             if (interp) {  
                 Tcl_AppendResult(interp, "bad value for -buffering: ",  
                         "must be one of full, line, or none",  
                         (char *) NULL);  
                 return TCL_ERROR;  
             }  
         }  
         return TCL_OK;  
     } else if ((len > 7) && (optionName[1] == 'b') &&  
             (strncmp(optionName, "-buffersize", len) == 0)) {  
         chanPtr->bufSize = atoi(newValue);      /* INTL: "C", UTF safe. */  
         if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {  
             chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;  
         }  
     } else if ((len > 2) && (optionName[1] == 'e') &&  
             (strncmp(optionName, "-encoding", len) == 0)) {  
         Tcl_Encoding encoding;  
   
         if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {  
             encoding = NULL;  
         } else {  
             encoding = Tcl_GetEncoding(interp, newValue);  
             if (encoding == NULL) {  
                 return TCL_ERROR;  
             }  
         }  
         Tcl_FreeEncoding(chanPtr->encoding);  
         chanPtr->encoding = encoding;  
         chanPtr->inputEncodingState = NULL;  
         chanPtr->inputEncodingFlags = TCL_ENCODING_START;  
         chanPtr->outputEncodingState = NULL;  
         chanPtr->outputEncodingFlags = TCL_ENCODING_START;  
         chanPtr->flags &= ~CHANNEL_NEED_MORE_DATA;  
         UpdateInterest(chanPtr);  
     } else if ((len > 2) && (optionName[1] == 'e') &&  
             (strncmp(optionName, "-eofchar", len) == 0)) {  
         if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {  
             return TCL_ERROR;  
         }  
         if (argc == 0) {  
             chanPtr->inEofChar = 0;  
             chanPtr->outEofChar = 0;  
         } else if (argc == 1) {  
             if (chanPtr->flags & TCL_WRITABLE) {  
                 chanPtr->outEofChar = (int) argv[0][0];  
             }  
             if (chanPtr->flags & TCL_READABLE) {  
                 chanPtr->inEofChar = (int) argv[0][0];  
             }  
         } else if (argc != 2) {  
             if (interp) {  
                 Tcl_AppendResult(interp,  
                         "bad value for -eofchar: should be a list of one or",  
                         " two elements", (char *) NULL);  
             }  
             ckfree((char *) argv);  
             return TCL_ERROR;  
         } else {  
             if (chanPtr->flags & TCL_READABLE) {  
                 chanPtr->inEofChar = (int) argv[0][0];  
             }  
             if (chanPtr->flags & TCL_WRITABLE) {  
                 chanPtr->outEofChar = (int) argv[1][0];  
             }  
         }  
         if (argv != (char **) NULL) {  
             ckfree((char *) argv);  
         }  
         return TCL_OK;  
     } else if ((len > 1) && (optionName[1] == 't') &&  
             (strncmp(optionName, "-translation", len) == 0)) {  
         char *readMode, *writeMode;  
   
         if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {  
             return TCL_ERROR;  
         }  
   
         if (argc == 1) {  
             readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;  
             writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;  
         } else if (argc == 2) {  
             readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;  
             writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;  
         } else {  
             if (interp) {  
                 Tcl_AppendResult(interp,  
                         "bad value for -translation: must be a one or two",  
                         " element list", (char *) NULL);  
             }  
             ckfree((char *) argv);  
             return TCL_ERROR;  
         }  
   
         if (readMode) {  
             if (*readMode == '\0') {  
                 newMode = chanPtr->inputTranslation;  
             } else if (strcmp(readMode, "auto") == 0) {  
                 newMode = TCL_TRANSLATE_AUTO;  
             } else if (strcmp(readMode, "binary") == 0) {  
                 newMode = TCL_TRANSLATE_LF;  
                 chanPtr->inEofChar = 0;  
                 Tcl_FreeEncoding(chanPtr->encoding);                  
                 chanPtr->encoding = NULL;  
             } else if (strcmp(readMode, "lf") == 0) {  
                 newMode = TCL_TRANSLATE_LF;  
             } else if (strcmp(readMode, "cr") == 0) {  
                 newMode = TCL_TRANSLATE_CR;  
             } else if (strcmp(readMode, "crlf") == 0) {  
                 newMode = TCL_TRANSLATE_CRLF;  
             } else if (strcmp(readMode, "platform") == 0) {  
                 newMode = TCL_PLATFORM_TRANSLATION;  
             } else {  
                 if (interp) {  
                     Tcl_AppendResult(interp,  
                             "bad value for -translation: ",  
                             "must be one of auto, binary, cr, lf, crlf,",  
                             " or platform", (char *) NULL);  
                 }  
                 ckfree((char *) argv);  
                 return TCL_ERROR;  
             }  
   
             /*  
              * Reset the EOL flags since we need to look at any buffered  
              * data to see if the new translation mode allows us to  
              * complete the line.  
              */  
   
             if (newMode != chanPtr->inputTranslation) {  
                 chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;  
                 chanPtr->flags &= ~(INPUT_SAW_CR);  
                 chanPtr->flags &= ~(CHANNEL_NEED_MORE_DATA);  
                 UpdateInterest(chanPtr);  
             }  
         }  
         if (writeMode) {  
             if (*writeMode == '\0') {  
                 /* Do nothing. */  
             } else if (strcmp(writeMode, "auto") == 0) {  
                 /*  
                  * This is a hack to get TCP sockets to produce output  
                  * in CRLF mode if they are being set into AUTO mode.  
                  * A better solution for achieving this effect will be  
                  * coded later.  
                  */  
   
                 if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {  
                     chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;  
                 } else {  
                     chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;  
                 }  
             } else if (strcmp(writeMode, "binary") == 0) {  
                 chanPtr->outEofChar = 0;  
                 chanPtr->outputTranslation = TCL_TRANSLATE_LF;  
                 Tcl_FreeEncoding(chanPtr->encoding);                  
                 chanPtr->encoding = NULL;  
             } else if (strcmp(writeMode, "lf") == 0) {  
                 chanPtr->outputTranslation = TCL_TRANSLATE_LF;  
             } else if (strcmp(writeMode, "cr") == 0) {  
                 chanPtr->outputTranslation = TCL_TRANSLATE_CR;  
             } else if (strcmp(writeMode, "crlf") == 0) {  
                 chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;  
             } else if (strcmp(writeMode, "platform") == 0) {  
                 chanPtr->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", (char *) NULL);  
                 }  
                 ckfree((char *) argv);  
                 return TCL_ERROR;  
             }  
         }  
         ckfree((char *) argv);              
         return TCL_OK;  
     } else if (chanPtr->typePtr->setOptionProc != NULL) {  
         return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,  
                 interp, optionName, newValue);  
     } else {  
         return Tcl_BadChannelOption(interp, optionName, (char *) NULL);  
     }  
   
     /*  
      * If bufsize changes, need to get rid of old utility buffer.  
      */  
   
     if (chanPtr->saveInBufPtr != NULL) {  
         RecycleBuffer(chanPtr, chanPtr->saveInBufPtr, 1);  
         chanPtr->saveInBufPtr = NULL;  
     }  
     if (chanPtr->inQueueHead != NULL) {  
         if ((chanPtr->inQueueHead->nextPtr == NULL)  
                 && (chanPtr->inQueueHead->nextAdded ==  
                         chanPtr->inQueueHead->nextRemoved)) {  
             RecycleBuffer(chanPtr, chanPtr->inQueueHead, 1);  
             chanPtr->inQueueHead = NULL;  
             chanPtr->inQueueTail = NULL;  
         }  
     }  
   
     /*  
      * If encoding or bufsize changes, need to update output staging buffer.  
      */  
   
     if (chanPtr->outputStage != NULL) {  
         ckfree((char *) chanPtr->outputStage);  
         chanPtr->outputStage = NULL;  
     }  
     if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {  
         chanPtr->outputStage = (char *)  
                 ckalloc((unsigned) (chanPtr->bufSize + 2));  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * CleanupChannelHandlers --  
  *  
  *      Removes channel handlers that refer to the supplied interpreter,  
  *      so that if the actual channel is not closed now, these handlers  
  *      will not run on subsequent events on the channel. This would be  
  *      erroneous, because the interpreter no longer has a reference to  
  *      this channel.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Removes channel handlers.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 CleanupChannelHandlers(interp, chanPtr)  
     Tcl_Interp *interp;  
     Channel *chanPtr;  
 {  
     EventScriptRecord *sPtr, *prevPtr, *nextPtr;  
   
     /*  
      * Remove fileevent records on this channel that refer to the  
      * given interpreter.  
      */  
       
     for (sPtr = chanPtr->scriptRecordPtr,  
              prevPtr = (EventScriptRecord *) NULL;  
              sPtr != (EventScriptRecord *) NULL;  
              sPtr = nextPtr) {  
         nextPtr = sPtr->nextPtr;  
         if (sPtr->interp == interp) {  
             if (prevPtr == (EventScriptRecord *) NULL) {  
                 chanPtr->scriptRecordPtr = nextPtr;  
             } else {  
                 prevPtr->nextPtr = nextPtr;  
             }  
   
             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,  
                     ChannelEventScriptInvoker, (ClientData) sPtr);  
   
             Tcl_DecrRefCount(sPtr->scriptPtr);  
             ckfree((char *) sPtr);  
         } else {  
             prevPtr = sPtr;  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_NotifyChannel --  
  *  
  *      This procedure is called by a channel driver when a driver  
  *      detects an event on a channel.  This procedure is responsible  
  *      for actually handling the event by invoking any channel  
  *      handler callbacks.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Whatever the channel handler callback procedure does.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_NotifyChannel(channel, mask)  
     Tcl_Channel channel;        /* Channel that detected an event. */  
     int mask;                   /* OR'ed combination of TCL_READABLE,  
                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates  
                                  * which events were detected. */  
 {  
     Channel *chanPtr = (Channel *) channel;  
     ChannelHandler *chPtr;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
     NextChannelHandler nh;  
   
     /* Walk all channels in a stack ! and notify them in order.  
      */  
   
     while (chanPtr !=  (Channel *) NULL) {  
         /*  
          * Preserve the channel struct in case the script closes it.  
          */  
       
         Tcl_Preserve((ClientData) channel);  
   
         /*  
          * If we are flushing in the background, be sure to call FlushChannel  
          * for writable events.  Note that we have to discard the writable  
          * event so we don't call any write handlers before the flush is  
          * complete.  
          */  
   
         if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {  
             FlushChannel(NULL, chanPtr, 1);  
             mask &= ~TCL_WRITABLE;  
         }  
   
         /*  
          * Add this invocation to the list of recursive invocations of  
          * ChannelHandlerEventProc.  
          */  
       
         nh.nextHandlerPtr = (ChannelHandler *) NULL;  
         nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;  
         tsdPtr->nestedHandlerPtr = &nh;  
       
         for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {  
   
             /*  
              * If this channel handler is interested in any of the events that  
              * have occurred on the channel, invoke its procedure.  
              */  
           
           if ((chPtr->mask & mask) != 0) {  
               nh.nextHandlerPtr = chPtr->nextPtr;  
               (*(chPtr->proc))(chPtr->clientData, mask);  
               chPtr = nh.nextHandlerPtr;  
           } else {  
               chPtr = chPtr->nextPtr;  
           }  
         }  
   
         /*  
          * Update the notifier interest, since it may have changed after  
          * invoking event handlers. Skip that if the channel was deleted  
          * in the call to the channel handler.  
          */  
   
         if (chanPtr->typePtr != NULL) {  
             UpdateInterest(chanPtr);  
   
             /* Walk down the stack.  
              */  
           chanPtr = chanPtr-> supercedes;  
         } else {  
             /* Stop walking the chain, the whole stack was destroyed!  
              */  
             chanPtr = (Channel*) NULL;  
         }  
   
         Tcl_Release((ClientData) channel);  
   
         tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;  
   
         channel = (Tcl_Channel) chanPtr;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * UpdateInterest --  
  *  
  *      Arrange for the notifier to call us back at appropriate times  
  *      based on the current state of the channel.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      May schedule a timer or driver handler.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 UpdateInterest(chanPtr)  
     Channel *chanPtr;           /* Channel to update. */  
 {  
     int mask = chanPtr->interestMask;  
   
     /*  
      * If there are flushed buffers waiting to be written, then  
      * we need to watch for the channel to become writable.  
      */  
   
     if (chanPtr->flags & BG_FLUSH_SCHEDULED) {  
         mask |= TCL_WRITABLE;  
     }  
   
     /*  
      * If there is data in the input queue, and we aren't waiting for more  
      * data, then we need to schedule a timer so we don't block in the  
      * notifier.  Also, cancel the read interest so we don't get duplicate  
      * events.  
      */  
   
     if (mask & TCL_READABLE) {  
         if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)  
                 && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)  
                 && (chanPtr->inQueueHead->nextRemoved <  
                         chanPtr->inQueueHead->nextAdded)) {  
             mask &= ~TCL_READABLE;  
             if (!chanPtr->timer) {  
                 chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,  
                         (ClientData) chanPtr);  
             }  
         }  
     }  
     (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ChannelTimerProc --  
  *  
  *      Timer handler scheduled by UpdateInterest to monitor the  
  *      channel buffers until they are empty.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      May invoke channel handlers.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 ChannelTimerProc(clientData)  
     ClientData clientData;  
 {  
     Channel *chanPtr = (Channel *) clientData;  
   
     if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)  
             && (chanPtr->interestMask & TCL_READABLE)  
             && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)  
             && (chanPtr->inQueueHead->nextRemoved <  
                     chanPtr->inQueueHead->nextAdded)) {  
         /*  
          * Restart the timer in case a channel handler reenters the  
          * event loop before UpdateInterest gets called by Tcl_NotifyChannel.  
          */  
   
         chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,  
                         (ClientData) chanPtr);  
         Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);  
   
    } else {  
         chanPtr->timer = NULL;  
         UpdateInterest(chanPtr);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_CreateChannelHandler --  
  *  
  *      Arrange for a given procedure to be invoked whenever the  
  *      channel indicated by the chanPtr arg becomes readable or  
  *      writable.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      From now on, whenever the I/O channel given by chanPtr becomes  
  *      ready in the way indicated by mask, proc will be invoked.  
  *      See the manual entry for details on the calling sequence  
  *      to proc.  If there is already an event handler for chan, proc  
  *      and clientData, then the mask will be updated.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_CreateChannelHandler(chan, mask, proc, clientData)  
     Tcl_Channel chan;           /* The channel to create the handler for. */  
     int mask;                   /* OR'ed combination of TCL_READABLE,  
                                  * TCL_WRITABLE, and TCL_EXCEPTION:  
                                  * indicates conditions under which  
                                  * proc should be called. Use 0 to  
                                  * disable a registered handler. */  
     Tcl_ChannelProc *proc;      /* Procedure to call for each  
                                  * selected event. */  
     ClientData clientData;      /* Arbitrary data to pass to proc. */  
 {  
     ChannelHandler *chPtr;  
     Channel *chanPtr;  
   
     chanPtr = (Channel *) chan;  
       
     /*  
      * Check whether this channel handler is not already registered. If  
      * it is not, create a new record, else reuse existing record (smash  
      * current values).  
      */  
   
     for (chPtr = chanPtr->chPtr;  
              chPtr != (ChannelHandler *) NULL;  
              chPtr = chPtr->nextPtr) {  
         if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&  
                 (chPtr->clientData == clientData)) {  
             break;  
         }  
     }  
     if (chPtr == (ChannelHandler *) NULL) {  
         chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));  
         chPtr->mask = 0;  
         chPtr->proc = proc;  
         chPtr->clientData = clientData;  
         chPtr->chanPtr = chanPtr;  
         chPtr->nextPtr = chanPtr->chPtr;  
         chanPtr->chPtr = chPtr;  
     }  
   
     /*  
      * The remainder of the initialization below is done regardless of  
      * whether or not this is a new record or a modification of an old  
      * one.  
      */  
   
     chPtr->mask = mask;  
   
     /*  
      * Recompute the interest mask for the channel - this call may actually  
      * be disabling an existing handler.  
      */  
       
     chanPtr->interestMask = 0;  
     for (chPtr = chanPtr->chPtr;  
          chPtr != (ChannelHandler *) NULL;  
          chPtr = chPtr->nextPtr) {  
         chanPtr->interestMask |= chPtr->mask;  
     }  
   
     UpdateInterest(chanPtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DeleteChannelHandler --  
  *  
  *      Cancel a previously arranged callback arrangement for an IO  
  *      channel.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      If a callback was previously registered for this chan, proc and  
  *       clientData , it is removed and the callback will no longer be called  
  *      when the channel becomes ready for IO.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_DeleteChannelHandler(chan, proc, clientData)  
     Tcl_Channel chan;           /* The channel for which to remove the  
                                  * callback. */  
     Tcl_ChannelProc *proc;      /* The procedure in the callback to delete. */  
     ClientData clientData;      /* The client data in the callback  
                                  * to delete. */  
       
 {  
     ChannelHandler *chPtr, *prevChPtr;  
     Channel *chanPtr;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
     NextChannelHandler *nhPtr;  
   
     chanPtr = (Channel *) chan;  
   
     /*  
      * Find the entry and the previous one in the list.  
      */  
   
     for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;  
              chPtr != (ChannelHandler *) NULL;  
              chPtr = chPtr->nextPtr) {  
         if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)  
                 && (chPtr->proc == proc)) {  
             break;  
         }  
         prevChPtr = chPtr;  
     }  
       
     /*  
      * If not found, return without doing anything.  
      */  
   
     if (chPtr == (ChannelHandler *) NULL) {  
         return;  
     }  
   
     /*  
      * If ChannelHandlerEventProc is about to process this handler, tell it to  
      * process the next one instead - we are going to delete *this* one.  
      */  
   
     for (nhPtr = tsdPtr->nestedHandlerPtr;  
              nhPtr != (NextChannelHandler *) NULL;  
              nhPtr = nhPtr->nestedHandlerPtr) {  
         if (nhPtr->nextHandlerPtr == chPtr) {  
             nhPtr->nextHandlerPtr = chPtr->nextPtr;  
         }  
     }  
   
     /*  
      * Splice it out of the list of channel handlers.  
      */  
       
     if (prevChPtr == (ChannelHandler *) NULL) {  
         chanPtr->chPtr = chPtr->nextPtr;  
     } else {  
         prevChPtr->nextPtr = chPtr->nextPtr;  
     }  
     ckfree((char *) chPtr);  
   
     /*  
      * Recompute the interest list for the channel, so that infinite loops  
      * will not result if Tcl_DeleteChannelHandler is called inside an  
      * event.  
      */  
   
     chanPtr->interestMask = 0;  
     for (chPtr = chanPtr->chPtr;  
              chPtr != (ChannelHandler *) NULL;  
              chPtr = chPtr->nextPtr) {  
         chanPtr->interestMask |= chPtr->mask;  
     }  
   
     UpdateInterest(chanPtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * DeleteScriptRecord --  
  *  
  *      Delete a script record for this combination of channel, interp  
  *      and mask.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Deletes a script record and cancels a channel event handler.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 DeleteScriptRecord(interp, chanPtr, mask)  
     Tcl_Interp *interp;         /* Interpreter in which script was to be  
                                  * executed. */  
     Channel *chanPtr;           /* The channel for which to delete the  
                                  * script record (if any). */  
     int mask;                   /* Events in mask must exactly match mask  
                                  * of script to delete. */  
 {  
     EventScriptRecord *esPtr, *prevEsPtr;  
   
     for (esPtr = chanPtr->scriptRecordPtr,  
              prevEsPtr = (EventScriptRecord *) NULL;  
              esPtr != (EventScriptRecord *) NULL;  
              prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {  
         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {  
             if (esPtr == chanPtr->scriptRecordPtr) {  
                 chanPtr->scriptRecordPtr = esPtr->nextPtr;  
             } else {  
                 prevEsPtr->nextPtr = esPtr->nextPtr;  
             }  
   
             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,  
                     ChannelEventScriptInvoker, (ClientData) esPtr);  
               
             Tcl_DecrRefCount(esPtr->scriptPtr);  
             ckfree((char *) esPtr);  
   
             break;  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * CreateScriptRecord --  
  *  
  *      Creates a record to store a script to be executed when a specific  
  *      event fires on a specific channel.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Causes the script to be stored for later execution.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 CreateScriptRecord(interp, chanPtr, mask, scriptPtr)  
     Tcl_Interp *interp;                 /* Interpreter in which to execute  
                                          * the stored script. */  
     Channel *chanPtr;                   /* Channel for which script is to  
                                          * be stored. */  
     int mask;                           /* Set of events for which script  
                                          * will be invoked. */  
     Tcl_Obj *scriptPtr;                 /* Pointer to script object. */  
 {  
     EventScriptRecord *esPtr;  
   
     for (esPtr = chanPtr->scriptRecordPtr;  
              esPtr != (EventScriptRecord *) NULL;  
              esPtr = esPtr->nextPtr) {  
         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {  
             Tcl_DecrRefCount(esPtr->scriptPtr);  
             esPtr->scriptPtr = (Tcl_Obj *) NULL;  
             break;  
         }  
     }  
     if (esPtr == (EventScriptRecord *) NULL) {  
         esPtr = (EventScriptRecord *) ckalloc((unsigned)  
                 sizeof(EventScriptRecord));  
         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,  
                 ChannelEventScriptInvoker, (ClientData) esPtr);  
         esPtr->nextPtr = chanPtr->scriptRecordPtr;  
         chanPtr->scriptRecordPtr = esPtr;  
     }  
     esPtr->chanPtr = chanPtr;  
     esPtr->interp = interp;  
     esPtr->mask = mask;  
     Tcl_IncrRefCount(scriptPtr);  
     esPtr->scriptPtr = scriptPtr;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ChannelEventScriptInvoker --  
  *  
  *      Invokes a script scheduled by "fileevent" for when the channel  
  *      becomes ready for IO. This function is invoked by the channel  
  *      handler which was created by the Tcl "fileevent" command.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Whatever the script does.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 ChannelEventScriptInvoker(clientData, mask)  
     ClientData clientData;      /* The script+interp record. */  
     int mask;                   /* Not used. */  
 {  
     Tcl_Interp *interp;         /* Interpreter in which to eval the script. */  
     Channel *chanPtr;           /* The channel for which this handler is  
                                  * registered. */  
     EventScriptRecord *esPtr;   /* The event script + interpreter to eval it  
                                  * in. */  
     int result;                 /* Result of call to eval script. */  
   
     esPtr = (EventScriptRecord *) clientData;  
   
     chanPtr = esPtr->chanPtr;  
     mask = esPtr->mask;  
     interp = esPtr->interp;  
       
     /*  
      * We must preserve the interpreter so we can report errors on it  
      * later.  Note that we do not need to preserve the channel because  
      * that is done by Tcl_NotifyChannel before calling channel handlers.  
      */  
       
     Tcl_Preserve((ClientData) interp);  
     result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);  
   
     /*  
      * On error, cause a background error and remove the channel handler  
      * and the script record.  
      *  
      * NOTE: Must delete channel handler before causing the background error  
      * because the background error may want to reinstall the handler.  
      */  
       
     if (result != TCL_OK) {  
         if (chanPtr->typePtr != NULL) {  
             DeleteScriptRecord(interp, chanPtr, mask);  
         }  
         Tcl_BackgroundError(interp);  
     }  
     Tcl_Release((ClientData) interp);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_FileEventObjCmd --  
  *  
  *      This procedure implements the "fileevent" Tcl command. See the  
  *      user documentation for details on what it does. This command is  
  *      based on the Tk command "fileevent" which in turn is based on work  
  *      contributed by Mark Diekhans.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      May create a channel handler for the specified channel.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 Tcl_FileEventObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;              /* Not used. */  
     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. */  
 {  
     Channel *chanPtr;                   /* The channel to create  
                                          * the handler for. */  
     Tcl_Channel chan;                   /* The opaque type for the channel. */  
     char *chanName;  
     int modeIndex;                      /* Index of mode argument. */  
     int mask;  
     static char *modeOptions[] = {"readable", "writable", NULL};  
     static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};  
   
     if ((objc != 3) && (objc != 4)) {  
         Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");  
         return TCL_ERROR;  
     }  
     if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,  
             &modeIndex) != TCL_OK) {  
         return TCL_ERROR;  
     }  
     mask = maskArray[modeIndex];  
   
     chanName = Tcl_GetString(objv[1]);  
     chan = Tcl_GetChannel(interp, chanName, NULL);  
     if (chan == (Tcl_Channel) NULL) {  
         return TCL_ERROR;  
     }  
     chanPtr = (Channel *) chan;  
     if ((chanPtr->flags & mask) == 0) {  
         Tcl_AppendResult(interp, "channel is not ",  
                 (mask == TCL_READABLE) ? "readable" : "writable",  
                 (char *) NULL);  
         return TCL_ERROR;  
     }  
       
     /*  
      * If we are supposed to return the script, do so.  
      */  
   
     if (objc == 3) {  
         EventScriptRecord *esPtr;  
         for (esPtr = chanPtr->scriptRecordPtr;  
              esPtr != (EventScriptRecord *) NULL;  
              esPtr = esPtr->nextPtr) {  
             if ((esPtr->interp == interp) && (esPtr->mask == mask)) {  
                 Tcl_SetObjResult(interp, esPtr->scriptPtr);  
                 break;  
             }  
         }  
         return TCL_OK;  
     }  
   
     /*  
      * If we are supposed to delete a stored script, do so.  
      */  
   
     if (*(Tcl_GetString(objv[3])) == '\0') {  
         DeleteScriptRecord(interp, chanPtr, mask);  
         return TCL_OK;  
     }  
   
     /*  
      * Make the script record that will link between the event and the  
      * script to invoke. This also creates a channel event handler which  
      * will evaluate the script in the supplied interpreter.  
      */  
   
     CreateScriptRecord(interp, chanPtr, mask, objv[3]);  
       
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclTestChannelCmd --  
  *  
  *      Implements the Tcl "testchannel" debugging command and its  
  *      subcommands. This is part of the testing environment but must be  
  *      in this file instead of tclTest.c because it needs access to the  
  *      fields of struct Channel.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 TclTestChannelCmd(clientData, interp, argc, argv)  
     ClientData clientData;      /* Not used. */  
     Tcl_Interp *interp;         /* Interpreter for result. */  
     int argc;                   /* Count of additional args. */  
     char **argv;                /* Additional arg strings. */  
 {  
     char *cmdName;              /* Sub command. */  
     Tcl_HashTable *hTblPtr;     /* Hash table of channels. */  
     Tcl_HashSearch hSearch;     /* Search variable. */  
     Tcl_HashEntry *hPtr;        /* Search variable. */  
     Channel *chanPtr;           /* The actual channel. */  
     Tcl_Channel chan;           /* The opaque type. */  
     size_t len;                 /* Length of subcommand string. */  
     int IOQueued;               /* How much IO is queued inside channel? */  
     ChannelBuffer *bufPtr;      /* For iterating over queued IO. */  
     char buf[TCL_INTEGER_SPACE];/* For sprintf. */  
       
     if (argc < 2) {  
         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                 " subcommand ?additional args..?\"", (char *) NULL);  
         return TCL_ERROR;  
     }  
     cmdName = argv[1];  
     len = strlen(cmdName);  
   
     chanPtr = (Channel *) NULL;  
   
     if (argc > 2) {  
         chan = Tcl_GetChannel(interp, argv[2], NULL);  
         if (chan == (Tcl_Channel) NULL) {  
             return TCL_ERROR;  
         }  
         chanPtr = (Channel *) chan;  
     }  
   
   
     if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                     " info channelName\"", (char *) NULL);  
             return TCL_ERROR;  
         }  
         Tcl_AppendElement(interp, argv[2]);  
         Tcl_AppendElement(interp, chanPtr->typePtr->typeName);  
         if (chanPtr->flags & TCL_READABLE) {  
             Tcl_AppendElement(interp, "read");  
         } else {  
             Tcl_AppendElement(interp, "");  
         }  
         if (chanPtr->flags & TCL_WRITABLE) {  
             Tcl_AppendElement(interp, "write");  
         } else {  
             Tcl_AppendElement(interp, "");  
         }  
         if (chanPtr->flags & CHANNEL_NONBLOCKING) {  
             Tcl_AppendElement(interp, "nonblocking");  
         } else {  
             Tcl_AppendElement(interp, "blocking");  
         }  
         if (chanPtr->flags & CHANNEL_LINEBUFFERED) {  
             Tcl_AppendElement(interp, "line");  
         } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {  
             Tcl_AppendElement(interp, "none");  
         } else {  
             Tcl_AppendElement(interp, "full");  
         }  
         if (chanPtr->flags & BG_FLUSH_SCHEDULED) {  
             Tcl_AppendElement(interp, "async_flush");  
         } else {  
             Tcl_AppendElement(interp, "");  
         }  
         if (chanPtr->flags & CHANNEL_EOF) {  
             Tcl_AppendElement(interp, "eof");  
         } else {  
             Tcl_AppendElement(interp, "");  
         }  
         if (chanPtr->flags & CHANNEL_BLOCKED) {  
             Tcl_AppendElement(interp, "blocked");  
         } else {  
             Tcl_AppendElement(interp, "unblocked");  
         }  
         if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {  
             Tcl_AppendElement(interp, "auto");  
             if (chanPtr->flags & INPUT_SAW_CR) {  
                 Tcl_AppendElement(interp, "saw_cr");  
             } else {  
                 Tcl_AppendElement(interp, "");  
             }  
         } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {  
             Tcl_AppendElement(interp, "lf");  
             Tcl_AppendElement(interp, "");  
         } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {  
             Tcl_AppendElement(interp, "cr");  
             Tcl_AppendElement(interp, "");  
         } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {  
             Tcl_AppendElement(interp, "crlf");  
             if (chanPtr->flags & INPUT_SAW_CR) {  
                 Tcl_AppendElement(interp, "queued_cr");  
             } else {  
                 Tcl_AppendElement(interp, "");  
             }  
         }  
         if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {  
             Tcl_AppendElement(interp, "auto");  
         } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {  
             Tcl_AppendElement(interp, "lf");  
         } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {  
             Tcl_AppendElement(interp, "cr");  
         } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {  
             Tcl_AppendElement(interp, "crlf");  
         }  
         for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;  
                  bufPtr != (ChannelBuffer *) NULL;  
                  bufPtr = bufPtr->nextPtr) {  
             IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;  
         }  
         TclFormatInt(buf, IOQueued);  
         Tcl_AppendElement(interp, buf);  
           
         IOQueued = 0;  
         if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {  
             IOQueued = chanPtr->curOutPtr->nextAdded -  
                 chanPtr->curOutPtr->nextRemoved;  
         }  
         for (bufPtr = chanPtr->outQueueHead;  
                  bufPtr != (ChannelBuffer *) NULL;  
                  bufPtr = bufPtr->nextPtr) {  
             IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);  
         }  
         TclFormatInt(buf, IOQueued);  
         Tcl_AppendElement(interp, buf);  
           
         TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));  
         Tcl_AppendElement(interp, buf);  
   
         TclFormatInt(buf, chanPtr->refCount);  
         Tcl_AppendElement(interp, buf);  
   
         return TCL_OK;  
     }  
   
     if ((cmdName[0] == 'i') &&  
             (strncmp(cmdName, "inputbuffered", len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "channel name required",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
           
         for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;  
                  bufPtr != (ChannelBuffer *) NULL;  
                  bufPtr = bufPtr->nextPtr) {  
             IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;  
         }  
         TclFormatInt(buf, IOQueued);  
         Tcl_AppendResult(interp, buf, (char *) NULL);  
         return TCL_OK;  
     }  
           
     if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "channel name required",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
           
         if (chanPtr->flags & TCL_READABLE) {  
             Tcl_AppendElement(interp, "read");  
         } else {  
             Tcl_AppendElement(interp, "");  
         }  
         if (chanPtr->flags & TCL_WRITABLE) {  
             Tcl_AppendElement(interp, "write");  
         } else {  
             Tcl_AppendElement(interp, "");  
         }  
         return TCL_OK;  
     }  
       
     if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "channel name required",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
         Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);  
         return TCL_OK;  
     }  
       
     if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {  
         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);  
         if (hTblPtr == (Tcl_HashTable *) NULL) {  
             return TCL_OK;  
         }  
         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);  
                  hPtr != (Tcl_HashEntry *) NULL;  
                  hPtr = Tcl_NextHashEntry(&hSearch)) {  
             Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));  
         }  
         return TCL_OK;  
     }  
   
     if ((cmdName[0] == 'o') &&  
             (strncmp(cmdName, "outputbuffered", len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "channel name required",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
           
         IOQueued = 0;  
         if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {  
             IOQueued = chanPtr->curOutPtr->nextAdded -  
                 chanPtr->curOutPtr->nextRemoved;  
         }  
         for (bufPtr = chanPtr->outQueueHead;  
                  bufPtr != (ChannelBuffer *) NULL;  
                  bufPtr = bufPtr->nextPtr) {  
             IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);  
         }  
         TclFormatInt(buf, IOQueued);  
         Tcl_AppendResult(interp, buf, (char *) NULL);  
         return TCL_OK;  
     }  
           
     if ((cmdName[0] == 'q') &&  
             (strncmp(cmdName, "queuedcr", len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "channel name required",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
           
         Tcl_AppendResult(interp,  
                 (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",  
                 (char *) NULL);  
         return TCL_OK;  
     }  
       
     if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {  
         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);  
         if (hTblPtr == (Tcl_HashTable *) NULL) {  
             return TCL_OK;  
         }  
         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);  
                  hPtr != (Tcl_HashEntry *) NULL;  
                  hPtr = Tcl_NextHashEntry(&hSearch)) {  
             chanPtr = (Channel *) Tcl_GetHashValue(hPtr);  
             if (chanPtr->flags & TCL_READABLE) {  
                 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));  
             }  
         }  
         return TCL_OK;  
     }  
   
     if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "channel name required",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
           
         TclFormatInt(buf, chanPtr->refCount);  
         Tcl_AppendResult(interp, buf, (char *) NULL);  
         return TCL_OK;  
     }  
       
     if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "channel name required",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
         Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);  
         return TCL_OK;  
     }  
       
     if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {  
         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);  
         if (hTblPtr == (Tcl_HashTable *) NULL) {  
             return TCL_OK;  
         }  
         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);  
                  hPtr != (Tcl_HashEntry *) NULL;  
                  hPtr = Tcl_NextHashEntry(&hSearch)) {  
             chanPtr = (Channel *) Tcl_GetHashValue(hPtr);  
             if (chanPtr->flags & TCL_WRITABLE) {  
                 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));  
             }  
         }  
         return TCL_OK;  
     }  
   
     Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",  
             "info, open, readable, or writable",  
             (char *) NULL);  
     return TCL_ERROR;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclTestChannelEventCmd --  
  *  
  *      This procedure implements the "testchannelevent" command. It is  
  *      used to test the Tcl channel event mechanism. It is present in  
  *      this file instead of tclTest.c because it needs access to the  
  *      internal structure of the channel.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      Creates, deletes and returns channel event handlers.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 TclTestChannelEventCmd(dummy, interp, argc, argv)  
     ClientData dummy;                   /* Not used. */  
     Tcl_Interp *interp;                 /* Current interpreter. */  
     int argc;                           /* Number of arguments. */  
     char **argv;                        /* Argument strings. */  
 {  
     Tcl_Obj *resultListPtr;  
     Channel *chanPtr;  
     EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;  
     char *cmd;  
     int index, i, mask, len;  
   
     if ((argc < 3) || (argc > 5)) {  
         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                 " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);  
         return TCL_ERROR;  
     }  
     chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);  
     if (chanPtr == (Channel *) NULL) {  
         return TCL_ERROR;  
     }  
     cmd = argv[2];  
     len = strlen(cmd);  
     if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {  
         if (argc != 5) {  
             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                     " channelName add eventSpec script\"", (char *) NULL);  
             return TCL_ERROR;  
         }  
         if (strcmp(argv[3], "readable") == 0) {  
             mask = TCL_READABLE;  
         } else if (strcmp(argv[3], "writable") == 0) {  
             mask = TCL_WRITABLE;  
         } else if (strcmp(argv[3], "none") == 0) {  
             mask = 0;  
         } else {  
             Tcl_AppendResult(interp, "bad event name \"", argv[3],  
                     "\": must be readable, writable, or none", (char *) NULL);  
             return TCL_ERROR;  
         }  
   
         esPtr = (EventScriptRecord *) ckalloc((unsigned)  
                 sizeof(EventScriptRecord));  
         esPtr->nextPtr = chanPtr->scriptRecordPtr;  
         chanPtr->scriptRecordPtr = esPtr;  
           
         esPtr->chanPtr = chanPtr;  
         esPtr->interp = interp;  
         esPtr->mask = mask;  
         esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);  
         Tcl_IncrRefCount(esPtr->scriptPtr);  
   
         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,  
                 ChannelEventScriptInvoker, (ClientData) esPtr);  
           
         return TCL_OK;  
     }  
   
     if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {  
         if (argc != 4) {  
             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                     " channelName delete index\"", (char *) NULL);  
             return TCL_ERROR;  
         }  
         if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {  
             return TCL_ERROR;  
         }  
         if (index < 0) {  
             Tcl_AppendResult(interp, "bad event index: ", argv[3],  
                     ": must be nonnegative", (char *) NULL);  
             return TCL_ERROR;  
         }  
         for (i = 0, esPtr = chanPtr->scriptRecordPtr;  
                  (i < index) && (esPtr != (EventScriptRecord *) NULL);  
                  i++, esPtr = esPtr->nextPtr) {  
             /* Empty loop body. */  
         }  
         if (esPtr == (EventScriptRecord *) NULL) {  
             Tcl_AppendResult(interp, "bad event index ", argv[3],  
                     ": out of range", (char *) NULL);  
             return TCL_ERROR;  
         }  
         if (esPtr == chanPtr->scriptRecordPtr) {  
             chanPtr->scriptRecordPtr = esPtr->nextPtr;  
         } else {  
             for (prevEsPtr = chanPtr->scriptRecordPtr;  
                      (prevEsPtr != (EventScriptRecord *) NULL) &&  
                          (prevEsPtr->nextPtr != esPtr);  
                      prevEsPtr = prevEsPtr->nextPtr) {  
                 /* Empty loop body. */  
             }  
             if (prevEsPtr == (EventScriptRecord *) NULL) {  
                 panic("TclTestChannelEventCmd: damaged event script list");  
             }  
             prevEsPtr->nextPtr = esPtr->nextPtr;  
         }  
         Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,  
                 ChannelEventScriptInvoker, (ClientData) esPtr);  
         Tcl_DecrRefCount(esPtr->scriptPtr);  
         ckfree((char *) esPtr);  
   
         return TCL_OK;  
     }  
   
     if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                     " channelName list\"", (char *) NULL);  
             return TCL_ERROR;  
         }  
         resultListPtr = Tcl_GetObjResult(interp);  
         for (esPtr = chanPtr->scriptRecordPtr;  
                  esPtr != (EventScriptRecord *) NULL;  
                  esPtr = esPtr->nextPtr) {  
             if (esPtr->mask) {  
                 Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(  
                     (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));  
             } else {  
                 Tcl_ListObjAppendElement(interp, resultListPtr,  
                     Tcl_NewStringObj("none", -1));  
             }  
             Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);  
         }  
         Tcl_SetObjResult(interp, resultListPtr);  
         return TCL_OK;  
     }  
   
     if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {  
         if (argc != 3) {  
             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                     " channelName removeall\"", (char *) NULL);  
             return TCL_ERROR;  
         }  
         for (esPtr = chanPtr->scriptRecordPtr;  
                  esPtr != (EventScriptRecord *) NULL;  
                  esPtr = nextEsPtr) {  
             nextEsPtr = esPtr->nextPtr;  
             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,  
                     ChannelEventScriptInvoker, (ClientData) esPtr);  
             Tcl_DecrRefCount(esPtr->scriptPtr);  
             ckfree((char *) esPtr);  
         }  
         chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;  
         return TCL_OK;  
     }  
   
     if  ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {  
         if (argc != 5) {  
             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                     " channelName delete index event\"", (char *) NULL);  
             return TCL_ERROR;  
         }  
         if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {  
             return TCL_ERROR;  
         }  
         if (index < 0) {  
             Tcl_AppendResult(interp, "bad event index: ", argv[3],  
                     ": must be nonnegative", (char *) NULL);  
             return TCL_ERROR;  
         }  
         for (i = 0, esPtr = chanPtr->scriptRecordPtr;  
                  (i < index) && (esPtr != (EventScriptRecord *) NULL);  
                  i++, esPtr = esPtr->nextPtr) {  
             /* Empty loop body. */  
         }  
         if (esPtr == (EventScriptRecord *) NULL) {  
             Tcl_AppendResult(interp, "bad event index ", argv[3],  
                     ": out of range", (char *) NULL);  
             return TCL_ERROR;  
         }  
   
         if (strcmp(argv[4], "readable") == 0) {  
             mask = TCL_READABLE;  
         } else if (strcmp(argv[4], "writable") == 0) {  
             mask = TCL_WRITABLE;  
         } else if (strcmp(argv[4], "none") == 0) {  
             mask = 0;  
         } else {  
             Tcl_AppendResult(interp, "bad event name \"", argv[4],  
                     "\": must be readable, writable, or none", (char *) NULL);  
             return TCL_ERROR;  
         }  
         esPtr->mask = mask;  
         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,  
                 ChannelEventScriptInvoker, (ClientData) esPtr);  
         return TCL_OK;  
     }      
     Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",  
             "add, delete, list, set, or removeall", (char *) NULL);  
     return TCL_ERROR;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclCopyChannel --  
  *  
  *      This routine copies data from one channel to another, either  
  *      synchronously or asynchronously.  If a command script is  
  *      supplied, the operation runs in the background.  The script  
  *      is invoked when the copy completes.  Otherwise the function  
  *      waits until the copy is completed before returning.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      May schedule a background copy operation that causes both  
  *      channels to be marked busy.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)  
     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. */  
 {  
     Channel *inPtr = (Channel *) inChan;  
     Channel *outPtr = (Channel *) outChan;  
     int readFlags, writeFlags;  
     CopyState *csPtr;  
     int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;  
   
     if (inPtr->csPtr) {  
         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",  
                 Tcl_GetChannelName(inChan), "\" is busy", NULL);  
         return TCL_ERROR;  
     }  
     if (outPtr->csPtr) {  
         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",  
                 Tcl_GetChannelName(outChan), "\" is busy", NULL);  
         return TCL_ERROR;  
     }  
   
     readFlags = inPtr->flags;  
     writeFlags = outPtr->flags;  
   
     /*  
      * Set up the blocking mode appropriately.  Background copies need  
      * non-blocking channels.  Foreground copies need blocking channels.  
      * If there is an error, restore the old blocking mode.  
      */  
   
     if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {  
         if (SetBlockMode(interp, inPtr,  
                 nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)  
                 != TCL_OK) {  
             return TCL_ERROR;  
         }  
     }        
     if (inPtr != outPtr) {  
         if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {  
             if (SetBlockMode(NULL, outPtr,  
                     nonBlocking ? TCL_MODE_BLOCKING : TCL_MODE_NONBLOCKING)  
                     != TCL_OK) {  
                 if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {  
                     SetBlockMode(NULL, inPtr,  
                             (readFlags & CHANNEL_NONBLOCKING)  
                             ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);  
                     return TCL_ERROR;  
                 }  
             }  
         }  
     }  
   
     /*  
      * Make sure the output side is unbuffered.  
      */  
   
     outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))  
         | CHANNEL_UNBUFFERED;  
   
     /*  
      * Allocate a new CopyState to maintain info about the current copy in  
      * progress.  This structure will be deallocated when the copy is  
      * completed.  
      */  
   
     csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);  
     csPtr->bufSize = inPtr->bufSize;  
     csPtr->readPtr = inPtr;  
     csPtr->writePtr = outPtr;  
     csPtr->readFlags = readFlags;  
     csPtr->writeFlags = writeFlags;  
     csPtr->toRead = toRead;  
     csPtr->total = 0;  
     csPtr->interp = interp;  
     if (cmdPtr) {  
         Tcl_IncrRefCount(cmdPtr);  
     }  
     csPtr->cmdPtr = cmdPtr;  
     inPtr->csPtr = csPtr;  
     outPtr->csPtr = csPtr;  
   
     /*  
      * Start copying data between the channels.  
      */  
   
     return CopyData(csPtr, 0);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * CopyData --  
  *  
  *      This function implements the lowest level of the copying  
  *      mechanism for TclCopyChannel.  
  *  
  * Results:  
  *      Returns TCL_OK on success, else TCL_ERROR.  
  *  
  * Side effects:  
  *      Moves data between channels, may create channel handlers.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 CopyData(csPtr, mask)  
     CopyState *csPtr;           /* State of copy operation. */  
     int mask;                   /* Current channel event flags. */  
 {  
     Tcl_Interp *interp;  
     Tcl_Obj *cmdPtr, *errObj = NULL;  
     Tcl_Channel inChan, outChan;  
     int result = TCL_OK;  
     int size;  
     int total;  
   
     inChan = (Tcl_Channel)csPtr->readPtr;  
     outChan = (Tcl_Channel)csPtr->writePtr;  
     interp = csPtr->interp;  
     cmdPtr = csPtr->cmdPtr;  
   
     /*  
      * Copy the data the slow way, using the translation mechanism.  
      */  
   
     while (csPtr->toRead != 0) {  
   
         /*  
          * Check for unreported background errors.  
          */  
   
         if (csPtr->readPtr->unreportedError != 0) {  
             Tcl_SetErrno(csPtr->readPtr->unreportedError);  
             csPtr->readPtr->unreportedError = 0;  
             goto readError;  
         }  
         if (csPtr->writePtr->unreportedError != 0) {  
             Tcl_SetErrno(csPtr->writePtr->unreportedError);  
             csPtr->writePtr->unreportedError = 0;  
             goto writeError;  
         }  
           
         /*  
          * Read up to bufSize bytes.  
          */  
   
         if ((csPtr->toRead == -1)  
                 || (csPtr->toRead > csPtr->bufSize)) {  
             size = csPtr->bufSize;  
         } else {  
             size = csPtr->toRead;  
         }  
         size = DoRead(csPtr->readPtr, csPtr->buffer, size);  
   
         if (size < 0) {  
             readError:  
             errObj = Tcl_NewObj();  
             Tcl_AppendStringsToObj(errObj, "error reading \"",  
                     Tcl_GetChannelName(inChan), "\": ",  
                     Tcl_PosixError(interp), (char *) NULL);  
             break;  
         } else if (size == 0) {  
             /*  
              * 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.  
              */  
               
             if (Tcl_Eof(inChan)) {  
                 break;  
             } else if (!(mask & TCL_READABLE)) {  
                 if (mask & TCL_WRITABLE) {  
                     Tcl_DeleteChannelHandler(outChan, CopyEventProc,  
                             (ClientData) csPtr);  
                 }  
                 Tcl_CreateChannelHandler(inChan, TCL_READABLE,  
                         CopyEventProc, (ClientData) csPtr);  
             }  
             return TCL_OK;  
         }  
   
         /*  
          * Now write the buffer out.  
          */  
   
         size = DoWrite(csPtr->writePtr, csPtr->buffer, size);  
         if (size < 0) {  
             writeError:  
             errObj = Tcl_NewObj();  
             Tcl_AppendStringsToObj(errObj, "error writing \"",  
                     Tcl_GetChannelName(outChan), "\": ",  
                     Tcl_PosixError(interp), (char *) NULL);  
             break;  
         }  
   
         /*  
          * Check to see if the write is happening in the background.  If so,  
          * stop copying and wait for the channel to become writable again.  
          */  
   
         if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {  
             if (!(mask & TCL_WRITABLE)) {  
                 if (mask & TCL_READABLE) {  
                     Tcl_DeleteChannelHandler(outChan, CopyEventProc,  
                             (ClientData) csPtr);  
                 }  
                 Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,  
                         CopyEventProc, (ClientData) csPtr);  
             }  
             return TCL_OK;  
         }  
   
         /*  
          * Update the current byte count if we care.  
          */  
   
         if (csPtr->toRead != -1) {  
             csPtr->toRead -= size;  
         }  
         csPtr->total += size;  
   
         /*  
          * For background copies, we only do one buffer per invocation so  
          * we don't starve the rest of the system.  
          */  
   
         if (cmdPtr) {  
             /*  
              * The first time we enter this code, there won't be a  
              * channel handler established yet, so do it here.  
              */  
   
             if (mask == 0) {  
                 Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,  
                         CopyEventProc, (ClientData) csPtr);  
             }  
             return TCL_OK;  
         }  
     }  
   
     /*  
      * Make the callback or return the number of bytes transferred.  
      * The local total is used because StopCopy frees csPtr.  
      */  
   
     total = csPtr->total;  
     if (cmdPtr) {  
         /*  
          * Get a private copy of the command so we can mutate it  
          * by adding arguments.  Note that StopCopy frees our saved  
          * reference to the original command obj.  
          */  
   
         cmdPtr = Tcl_DuplicateObj(cmdPtr);  
         Tcl_IncrRefCount(cmdPtr);  
         StopCopy(csPtr);  
         Tcl_Preserve((ClientData) interp);  
   
         Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));  
         if (errObj) {  
             Tcl_ListObjAppendElement(interp, cmdPtr, errObj);  
         }  
         if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {  
             Tcl_BackgroundError(interp);  
             result = TCL_ERROR;  
         }  
         Tcl_DecrRefCount(cmdPtr);  
         Tcl_Release((ClientData) interp);  
     } else {  
         StopCopy(csPtr);  
         if (errObj) {  
             Tcl_SetObjResult(interp, errObj);  
             result = TCL_ERROR;  
         } else {  
             Tcl_ResetResult(interp);  
             Tcl_SetIntObj(Tcl_GetObjResult(interp), total);  
         }  
     }  
     return result;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * DoRead --  
  *  
  *      Reads a given number of bytes from a channel.  
  *  
  * Results:  
  *      The number of characters read, or -1 on error. Use Tcl_GetErrno()  
  *      to retrieve the error code for the error that occurred.  
  *  
  * Side effects:  
  *      May cause input to be buffered.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 DoRead(chanPtr, bufPtr, toRead)  
     Channel *chanPtr;           /* The channel from which to read. */  
     char *bufPtr;               /* Where to store input read. */  
     int toRead;                 /* Maximum number of bytes to read. */  
 {  
     int copied;                 /* How many characters were copied into  
                                  * the result string? */  
     int copiedNow;              /* How many characters were copied from  
                                  * the current input buffer? */  
     int result;                 /* Of calling GetInput. */  
       
     /*  
      * If we have not encountered a sticky EOF, clear the EOF bit. Either  
      * way clear the BLOCKED bit. We want to discover these anew during  
      * each operation.  
      */  
   
     if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {  
         chanPtr->flags &= ~CHANNEL_EOF;  
     }  
     chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);  
       
     for (copied = 0; copied < toRead; copied += copiedNow) {  
         copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,  
                 toRead - copied);  
         if (copiedNow == 0) {  
             if (chanPtr->flags & CHANNEL_EOF) {  
                 goto done;  
             }  
             if (chanPtr->flags & CHANNEL_BLOCKED) {  
                 if (chanPtr->flags & CHANNEL_NONBLOCKING) {  
                     goto done;  
                 }  
                 chanPtr->flags &= (~(CHANNEL_BLOCKED));  
             }  
             result = GetInput(chanPtr);  
             if (result != 0) {  
                 if (result != EAGAIN) {  
                     copied = -1;  
                 }  
                 goto done;  
             }  
         }  
     }  
   
     chanPtr->flags &= (~(CHANNEL_BLOCKED));  
   
     done:  
     /*  
      * Update the notifier state so we don't block while there is still  
      * data in the buffers.  
      */  
   
     UpdateInterest(chanPtr);  
     return copied;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * CopyAndTranslateBuffer --  
  *  
  *      Copy at most one buffer of input to the result space, doing  
  *      eol translations according to mode in effect currently.  
  *  
  * Results:  
  *      Number of bytes stored in the result buffer (as opposed to the  
  *      number of bytes read from the channel).  May return  
  *      zero if no input is available to be translated.  
  *  
  * Side effects:  
  *      Consumes buffered input. May deallocate one buffer.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 CopyAndTranslateBuffer(chanPtr, result, space)  
     Channel *chanPtr;           /* The channel from which to read input. */  
     char *result;               /* Where to store the copied input. */  
     int space;                  /* How many bytes are available in result  
                                  * to store the copied input? */  
 {  
     int bytesInBuffer;          /* How many bytes are available to be  
                                  * copied in the current input buffer? */  
     int copied;                 /* How many characters were already copied  
                                  * into the destination space? */  
     ChannelBuffer *bufPtr;      /* The buffer from which to copy bytes. */  
     int i;                      /* Iterates over the copied input looking  
                                  * for the input eofChar. */  
       
     /*  
      * If there is no input at all, return zero. The invariant is that either  
      * there is no buffer in the queue, or if the first buffer is empty, it  
      * is also the last buffer (and thus there is no input in the queue).  
      * Note also that if the buffer is empty, we leave it in the queue.  
      */  
       
     if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {  
         return 0;  
     }  
     bufPtr = chanPtr->inQueueHead;  
     bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;  
   
     copied = 0;  
     switch (chanPtr->inputTranslation) {  
         case TCL_TRANSLATE_LF: {  
             if (bytesInBuffer == 0) {  
                 return 0;  
             }  
   
             /*  
              * Copy the current chunk into the result buffer.  
              */  
   
             if (bytesInBuffer < space) {  
                 space = bytesInBuffer;  
             }  
             memcpy((VOID *) result,  
                     (VOID *) (bufPtr->buf + bufPtr->nextRemoved),  
                     (size_t) space);  
             bufPtr->nextRemoved += space;  
             copied = space;  
             break;  
         }  
         case TCL_TRANSLATE_CR: {  
             char *end;  
               
             if (bytesInBuffer == 0) {  
                 return 0;  
             }  
   
             /*  
              * Copy the current chunk into the result buffer, then  
              * replace all \r with \n.  
              */  
   
             if (bytesInBuffer < space) {  
                 space = bytesInBuffer;  
             }  
             memcpy((VOID *) result,  
                     (VOID *) (bufPtr->buf + bufPtr->nextRemoved),  
                     (size_t) space);  
             bufPtr->nextRemoved += space;  
             copied = space;  
   
             for (end = result + copied; result < end; result++) {  
                 if (*result == '\r') {  
                     *result = '\n';  
                 }  
             }  
             break;  
         }  
         case TCL_TRANSLATE_CRLF: {  
             char *src, *end, *dst;  
             int curByte;  
               
             /*  
              * If there is a held-back "\r" at EOF, produce it now.  
              */  
               
             if (bytesInBuffer == 0) {  
                 if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==  
                         (INPUT_SAW_CR | CHANNEL_EOF)) {  
                     result[0] = '\r';  
                     chanPtr->flags &= ~INPUT_SAW_CR;  
                     return 1;  
                 }  
                 return 0;  
             }  
   
             /*  
              * 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);  
             bufPtr->nextRemoved += space;  
             copied = space;  
   
             end = result + copied;  
             dst = result;  
             for (src = result; src < end; src++) {  
                 curByte = *src;  
                 if (curByte == '\n') {  
                     chanPtr->flags &= ~INPUT_SAW_CR;  
                 } else if (chanPtr->flags & INPUT_SAW_CR) {  
                     chanPtr->flags &= ~INPUT_SAW_CR;  
                     *dst = '\r';  
                     dst++;  
                 }  
                 if (curByte == '\r') {  
                     chanPtr->flags |= INPUT_SAW_CR;  
                 } else {  
                     *dst = (char) curByte;  
                     dst++;  
                 }  
             }  
             copied = dst - result;  
             break;  
         }  
         case TCL_TRANSLATE_AUTO: {  
             char *src, *end, *dst;  
             int curByte;  
           
             if (bytesInBuffer == 0) {  
                 return 0;  
             }  
   
             /*  
              * Loop over the current buffer, converting "\r" and "\r\n"  
              * to "\n".  
              */  
   
             if (bytesInBuffer < space) {  
                 space = bytesInBuffer;  
             }  
             memcpy((VOID *) result,  
                     (VOID *) (bufPtr->buf + bufPtr->nextRemoved),  
                     (size_t) space);  
             bufPtr->nextRemoved += space;  
             copied = space;  
   
             end = result + copied;  
             dst = result;  
             for (src = result; src < end; src++) {  
                 curByte = *src;  
                 if (curByte == '\r') {  
                     chanPtr->flags |= INPUT_SAW_CR;  
                     *dst = '\n';  
                     dst++;  
                 } else {  
                     if ((curByte != '\n') ||  
                             !(chanPtr->flags & INPUT_SAW_CR)) {  
                         *dst = (char) curByte;  
                         dst++;  
                     }  
                     chanPtr->flags &= ~INPUT_SAW_CR;  
                 }  
             }  
             copied = dst - result;  
             break;  
         }  
         default: {  
             panic("unknown eol translation mode");  
         }  
     }  
   
     /*  
      * If an in-stream EOF character is set for this channel, check that  
      * the input we copied so far does not contain the EOF char.  If it does,  
      * copy only up to and excluding that character.  
      */  
       
     if (chanPtr->inEofChar != 0) {  
         for (i = 0; i < copied; i++) {  
             if (result[i] == (char) chanPtr->inEofChar) {  
                 /*  
                  * Set sticky EOF so that no further input is presented  
                  * to the caller.  
                  */  
                   
                 chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);  
                 chanPtr->inputEncodingFlags |= TCL_ENCODING_END;  
                 copied = i;  
                 break;  
             }  
         }  
     }  
   
     /*  
      * If the current buffer is empty recycle it.  
      */  
   
     if (bufPtr->nextRemoved == bufPtr->nextAdded) {  
         chanPtr->inQueueHead = bufPtr->nextPtr;  
         if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {  
             chanPtr->inQueueTail = (ChannelBuffer *) NULL;  
         }  
         RecycleBuffer(chanPtr, bufPtr, 0);  
     }  
   
     /*  
      * Return the number of characters copied into the result buffer.  
      * This may be different from the number of bytes consumed, because  
      * of EOL translations.  
      */  
   
     return copied;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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(chanPtr, src, srcLen)  
     Channel *chanPtr;                   /* The channel to buffer output for. */  
     char *src;                          /* Data to write. */  
     int srcLen;                         /* Number of bytes to write. */  
 {  
     ChannelBuffer *outBufPtr;           /* Current output buffer. */  
     int foundNewline;                   /* Did we find a newline in output? */  
     char *dPtr;  
     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 (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {  
             chanPtr->curOutPtr = AllocChannelBuffer(chanPtr->bufSize);  
         }  
   
         outBufPtr = chanPtr->curOutPtr;  
   
         destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;  
         if (destCopied > srcLen) {  
             destCopied = srcLen;  
         }  
           
         destPtr = outBufPtr->buf + outBufPtr->nextAdded;  
         switch (chanPtr->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:  
                 panic("Tcl_Write: AUTO output translation mode not supported");  
             default:  
                 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 (!(chanPtr->flags & BUFFER_READY)) {  
             if (outBufPtr->nextAdded == outBufPtr->bufLength) {  
                 chanPtr->flags |= BUFFER_READY;  
             } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {  
                 for (sPtr = src, i = 0, foundNewline = 0;  
                          (i < srcCopied) && (!foundNewline);  
                          i++, sPtr++) {  
                     if (*sPtr == '\n') {  
                         foundNewline = 1;  
                         break;  
                     }  
                 }  
                 if (foundNewline) {  
                     chanPtr->flags |= BUFFER_READY;  
                 }  
             } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {  
                 chanPtr->flags |= BUFFER_READY;  
             }  
         }  
           
         totalDestCopied += srcCopied;  
         src += srcCopied;  
         srcLen -= srcCopied;  
   
         if (chanPtr->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 copy operation.  It is just a trivial wrapper  
  *      around the CopyData routine.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 CopyEventProc(clientData, mask)  
     ClientData clientData;  
     int mask;  
 {  
     (void) CopyData((CopyState *)clientData, mask);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * StopCopy --  
  *  
  *      This routine halts a copy that is in progress.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Removes any pending channel handlers and restores the blocking  
  *      and buffering modes of the channels.  The CopyState is freed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 StopCopy(csPtr)  
     CopyState *csPtr;           /* State for bg copy to stop . */  
 {  
     int nonBlocking;  
   
     if (!csPtr) {  
         return;  
     }  
   
     /*  
      * Restore the old blocking mode and output buffering mode.  
      */  
   
     nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);  
     if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {  
         SetBlockMode(NULL, csPtr->readPtr,  
                 nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);  
     }  
     if (csPtr->writePtr != csPtr->writePtr) {  
         if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {  
             SetBlockMode(NULL, csPtr->writePtr,  
                     nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);  
         }  
     }  
     csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);  
     csPtr->writePtr->flags |=  
         csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);  
               
   
     if (csPtr->cmdPtr) {  
         Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,  
             (ClientData)csPtr);  
         if (csPtr->readPtr != csPtr->writePtr) {  
             Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,  
                     CopyEventProc, (ClientData)csPtr);  
         }  
         Tcl_DecrRefCount(csPtr->cmdPtr);  
     }  
     csPtr->readPtr->csPtr = NULL;  
     csPtr->writePtr->csPtr = NULL;  
     ckfree((char*) csPtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * SetBlockMode --  
  *  
  *      This function sets the blocking mode for a channel and updates  
  *      the state flags.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      Modifies the blocking mode of the channel and possibly generates  
  *      an error.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 SetBlockMode(interp, chanPtr, mode)  
     Tcl_Interp *interp;         /* Interp for error reporting. */  
     Channel *chanPtr;           /* Channel to modify. */  
     int mode;                   /* One of TCL_MODE_BLOCKING or  
                                  * TCL_MODE_NONBLOCKING. */  
 {  
     int result = 0;  
     if (chanPtr->typePtr->blockModeProc != NULL) {  
         result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,  
                 mode);  
     }  
     if (result != 0) {  
         Tcl_SetErrno(result);  
         if (interp != (Tcl_Interp *) NULL) {  
             Tcl_AppendResult(interp, "error setting blocking mode: ",  
                     Tcl_PosixError(interp), (char *) NULL);  
         }  
         return TCL_ERROR;  
     }  
     if (mode == TCL_MODE_BLOCKING) {  
         chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));  
     } else {  
         chanPtr->flags |= CHANNEL_NONBLOCKING;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetChannelNames --  
  *  
  *      Return the names of all open channels in the interp.  
  *  
  * Results:  
  *      TCL_OK or TCL_ERROR.  
  *  
  * Side effects:  
  *      Interp result modified with list of channel names.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetChannelNames(interp)  
     Tcl_Interp *interp;         /* Interp for error reporting. */  
 {  
     return Tcl_GetChannelNamesEx(interp, (char *) NULL);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetChannelNamesEx --  
  *  
  *      Return the names of open channels in the interp filtered  
  *      filtered through a pattern.  If pattern is NULL, it returns  
  *      all the open channels.  
  *  
  * Results:  
  *      TCL_OK or TCL_ERROR.  
  *  
  * Side effects:  
  *      Interp result modified with list of channel names.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetChannelNamesEx(interp, pattern)  
     Tcl_Interp *interp;         /* Interp for error reporting. */  
     char *pattern;              /* pattern to filter on. */  
 {  
     Channel *chanPtr;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
     char *name;  
     Tcl_Obj *resultPtr;  
   
     resultPtr = Tcl_GetObjResult(interp);  
     for (chanPtr = tsdPtr->firstChanPtr;  
          chanPtr != NULL;  
          chanPtr = chanPtr->nextChanPtr) {  
         if (chanPtr == (Channel *) tsdPtr->stdinChannel) {  
             name = "stdin";  
         } else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {  
             name = "stdout";  
         } else if (chanPtr == (Channel *) tsdPtr->stderrChannel) {  
             name = "stderr";  
         } else {  
             name = chanPtr->channelName;  
         }  
         if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&  
                 (Tcl_ListObjAppendElement(interp, resultPtr,  
                         Tcl_NewStringObj(name, -1)) != TCL_OK)) {  
             return TCL_ERROR;  
         }  
     }  
     return TCL_OK;  
 }  
   
   
 /* $History: tclio.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:33a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLIO.C */  
1    /* $Header$ */
2    /*
3     * tclIO.c --
4     *
5     *      This file provides the generic portions (those that are the same on
6     *      all platforms and for all channel types) of Tcl's IO facilities.
7     *
8     * Copyright (c) 1998 Scriptics Corporation
9     * Copyright (c) 1995-1997 Sun Microsystems, Inc.
10     *
11     * See the file "license.terms" for information on usage and redistribution
12     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13     *
14     * RCS: @(#) $Id: tclio.c,v 1.1.1.1 2001/06/13 04:42:01 dtashley Exp $
15     */
16    
17    #include "tclInt.h"
18    #include "tclPort.h"
19    
20    /*
21     * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
22     * compile on systems where neither is defined. We want both defined so
23     * that we can test safely for both. In the code we still have to test for
24     * both because there may be systems on which both are defined and have
25     * different values.
26     */
27    
28    #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
29    #   define EWOULDBLOCK EAGAIN
30    #endif
31    #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
32    #   define EAGAIN EWOULDBLOCK
33    #endif
34    #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
35        error one of EWOULDBLOCK or EAGAIN must be defined
36    #endif
37    
38    /*
39     * The following structure encapsulates the state for a background channel
40     * copy.  Note that the data buffer for the copy will be appended to this
41     * structure.
42     */
43    
44    typedef struct CopyState {
45        struct Channel *readPtr;    /* Pointer to input channel. */
46        struct Channel *writePtr;   /* Pointer to output channel. */
47        int readFlags;              /* Original read channel flags. */
48        int writeFlags;             /* Original write channel flags. */
49        int toRead;                 /* Number of bytes to copy, or -1. */
50        int total;                  /* Total bytes transferred (written). */
51        Tcl_Interp *interp;         /* Interp that started the copy. */
52        Tcl_Obj *cmdPtr;            /* Command to be invoked at completion. */
53        int bufSize;                /* Size of appended buffer. */
54        char buffer[1];             /* Copy buffer, this must be the last
55                                     * field. */
56    } CopyState;
57    
58    /*
59     * struct ChannelBuffer:
60     *
61     * Buffers data being sent to or from a channel.
62     */
63    
64    typedef struct ChannelBuffer {
65        int nextAdded;              /* The next position into which a character
66                                     * will be put in the buffer. */
67        int nextRemoved;            /* Position of next byte to be removed
68                                     * from the buffer. */
69        int bufLength;              /* How big is the buffer? */
70        struct ChannelBuffer *nextPtr;
71                                    /* Next buffer in chain. */
72        char buf[4];                /* Placeholder for real buffer. The real
73                                     * buffer occuppies this space + bufSize-4
74                                     * bytes. This must be the last field in
75                                     * the structure. */
76    } ChannelBuffer;
77    
78    #define CHANNELBUFFER_HEADER_SIZE       (sizeof(ChannelBuffer) - 4)
79    
80    /*
81     * How much extra space to allocate in buffer to hold bytes from previous
82     * buffer (when converting to UTF-8) or to hold bytes that will go to
83     * next buffer (when converting from UTF-8).
84     */
85    
86    #define BUFFER_PADDING      16
87    
88    /*
89     * The following defines the *default* buffer size for channels.
90     */
91    
92    #define CHANNELBUFFER_DEFAULT_SIZE      (1024 * 4)
93    
94    /*
95     * Structure to record a close callback. One such record exists for
96     * each close callback registered for a channel.
97     */
98    
99    typedef struct CloseCallback {
100        Tcl_CloseProc *proc;                /* The procedure to call. */
101        ClientData clientData;              /* Arbitrary one-word data to pass
102                                             * to the callback. */
103        struct CloseCallback *nextPtr;      /* For chaining close callbacks. */
104    } CloseCallback;
105    
106    /*
107     * The following structure describes the information saved from a call to
108     * "fileevent". This is used later when the event being waited for to
109     * invoke the saved script in the interpreter designed in this record.
110     */
111    
112    typedef struct EventScriptRecord {
113        struct Channel *chanPtr;    /* The channel for which this script is
114                                     * registered. This is used only when an
115                                     * error occurs during evaluation of the
116                                     * script, to delete the handler. */
117        Tcl_Obj *scriptPtr;         /* Script to invoke. */
118        Tcl_Interp *interp;         /* In what interpreter to invoke script? */
119        int mask;                   /* Events must overlap current mask for the
120                                     * stored script to be invoked. */
121        struct EventScriptRecord *nextPtr;
122                                    /* Next in chain of records. */
123    } EventScriptRecord;
124    
125    /*
126     * struct Channel:
127     *
128     * One of these structures is allocated for each open channel. It contains data
129     * specific to the channel but which belongs to the generic part of the Tcl
130     * channel mechanism, and it points at an instance specific (and type
131     * specific) * instance data, and at a channel type structure.
132     */
133    
134    typedef struct Channel {
135        char *channelName;          /* The name of the channel instance in Tcl
136                                     * commands. Storage is owned by the generic IO
137                                     * code,  is dynamically allocated. */
138        int flags;                  /* ORed combination of the flags defined
139                                     * below. */
140        Tcl_Encoding encoding;      /* Encoding to apply when reading or writing
141                                     * data on this channel.  NULL means no
142                                     * encoding is applied to data. */
143        Tcl_EncodingState inputEncodingState;
144                                    /* Current encoding state, used when converting
145                                     * input data bytes to UTF-8. */
146        int inputEncodingFlags;     /* Encoding flags to pass to conversion
147                                     * routine when converting input data bytes to
148                                     * UTF-8.  May be TCL_ENCODING_START before
149                                     * converting first byte and TCL_ENCODING_END
150                                     * when EOF is seen. */
151        Tcl_EncodingState outputEncodingState;
152                                    /* Current encoding state, used when converting
153                                     * UTF-8 to output data bytes. */
154        int outputEncodingFlags;    /* Encoding flags to pass to conversion
155                                     * routine when converting UTF-8 to output
156                                     * data bytes.  May be TCL_ENCODING_START
157                                     * before converting first byte and
158                                     * TCL_ENCODING_END when EOF is seen. */
159        Tcl_EolTranslation inputTranslation;
160                                    /* What translation to apply for end of line
161                                     * sequences on input? */    
162        Tcl_EolTranslation outputTranslation;
163                                    /* What translation to use for generating
164                                     * end of line sequences in output? */
165        int inEofChar;              /* If nonzero, use this as a signal of EOF
166                                     * on input. */
167        int outEofChar;             /* If nonzero, append this to the channel
168                                     * when it is closed if it is open for
169                                     * writing. */
170        int unreportedError;        /* Non-zero if an error report was deferred
171                                     * because it happened in the background. The
172                                     * value is the POSIX error code. */
173        ClientData instanceData;    /* Instance-specific data provided by
174                                     * creator of channel. */
175    
176        Tcl_ChannelType *typePtr;   /* Pointer to channel type structure. */
177        int refCount;               /* How many interpreters hold references to
178                                     * this IO channel? */
179        CloseCallback *closeCbPtr;  /* Callbacks registered to be called when the
180                                     * channel is closed. */
181        char *outputStage;          /* Temporary staging buffer used when
182                                     * translating EOL before converting from
183                                     * UTF-8 to external form. */
184        ChannelBuffer *curOutPtr;   /* Current output buffer being filled. */
185        ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
186        ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
187    
188        ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
189                                     * need to allocate a new buffer for "gets"
190                                     * that crosses buffer boundaries. */
191        ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
192        ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
193    
194        struct ChannelHandler *chPtr;/* List of channel handlers registered
195                                      * for this channel. */
196        int interestMask;           /* Mask of all events this channel has
197                                     * handlers for. */
198        struct Channel *nextChanPtr;/* Next in list of channels currently open. */
199        EventScriptRecord *scriptRecordPtr;
200                                    /* Chain of all scripts registered for
201                                     * event handlers ("fileevent") on this
202                                     * channel. */
203        int bufSize;                /* What size buffers to allocate? */
204        Tcl_TimerToken timer;       /* Handle to wakeup timer for this channel. */
205        CopyState *csPtr;           /* State of background copy, or NULL. */
206        struct Channel* supercedes; /* Refers to channel this one was stacked upon.
207                                       This reference is NULL for normal channels.
208                                       See Tcl_StackChannel. */
209    
210    } Channel;
211        
212    /*
213     * Values for the flags field in Channel. Any ORed combination of the
214     * following flags can be stored in the field. These flags record various
215     * options and state bits about the channel. In addition to the flags below,
216     * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
217     */
218    
219    #define CHANNEL_NONBLOCKING     (1<<3)  /* Channel is currently in
220                                             * nonblocking mode. */
221    #define CHANNEL_LINEBUFFERED    (1<<4)  /* Output to the channel must be
222                                             * flushed after every newline. */
223    #define CHANNEL_UNBUFFERED      (1<<5)  /* Output to the channel must always
224                                             * be flushed immediately. */
225    #define BUFFER_READY            (1<<6)  /* Current output buffer (the
226                                             * curOutPtr field in the
227                                             * channel structure) should be
228                                             * output as soon as possible even
229                                             * though it may not be full. */
230    #define BG_FLUSH_SCHEDULED      (1<<7)  /* A background flush of the
231                                             * queued output buffers has been
232                                             * scheduled. */
233    #define CHANNEL_CLOSED          (1<<8)  /* Channel has been closed. No
234                                             * further Tcl-level IO on the
235                                             * channel is allowed. */
236    #define CHANNEL_EOF             (1<<9)  /* EOF occurred on this channel.
237                                             * This bit is cleared before every
238                                             * input operation. */
239    #define CHANNEL_STICKY_EOF      (1<<10) /* EOF occurred on this channel because
240                                             * we saw the input eofChar. This bit
241                                             * prevents clearing of the EOF bit
242                                             * before every input operation. */
243    #define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
244                                             * on this channel. This bit is
245                                             * cleared before every input or
246                                             * output operation. */
247    #define INPUT_SAW_CR            (1<<12) /* Channel is in CRLF eol input
248                                             * translation mode and the last
249                                             * byte seen was a "\r". */
250    #define INPUT_NEED_NL           (1<<15) /* Saw a '\r' at end of last buffer,
251                                             * and there should be a '\n' at
252                                             * beginning of next buffer. */
253    #define CHANNEL_DEAD            (1<<13) /* The channel has been closed by
254                                             * the exit handler (on exit) but
255                                             * not deallocated. When any IO
256                                             * operation sees this flag on a
257                                             * channel, it does not call driver
258                                             * level functions to avoid referring
259                                             * to deallocated data. */
260    #define CHANNEL_NEED_MORE_DATA  (1<<14) /* The last input operation failed
261                                             * because there was not enough data
262                                             * to complete the operation.  This
263                                             * flag is set when gets fails to
264                                             * get a complete line or when read
265                                             * fails to get a complete character.
266                                             * When set, file events will not be
267                                             * delivered for buffered data until
268                                             * the state of the channel changes. */
269    
270    /*
271     * For each channel handler registered in a call to Tcl_CreateChannelHandler,
272     * there is one record of the following type. All of records for a specific
273     * channel are chained together in a singly linked list which is stored in
274     * the channel structure.
275     */
276    
277    typedef struct ChannelHandler {
278        Channel *chanPtr;           /* The channel structure for this channel. */
279        int mask;                   /* Mask of desired events. */
280        Tcl_ChannelProc *proc;      /* Procedure to call in the type of
281                                     * Tcl_CreateChannelHandler. */
282        ClientData clientData;      /* Argument to pass to procedure. */
283        struct ChannelHandler *nextPtr;
284                                    /* Next one in list of registered handlers. */
285    } ChannelHandler;
286    
287    /*
288     * This structure keeps track of the current ChannelHandler being invoked in
289     * the current invocation of ChannelHandlerEventProc. There is a potential
290     * problem if a ChannelHandler is deleted while it is the current one, since
291     * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
292     * problem, structures of the type below indicate the next handler to be
293     * processed for any (recursively nested) dispatches in progress. The
294     * nextHandlerPtr field is updated if the handler being pointed to is deleted.
295     * The nextPtr field is used to chain together all recursive invocations, so
296     * that Tcl_DeleteChannelHandler can find all the recursively nested
297     * invocations of ChannelHandlerEventProc and compare the handler being
298     * deleted against the NEXT handler to be invoked in that invocation; when it
299     * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
300     * field of the structure to the next handler.
301     */
302    
303    typedef struct NextChannelHandler {
304        ChannelHandler *nextHandlerPtr;     /* The next handler to be invoked in
305                                             * this invocation. */
306        struct NextChannelHandler *nestedHandlerPtr;
307                                            /* Next nested invocation of
308                                             * ChannelHandlerEventProc. */
309    } NextChannelHandler;
310    
311    
312    /*
313     * The following structure describes the event that is added to the Tcl
314     * event queue by the channel handler check procedure.
315     */
316    
317    typedef struct ChannelHandlerEvent {
318        Tcl_Event header;           /* Standard header for all events. */
319        Channel *chanPtr;           /* The channel that is ready. */
320        int readyMask;              /* Events that have occurred. */
321    } ChannelHandlerEvent;
322    
323    /*
324     * The following structure is used by Tcl_GetsObj() to encapsulates the
325     * state for a "gets" operation.
326     */
327    
328    typedef struct GetsState {
329        Tcl_Obj *objPtr;            /* The object to which UTF-8 characters
330                                     * will be appended. */
331        char **dstPtr;              /* Pointer into objPtr's string rep where
332                                     * next character should be stored. */
333        Tcl_Encoding encoding;      /* The encoding to use to convert raw bytes
334                                     * to UTF-8.  */
335        ChannelBuffer *bufPtr;      /* The current buffer of raw bytes being
336                                     * emptied. */
337        Tcl_EncodingState state;    /* The encoding state just before the last
338                                     * external to UTF-8 conversion in
339                                     * FilterInputBytes(). */
340        int rawRead;                /* The number of bytes removed from bufPtr
341                                     * in the last call to FilterInputBytes(). */
342        int bytesWrote;             /* The number of bytes of UTF-8 data
343                                     * appended to objPtr during the last call to
344                                     * FilterInputBytes(). */
345        int charsWrote;             /* The corresponding number of UTF-8
346                                     * characters appended to objPtr during the
347                                     * last call to FilterInputBytes(). */
348        int totalChars;             /* The total number of UTF-8 characters
349                                     * appended to objPtr so far, just before the
350                                     * last call to FilterInputBytes(). */
351    } GetsState;
352    
353    /*
354     * All static variables used in this file are collected into a single
355     * instance of the following structure.  For multi-threaded implementations,
356     * there is one instance of this structure for each thread.
357     *
358     * Notice that different structures with the same name appear in other
359     * files.  The structure defined below is used in this file only.
360     */
361    
362    typedef struct ThreadSpecificData {
363    
364        /*
365         * This variable holds the list of nested ChannelHandlerEventProc
366         * invocations.
367         */
368        NextChannelHandler *nestedHandlerPtr;
369    
370        /*
371         * List of all channels currently open.
372         */
373        Channel *firstChanPtr;
374    #ifdef oldcode
375        /*
376         * Has a channel exit handler been created yet?
377         */
378        int channelExitHandlerCreated;
379    
380        /*
381         * Has the channel event source been created and registered with the
382         * notifier?
383         */
384        int channelEventSourceCreated;
385    #endif
386        /*
387         * Static variables to hold channels for stdin, stdout and stderr.
388         */
389        Tcl_Channel stdinChannel;
390        int stdinInitialized;
391        Tcl_Channel stdoutChannel;
392        int stdoutInitialized;
393        Tcl_Channel stderrChannel;
394        int stderrInitialized;
395    
396    } ThreadSpecificData;
397    
398    static Tcl_ThreadDataKey dataKey;
399    
400    
401    /*
402     * Static functions in this file:
403     */
404    
405    static ChannelBuffer *  AllocChannelBuffer _ANSI_ARGS_((int length));
406    static void             ChannelEventScriptInvoker _ANSI_ARGS_((
407                                ClientData clientData, int flags));
408    static void             ChannelTimerProc _ANSI_ARGS_((
409                                ClientData clientData));
410    static int              CheckChannelErrors _ANSI_ARGS_((Channel *chanPtr,
411                                int direction));
412    static int              CheckFlush _ANSI_ARGS_((Channel *chanPtr,
413                                ChannelBuffer *bufPtr, int newlineFlag));
414    static int              CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
415                                Channel *chan));
416    static void             CheckForStdChannelsBeingClosed _ANSI_ARGS_((
417                                Tcl_Channel chan));
418    static void             CleanupChannelHandlers _ANSI_ARGS_((
419                                Tcl_Interp *interp, Channel *chanPtr));
420    static int              CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
421                                Channel *chanPtr, int errorCode));
422    static void             CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
423                                Tcl_Encoding encoding));
424    static int              CopyAndTranslateBuffer _ANSI_ARGS_((
425                                Channel *chanPtr, char *result, int space));
426    static int              CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
427    static void             CopyEventProc _ANSI_ARGS_((ClientData clientData,
428                                int mask));
429    static void             CreateScriptRecord _ANSI_ARGS_((
430                                Tcl_Interp *interp, Channel *chanPtr,
431                                int mask, Tcl_Obj *scriptPtr));
432    static void             DeleteChannelTable _ANSI_ARGS_((
433                                ClientData clientData, Tcl_Interp *interp));
434    static void             DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
435                                Channel *chanPtr, int mask));
436    static void             DiscardInputQueued _ANSI_ARGS_((
437                                Channel *chanPtr, int discardSavedBuffers));
438    static void             DiscardOutputQueued _ANSI_ARGS_((
439                                Channel *chanPtr));
440    static int              DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
441                                int slen));
442    static int              DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,
443                                int srcLen));
444    static int              FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
445                                GetsState *statePtr));
446    static int              FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
447                                Channel *chanPtr, int calledFromAsyncFlush));
448    static Tcl_HashTable *  GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
449    static int              GetInput _ANSI_ARGS_((Channel *chanPtr));
450    static void             PeekAhead _ANSI_ARGS_((Channel *chanPtr,
451                                char **dstEndPtr, GetsState *gsPtr));
452    static int              ReadBytes _ANSI_ARGS_((Channel *chanPtr,
453                                Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));
454    static int              ReadChars _ANSI_ARGS_((Channel *chanPtr,
455                                Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
456                                int *factorPtr));
457    static void             RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
458                                ChannelBuffer *bufPtr, int mustDiscard));
459    static int              SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
460                                Channel *chanPtr, int mode));
461    static void             StopCopy _ANSI_ARGS_((CopyState *csPtr));
462    static int              TranslateInputEOL _ANSI_ARGS_((Channel *chanPtr,
463                                char *dst, CONST char *src, int *dstLenPtr,
464                                int *srcLenPtr));
465    static int              TranslateOutputEOL _ANSI_ARGS_((Channel *chanPtr,
466                                char *dst, CONST char *src, int *dstLenPtr,
467                                int *srcLenPtr));
468    static void             UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
469    static int              WriteBytes _ANSI_ARGS_((Channel *chanPtr,
470                                CONST char *src, int srcLen));
471    static int              WriteChars _ANSI_ARGS_((Channel *chanPtr,
472                                CONST char *src, int srcLen));
473    
474    
475    /*
476     *---------------------------------------------------------------------------
477     *
478     * TclInitIOSubsystem --
479     *
480     *      Initialize all resources used by this subsystem on a per-process
481     *      basis.  
482     *
483     * Results:
484     *      None.
485     *
486     * Side effects:
487     *      Depends on the memory subsystems.
488     *
489     *---------------------------------------------------------------------------
490     */
491    
492    void
493    TclInitIOSubsystem()
494    {
495        /*
496         * By fetching thread local storage we take care of
497         * allocating it for each thread.
498         */
499        (void) TCL_TSD_INIT(&dataKey);
500    }  
501    
502    /*
503     *-------------------------------------------------------------------------
504     *
505     * TclFinalizeIOSubsystem --
506     *
507     *      Releases all resources used by this subsystem on a per-process
508     *      basis.  Closes all extant channels that have not already been
509     *      closed because they were not owned by any interp.  
510     *
511     * Results:
512     *      None.
513     *
514     * Side effects:
515     *      Depends on encoding and memory subsystems.
516     *
517     *-------------------------------------------------------------------------
518     */
519    
520            /* ARGSUSED */
521    void
522    TclFinalizeIOSubsystem()
523    {
524        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
525        Channel *chanPtr;                   /* Iterates over open channels. */
526        Channel *nextChanPtr;               /* Iterates over open channels. */
527    
528    
529        for (chanPtr = tsdPtr->firstChanPtr; chanPtr != (Channel *) NULL;
530                 chanPtr = nextChanPtr) {
531            nextChanPtr = chanPtr->nextChanPtr;
532    
533            /*
534             * Set the channel back into blocking mode to ensure that we wait
535             * for all data to flush out.
536             */
537            
538            (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
539                    "-blocking", "on");
540    
541            if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
542                    (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
543                    (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
544    
545                /*
546                 * Decrement the refcount which was earlier artificially bumped
547                 * up to keep the channel from being closed.
548                 */
549    
550                chanPtr->refCount--;
551            }
552    
553            if (chanPtr->refCount <= 0) {
554    
555                /*
556                 * Close it only if the refcount indicates that the channel is not
557                 * referenced from any interpreter. If it is, that interpreter will
558                 * close the channel when it gets destroyed.
559                 */
560    
561                (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
562    
563            } else {
564    
565                /*
566                 * The refcount is greater than zero, so flush the channel.
567                 */
568    
569                Tcl_Flush((Tcl_Channel) chanPtr);
570    
571                /*
572                 * Call the device driver to actually close the underlying
573                 * device for this channel.
574                 */
575                
576                if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
577                    (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
578                            (Tcl_Interp *) NULL);
579                } else {
580                    (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
581                            (Tcl_Interp *) NULL, 0);
582                }
583    
584                /*
585                 * Finally, we clean up the fields in the channel data structure
586                 * since all of them have been deleted already. We mark the
587                 * channel with CHANNEL_DEAD to prevent any further IO operations
588                 * on it.
589                 */
590    
591                chanPtr->instanceData = (ClientData) NULL;
592                chanPtr->flags |= CHANNEL_DEAD;
593            }
594        }
595    }
596    
597    
598    /*
599     *----------------------------------------------------------------------
600     *
601     * Tcl_SetStdChannel --
602     *
603     *      This function is used to change the channels that are used
604     *      for stdin/stdout/stderr in new interpreters.
605     *
606     * Results:
607     *      None
608     *
609     * Side effects:
610     *      None.
611     *
612     *----------------------------------------------------------------------
613     */
614    
615    void
616    Tcl_SetStdChannel(channel, type)
617        Tcl_Channel channel;
618        int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
619    {
620        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
621        switch (type) {
622            case TCL_STDIN:
623                tsdPtr->stdinInitialized = 1;
624                tsdPtr->stdinChannel = channel;
625                break;
626            case TCL_STDOUT:
627                tsdPtr->stdoutInitialized = 1;
628                tsdPtr->stdoutChannel = channel;
629                break;
630            case TCL_STDERR:
631                tsdPtr->stderrInitialized = 1;
632                tsdPtr->stderrChannel = channel;
633                break;
634        }
635    }
636    
637    /*
638     *----------------------------------------------------------------------
639     *
640     * Tcl_GetStdChannel --
641     *
642     *      Returns the specified standard channel.
643     *
644     * Results:
645     *      Returns the specified standard channel, or NULL.
646     *
647     * Side effects:
648     *      May cause the creation of a standard channel and the underlying
649     *      file.
650     *
651     *----------------------------------------------------------------------
652     */
653    Tcl_Channel
654    Tcl_GetStdChannel(type)
655        int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
656    {
657        Tcl_Channel channel = NULL;
658        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
659    
660        /*
661         * If the channels were not created yet, create them now and
662         * store them in the static variables.
663         */
664    
665        switch (type) {
666            case TCL_STDIN:
667                if (!tsdPtr->stdinInitialized) {
668                    tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
669                    tsdPtr->stdinInitialized = 1;
670    
671                    /*
672                     * Artificially bump the refcount to ensure that the channel
673                     * is only closed on exit.
674                     *
675                     * NOTE: Must only do this if stdinChannel is not NULL. It
676                     * can be NULL in situations where Tcl is unable to connect
677                     * to the standard input.
678                     */
679    
680                    if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
681                        (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
682                                tsdPtr->stdinChannel);
683                    }
684                }
685                channel = tsdPtr->stdinChannel;
686                break;
687            case TCL_STDOUT:
688                if (!tsdPtr->stdoutInitialized) {
689                    tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
690                    tsdPtr->stdoutInitialized = 1;
691                    if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
692                        (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
693                                tsdPtr->stdoutChannel);
694                    }
695                }
696                channel = tsdPtr->stdoutChannel;
697                break;
698            case TCL_STDERR:
699                if (!tsdPtr->stderrInitialized) {
700                    tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
701                    tsdPtr->stderrInitialized = 1;
702                    if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
703                        (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
704                                tsdPtr->stderrChannel);
705                    }
706                }
707                channel = tsdPtr->stderrChannel;
708                break;
709        }
710        return channel;
711    }
712    
713    
714    /*
715     *----------------------------------------------------------------------
716     *
717     * Tcl_CreateCloseHandler
718     *
719     *      Creates a close callback which will be called when the channel is
720     *      closed.
721     *
722     * Results:
723     *      None.
724     *
725     * Side effects:
726     *      Causes the callback to be called in the future when the channel
727     *      will be closed.
728     *
729     *----------------------------------------------------------------------
730     */
731    
732    void
733    Tcl_CreateCloseHandler(chan, proc, clientData)
734        Tcl_Channel chan;           /* The channel for which to create the
735                                     * close callback. */
736        Tcl_CloseProc *proc;        /* The callback routine to call when the
737                                     * channel will be closed. */
738        ClientData clientData;      /* Arbitrary data to pass to the
739                                     * close callback. */
740    {
741        Channel *chanPtr;
742        CloseCallback *cbPtr;
743    
744        chanPtr = (Channel *) chan;
745    
746        cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
747        cbPtr->proc = proc;
748        cbPtr->clientData = clientData;
749    
750        cbPtr->nextPtr = chanPtr->closeCbPtr;
751        chanPtr->closeCbPtr = cbPtr;
752    }
753    
754    /*
755     *----------------------------------------------------------------------
756     *
757     * Tcl_DeleteCloseHandler --
758     *
759     *      Removes a callback that would have been called on closing
760     *      the channel. If there is no matching callback then this
761     *      function has no effect.
762     *
763     * Results:
764     *      None.
765     *
766     * Side effects:
767     *      The callback will not be called in the future when the channel
768     *      is eventually closed.
769     *
770     *----------------------------------------------------------------------
771     */
772    
773    void
774    Tcl_DeleteCloseHandler(chan, proc, clientData)
775        Tcl_Channel chan;           /* The channel for which to cancel the
776                                     * close callback. */
777        Tcl_CloseProc *proc;        /* The procedure for the callback to
778                                     * remove. */
779        ClientData clientData;      /* The callback data for the callback
780                                     * to remove. */
781    {
782        Channel *chanPtr;
783        CloseCallback *cbPtr, *cbPrevPtr;
784    
785        chanPtr = (Channel *) chan;
786        for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
787                 cbPtr != (CloseCallback *) NULL;
788                 cbPtr = cbPtr->nextPtr) {
789            if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
790                if (cbPrevPtr == (CloseCallback *) NULL) {
791                    chanPtr->closeCbPtr = cbPtr->nextPtr;
792                }
793                ckfree((char *) cbPtr);
794                break;
795            } else {
796                cbPrevPtr = cbPtr;
797            }
798        }
799    }
800    
801    /*
802     *----------------------------------------------------------------------
803     *
804     * GetChannelTable --
805     *
806     *      Gets and potentially initializes the channel table for an
807     *      interpreter. If it is initializing the table it also inserts
808     *      channels for stdin, stdout and stderr if the interpreter is
809     *      trusted.
810     *
811     * Results:
812     *      A pointer to the hash table created, for use by the caller.
813     *
814     * Side effects:
815     *      Initializes the channel table for an interpreter. May create
816     *      channels for stdin, stdout and stderr.
817     *
818     *----------------------------------------------------------------------
819     */
820    
821    static Tcl_HashTable *
822    GetChannelTable(interp)
823        Tcl_Interp *interp;
824    {
825        Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
826        Tcl_Channel stdinChan, stdoutChan, stderrChan;
827    
828        hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
829        if (hTblPtr == (Tcl_HashTable *) NULL) {
830            hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
831            Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
832    
833            (void) Tcl_SetAssocData(interp, "tclIO",
834                    (Tcl_InterpDeleteProc *) DeleteChannelTable,
835                    (ClientData) hTblPtr);
836    
837            /*
838             * If the interpreter is trusted (not "safe"), insert channels
839             * for stdin, stdout and stderr (possibly creating them in the
840             * process).
841             */
842    
843            if (Tcl_IsSafe(interp) == 0) {
844                stdinChan = Tcl_GetStdChannel(TCL_STDIN);
845                if (stdinChan != NULL) {
846                    Tcl_RegisterChannel(interp, stdinChan);
847                }
848                stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
849                if (stdoutChan != NULL) {
850                    Tcl_RegisterChannel(interp, stdoutChan);
851                }
852                stderrChan = Tcl_GetStdChannel(TCL_STDERR);
853                if (stderrChan != NULL) {
854                    Tcl_RegisterChannel(interp, stderrChan);
855                }
856            }
857    
858        }
859        return hTblPtr;
860    }
861    
862    /*
863     *----------------------------------------------------------------------
864     *
865     * DeleteChannelTable --
866     *
867     *      Deletes the channel table for an interpreter, closing any open
868     *      channels whose refcount reaches zero. This procedure is invoked
869     *      when an interpreter is deleted, via the AssocData cleanup
870     *      mechanism.
871     *
872     * Results:
873     *      None.
874     *
875     * Side effects:
876     *      Deletes the hash table of channels. May close channels. May flush
877     *      output on closed channels. Removes any channeEvent handlers that were
878     *      registered in this interpreter.
879     *
880     *----------------------------------------------------------------------
881     */
882    
883    static void
884    DeleteChannelTable(clientData, interp)
885        ClientData clientData;      /* The per-interpreter data structure. */
886        Tcl_Interp *interp;         /* The interpreter being deleted. */
887    {
888        Tcl_HashTable *hTblPtr;     /* The hash table. */
889        Tcl_HashSearch hSearch;     /* Search variable. */
890        Tcl_HashEntry *hPtr;        /* Search variable. */
891        Channel *chanPtr;   /* Channel being deleted. */
892        EventScriptRecord *sPtr, *prevPtr, *nextPtr;
893                                    /* Variables to loop over all channel events
894                                     * registered, to delete the ones that refer
895                                     * to the interpreter being deleted. */
896        
897        /*
898         * Delete all the registered channels - this will close channels whose
899         * refcount reaches zero.
900         */
901        
902        hTblPtr = (Tcl_HashTable *) clientData;
903        for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
904                 hPtr != (Tcl_HashEntry *) NULL;
905                 hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
906    
907            chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
908    
909            /*
910             * Remove any fileevents registered in this interpreter.
911             */
912            
913            for (sPtr = chanPtr->scriptRecordPtr,
914                     prevPtr = (EventScriptRecord *) NULL;
915                     sPtr != (EventScriptRecord *) NULL;
916                     sPtr = nextPtr) {
917                nextPtr = sPtr->nextPtr;
918                if (sPtr->interp == interp) {
919                    if (prevPtr == (EventScriptRecord *) NULL) {
920                        chanPtr->scriptRecordPtr = nextPtr;
921                    } else {
922                        prevPtr->nextPtr = nextPtr;
923                    }
924    
925                    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
926                            ChannelEventScriptInvoker, (ClientData) sPtr);
927    
928                    Tcl_DecrRefCount(sPtr->scriptPtr);
929                    ckfree((char *) sPtr);
930                } else {
931                    prevPtr = sPtr;
932                }
933            }
934    
935            /*
936             * Cannot call Tcl_UnregisterChannel because that procedure calls
937             * Tcl_GetAssocData to get the channel table, which might already
938             * be inaccessible from the interpreter structure. Instead, we
939             * emulate the behavior of Tcl_UnregisterChannel directly here.
940             */
941    
942            Tcl_DeleteHashEntry(hPtr);
943            chanPtr->refCount--;
944            if (chanPtr->refCount <= 0) {
945                if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
946                    (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
947                }
948            }
949        }
950        Tcl_DeleteHashTable(hTblPtr);
951        ckfree((char *) hTblPtr);
952    }
953    
954    /*
955     *----------------------------------------------------------------------
956     *
957     * CheckForStdChannelsBeingClosed --
958     *
959     *      Perform special handling for standard channels being closed. When
960     *      given a standard channel, if the refcount is now 1, it means that
961     *      the last reference to the standard channel is being explicitly
962     *      closed. Now bump the refcount artificially down to 0, to ensure the
963     *      normal handling of channels being closed will occur. Also reset the
964     *      static pointer to the channel to NULL, to avoid dangling references.
965     *
966     * Results:
967     *      None.
968     *
969     * Side effects:
970     *      Manipulates the refcount on standard channels. May smash the global
971     *      static pointer to a standard channel.
972     *
973     *----------------------------------------------------------------------
974     */
975    
976    static void
977    CheckForStdChannelsBeingClosed(chan)
978        Tcl_Channel chan;
979    {
980        Channel *chanPtr = (Channel *) chan;
981        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
982    
983        if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
984            if (chanPtr->refCount < 2) {
985                chanPtr->refCount = 0;
986                tsdPtr->stdinChannel = NULL;
987                return;
988            }
989        } else if ((chan == tsdPtr->stdoutChannel) && (tsdPtr->stdoutInitialized)) {
990            if (chanPtr->refCount < 2) {
991                chanPtr->refCount = 0;
992                tsdPtr->stdoutChannel = NULL;
993                return;
994            }
995        } else if ((chan == tsdPtr->stderrChannel) && (tsdPtr->stderrInitialized)) {
996            if (chanPtr->refCount < 2) {
997                chanPtr->refCount = 0;
998                tsdPtr->stderrChannel = NULL;
999                return;
1000            }
1001        }
1002    }
1003    
1004    /*
1005     *----------------------------------------------------------------------
1006     *
1007     * Tcl_RegisterChannel --
1008     *
1009     *      Adds an already-open channel to the channel table of an interpreter.
1010     *      If the interpreter passed as argument is NULL, it only increments
1011     *      the channel refCount.
1012     *
1013     * Results:
1014     *      None.
1015     *
1016     * Side effects:
1017     *      May increment the reference count of a channel.
1018     *
1019     *----------------------------------------------------------------------
1020     */
1021    
1022    void
1023    Tcl_RegisterChannel(interp, chan)
1024        Tcl_Interp *interp;         /* Interpreter in which to add the channel. */
1025        Tcl_Channel chan;           /* The channel to add to this interpreter
1026                                     * channel table. */
1027    {
1028        Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
1029        Tcl_HashEntry *hPtr;        /* Search variable. */
1030        int new;                    /* Is the hash entry new or does it exist? */
1031        Channel *chanPtr;           /* The actual channel. */
1032    
1033        chanPtr = (Channel *) chan;
1034    
1035        if (chanPtr->channelName == (char *) NULL) {
1036            panic("Tcl_RegisterChannel: channel without name");
1037        }
1038        if (interp != (Tcl_Interp *) NULL) {
1039            hTblPtr = GetChannelTable(interp);
1040            hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
1041            if (new == 0) {
1042                if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
1043                    return;
1044                }
1045    
1046                /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
1047                 * "Trf-Patch for filtering channels"
1048                 *
1049                 * This is the change to 'Tcl_RegisterChannel'.
1050                 *
1051                 * Explanation:
1052                 *          The moment a channel is stacked upon another he
1053                 *          takes the identity of the channel he supercedes,
1054                 *          i.e. he gets the *same* name. Because of this we
1055                 *          cannot check for duplicate names anymore, they
1056                 *          have to be allowed now.
1057                 */
1058    
1059                /* panic("Tcl_RegisterChannel: duplicate channel names"); */
1060            }
1061            Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
1062        }
1063        chanPtr->refCount++;
1064    }
1065    
1066    /*
1067     *----------------------------------------------------------------------
1068     *
1069     * Tcl_UnregisterChannel --
1070     *
1071     *      Deletes the hash entry for a channel associated with an interpreter.
1072     *      If the interpreter given as argument is NULL, it only decrements the
1073     *      reference count.
1074     *
1075     * Results:
1076     *      A standard Tcl result.
1077     *
1078     * Side effects:
1079     *      Deletes the hash entry for a channel associated with an interpreter.
1080     *
1081     *----------------------------------------------------------------------
1082     */
1083    
1084    int
1085    Tcl_UnregisterChannel(interp, chan)
1086        Tcl_Interp *interp;         /* Interpreter in which channel is defined. */
1087        Tcl_Channel chan;           /* Channel to delete. */
1088    {
1089        Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
1090        Tcl_HashEntry *hPtr;        /* Search variable. */
1091        Channel *chanPtr;           /* The real IO channel. */
1092    
1093        chanPtr = (Channel *) chan;
1094        
1095        if (interp != (Tcl_Interp *) NULL) {
1096            hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
1097            if (hTblPtr == (Tcl_HashTable *) NULL) {
1098                return TCL_OK;
1099            }
1100            hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
1101            if (hPtr == (Tcl_HashEntry *) NULL) {
1102                return TCL_OK;
1103            }
1104            if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
1105                return TCL_OK;
1106            }
1107            Tcl_DeleteHashEntry(hPtr);
1108    
1109            /*
1110             * Remove channel handlers that refer to this interpreter, so that they
1111             * will not be present if the actual close is delayed and more events
1112             * happen on the channel. This may occur if the channel is shared
1113             * between several interpreters, or if the channel has async
1114             * flushing active.
1115             */
1116        
1117            CleanupChannelHandlers(interp, chanPtr);
1118        }
1119    
1120        chanPtr->refCount--;
1121        
1122        /*
1123         * Perform special handling for standard channels being closed. If the
1124         * refCount is now 1 it means that the last reference to the standard
1125         * channel is being explicitly closed, so bump the refCount down
1126         * artificially to 0. This will ensure that the channel is actually
1127         * closed, below. Also set the static pointer to NULL for the channel.
1128         */
1129    
1130        CheckForStdChannelsBeingClosed(chan);
1131    
1132        /*
1133         * If the refCount reached zero, close the actual channel.
1134         */
1135    
1136        if (chanPtr->refCount <= 0) {
1137    
1138            /*
1139             * Ensure that if there is another buffer, it gets flushed
1140             * whether or not we are doing a background flush.
1141             */
1142    
1143            if ((chanPtr->curOutPtr != NULL) &&
1144                    (chanPtr->curOutPtr->nextAdded >
1145                            chanPtr->curOutPtr->nextRemoved)) {
1146                chanPtr->flags |= BUFFER_READY;
1147            }
1148            chanPtr->flags |= CHANNEL_CLOSED;
1149            if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
1150                if (Tcl_Close(interp, chan) != TCL_OK) {
1151                    return TCL_ERROR;
1152                }
1153            }
1154        }
1155        return TCL_OK;
1156    }
1157    
1158    /*
1159     *---------------------------------------------------------------------------
1160     *
1161     * Tcl_GetChannel --
1162     *
1163     *      Finds an existing Tcl_Channel structure by name in a given
1164     *      interpreter. This function is public because it is used by
1165     *      channel-type-specific functions.
1166     *
1167     * Results:
1168     *      A Tcl_Channel or NULL on failure. If failed, interp's result
1169     *      object contains an error message.  *modePtr is filled with the
1170     *      modes in which the channel was opened.
1171     *
1172     * Side effects:
1173     *      None.
1174     *
1175     *---------------------------------------------------------------------------
1176     */
1177    
1178    Tcl_Channel
1179    Tcl_GetChannel(interp, chanName, modePtr)
1180        Tcl_Interp *interp;         /* Interpreter in which to find or create
1181                                     * the channel. */
1182        char *chanName;             /* The name of the channel. */
1183        int *modePtr;               /* Where to store the mode in which the
1184                                     * channel was opened? Will contain an ORed
1185                                     * combination of TCL_READABLE and
1186                                     * TCL_WRITABLE, if non-NULL. */
1187    {
1188        Channel *chanPtr;           /* The actual channel. */
1189        Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
1190        Tcl_HashEntry *hPtr;        /* Search variable. */
1191        char *name;                 /* Translated name. */
1192    
1193        /*
1194         * Substitute "stdin", etc.  Note that even though we immediately
1195         * find the channel using Tcl_GetStdChannel, we still need to look
1196         * it up in the specified interpreter to ensure that it is present
1197         * in the channel table.  Otherwise, safe interpreters would always
1198         * have access to the standard channels.
1199         */
1200    
1201        name = chanName;
1202        if ((chanName[0] == 's') && (chanName[1] == 't')) {
1203            chanPtr = NULL;
1204            if (strcmp(chanName, "stdin") == 0) {
1205                chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
1206            } else if (strcmp(chanName, "stdout") == 0) {
1207                chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
1208            } else if (strcmp(chanName, "stderr") == 0) {
1209                chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
1210            }
1211            if (chanPtr != NULL) {
1212                name = chanPtr->channelName;
1213            }
1214        }
1215        
1216        hTblPtr = GetChannelTable(interp);
1217        hPtr = Tcl_FindHashEntry(hTblPtr, name);
1218        if (hPtr == (Tcl_HashEntry *) NULL) {
1219            Tcl_AppendResult(interp, "can not find channel named \"",
1220                    chanName, "\"", (char *) NULL);
1221            return NULL;
1222        }
1223    
1224        chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
1225        if (modePtr != NULL) {
1226            *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
1227        }
1228        
1229        return (Tcl_Channel) chanPtr;
1230    }
1231    
1232    /*
1233     *----------------------------------------------------------------------
1234     *
1235     * Tcl_CreateChannel --
1236     *
1237     *      Creates a new entry in the hash table for a Tcl_Channel
1238     *      record.
1239     *
1240     * Results:
1241     *      Returns the new Tcl_Channel.
1242     *
1243     * Side effects:
1244     *      Creates a new Tcl_Channel instance and inserts it into the
1245     *      hash table.
1246     *
1247     *----------------------------------------------------------------------
1248     */
1249    
1250    Tcl_Channel
1251    Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
1252        Tcl_ChannelType *typePtr;   /* The channel type record. */
1253        char *chanName;             /* Name of channel to record. */
1254        ClientData instanceData;    /* Instance specific data. */
1255        int mask;                   /* TCL_READABLE & TCL_WRITABLE to indicate
1256                                     * if the channel is readable, writable. */
1257    {
1258        Channel *chanPtr;           /* The channel structure newly created. */
1259        CONST char *name;
1260        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1261    
1262        chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1263        
1264        if (chanName != (char *) NULL) {
1265            chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
1266            strcpy(chanPtr->channelName, chanName);
1267        } else {
1268            panic("Tcl_CreateChannel: NULL channel name");
1269        }
1270    
1271        chanPtr->flags = mask;
1272    
1273        /*
1274         * Set the channel to system default encoding.
1275         */
1276    
1277        chanPtr->encoding = NULL;
1278        name = Tcl_GetEncodingName(NULL);
1279        if (strcmp(name, "binary") != 0) {
1280            chanPtr->encoding = Tcl_GetEncoding(NULL, name);
1281        }
1282        chanPtr->inputEncodingState = NULL;
1283        chanPtr->inputEncodingFlags = TCL_ENCODING_START;
1284        chanPtr->outputEncodingState = NULL;
1285        chanPtr->outputEncodingFlags = TCL_ENCODING_START;
1286    
1287        /*
1288         * Set the channel up initially in AUTO input translation mode to
1289         * accept "\n", "\r" and "\r\n". Output translation mode is set to
1290         * a platform specific default value. The eofChar is set to 0 for both
1291         * input and output, so that Tcl does not look for an in-file EOF
1292         * indicator (e.g. ^Z) and does not append an EOF indicator to files.
1293         */
1294    
1295        chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
1296        chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
1297        chanPtr->inEofChar = 0;
1298        chanPtr->outEofChar = 0;
1299    
1300        chanPtr->unreportedError = 0;
1301        chanPtr->instanceData = instanceData;
1302        chanPtr->typePtr = typePtr;
1303        chanPtr->refCount = 0;
1304        chanPtr->closeCbPtr = (CloseCallback *) NULL;
1305        chanPtr->curOutPtr = (ChannelBuffer *) NULL;
1306        chanPtr->outQueueHead = (ChannelBuffer *) NULL;
1307        chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1308        chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
1309        chanPtr->inQueueHead = (ChannelBuffer *) NULL;
1310        chanPtr->inQueueTail = (ChannelBuffer *) NULL;
1311        chanPtr->chPtr = (ChannelHandler *) NULL;
1312        chanPtr->interestMask = 0;
1313        chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
1314        chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1315        chanPtr->timer = NULL;
1316        chanPtr->csPtr = NULL;
1317        chanPtr->supercedes = (Channel*) NULL;
1318    
1319        chanPtr->outputStage = NULL;
1320        if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1321            chanPtr->outputStage = (char *)
1322                    ckalloc((unsigned) (chanPtr->bufSize + 2));
1323        }
1324    
1325        /*
1326         * Link the channel into the list of all channels; create an on-exit
1327         * handler if there is not one already, to close off all the channels
1328         * in the list on exit.
1329         */
1330    
1331        chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
1332        tsdPtr->firstChanPtr = chanPtr;
1333    
1334        /*
1335         * Install this channel in the first empty standard channel slot, if
1336         * the channel was previously closed explicitly.
1337         */
1338    
1339        if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
1340            Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
1341            Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1342        } else if ((tsdPtr->stdoutChannel == NULL) && (tsdPtr->stdoutInitialized == 1)) {
1343            Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
1344            Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1345        } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) {
1346            Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
1347            Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1348        }
1349        return (Tcl_Channel) chanPtr;
1350    }
1351    
1352    /*
1353     *----------------------------------------------------------------------
1354     *
1355     * Tcl_StackChannel --
1356     *
1357     *      Replaces an entry in the hash table for a Tcl_Channel
1358     *      record. The replacement is a new channel with same name,
1359     *      it supercedes the replaced channel. Input and output of
1360     *      the superceded channel is now going through the newly
1361     *      created channel and allows the arbitrary filtering/manipulation
1362     *      of the dataflow.
1363     *
1364     *      Andreas Kupries <a.kupries@westend.com>, 12/13/1998
1365     *      "Trf-Patch for filtering channels"
1366     *
1367     * Results:
1368     *      Returns the new Tcl_Channel, which actually contains the
1369     *      saved information about prevChan.
1370     *
1371     * Side effects:
1372     *    A new channel structure is allocated and linked below
1373     *    the existing channel.  The channel operations and client
1374     *    data of the existing channel are copied down to the newly
1375     *    created channel, and the current channel has its operations
1376     *    replaced by the new typePtr.
1377     *
1378     *----------------------------------------------------------------------
1379     */
1380    
1381    Tcl_Channel
1382    Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
1383        Tcl_Interp*      interp;       /* The interpreter we are working in */
1384        Tcl_ChannelType *typePtr;      /* The channel type record for the new
1385                                        * channel. */
1386        ClientData       instanceData; /* Instance specific data for the new
1387                                        * channel. */
1388        int              mask;         /* TCL_READABLE & TCL_WRITABLE to indicate
1389                                        * if the channel is readable, writable. */
1390        Tcl_Channel      prevChan;     /* The channel structure to replace */
1391    {
1392        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1393        Channel            *chanPtr, *pt;
1394        int                 interest = 0;
1395    
1396        /*
1397         * AK, 06/30/1999
1398         *
1399         * Tcl_StackChannel differs from Tcl_ReplaceChannel of the
1400         * original "Trf" patch. Instead of seeing the
1401         * newly created structure as the *new* channel to cover the specified
1402         * one use it to *save* the current state of the specified channel and
1403         * then reinitialize the current structure for the given transformation.
1404         *
1405         * Advantages:
1406         * - No splicing into the (thread-)global list of channels (or the per-
1407         *   interp hash-tables).
1408         * - Users of the C-API still have valid channel references even after
1409         *   the call to this procedure.
1410         *
1411         * Disadvantages:
1412         * - Untested code.
1413         */
1414    
1415        /*
1416         * Find the given channel in the list of all channels.
1417         */
1418    
1419        pt     = (Channel*) tsdPtr->firstChanPtr;
1420    
1421        while (pt != (Channel *) prevChan) {
1422            pt = pt->nextChanPtr;
1423        }
1424    
1425        /*
1426         * 'pt == prevChan' now (or NULL, if not found).
1427         */
1428    
1429        if (!pt) {
1430            return (Tcl_Channel) NULL;
1431        }
1432    
1433        /*
1434         * Here we check if the given "mask" matches the "flags"
1435         * of the already existing channel.
1436         *
1437         *    | - | R | W | RW |
1438         *  --+---+---+---+----+    <=>  0 != (chan->mask & prevChan->mask)
1439         *  - |   |   |   |    |
1440         *  R |   | + |   | +  |    The superceding channel is allowed to
1441         *  W |   |   | + | +  |    restrict the capabilities of the
1442         *  RW|   | + | + | +  |    superceded one !
1443         *  --+---+---+---+----+
1444         */
1445    
1446        if ((mask & Tcl_GetChannelMode (prevChan)) == 0) {
1447            return (Tcl_Channel) NULL;
1448        }
1449    
1450        chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1451    
1452        /*
1453         * If there is some interest in the channel, remove it, break
1454         * down the whole chain. It will be reconstructed later.
1455         */
1456    
1457        interest = pt->interestMask;
1458    
1459        pt->interestMask = 0;
1460    
1461        if (interest) {
1462            (pt->typePtr->watchProc) (pt->instanceData, 0);
1463        }
1464    
1465        /*
1466         * Save some of the current state into the new structure,
1467         * reinitialize the parts which will stay with the transformation.
1468         *
1469         * Remarks:
1470         * - We cannot discard the buffers, and they cannot be used from the
1471         *   transformation placed later into the 'pt' structure. Save them,
1472         *   and believe that Tcl_SetChannelOption (buffering, none) will do
1473         *   the right thing.
1474         * - encoding and EOL-translation control information is initialized
1475         *   to values for 'binary'. This is later reinforced via
1476         *   Tcl_SetChanneloption to get the handling of flags and the event
1477         *   system right.
1478         * - The 'interestMask' of the saved channel is cleared, but the
1479         *   transformations WatchProc is used to establish the connection
1480         *   between transformation and underlying channel. This should
1481         *   reestablish the correct mask.
1482         * - TTO = Transform Takes Over.   The hidden channel no longer
1483         *         needs to perform this function.
1484         */
1485    
1486        chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);
1487        strcpy (chanPtr->channelName, pt->channelName);
1488    
1489        chanPtr->flags               = pt->flags;           /* Save */
1490    
1491        chanPtr->encoding            = (Tcl_Encoding) NULL; /* == 'binary' */
1492        chanPtr->inputEncodingState  = (Tcl_EncodingState) NULL;
1493        chanPtr->inputEncodingFlags  = TCL_ENCODING_START;
1494        chanPtr->outputEncodingState = (Tcl_EncodingState) NULL;
1495        chanPtr->outputEncodingFlags = TCL_ENCODING_START;
1496    
1497        chanPtr->inputTranslation    = TCL_TRANSLATE_LF; /* == 'binary' */
1498        chanPtr->outputTranslation   = TCL_TRANSLATE_LF; /* == 'binary' */
1499        chanPtr->inEofChar           = pt->inEofChar;         /* Save */
1500        chanPtr->outEofChar          = pt->outEofChar;        /* Save */
1501    
1502        chanPtr->unreportedError     = pt->unreportedError;   /* Save */
1503        chanPtr->instanceData        = pt->instanceData;      /* Save */
1504        chanPtr->typePtr             = pt->typePtr;           /* Save */
1505        chanPtr->refCount            = 0;   /* None, as the structure is covered */
1506        chanPtr->closeCbPtr          = (CloseCallback*) NULL; /* TTO */
1507    
1508        chanPtr->outputStage         = (char*) NULL;
1509        chanPtr->curOutPtr           = pt->curOutPtr;    /* Save */
1510        chanPtr->outQueueHead        = pt->outQueueHead; /* Save */
1511        chanPtr->outQueueTail        = pt->outQueueTail; /* Save */
1512        chanPtr->saveInBufPtr        = pt->saveInBufPtr; /* Save */
1513        chanPtr->inQueueHead         = pt->inQueueHead;  /* Save */
1514        chanPtr->inQueueTail         = pt->inQueueTail;  /* Save */
1515    
1516        chanPtr->chPtr               = (ChannelHandler *) NULL;  /* TTO */
1517        chanPtr->interestMask        = 0;
1518        chanPtr->nextChanPtr         = (Channel*) NULL;     /* Is not in list! */
1519        chanPtr->scriptRecordPtr     = (EventScriptRecord *) NULL; /* TTO */
1520        chanPtr->bufSize             = CHANNELBUFFER_DEFAULT_SIZE;
1521        chanPtr->timer               = (Tcl_TimerToken) NULL;      /* TTO */
1522        chanPtr->csPtr               = (CopyState*) NULL;          /* TTO */
1523    
1524        /*
1525         * Place new block at the head of a possibly existing list of previously
1526         * stacked channels, then do the missing initializations of translation
1527         * and buffer system.
1528         */
1529    
1530        chanPtr->supercedes          = pt->supercedes;
1531    
1532        Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1533            "-translation", "binary");
1534        Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1535            "-buffering",   "none");
1536    
1537        /*
1538         * Save accomplished, now reinitialize the (old) structure for the
1539         * transformation.
1540         *
1541         * - The information about encoding and eol-translation is taken
1542         *   without change.  There is no need to fiddle with
1543         *   refCount et. al.
1544         *
1545         * Don't forget to use the same blocking mode as the old channel.
1546         */
1547    
1548        pt->flags               = mask | (chanPtr->flags & CHANNEL_NONBLOCKING);
1549    
1550        /*
1551         * EDITORS NOTE:  all the lines with "take it as is" should get
1552         * deleted once this code has been debugged.
1553         */
1554    
1555        /* pt->encoding,            take it as is */
1556        /* pt->inputEncodingState,  take it as is */
1557        /* pt->inputEncodingFlags,  take it as is */
1558        /* pt->outputEncodingState, take it as is */
1559        /* pt->outputEncodingFlags, take it as is */
1560    
1561        /* pt->inputTranslation,    take it as is */
1562        /* pt->outputTranslation,   take it as is */
1563    
1564        /*
1565         * No special EOF character, that condition is determined by the
1566         * old channel
1567         */
1568    
1569        pt->inEofChar           = 0;
1570        pt->outEofChar          = 0;
1571    
1572        pt->unreportedError     = 0; /* No errors yet */
1573        pt->instanceData        = instanceData; /* Transformation state */
1574        pt->typePtr             = typePtr;      /* Transformation type */
1575        /* pt->refCount,            take it as it is */
1576        /* pt->closeCbPtr,          take it as it is */
1577    
1578        /* pt->outputStage,         take it as it is */
1579        pt->curOutPtr           = (ChannelBuffer *) NULL;
1580        pt->outQueueHead        = (ChannelBuffer *) NULL;
1581        pt->outQueueTail        = (ChannelBuffer *) NULL;
1582        pt->saveInBufPtr        = (ChannelBuffer *) NULL;
1583        pt->inQueueHead         = (ChannelBuffer *) NULL;
1584        pt->inQueueTail         = (ChannelBuffer *) NULL;
1585    
1586        /* pt->chPtr,               take it as it is */
1587        /* pt->interestMask,        take it as it is */
1588        /* pt->nextChanPtr,         take it as it is */
1589        /* pt->scriptRecordPtr,     take it as it is */
1590        pt->bufSize             = CHANNELBUFFER_DEFAULT_SIZE;
1591        /* pt->timer,               take it as it is */
1592        /* pt->csPtr,               take it as it is */
1593    
1594        /*
1595         * Have the transformation reference the new structure containing
1596         * the saved channel.
1597         */
1598    
1599        pt->supercedes          = chanPtr;
1600    
1601        /*
1602         * Don't forget to reinitialize the output buffer used for encodings.
1603         */
1604    
1605        if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1606            chanPtr->outputStage = (char *)
1607                ckalloc((unsigned) (chanPtr->bufSize + 2));
1608        }
1609    
1610        /*
1611         * Event handling: If the information in the old channel shows
1612         * that there was interest in some events call the 'WatchProc'
1613         * of the transformation to establish the proper connection
1614         * between them.
1615         */
1616    
1617        if (interest) {
1618            (pt->typePtr->watchProc) (pt->instanceData, interest);
1619        }
1620    
1621        /*
1622         * The superceded channel is effectively unregistered
1623         * We cannot decrement its reference count because that
1624         * can cause it to get garbage collected out from under us.
1625         * Don't add the following code:
1626         *
1627         * chanPtr->supercedes->refCount --;
1628         */
1629    
1630        return (Tcl_Channel) chanPtr;
1631    }
1632    
1633    /*
1634     *----------------------------------------------------------------------
1635     *
1636     * Tcl_UnstackChannel --
1637     *
1638     *      Unstacks an entry in the hash table for a Tcl_Channel
1639     *      record. This is the reverse to 'Tcl_StackChannel'.
1640     *      The old, superceded channel is uncovered and re-registered
1641     *      in the appropriate data structures.
1642     *
1643     * Results:
1644     *      Returns the old Tcl_Channel, i.e. the one which was stacked over.
1645     *
1646     * Side effects:
1647     *      See above.
1648     *
1649     *----------------------------------------------------------------------
1650     */
1651    
1652    void
1653    Tcl_UnstackChannel (interp, chan)
1654        Tcl_Interp* interp; /* The interpreter we are working in */
1655        Tcl_Channel chan;   /* The channel to unstack */
1656    {
1657        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1658        Channel* chanPtr = (Channel*) chan;
1659    
1660        if (chanPtr->supercedes != (Channel*) NULL) {
1661            /*
1662             * Instead of manipulating the per-thread / per-interp list/hashtable
1663             * of registered channels we wind down the state of the transformation,
1664             * and then restore the state of underlying channel into the old
1665             * structure.
1666             */
1667    
1668            Tcl_DString       dsTrans; /* storage to save option information */
1669            Tcl_DString       dsBuf;   /* storage to save option information */
1670            Channel           top;     /* Save area for current transformation */
1671            Channel*          chanDownPtr = chanPtr->supercedes;
1672            int               interest;     /* interest mask of transformation
1673                                             * before destruct. */
1674            int               saveInputEncodingFlags;  /* Save area for encoding */
1675            int               saveOutputEncodingFlags; /* related information */
1676            Tcl_EncodingState saveInputEncodingState;
1677            Tcl_EncodingState saveOutputEncodingState;
1678            Tcl_Encoding      saveEncoding;
1679    
1680            /*
1681             * Event handling: Disallow the delivery of events from the
1682             * old, now uncovered channel to the transformation.
1683             *
1684             * This is done before everything else to avoid problems
1685             * after our heavy-duty shuffling of pointers around.
1686             */
1687    
1688            interest = chanPtr->interestMask;
1689            (chanPtr->typePtr->watchProc) (chanPtr->instanceData, 0);
1690    
1691            /* 1. Swap the information in the top channel (the transformation)
1692             *    and the channel below, with some exceptions. This additionally
1693             *    cuts the top channel out of the chain. Without the latter
1694             *    a Tcl_Close on the transformation would be impossible, as that
1695             *    procedure will free the structure, making 'top' unusable.
1696             *
1697             * chanPtr     -> top channel, transformation.
1698             * chanDownPtr -> channel immediately below the transformation.
1699             */
1700    
1701            memcpy ((void*) &top,        (void*) chanPtr,     sizeof (Channel));
1702            memcpy ((void*) chanPtr,     (void*) chanDownPtr, sizeof (Channel));
1703            top.supercedes = (Channel*) NULL;
1704            memcpy ((void*) chanDownPtr, (void*) &top,        sizeof (Channel));
1705    
1706            /* Now:
1707             * chanPtr     -> channel immediately below the transformation, now top
1708             * chanDownPtr -> transformation, cut loose.
1709             *
1710             * Handle the exceptions mentioned above, i.e. move the information
1711             * from the transformation into the new top, and reinitialize it to
1712             * safe values in the transformation.
1713             */
1714    
1715            chanPtr->refCount        = chanDownPtr->refCount;
1716            chanPtr->closeCbPtr      = chanDownPtr->closeCbPtr;
1717            chanPtr->chPtr           = chanDownPtr->chPtr;
1718            chanPtr->nextChanPtr     = chanDownPtr->nextChanPtr;
1719            chanPtr->scriptRecordPtr = chanDownPtr->scriptRecordPtr;
1720            chanPtr->timer           = chanDownPtr->timer;
1721            chanPtr->csPtr           = chanDownPtr->csPtr;
1722    
1723            chanDownPtr->refCount        = 0;
1724            chanDownPtr->closeCbPtr      = (CloseCallback*) NULL;
1725            chanDownPtr->chPtr           = (ChannelHandler*) NULL;
1726            chanDownPtr->nextChanPtr     = (Channel*) NULL;
1727            chanDownPtr->scriptRecordPtr = (EventScriptRecord*) NULL;
1728            chanDownPtr->timer           = (Tcl_TimerToken) NULL;
1729            chanDownPtr->csPtr           = (CopyState*) NULL;
1730    
1731            /* The now uncovered channel still has encoding and eol-translation
1732             * deactivated, i.e. switched to 'binary'. *Don't* touch this until
1733             * after the transformation is closed for good, as it may write
1734             * information into it during that (-> flushing of data waiting in
1735             * internal buffers!) and rely on these settings. Thanks to Matt
1736             * Newman <matt@sensus.org> for finding this goof.
1737             *
1738             * But we also have to protect the state of the encoding from removal
1739             * during the close. So we save it in some local variables.
1740             * Additionally the current value of the options is lost after we
1741             * close, we have to save them now.
1742             */
1743    
1744            saveEncoding            = chanDownPtr->encoding;
1745            saveInputEncodingState  = chanDownPtr->inputEncodingState;
1746            saveInputEncodingFlags  = chanDownPtr->inputEncodingFlags;
1747            saveOutputEncodingState = chanDownPtr->outputEncodingState;
1748            saveOutputEncodingFlags = chanDownPtr->outputEncodingFlags;
1749    
1750            Tcl_DStringInit (&dsTrans);
1751            Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
1752                    "-translation", &dsTrans);
1753    
1754            Tcl_DStringInit (&dsBuf);
1755            Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
1756                    "-buffering", &dsBuf);
1757    
1758            /*
1759             * Prevent the accidential removal of the encoding during
1760             * the destruction of the transformation channel.
1761             */
1762    
1763            chanDownPtr->encoding            = (Tcl_Encoding) NULL;
1764            chanDownPtr->inputEncodingState  = (Tcl_EncodingState) NULL;
1765            chanDownPtr->inputEncodingFlags  = TCL_ENCODING_START;
1766            chanDownPtr->outputEncodingState = (Tcl_EncodingState) NULL;
1767            chanDownPtr->outputEncodingFlags = TCL_ENCODING_START;
1768    
1769            /*
1770             * A little trick: Add the transformation structure to the
1771             * per-thread list of existing channels (which it never were
1772             * part of so far), or Tcl_Close/FlushChannel will panic
1773             * ("damaged channel list").
1774             *
1775             * Afterward do a regular close upon the transformation.
1776             * This may cause flushing of data into the old channel (if the
1777             * transformation remembered its own channel in itself).
1778             *
1779             * We know that its refCount dropped to 0.
1780             */
1781    
1782            chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr;
1783            tsdPtr->firstChanPtr     = chanDownPtr;
1784    
1785            Tcl_Close (interp, (Tcl_Channel)chanDownPtr);
1786    
1787            /*
1788             * Now it is possible to wind down the transformation (in 'top'),
1789             * especially to copy the current encoding and translation control
1790             * information down.
1791             */
1792            
1793            /*
1794             * Move the currently active encoding from the save area
1795             * to the now uncovered channel. We assume here that this
1796             * channel uses 'encoding binary' (==> encoding == NULL, etc.
1797             * This allows us to simply copy the pointers without having to
1798             * think about refcounts and deallocation of the old encoding.
1799             *
1800             * And don't forget to reenable the EOL-translation used by the
1801             * transformation. Using a DString to do this *is* a bit awkward,
1802             * but still the best way to handle the complexities here, like
1803             * flag manipulation and event system.
1804             */
1805    
1806            chanPtr->encoding            = saveEncoding;
1807            chanPtr->inputEncodingState  = saveInputEncodingState;
1808            chanPtr->inputEncodingFlags  = saveInputEncodingFlags;
1809            chanPtr->outputEncodingState = saveOutputEncodingState;
1810            chanPtr->outputEncodingFlags = saveOutputEncodingFlags;
1811    
1812            Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1813                    "-translation", dsTrans.string);
1814    
1815            Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1816                    "-buffering", dsBuf.string);
1817    
1818            Tcl_DStringFree (&dsTrans);
1819            Tcl_DStringFree (&dsBuf);
1820    
1821            /*
1822             * Event handling: If the information from the now destroyed
1823             * transformation shows that there was interest in some events
1824             * call the 'WatchProc' of the now uncovered channel to renew
1825             * that interest with underlying channels or the driver.
1826             */
1827    
1828            if (interest) {
1829                chanPtr->interestMask = 0;
1830                (chanPtr->typePtr->watchProc) (chanPtr->instanceData,
1831                    interest);
1832                chanPtr->interestMask = interest;
1833            }
1834    
1835        } else {
1836            /* This channel does not cover another one.
1837             * Simply do a close, if necessary.
1838             */
1839    
1840            if (chanPtr->refCount == 0) {
1841                Tcl_Close (interp, chan);
1842            }
1843        }
1844    }
1845    
1846    /*
1847     *----------------------------------------------------------------------
1848     *
1849     * Tcl_GetStackedChannel --
1850     *
1851     *      Determines wether the specified channel is stacked upon another.
1852     *
1853     * Results:
1854     *      NULL if the channel is not stacked upon another one, or a reference
1855     *      to the channel it is stacked upon. This reference can be used in
1856     *      queries, but modification is not allowed.
1857     *
1858     * Side effects:
1859     *      None.
1860     *
1861     *----------------------------------------------------------------------
1862     */
1863    
1864    Tcl_Channel
1865    Tcl_GetStackedChannel(chan)
1866        Tcl_Channel chan;
1867    {
1868      Channel* chanPtr = (Channel*) chan;
1869      return (Tcl_Channel) chanPtr->supercedes;
1870    }
1871    
1872    /*
1873     *----------------------------------------------------------------------
1874     *
1875     * Tcl_GetChannelMode --
1876     *
1877     *      Computes a mask indicating whether the channel is open for
1878     *      reading and writing.
1879     *
1880     * Results:
1881     *      An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
1882     *
1883     * Side effects:
1884     *      None.
1885     *
1886     *----------------------------------------------------------------------
1887     */
1888    
1889    int
1890    Tcl_GetChannelMode(chan)
1891        Tcl_Channel chan;           /* The channel for which the mode is
1892                                     * being computed. */
1893    {
1894        Channel *chanPtr;           /* The actual channel. */
1895    
1896        chanPtr = (Channel *) chan;
1897        return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));
1898    }
1899    
1900    /*
1901     *----------------------------------------------------------------------
1902     *
1903     * Tcl_GetChannelName --
1904     *
1905     *      Returns the string identifying the channel name.
1906     *
1907     * Results:
1908     *      The string containing the channel name. This memory is
1909     *      owned by the generic layer and should not be modified by
1910     *      the caller.
1911     *
1912     * Side effects:
1913     *      None.
1914     *
1915     *----------------------------------------------------------------------
1916     */
1917    
1918    char *
1919    Tcl_GetChannelName(chan)
1920        Tcl_Channel chan;           /* The channel for which to return the name. */
1921    {
1922        Channel *chanPtr;           /* The actual channel. */
1923    
1924        chanPtr = (Channel *) chan;
1925        return chanPtr->channelName;
1926    }
1927    
1928    /*
1929     *----------------------------------------------------------------------
1930     *
1931     * Tcl_GetChannelType --
1932     *
1933     *      Given a channel structure, returns the channel type structure.
1934     *
1935     * Results:
1936     *      Returns a pointer to the channel type structure.
1937     *
1938     * Side effects:
1939     *      None.
1940     *
1941     *----------------------------------------------------------------------
1942     */
1943    
1944    Tcl_ChannelType *
1945    Tcl_GetChannelType(chan)
1946        Tcl_Channel chan;           /* The channel to return type for. */
1947    {
1948        Channel *chanPtr;           /* The actual channel. */
1949    
1950        chanPtr = (Channel *) chan;
1951        return chanPtr->typePtr;
1952    }
1953    
1954    /*
1955     *----------------------------------------------------------------------
1956     *
1957     * Tcl_GetChannelHandle --
1958     *
1959     *      Returns an OS handle associated with a channel.
1960     *
1961     * Results:
1962     *      Returns TCL_OK and places the handle in handlePtr, or returns
1963     *      TCL_ERROR on failure.
1964     *
1965     * Side effects:
1966     *      None.
1967     *
1968     *----------------------------------------------------------------------
1969     */
1970    
1971    int
1972    Tcl_GetChannelHandle(chan, direction, handlePtr)
1973        Tcl_Channel chan;           /* The channel to get file from. */
1974        int direction;              /* TCL_WRITABLE or TCL_READABLE. */
1975        ClientData *handlePtr;      /* Where to store handle */
1976    {
1977        Channel *chanPtr;           /* The actual channel. */
1978        ClientData handle;
1979        int result;
1980    
1981        chanPtr = (Channel *) chan;
1982        result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
1983                direction, &handle);
1984        if (handlePtr) {
1985            *handlePtr = handle;
1986        }
1987        return result;
1988    }
1989    
1990    /*
1991     *----------------------------------------------------------------------
1992     *
1993     * Tcl_GetChannelInstanceData --
1994     *
1995     *      Returns the client data associated with a channel.
1996     *
1997     * Results:
1998     *      The client data.
1999     *
2000     * Side effects:
2001     *      None.
2002     *
2003     *----------------------------------------------------------------------
2004     */
2005    
2006    ClientData
2007    Tcl_GetChannelInstanceData(chan)
2008        Tcl_Channel chan;           /* Channel for which to return client data. */
2009    {
2010        Channel *chanPtr;           /* The actual channel. */
2011    
2012        chanPtr = (Channel *) chan;
2013        return chanPtr->instanceData;
2014    }
2015    
2016    /*
2017     *---------------------------------------------------------------------------
2018     *
2019     * AllocChannelBuffer --
2020     *
2021     *      A channel buffer has BUFFER_PADDING bytes extra at beginning to
2022     *      hold any bytes of a native-encoding character that got split by
2023     *      the end of the previous buffer and need to be moved to the
2024     *      beginning of the next buffer to make a contiguous string so it
2025     *      can be converted to UTF-8.
2026     *
2027     *      A channel buffer has BUFFER_PADDING bytes extra at the end to
2028     *      hold any bytes of a native-encoding character (generated from a
2029     *      UTF-8 character) that overflow past the end of the buffer and
2030     *      need to be moved to the next buffer.
2031     *
2032     * Results:
2033     *      A newly allocated channel buffer.
2034     *
2035     * Side effects:
2036     *      None.
2037     *
2038     *---------------------------------------------------------------------------
2039     */
2040    
2041    static ChannelBuffer *
2042    AllocChannelBuffer(length)
2043        int length;                 /* Desired length of channel buffer. */
2044    {
2045        ChannelBuffer *bufPtr;
2046        int n;
2047    
2048        n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
2049        bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
2050        bufPtr->nextAdded   = BUFFER_PADDING;
2051        bufPtr->nextRemoved = BUFFER_PADDING;
2052        bufPtr->bufLength   = length + BUFFER_PADDING;
2053        bufPtr->nextPtr     = (ChannelBuffer *) NULL;
2054        return bufPtr;
2055    }
2056    
2057    /*
2058     *----------------------------------------------------------------------
2059     *
2060     * RecycleBuffer --
2061     *
2062     *      Helper function to recycle input and output buffers. Ensures
2063     *      that two input buffers are saved (one in the input queue and
2064     *      another in the saveInBufPtr field) and that curOutPtr is set
2065     *      to a buffer. Only if these conditions are met is the buffer
2066     *      freed to the OS.
2067     *
2068     * Results:
2069     *      None.
2070     *
2071     * Side effects:
2072     *      May free a buffer to the OS.
2073     *
2074     *----------------------------------------------------------------------
2075     */
2076    
2077    static void
2078    RecycleBuffer(chanPtr, bufPtr, mustDiscard)
2079        Channel *chanPtr;           /* Channel for which to recycle buffers. */
2080        ChannelBuffer *bufPtr;      /* The buffer to recycle. */
2081        int mustDiscard;            /* If nonzero, free the buffer to the
2082                                     * OS, always. */
2083    {
2084        /*
2085         * Do we have to free the buffer to the OS?
2086         */
2087    
2088        if (mustDiscard) {
2089            ckfree((char *) bufPtr);
2090            return;
2091        }
2092        
2093        /*
2094         * Only save buffers for the input queue if the channel is readable.
2095         */
2096        
2097        if (chanPtr->flags & TCL_READABLE) {
2098            if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
2099                chanPtr->inQueueHead = bufPtr;
2100                chanPtr->inQueueTail = bufPtr;
2101                goto keepit;
2102            }
2103            if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
2104                chanPtr->saveInBufPtr = bufPtr;
2105                goto keepit;
2106            }
2107        }
2108    
2109        /*
2110         * Only save buffers for the output queue if the channel is writable.
2111         */
2112    
2113        if (chanPtr->flags & TCL_WRITABLE) {
2114            if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
2115                chanPtr->curOutPtr = bufPtr;
2116                goto keepit;
2117            }
2118        }
2119    
2120        /*
2121         * If we reached this code we return the buffer to the OS.
2122         */
2123    
2124        ckfree((char *) bufPtr);
2125        return;
2126    
2127    keepit:
2128        bufPtr->nextRemoved = BUFFER_PADDING;
2129        bufPtr->nextAdded = BUFFER_PADDING;
2130        bufPtr->nextPtr = (ChannelBuffer *) NULL;
2131    }
2132    
2133    /*
2134     *----------------------------------------------------------------------
2135     *
2136     * DiscardOutputQueued --
2137     *
2138     *      Discards all output queued in the output queue of a channel.
2139     *
2140     * Results:
2141     *      None.
2142     *
2143     * Side effects:
2144     *      Recycles buffers.
2145     *
2146     *----------------------------------------------------------------------
2147     */
2148    
2149    static void
2150    DiscardOutputQueued(chanPtr)
2151        Channel *chanPtr;           /* The channel for which to discard output. */
2152    {
2153        ChannelBuffer *bufPtr;
2154        
2155        while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
2156            bufPtr = chanPtr->outQueueHead;
2157            chanPtr->outQueueHead = bufPtr->nextPtr;
2158            RecycleBuffer(chanPtr, bufPtr, 0);
2159        }
2160        chanPtr->outQueueHead = (ChannelBuffer *) NULL;
2161        chanPtr->outQueueTail = (ChannelBuffer *) NULL;
2162    }
2163    
2164    /*
2165     *----------------------------------------------------------------------
2166     *
2167     * CheckForDeadChannel --
2168     *
2169     *      This function checks is a given channel is Dead.
2170     *      (A channel that has been closed but not yet deallocated.)
2171     *
2172     * Results:
2173     *      True (1) if channel is Dead, False (0) if channel is Ok
2174     *
2175     * Side effects:
2176     *      None
2177     *
2178     *----------------------------------------------------------------------
2179     */
2180    
2181    static int
2182    CheckForDeadChannel(interp, chanPtr)
2183        Tcl_Interp *interp;         /* For error reporting (can be NULL) */
2184        Channel    *chanPtr;        /* The channel to check. */
2185    {
2186        if (chanPtr->flags & CHANNEL_DEAD) {
2187            Tcl_SetErrno(EINVAL);
2188            if (interp) {
2189                Tcl_AppendResult(interp,
2190                                 "unable to access channel: invalid channel",
2191                                 (char *) NULL);  
2192            }
2193            return 1;
2194        }
2195        return 0;
2196    }
2197    
2198    /*
2199     *----------------------------------------------------------------------
2200     *
2201     * FlushChannel --
2202     *
2203     *      This function flushes as much of the queued output as is possible
2204     *      now. If calledFromAsyncFlush is nonzero, it is being called in an
2205     *      event handler to flush channel output asynchronously.
2206     *
2207     * Results:
2208     *      0 if successful, else the error code that was returned by the
2209     *      channel type operation.
2210     *
2211     * Side effects:
2212     *      May produce output on a channel. May block indefinitely if the
2213     *      channel is synchronous. May schedule an async flush on the channel.
2214     *      May recycle memory for buffers in the output queue.
2215     *
2216     *----------------------------------------------------------------------
2217     */
2218    
2219    static int
2220    FlushChannel(interp, chanPtr, calledFromAsyncFlush)
2221        Tcl_Interp *interp;                 /* For error reporting during close. */
2222        Channel *chanPtr;                   /* The channel to flush on. */
2223        int calledFromAsyncFlush;           /* If nonzero then we are being
2224                                             * called from an asynchronous
2225                                             * flush callback. */
2226    {
2227        ChannelBuffer *bufPtr;              /* Iterates over buffered output
2228                                             * queue. */
2229        int toWrite;                        /* Amount of output data in current
2230                                             * buffer available to be written. */
2231        int written;                        /* Amount of output data actually
2232                                             * written in current round. */
2233        int errorCode = 0;                  /* Stores POSIX error codes from
2234                                             * channel driver operations. */
2235        int wroteSome = 0;                  /* Set to one if any data was
2236                                             * written to the driver. */
2237    
2238        /*
2239         * Prevent writing on a dead channel -- a channel that has been closed
2240         * but not yet deallocated. This can occur if the exit handler for the
2241         * channel deallocation runs before all channels are deregistered in
2242         * all interpreters.
2243         */
2244        
2245        if (CheckForDeadChannel(interp,chanPtr)) return -1;
2246        
2247        /*
2248         * Loop over the queued buffers and attempt to flush as
2249         * much as possible of the queued output to the channel.
2250         */
2251    
2252        while (1) {
2253    
2254            /*
2255             * If the queue is empty and there is a ready current buffer, OR if
2256             * the current buffer is full, then move the current buffer to the
2257             * queue.
2258             */
2259            
2260            if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2261                    (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufLength))
2262                    || ((chanPtr->flags & BUFFER_READY) &&
2263                            (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
2264                chanPtr->flags &= (~(BUFFER_READY));
2265                chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
2266                if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2267                    chanPtr->outQueueHead = chanPtr->curOutPtr;
2268                } else {
2269                    chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
2270                }
2271                chanPtr->outQueueTail = chanPtr->curOutPtr;
2272                chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2273            }
2274            bufPtr = chanPtr->outQueueHead;
2275    
2276            /*
2277             * If we are not being called from an async flush and an async
2278             * flush is active, we just return without producing any output.
2279             */
2280    
2281            if ((!calledFromAsyncFlush) &&
2282                    (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2283                return 0;
2284            }
2285    
2286            /*
2287             * If the output queue is still empty, break out of the while loop.
2288             */
2289    
2290            if (bufPtr == (ChannelBuffer *) NULL) {
2291                break;      /* Out of the "while (1)". */
2292            }
2293    
2294            /*
2295             * Produce the output on the channel.
2296             */
2297            
2298            toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
2299            written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
2300                    (char *) bufPtr->buf + bufPtr->nextRemoved, toWrite,
2301                    &errorCode);
2302                
2303            /*
2304             * If the write failed completely attempt to start the asynchronous
2305             * flush mechanism and break out of this loop - do not attempt to
2306             * write any more output at this time.
2307             */
2308    
2309            if (written < 0) {
2310                
2311                /*
2312                 * If the last attempt to write was interrupted, simply retry.
2313                 */
2314                
2315                if (errorCode == EINTR) {
2316                    errorCode = 0;
2317                    continue;
2318                }
2319    
2320                /*
2321                 * If the channel is non-blocking and we would have blocked,
2322                 * start a background flushing handler and break out of the loop.
2323                 */
2324    
2325                if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
2326                    /*
2327                     * This used to check for CHANNEL_NONBLOCKING, and panic
2328                     * if the channel was blocking.  However, it appears
2329                     * that setting stdin to -blocking 0 has some effect on
2330                     * the stdout when it's a tty channel (dup'ed underneath)
2331                     */
2332                    if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2333                        chanPtr->flags |= BG_FLUSH_SCHEDULED;
2334                        UpdateInterest(chanPtr);
2335                    }
2336                    errorCode = 0;
2337                    break;
2338                }
2339    
2340                /*
2341                 * Decide whether to report the error upwards or defer it.
2342                 */
2343    
2344                if (calledFromAsyncFlush) {
2345                    if (chanPtr->unreportedError == 0) {
2346                        chanPtr->unreportedError = errorCode;
2347                    }
2348                } else {
2349                    Tcl_SetErrno(errorCode);
2350                    if (interp != NULL) {
2351                        Tcl_SetResult(interp,
2352                                Tcl_PosixError(interp), TCL_VOLATILE);
2353                    }
2354                }
2355    
2356                /*
2357                 * When we get an error we throw away all the output
2358                 * currently queued.
2359                 */
2360    
2361                DiscardOutputQueued(chanPtr);
2362                continue;
2363            } else {
2364                wroteSome = 1;
2365            }
2366    
2367            bufPtr->nextRemoved += written;
2368    
2369            /*
2370             * If this buffer is now empty, recycle it.
2371             */
2372    
2373            if (bufPtr->nextRemoved == bufPtr->nextAdded) {
2374                chanPtr->outQueueHead = bufPtr->nextPtr;
2375                if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2376                    chanPtr->outQueueTail = (ChannelBuffer *) NULL;
2377                }
2378                RecycleBuffer(chanPtr, bufPtr, 0);
2379            }
2380        }   /* Closes "while (1)". */
2381    
2382        /*
2383         * If we wrote some data while flushing in the background, we are done.
2384         * We can't finish the background flush until we run out of data and
2385         * the channel becomes writable again.  This ensures that all of the
2386         * pending data has been flushed at the system level.
2387         */
2388    
2389        if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
2390            if (wroteSome) {
2391                return errorCode;
2392            } else if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2393                chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
2394                (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
2395                        chanPtr->interestMask);
2396            }
2397        }
2398    
2399        /*
2400         * If the channel is flagged as closed, delete it when the refCount
2401         * drops to zero, the output queue is empty and there is no output
2402         * in the current output buffer.
2403         */
2404    
2405        if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
2406                (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
2407                ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
2408                        (chanPtr->curOutPtr->nextAdded ==
2409                                chanPtr->curOutPtr->nextRemoved))) {
2410            return CloseChannel(interp, chanPtr, errorCode);
2411        }
2412        return errorCode;
2413    }
2414    
2415    /*
2416     *----------------------------------------------------------------------
2417     *
2418     * CloseChannel --
2419     *
2420     *      Utility procedure to close a channel and free its associated
2421     *      resources.
2422     *
2423     * Results:
2424     *      0 on success or a POSIX error code if the operation failed.
2425     *
2426     * Side effects:
2427     *      May close the actual channel; may free memory.
2428     *
2429     *----------------------------------------------------------------------
2430     */
2431    
2432    static int
2433    CloseChannel(interp, chanPtr, errorCode)
2434        Tcl_Interp *interp;                 /* For error reporting. */
2435        Channel *chanPtr;                   /* The channel to close. */
2436        int errorCode;                      /* Status of operation so far. */
2437    {
2438        int result = 0;                     /* Of calling driver close
2439                                             * operation. */
2440        Channel *prevChanPtr;               /* Preceding channel in list of
2441                                             * all channels - used to splice a
2442                                             * channel out of the list on close. */
2443        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2444    
2445        if (chanPtr == NULL) {
2446            return result;
2447        }
2448        
2449        /*
2450         * No more input can be consumed so discard any leftover input.
2451         */
2452    
2453        DiscardInputQueued(chanPtr, 1);
2454    
2455        /*
2456         * Discard a leftover buffer in the current output buffer field.
2457         */
2458    
2459        if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
2460            ckfree((char *) chanPtr->curOutPtr);
2461            chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2462        }
2463        
2464        /*
2465         * The caller guarantees that there are no more buffers
2466         * queued for output.
2467         */
2468    
2469        if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
2470            panic("TclFlush, closed channel: queued output left");
2471        }
2472    
2473        /*
2474         * If the EOF character is set in the channel, append that to the
2475         * output device.
2476         */
2477    
2478        if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
2479            int dummy;
2480            char c;
2481    
2482            c = (char) chanPtr->outEofChar;
2483            (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
2484        }
2485    
2486        /*
2487         * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
2488         * that close callbacks can not do input or output (assuming they
2489         * squirreled the channel away in their clientData). This also
2490         * prevents infinite loops if the callback calls any C API that
2491         * could call FlushChannel.
2492         */
2493    
2494        chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
2495            
2496        /*
2497         * Splice this channel out of the list of all channels.
2498         */
2499    
2500        if (chanPtr == tsdPtr->firstChanPtr) {
2501            tsdPtr->firstChanPtr = chanPtr->nextChanPtr;
2502        } else {
2503            for (prevChanPtr = tsdPtr->firstChanPtr;
2504                     (prevChanPtr != (Channel *) NULL) &&
2505                         (prevChanPtr->nextChanPtr != chanPtr);
2506                     prevChanPtr = prevChanPtr->nextChanPtr) {
2507                /* Empty loop body. */
2508            }
2509            if (prevChanPtr == (Channel *) NULL) {
2510                panic("FlushChannel: damaged channel list");
2511            }
2512            prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
2513        }
2514    
2515        /*
2516         * Close and free the channel driver state.
2517         */
2518                
2519        if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
2520            result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
2521        } else {
2522            result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2523                    0);
2524        }
2525        
2526        if (chanPtr->channelName != (char *) NULL) {
2527            ckfree(chanPtr->channelName);
2528        }
2529        Tcl_FreeEncoding(chanPtr->encoding);
2530        if (chanPtr->outputStage != NULL) {
2531            ckfree((char *) chanPtr->outputStage);
2532        }
2533        
2534        /*
2535         * If we are being called synchronously, report either
2536         * any latent error on the channel or the current error.
2537         */
2538            
2539        if (chanPtr->unreportedError != 0) {
2540            errorCode = chanPtr->unreportedError;
2541        }
2542        if (errorCode == 0) {
2543            errorCode = result;
2544            if (errorCode != 0) {
2545                Tcl_SetErrno(errorCode);
2546            }
2547        }
2548    
2549        /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
2550         * "Trf-Patch for filtering channels"
2551         *
2552         * This is the change to 'CloseChannel'.
2553         *
2554         * Explanation
2555         *          Closing a filtering channel closes the one it
2556         *          superceded too. This basically ripples through
2557         *          the whole chain of filters until it reaches
2558         *          the underlying normal channel.
2559         *
2560         *          This is done by reintegrating the superceded
2561         *          channel into the (thread) global list of open
2562         *          channels and then invoking a regular close.
2563         *          There is no need to handle the complexities of
2564         *          this process by ourselves.
2565         *
2566         *          *Note*
2567         *          This has to be done after the call to the
2568         *          'closeProc' of the filtering channel to allow
2569         *          that one to flush internal buffers into
2570         *          the underlying channel.
2571         */
2572    
2573        if (chanPtr->supercedes != (Channel*) NULL) {
2574            /*
2575             * Insert the channel we were stacked upon back into
2576             * the list of open channels, then do a regular close.
2577             */
2578    
2579            chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
2580            tsdPtr->firstChanPtr             = chanPtr->supercedes;
2581            chanPtr->supercedes->refCount --; /* is deregistered */
2582            Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);
2583        }
2584    
2585        /*
2586         * Cancel any outstanding timer.
2587         */
2588    
2589        Tcl_DeleteTimerHandler(chanPtr->timer);
2590    
2591        /*
2592         * Mark the channel as deleted by clearing the type structure.
2593         */
2594    
2595        chanPtr->typePtr = NULL;
2596    
2597        Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
2598    
2599        return errorCode;
2600    }
2601    
2602    /*
2603     *----------------------------------------------------------------------
2604     *
2605     * Tcl_Close --
2606     *
2607     *      Closes a channel.
2608     *
2609     * Results:
2610     *      A standard Tcl result.
2611     *
2612     * Side effects:
2613     *      Closes the channel if this is the last reference.
2614     *
2615     * NOTE:
2616     *      Tcl_Close removes the channel as far as the user is concerned.
2617     *      However, it may continue to exist for a while longer if it has
2618     *      a background flush scheduled. The device itself is eventually
2619     *      closed and the channel record removed, in CloseChannel, above.
2620     *
2621     *----------------------------------------------------------------------
2622     */
2623    
2624            /* ARGSUSED */
2625    int
2626    Tcl_Close(interp, chan)
2627        Tcl_Interp *interp;                 /* Interpreter for errors. */
2628        Tcl_Channel chan;                   /* The channel being closed. Must
2629                                             * not be referenced in any
2630                                             * interpreter. */
2631    {
2632        ChannelHandler *chPtr, *chNext;     /* Iterate over channel handlers. */
2633        CloseCallback *cbPtr;               /* Iterate over close callbacks
2634                                             * for this channel. */
2635        EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
2636        Channel *chanPtr;                   /* The real IO channel. */
2637        int result;                         /* Of calling FlushChannel. */
2638        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2639        NextChannelHandler *nhPtr;
2640    
2641        if (chan == (Tcl_Channel) NULL) {
2642            return TCL_OK;
2643        }
2644        
2645        /*
2646         * Perform special handling for standard channels being closed. If the
2647         * refCount is now 1 it means that the last reference to the standard
2648         * channel is being explicitly closed, so bump the refCount down
2649         * artificially to 0. This will ensure that the channel is actually
2650         * closed, below. Also set the static pointer to NULL for the channel.
2651         */
2652    
2653        CheckForStdChannelsBeingClosed(chan);
2654    
2655        chanPtr = (Channel *) chan;
2656        if (chanPtr->refCount > 0) {
2657            panic("called Tcl_Close on channel with refCount > 0");
2658        }
2659    
2660        /*
2661         * Remove any references to channel handlers for this channel that
2662         * may be about to be invoked.
2663         */
2664    
2665        for (nhPtr = tsdPtr->nestedHandlerPtr;
2666                 nhPtr != (NextChannelHandler *) NULL;
2667                 nhPtr = nhPtr->nestedHandlerPtr) {
2668            if (nhPtr->nextHandlerPtr &&
2669                    (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
2670                nhPtr->nextHandlerPtr = NULL;
2671            }
2672        }
2673    
2674        /*
2675         * Remove all the channel handler records attached to the channel
2676         * itself.
2677         */
2678            
2679        for (chPtr = chanPtr->chPtr;
2680                 chPtr != (ChannelHandler *) NULL;
2681                 chPtr = chNext) {
2682            chNext = chPtr->nextPtr;
2683            ckfree((char *) chPtr);
2684        }
2685        chanPtr->chPtr = (ChannelHandler *) NULL;
2686        
2687        
2688        /*
2689         * Cancel any pending copy operation.
2690         */
2691    
2692        StopCopy(chanPtr->csPtr);
2693    
2694        /*
2695         * Must set the interest mask now to 0, otherwise infinite loops
2696         * will occur if Tcl_DoOneEvent is called before the channel is
2697         * finally deleted in FlushChannel. This can happen if the channel
2698         * has a background flush active.
2699         */
2700            
2701        chanPtr->interestMask = 0;
2702        
2703        /*
2704         * Remove any EventScript records for this channel.
2705         */
2706    
2707        for (ePtr = chanPtr->scriptRecordPtr;
2708                 ePtr != (EventScriptRecord *) NULL;
2709                 ePtr = eNextPtr) {
2710            eNextPtr = ePtr->nextPtr;
2711            Tcl_DecrRefCount(ePtr->scriptPtr);
2712            ckfree((char *) ePtr);
2713        }
2714        chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
2715            
2716        /*
2717         * Invoke the registered close callbacks and delete their records.
2718         */
2719    
2720        while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
2721            cbPtr = chanPtr->closeCbPtr;
2722            chanPtr->closeCbPtr = cbPtr->nextPtr;
2723            (cbPtr->proc) (cbPtr->clientData);
2724            ckfree((char *) cbPtr);
2725        }
2726    
2727        /*
2728         * Ensure that the last output buffer will be flushed.
2729         */
2730        
2731        if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2732               (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
2733            chanPtr->flags |= BUFFER_READY;
2734        }
2735    
2736        /*
2737         * If this channel supports it, close the read side, since we don't need it
2738         * anymore and this will help avoid deadlocks on some channel types.
2739         */
2740    
2741        if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
2742            result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2743                    TCL_CLOSE_READ);
2744        } else {
2745            result = 0;
2746        }
2747    
2748        /*
2749         * The call to FlushChannel will flush any queued output and invoke
2750         * the close function of the channel driver, or it will set up the
2751         * channel to be flushed and closed asynchronously.
2752         */
2753    
2754        chanPtr->flags |= CHANNEL_CLOSED;
2755        if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
2756            return TCL_ERROR;
2757        }
2758        return TCL_OK;
2759    }
2760    
2761    /*
2762     *----------------------------------------------------------------------
2763     *
2764     * Tcl_Write --
2765     *
2766     *      Puts a sequence of bytes into an output buffer, may queue the
2767     *      buffer for output if it gets full, and also remembers whether the
2768     *      current buffer is ready e.g. if it contains a newline and we are in
2769     *      line buffering mode.
2770     *
2771     * Results:
2772     *      The number of bytes written or -1 in case of error. If -1,
2773     *      Tcl_GetErrno will return the error code.
2774     *
2775     * Side effects:
2776     *      May buffer up output and may cause output to be produced on the
2777     *      channel.
2778     *
2779     *----------------------------------------------------------------------
2780     */
2781    
2782    int
2783    Tcl_Write(chan, src, srcLen)
2784        Tcl_Channel chan;                   /* The channel to buffer output for. */
2785        char *src;                          /* Data to queue in output buffer. */
2786        int srcLen;                         /* Length of data in bytes, or < 0 for
2787                                             * strlen(). */
2788    {
2789        Channel *chanPtr;
2790    
2791        chanPtr = (Channel *) chan;
2792        if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2793            return -1;
2794        }
2795        if (srcLen < 0) {
2796            srcLen = strlen(src);
2797        }
2798        return DoWrite(chanPtr, src, srcLen);
2799    }
2800    
2801    /*
2802     *---------------------------------------------------------------------------
2803     *
2804     * Tcl_WriteChars --
2805     *
2806     *      Takes a sequence of UTF-8 characters and converts them for output
2807     *      using the channel's current encoding, may queue the buffer for
2808     *      output if it gets full, and also remembers whether the current
2809     *      buffer is ready e.g. if it contains a newline and we are in
2810     *      line buffering mode.
2811     *
2812     * Results:
2813     *      The number of bytes written or -1 in case of error. If -1,
2814     *      Tcl_GetErrno will return the error code.
2815     *
2816     * Side effects:
2817     *      May buffer up output and may cause output to be produced on the
2818     *      channel.
2819     *
2820     *----------------------------------------------------------------------
2821     */
2822    
2823    int
2824    Tcl_WriteChars(chan, src, len)
2825        Tcl_Channel chan;           /* The channel to buffer output for. */
2826        CONST char *src;            /* UTF-8 characters to queue in output buffer. */
2827        int len;                    /* Length of string in bytes, or < 0 for
2828                                     * strlen(). */
2829    {
2830        Channel *chanPtr;
2831    
2832        chanPtr = (Channel *) chan;
2833        if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2834            return -1;
2835        }
2836        if (len < 0) {
2837            len = strlen(src);
2838        }
2839        if (chanPtr->encoding == NULL) {
2840            /*
2841             * Inefficient way to convert UTF-8 to byte-array, but the  
2842             * code parallels the way it is done for objects.
2843             */
2844    
2845            Tcl_Obj *objPtr;
2846            int result;
2847    
2848            objPtr = Tcl_NewStringObj(src, len);
2849            src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
2850            result = WriteBytes(chanPtr, src, len);
2851            Tcl_DecrRefCount(objPtr);
2852            return result;
2853        }
2854        return WriteChars(chanPtr, src, len);
2855    }
2856    
2857    /*
2858     *---------------------------------------------------------------------------
2859     *
2860     * Tcl_WriteObj --
2861     *
2862     *      Takes the Tcl object and queues its contents for output.  If the
2863     *      encoding of the channel is NULL, takes the byte-array representation
2864     *      of the object and queues those bytes for output.  Otherwise, takes
2865     *      the characters in the UTF-8 (string) representation of the object
2866     *      and converts them for output using the channel's current encoding.  
2867     *      May flush internal buffers to output if one becomes full or is ready
2868     *      for some other reason, e.g. if it contains a newline and the channel
2869     *      is in line buffering mode.
2870     *
2871     * Results:
2872     *      The number of bytes written or -1 in case of error. If -1,
2873     *      Tcl_GetErrno() will return the error code.
2874     *
2875     * Side effects:
2876     *      May buffer up output and may cause output to be produced on the
2877     *      channel.
2878     *
2879     *----------------------------------------------------------------------
2880     */
2881    
2882    int
2883    Tcl_WriteObj(chan, objPtr)
2884        Tcl_Channel chan;           /* The channel to buffer output for. */
2885        Tcl_Obj *objPtr;            /* The object to write. */
2886    {
2887        Channel *chanPtr;
2888        char *src;
2889        int srcLen;
2890    
2891        chanPtr = (Channel *) chan;
2892        if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2893            return -1;
2894        }
2895        if (chanPtr->encoding == NULL) {
2896            src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
2897            return WriteBytes(chanPtr, src, srcLen);
2898        } else {
2899            src = Tcl_GetStringFromObj(objPtr, &srcLen);
2900            return WriteChars(chanPtr, src, srcLen);
2901        }
2902    }
2903    
2904    /*
2905     *----------------------------------------------------------------------
2906     *
2907     * WriteBytes --
2908     *
2909     *      Write a sequence of bytes into an output buffer, may queue the
2910     *      buffer for output if it gets full, and also remembers whether the
2911     *      current buffer is ready e.g. if it contains a newline and we are in
2912     *      line buffering mode.
2913     *
2914     * Results:
2915     *      The number of bytes written or -1 in case of error. If -1,
2916     *      Tcl_GetErrno will return the error code.
2917     *
2918     * Side effects:
2919     *      May buffer up output and may cause output to be produced on the
2920     *      channel.
2921     *
2922     *----------------------------------------------------------------------
2923     */
2924    
2925    static int
2926    WriteBytes(chanPtr, src, srcLen)
2927        Channel *chanPtr;           /* The channel to buffer output for. */
2928        CONST char *src;            /* Bytes to write. */
2929        int srcLen;                 /* Number of bytes to write. */
2930    {
2931        ChannelBuffer *bufPtr;
2932        char *dst;
2933        int dstLen, dstMax, sawLF, savedLF, total, toWrite;
2934        
2935        total = 0;
2936        sawLF = 0;
2937        savedLF = 0;
2938    
2939        /*
2940         * Loop over all bytes in src, storing them in output buffer with
2941         * proper EOL translation.
2942         */
2943    
2944        while (srcLen + savedLF > 0) {
2945            bufPtr = chanPtr->curOutPtr;
2946            if (bufPtr == NULL) {
2947                bufPtr = AllocChannelBuffer(chanPtr->bufSize);
2948                chanPtr->curOutPtr  = bufPtr;
2949            }
2950            dst = bufPtr->buf + bufPtr->nextAdded;
2951            dstMax = bufPtr->bufLength - bufPtr->nextAdded;
2952            dstLen = dstMax;
2953    
2954            toWrite = dstLen;
2955            if (toWrite > srcLen) {
2956                toWrite = srcLen;
2957            }
2958    
2959            if (savedLF) {
2960                /*
2961                 * A '\n' was left over from last call to TranslateOutputEOL()
2962                 * and we need to store it in this buffer.  If the channel is
2963                 * line-based, we will need to flush it.
2964                 */
2965    
2966                *dst++ = '\n';
2967                dstLen--;
2968                sawLF++;
2969            }
2970            sawLF += TranslateOutputEOL(chanPtr, dst, src, &dstLen, &toWrite);
2971            dstLen += savedLF;
2972            savedLF = 0;
2973    
2974            if (dstLen > dstMax) {
2975                savedLF = 1;
2976                dstLen = dstMax;
2977            }
2978            bufPtr->nextAdded += dstLen;
2979            if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
2980                return -1;
2981            }
2982            total += dstLen;
2983            src += toWrite;
2984            srcLen -= toWrite;
2985            sawLF = 0;
2986        }
2987        return total;
2988    }
2989    
2990    /*
2991     *----------------------------------------------------------------------
2992     *
2993     * WriteChars --
2994     *
2995     *      Convert UTF-8 bytes to the channel's external encoding and
2996     *      write the produced bytes into an output buffer, may queue the
2997     *      buffer for output if it gets full, and also remembers whether the
2998     *      current buffer is ready e.g. if it contains a newline and we are in
2999     *      line buffering mode.
3000     *
3001     * Results:
3002     *      The number of bytes written or -1 in case of error. If -1,
3003     *      Tcl_GetErrno will return the error code.
3004     *
3005     * Side effects:
3006     *      May buffer up output and may cause output to be produced on the
3007     *      channel.
3008     *
3009     *----------------------------------------------------------------------
3010     */
3011    
3012    static int
3013    WriteChars(chanPtr, src, srcLen)
3014        Channel *chanPtr;           /* The channel to buffer output for. */
3015        CONST char *src;            /* UTF-8 string to write. */
3016        int srcLen;                 /* Length of UTF-8 string in bytes. */
3017    {
3018        ChannelBuffer *bufPtr;
3019        char *dst, *stage;
3020        int saved, savedLF, sawLF, total, toWrite, flags;
3021        int dstWrote, dstLen, stageLen, stageMax, stageRead;
3022        Tcl_Encoding encoding;
3023        char safe[BUFFER_PADDING];
3024        
3025        total = 0;
3026        sawLF = 0;
3027        savedLF = 0;
3028        saved = 0;
3029        encoding = chanPtr->encoding;
3030    
3031        /*
3032         * Loop over all UTF-8 characters in src, storing them in staging buffer
3033         * with proper EOL translation.
3034         */
3035    
3036        while (srcLen + savedLF > 0) {
3037            stage = chanPtr->outputStage;
3038            stageMax = chanPtr->bufSize;
3039            stageLen = stageMax;
3040    
3041            toWrite = stageLen;
3042            if (toWrite > srcLen) {
3043                toWrite = srcLen;
3044            }
3045    
3046            if (savedLF) {
3047                /*
3048                 * A '\n' was left over from last call to TranslateOutputEOL()
3049                 * and we need to store it in the staging buffer.  If the
3050                 * channel is line-based, we will need to flush the output
3051                 * buffer (after translating the staging buffer).
3052                 */
3053                
3054                *stage++ = '\n';
3055                stageLen--;
3056                sawLF++;
3057            }
3058            sawLF += TranslateOutputEOL(chanPtr, stage, src, &stageLen, &toWrite);
3059    
3060            stage -= savedLF;
3061            stageLen += savedLF;
3062            savedLF = 0;
3063    
3064            if (stageLen > stageMax) {
3065                savedLF = 1;
3066                stageLen = stageMax;
3067            }
3068            src += toWrite;
3069            srcLen -= toWrite;
3070    
3071            flags = chanPtr->outputEncodingFlags;
3072            if (srcLen == 0) {
3073                flags |= TCL_ENCODING_END;
3074            }
3075    
3076            /*
3077             * Loop over all UTF-8 characters in staging buffer, converting them
3078             * to external encoding, storing them in output buffer.
3079             */
3080    
3081            while (stageLen + saved > 0) {
3082                bufPtr = chanPtr->curOutPtr;
3083                if (bufPtr == NULL) {
3084                    bufPtr = AllocChannelBuffer(chanPtr->bufSize);
3085                    chanPtr->curOutPtr = bufPtr;
3086                }
3087                dst = bufPtr->buf + bufPtr->nextAdded;
3088                dstLen = bufPtr->bufLength - bufPtr->nextAdded;
3089    
3090                if (saved != 0) {
3091                    /*
3092                     * Here's some translated bytes left over from the last
3093                     * buffer that we need to stick at the beginning of this
3094                     * buffer.
3095                     */
3096                    
3097                    memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);
3098                    bufPtr->nextAdded += saved;
3099                    dst += saved;
3100                    dstLen -= saved;
3101                    saved = 0;
3102                }
3103    
3104                Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,
3105                        &chanPtr->outputEncodingState, dst,
3106                        dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
3107                if (stageRead + dstWrote == 0) {
3108                    /*
3109                     * We have an incomplete UTF-8 character at the end of the
3110                     * staging buffer.  It will get moved to the beginning of the
3111                     * staging buffer followed by more bytes from src.
3112                     */
3113    
3114                    src -= stageLen;
3115                    srcLen += stageLen;
3116                    stageLen = 0;
3117                    savedLF = 0;
3118                    break;
3119                }
3120                bufPtr->nextAdded += dstWrote;
3121                if (bufPtr->nextAdded > bufPtr->bufLength) {
3122                    /*
3123                     * When translating from UTF-8 to external encoding, we
3124                     * allowed the translation to produce a character that
3125                     * crossed the end of the output buffer, so that we would
3126                     * get a completely full buffer before flushing it.  The
3127                     * extra bytes will be moved to the beginning of the next
3128                     * buffer.
3129                     */
3130    
3131                    saved = bufPtr->nextAdded - bufPtr->bufLength;
3132                    memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
3133                    bufPtr->nextAdded = bufPtr->bufLength;
3134                }
3135                if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
3136                    return -1;
3137                }
3138    
3139                total += dstWrote;
3140                stage += stageRead;
3141                stageLen -= stageRead;
3142                sawLF = 0;
3143            }
3144        }
3145        return total;
3146    }
3147    
3148    /*
3149     *---------------------------------------------------------------------------
3150     *
3151     * TranslateOutputEOL --
3152     *
3153     *      Helper function for WriteBytes() and WriteChars().  Converts the
3154     *      '\n' characters in the source buffer into the appropriate EOL
3155     *      form specified by the output translation mode.
3156     *
3157     *      EOL translation stops either when the source buffer is empty
3158     *      or the output buffer is full.
3159     *
3160     *      When converting to CRLF mode and there is only 1 byte left in
3161     *      the output buffer, this routine stores the '\r' in the last
3162     *      byte and then stores the '\n' in the byte just past the end of the
3163     *      buffer.  The caller is responsible for passing in a buffer that
3164     *      is large enough to hold the extra byte.
3165     *
3166     * Results:
3167     *      The return value is 1 if a '\n' was translated from the source
3168     *      buffer, or 0 otherwise -- this can be used by the caller to
3169     *      decide to flush a line-based channel even though the channel
3170     *      buffer is not full.
3171     *
3172     *      *dstLenPtr is filled with how many bytes of the output buffer
3173     *      were used.  As mentioned above, this can be one more that
3174     *      the output buffer's specified length if a CRLF was stored.
3175     *
3176     *      *srcLenPtr is filled with how many bytes of the source buffer
3177     *      were consumed.  
3178     *
3179     * Side effects:
3180     *      It may be obvious, but bears mentioning that when converting
3181     *      in CRLF mode (which requires two bytes of storage in the output
3182     *      buffer), the number of bytes consumed from the source buffer
3183     *      will be less than the number of bytes stored in the output buffer.
3184     *
3185     *---------------------------------------------------------------------------
3186     */
3187    
3188    static int
3189    TranslateOutputEOL(chanPtr, dst, src, dstLenPtr, srcLenPtr)
3190        Channel *chanPtr;           /* Channel being read, for translation and
3191                                     * buffering modes. */
3192        char *dst;                  /* Output buffer filled with UTF-8 chars by
3193                                     * applying appropriate EOL translation to
3194                                     * source characters. */
3195        CONST char *src;            /* Source UTF-8 characters. */
3196        int *dstLenPtr;             /* On entry, the maximum length of output
3197                                     * buffer in bytes.  On exit, the number of
3198                                     * bytes actually used in output buffer. */
3199        int *srcLenPtr;             /* On entry, the length of source buffer.
3200                                     * On exit, the number of bytes read from
3201                                     * the source buffer. */
3202    {
3203        char *dstEnd;
3204        int srcLen, newlineFound;
3205        
3206        newlineFound = 0;
3207        srcLen = *srcLenPtr;
3208    
3209        switch (chanPtr->outputTranslation) {
3210            case TCL_TRANSLATE_LF: {
3211                for (dstEnd = dst + srcLen; dst < dstEnd; ) {
3212                    if (*src == '\n') {
3213                        newlineFound = 1;
3214                    }
3215                    *dst++ = *src++;
3216                }
3217                *dstLenPtr = srcLen;
3218                break;
3219            }
3220            case TCL_TRANSLATE_CR: {
3221                for (dstEnd = dst + srcLen; dst < dstEnd;) {
3222                    if (*src == '\n') {
3223                        *dst++ = '\r';
3224                        newlineFound = 1;
3225                        src++;
3226                    } else {
3227                        *dst++ = *src++;
3228                    }
3229                }
3230                *dstLenPtr = srcLen;
3231                break;
3232            }
3233            case TCL_TRANSLATE_CRLF: {
3234                /*
3235                 * Since this causes the number of bytes to grow, we
3236                 * start off trying to put 'srcLen' bytes into the
3237                 * output buffer, but allow it to store more bytes, as
3238                 * long as there's still source bytes and room in the
3239                 * output buffer.
3240                 */
3241    
3242                char *dstStart, *dstMax;
3243                CONST char *srcStart;
3244                
3245                dstStart = dst;
3246                dstMax = dst + *dstLenPtr;
3247    
3248                srcStart = src;
3249                
3250                if (srcLen < *dstLenPtr) {
3251                    dstEnd = dst + srcLen;
3252                } else {
3253                    dstEnd = dst + *dstLenPtr;
3254                }
3255                while (dst < dstEnd) {
3256                    if (*src == '\n') {
3257                        if (dstEnd < dstMax) {
3258                            dstEnd++;
3259                        }
3260                        *dst++ = '\r';
3261                        newlineFound = 1;
3262                    }
3263                    *dst++ = *src++;
3264                }
3265                *srcLenPtr = src - srcStart;
3266                *dstLenPtr = dst - dstStart;
3267                break;
3268            }
3269            default: {
3270                break;
3271            }
3272        }
3273        return newlineFound;
3274    }
3275    
3276    /*
3277     *---------------------------------------------------------------------------
3278     *
3279     * CheckFlush --
3280     *
3281     *      Helper function for WriteBytes() and WriteChars().  If the
3282     *      channel buffer is ready to be flushed, flush it.
3283     *
3284     * Results:
3285     *      The return value is -1 if there was a problem flushing the
3286     *      channel buffer, or 0 otherwise.
3287     *
3288     * Side effects:
3289     *      The buffer will be recycled if it is flushed.
3290     *
3291     *---------------------------------------------------------------------------
3292     */
3293    
3294    static int
3295    CheckFlush(chanPtr, bufPtr, newlineFlag)
3296        Channel *chanPtr;           /* Channel being read, for buffering mode. */
3297        ChannelBuffer *bufPtr;      /* Channel buffer to possibly flush. */
3298        int newlineFlag;            /* Non-zero if a the channel buffer
3299                                     * contains a newline. */
3300    {
3301        /*
3302         * The current buffer is ready for output:
3303         * 1. if it is full.
3304         * 2. if it contains a newline and this channel is line-buffered.
3305         * 3. if it contains any output and this channel is unbuffered.
3306         */
3307    
3308        if ((chanPtr->flags & BUFFER_READY) == 0) {
3309            if (bufPtr->nextAdded == bufPtr->bufLength) {
3310                chanPtr->flags |= BUFFER_READY;
3311            } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
3312                if (newlineFlag != 0) {
3313                    chanPtr->flags |= BUFFER_READY;
3314                }
3315            } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
3316                chanPtr->flags |= BUFFER_READY;
3317            }
3318        }
3319        if (chanPtr->flags & BUFFER_READY) {
3320            if (FlushChannel(NULL, chanPtr, 0) != 0) {
3321                return -1;
3322            }
3323        }
3324        return 0;
3325    }
3326    
3327    /*
3328     *---------------------------------------------------------------------------
3329     *
3330     * Tcl_Gets --
3331     *
3332     *      Reads a complete line of input from the channel into a Tcl_DString.
3333     *
3334     * Results:
3335     *      Length of line read (in characters) or -1 if error, EOF, or blocked.
3336     *      If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the
3337     *      error or condition that occurred.
3338     *
3339     * Side effects:
3340     *      May flush output on the channel.  May cause input to be consumed
3341     *      from the channel.
3342     *
3343     *---------------------------------------------------------------------------
3344     */
3345    
3346    int
3347    Tcl_Gets(chan, lineRead)
3348        Tcl_Channel chan;           /* Channel from which to read. */
3349        Tcl_DString *lineRead;      /* The line read will be appended to this
3350                                     * DString as UTF-8 characters.  The caller
3351                                     * must have initialized it and is responsible
3352                                     * for managing the storage. */
3353    {
3354        Tcl_Obj *objPtr;
3355        int charsStored, length;
3356        char *string;
3357    
3358        objPtr = Tcl_NewObj();
3359        charsStored = Tcl_GetsObj(chan, objPtr);
3360        if (charsStored > 0) {
3361            string = Tcl_GetStringFromObj(objPtr, &length);
3362            Tcl_DStringAppend(lineRead, string, length);
3363        }
3364        Tcl_DecrRefCount(objPtr);
3365        return charsStored;
3366    }
3367    
3368    /*
3369     *---------------------------------------------------------------------------
3370     *
3371     * Tcl_GetsObj --
3372     *
3373     *      Accumulate input from the input channel until end-of-line or
3374     *      end-of-file has been seen.  Bytes read from the input channel
3375     *      are converted to UTF-8 using the encoding specified by the
3376     *      channel.
3377     *
3378     * Results:
3379     *      Number of characters accumulated in the object or -1 if error,
3380     *      blocked, or EOF.  If -1, use Tcl_GetErrno() to retrieve the
3381     *      POSIX error code for the error or condition that occurred.
3382     *
3383     * Side effects:
3384     *      Consumes input from the channel.
3385     *
3386     *      On reading EOF, leave channel pointing at EOF char.
3387     *      On reading EOL, leave channel pointing after EOL, but don't
3388     *      return EOL in dst buffer.
3389     *
3390     *---------------------------------------------------------------------------
3391     */
3392    
3393    int
3394    Tcl_GetsObj(chan, objPtr)
3395        Tcl_Channel chan;           /* Channel from which to read. */
3396        Tcl_Obj *objPtr;            /* The line read will be appended to this
3397                                     * object as UTF-8 characters. */
3398    {
3399        GetsState gs;
3400        Channel *chanPtr;
3401        int inEofChar, skip, copiedTotal;
3402        ChannelBuffer *bufPtr;
3403        Tcl_Encoding encoding;
3404        char *dst, *dstEnd, *eol, *eof;
3405        Tcl_EncodingState oldState;
3406        int oldLength, oldFlags, oldRemoved;
3407    
3408        chanPtr = (Channel *) chan;
3409        if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
3410            copiedTotal = -1;
3411            goto done;
3412        }
3413    
3414        bufPtr = chanPtr->inQueueHead;
3415        encoding = chanPtr->encoding;
3416    
3417        /*
3418         * Preserved so we can restore the channel's state in case we don't
3419         * find a newline in the available input.
3420         */
3421    
3422        Tcl_GetStringFromObj(objPtr, &oldLength);
3423        oldFlags = chanPtr->inputEncodingFlags;
3424        oldState = chanPtr->inputEncodingState;
3425        oldRemoved = BUFFER_PADDING;
3426        if (bufPtr != NULL) {
3427            oldRemoved = bufPtr->nextRemoved;
3428        }
3429    
3430        /*
3431         * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
3432         * produce ByteArray objects.  To avoid circularity problems,
3433         * "iso8859-1" is builtin to Tcl.
3434         */
3435    
3436        if (encoding == NULL) {
3437            encoding = Tcl_GetEncoding(NULL, "iso8859-1");
3438        }
3439    
3440        /*
3441         * Object used by FilterInputBytes to keep track of how much data has
3442         * been consumed from the channel buffers.
3443         */
3444    
3445        gs.objPtr           = objPtr;
3446        gs.dstPtr           = &dst;
3447        gs.encoding         = encoding;
3448        gs.bufPtr           = bufPtr;
3449        gs.state            = oldState;
3450        gs.rawRead          = 0;
3451        gs.bytesWrote       = 0;
3452        gs.charsWrote       = 0;
3453        gs.totalChars       = 0;
3454    
3455        dst = objPtr->bytes + oldLength;
3456        dstEnd = dst;
3457    
3458        skip = 0;
3459        eof = NULL;
3460        inEofChar = chanPtr->inEofChar;
3461    
3462        while (1) {
3463            if (dst >= dstEnd) {
3464                if (FilterInputBytes(chanPtr, &gs) != 0) {
3465                    goto restore;
3466                }
3467                dstEnd = dst + gs.bytesWrote;
3468            }
3469            
3470            /*
3471             * Remember if EOF char is seen, then look for EOL anyhow, because
3472             * the EOL might be before the EOF char.
3473             */
3474    
3475            if (inEofChar != '\0') {
3476                for (eol = dst; eol < dstEnd; eol++) {
3477                    if (*eol == inEofChar) {
3478                        dstEnd = eol;
3479                        eof = eol;
3480                        break;
3481                    }
3482                }
3483            }
3484    
3485            /*
3486             * On EOL, leave current file position pointing after the EOL, but
3487             * don't store the EOL in the output string.
3488             */
3489    
3490            eol = dst;
3491            switch (chanPtr->inputTranslation) {
3492                case TCL_TRANSLATE_LF: {
3493                    for (eol = dst; eol < dstEnd; eol++) {
3494                        if (*eol == '\n') {
3495                            skip = 1;
3496                            goto goteol;
3497                        }
3498                    }
3499                    break;
3500                }
3501                case TCL_TRANSLATE_CR: {
3502                    for (eol = dst; eol < dstEnd; eol++) {
3503                        if (*eol == '\r') {
3504                            skip = 1;
3505                            goto goteol;
3506                        }
3507                    }
3508                    break;
3509                }
3510                case TCL_TRANSLATE_CRLF: {
3511                    for (eol = dst; eol < dstEnd; eol++) {
3512                        if (*eol == '\r') {
3513                            eol++;
3514                            if (eol >= dstEnd) {
3515                                int offset;
3516                                
3517                                offset = eol - objPtr->bytes;
3518                                dst = dstEnd;
3519                                if (FilterInputBytes(chanPtr, &gs) != 0) {
3520                                    goto restore;
3521                                }
3522                                dstEnd = dst + gs.bytesWrote;
3523                                eol = objPtr->bytes + offset;
3524                                if (eol >= dstEnd) {
3525                                    skip = 0;
3526                                    goto goteol;
3527                                }
3528                            }
3529                            if (*eol == '\n') {
3530                                eol--;
3531                                skip = 2;
3532                                goto goteol;
3533                            }
3534                        }
3535                    }
3536                    break;
3537                }
3538                case TCL_TRANSLATE_AUTO: {
3539                    skip = 1;
3540                    if (chanPtr->flags & INPUT_SAW_CR) {
3541                        chanPtr->flags &= ~INPUT_SAW_CR;
3542                        if (*eol == '\n') {
3543                            /*
3544                             * Skip the raw bytes that make up the '\n'.
3545                             */
3546    
3547                            char tmp[1 + TCL_UTF_MAX];
3548                            int rawRead;
3549    
3550                            bufPtr = gs.bufPtr;
3551                            Tcl_ExternalToUtf(NULL, gs.encoding,
3552                                    bufPtr->buf + bufPtr->nextRemoved,
3553                                    gs.rawRead, chanPtr->inputEncodingFlags,
3554                                    &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
3555                                    NULL, NULL);
3556                            bufPtr->nextRemoved += rawRead;
3557                            gs.rawRead -= rawRead;
3558                            gs.bytesWrote--;
3559                            gs.charsWrote--;
3560                            memmove(dst, dst + 1, (size_t) (dstEnd - dst));
3561                            dstEnd--;
3562                        }
3563                    }
3564                    for (eol = dst; eol < dstEnd; eol++) {
3565                        if (*eol == '\r') {
3566                            eol++;
3567                            if (eol == dstEnd) {
3568                                /*
3569                                 * If buffer ended on \r, peek ahead to see if a
3570                                 * \n is available.
3571                                 */
3572    
3573                                int offset;
3574                                
3575                                offset = eol - objPtr->bytes;
3576                                dst = dstEnd;
3577                                PeekAhead(chanPtr, &dstEnd, &gs);
3578                                eol = objPtr->bytes + offset;
3579                                if (eol >= dstEnd) {
3580                                    eol--;
3581                                    chanPtr->flags |= INPUT_SAW_CR;
3582                                    goto goteol;
3583                                }
3584                            }
3585                            if (*eol == '\n') {
3586                                skip++;
3587                            }
3588                            eol--;
3589                            goto goteol;
3590                        } else if (*eol == '\n') {
3591                            goto goteol;
3592                        }
3593                    }
3594                }
3595            }
3596            if (eof != NULL) {
3597                /*
3598                 * EOF character was seen.  On EOF, leave current file position
3599                 * pointing at the EOF character, but don't store the EOF
3600                 * character in the output string.
3601                 */
3602    
3603                dstEnd = eof;
3604                chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
3605                chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
3606            }
3607            if (chanPtr->flags & CHANNEL_EOF) {
3608                skip = 0;
3609                eol = dstEnd;
3610                if (eol == objPtr->bytes) {
3611                    /*
3612                     * If we didn't produce any bytes before encountering EOF,
3613                     * caller needs to see -1.
3614                     */
3615    
3616                    Tcl_SetObjLength(objPtr, 0);
3617                    CommonGetsCleanup(chanPtr, encoding);
3618                    copiedTotal = -1;
3619                    goto done;
3620                }
3621                goto goteol;
3622            }
3623            dst = dstEnd;
3624        }
3625    
3626        /*
3627         * Found EOL or EOF, but the output buffer may now contain too many
3628         * UTF-8 characters.  We need to know how many raw bytes correspond to
3629         * the number of UTF-8 characters we want, plus how many raw bytes
3630         * correspond to the character(s) making up EOL (if any), so we can
3631         * remove the correct number of bytes from the channel buffer.
3632         */
3633        
3634        goteol:
3635        bufPtr = gs.bufPtr;
3636        chanPtr->inputEncodingState = gs.state;
3637        Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
3638                gs.rawRead, chanPtr->inputEncodingFlags,
3639                &chanPtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,
3640                &gs.rawRead, NULL, &gs.charsWrote);
3641        bufPtr->nextRemoved += gs.rawRead;
3642    
3643        /*
3644         * Recycle all the emptied buffers.
3645         */
3646    
3647        Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
3648        CommonGetsCleanup(chanPtr, encoding);
3649        chanPtr->flags &= ~CHANNEL_BLOCKED;
3650        copiedTotal = gs.totalChars + gs.charsWrote - skip;
3651        goto done;
3652    
3653        /*
3654         * Couldn't get a complete line.  This only happens if we get a error
3655         * reading from the channel or we are non-blocking and there wasn't
3656         * an EOL or EOF in the data available.
3657         */
3658    
3659        restore:
3660        bufPtr = chanPtr->inQueueHead;
3661        bufPtr->nextRemoved = oldRemoved;
3662    
3663        for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
3664            bufPtr->nextRemoved = BUFFER_PADDING;
3665        }
3666        CommonGetsCleanup(chanPtr, encoding);
3667    
3668        chanPtr->inputEncodingState = oldState;
3669        chanPtr->inputEncodingFlags = oldFlags;
3670        Tcl_SetObjLength(objPtr, oldLength);
3671    
3672        /*
3673         * We didn't get a complete line so we need to indicate to UpdateInterest
3674         * that the gets blocked.  It will wait for more data instead of firing
3675         * a timer, avoiding a busy wait.  This is where we are assuming that the
3676         * next operation is a gets.  No more file events will be delivered on
3677         * this channel until new data arrives or some operation is performed
3678         * on the channel (e.g. gets, read, fconfigure) that changes the blocking
3679         * state.  Note that this means a file event will not be delivered even
3680         * though a read would be able to consume the buffered data.
3681         */
3682    
3683        chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
3684        copiedTotal = -1;
3685    
3686        done:
3687        /*
3688         * Update the notifier state so we don't block while there is still
3689         * data in the buffers.
3690         */
3691    
3692        UpdateInterest(chanPtr);
3693        return copiedTotal;
3694    }
3695    
3696    /*
3697     *---------------------------------------------------------------------------
3698     *
3699     * FilterInputBytes --
3700     *
3701     *      Helper function for Tcl_GetsObj.  Produces UTF-8 characters from
3702     *      raw bytes read from the channel.  
3703     *
3704     *      Consumes available bytes from channel buffers.  When channel
3705     *      buffers are exhausted, reads more bytes from channel device into
3706     *      a new channel buffer.  It is the caller's responsibility to
3707     *      free the channel buffers that have been exhausted.
3708     *
3709     * Results:
3710     *      The return value is -1 if there was an error reading from the
3711     *      channel, 0 otherwise.
3712     *
3713     * Side effects:
3714     *      Status object keeps track of how much data from channel buffers
3715     *      has been consumed and where UTF-8 bytes should be stored.
3716     *
3717     *---------------------------------------------------------------------------
3718     */
3719    
3720    static int
3721    FilterInputBytes(chanPtr, gsPtr)
3722        Channel *chanPtr;           /* Channel to read. */
3723        GetsState *gsPtr;           /* Current state of gets operation. */
3724    {
3725        ChannelBuffer *bufPtr;
3726        char *raw, *rawStart, *rawEnd;
3727        char *dst;
3728        int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
3729        Tcl_Obj *objPtr;
3730    #define ENCODING_LINESIZE   30  /* Lower bound on how many bytes to convert
3731                                     * at a time.  Since we don't know a priori
3732                                     * how many bytes of storage this many source
3733                                     * bytes will use, we actually need at least
3734                                     * ENCODING_LINESIZE * TCL_MAX_UTF bytes of
3735                                     * room. */
3736    
3737        objPtr = gsPtr->objPtr;
3738    
3739        /*
3740         * Subtract the number of bytes that were removed from channel buffer
3741         * during last call.
3742         */
3743    
3744        bufPtr = gsPtr->bufPtr;
3745        if (bufPtr != NULL) {
3746            bufPtr->nextRemoved += gsPtr->rawRead;
3747            if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
3748                bufPtr = bufPtr->nextPtr;
3749            }
3750        }
3751        gsPtr->totalChars += gsPtr->charsWrote;
3752    
3753        if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
3754            /*
3755             * All channel buffers were exhausted and the caller still hasn't
3756             * seen EOL.  Need to read more bytes from the channel device.
3757             * Side effect is to allocate another channel buffer.
3758             */
3759            
3760            read:
3761            if (chanPtr->flags & CHANNEL_BLOCKED) {
3762                if (chanPtr->flags & CHANNEL_NONBLOCKING) {
3763                    gsPtr->charsWrote = 0;
3764                    gsPtr->rawRead = 0;
3765                    return -1;
3766                }
3767                chanPtr->flags &= ~CHANNEL_BLOCKED;
3768            }
3769            if (GetInput(chanPtr) != 0) {
3770                gsPtr->charsWrote = 0;
3771                gsPtr->rawRead = 0;
3772                return -1;
3773            }
3774            bufPtr = chanPtr->inQueueTail;
3775            gsPtr->bufPtr = bufPtr;
3776        }
3777    
3778        /*
3779         * Convert some of the bytes from the channel buffer to UTF-8.  Space in
3780         * objPtr's string rep is used to hold the UTF-8 characters.  Grow the
3781         * string rep if we need more space.
3782         */
3783    
3784        rawStart = bufPtr->buf + bufPtr->nextRemoved;
3785        raw = rawStart;
3786        rawEnd = bufPtr->buf + bufPtr->nextAdded;
3787        rawLen = rawEnd - rawStart;
3788    
3789        dst = *gsPtr->dstPtr;
3790        offset = dst - objPtr->bytes;
3791        toRead = ENCODING_LINESIZE;
3792        if (toRead > rawLen) {
3793            toRead = rawLen;
3794        }
3795        dstNeeded = toRead * TCL_UTF_MAX + 1;
3796        spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
3797        if (dstNeeded > spaceLeft) {
3798            length = offset * 2;
3799            if (offset < dstNeeded) {
3800                length = offset + dstNeeded;
3801            }
3802            length += TCL_UTF_MAX + 1;
3803            Tcl_SetObjLength(objPtr, length);
3804            spaceLeft = length - offset;
3805            dst = objPtr->bytes + offset;
3806            *gsPtr->dstPtr = dst;
3807        }
3808        gsPtr->state = chanPtr->inputEncodingState;
3809        result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
3810                chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
3811                dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
3812                &gsPtr->charsWrote);
3813        if (result == TCL_CONVERT_MULTIBYTE) {
3814            /*
3815             * The last few bytes in this channel buffer were the start of a
3816             * multibyte sequence.  If this buffer was full, then move them to
3817             * the next buffer so the bytes will be contiguous.  
3818             */
3819    
3820            ChannelBuffer *nextPtr;
3821            int extra;
3822            
3823            nextPtr = bufPtr->nextPtr;
3824            if (bufPtr->nextAdded < bufPtr->bufLength) {
3825                if (gsPtr->rawRead > 0) {
3826                    /*
3827                     * Some raw bytes were converted to UTF-8.  Fall through,
3828                     * returning those UTF-8 characters because a EOL might be
3829                     * present in them.
3830                     */
3831                } else if (chanPtr->flags & CHANNEL_EOF) {
3832                    /*
3833                     * There was a partial character followed by EOF on the
3834                     * device.  Fall through, returning that nothing was found.
3835                     */
3836    
3837                     bufPtr->nextRemoved = bufPtr->nextAdded;
3838                } else {
3839                    /*
3840                     * There are no more cached raw bytes left.  See if we can
3841                     * get some more.
3842                     */
3843    
3844                    goto read;
3845                }
3846            } else {
3847                if (nextPtr == NULL) {
3848                    nextPtr = AllocChannelBuffer(chanPtr->bufSize);
3849                    bufPtr->nextPtr = nextPtr;
3850                    chanPtr->inQueueTail = nextPtr;
3851                }
3852                extra = rawLen - gsPtr->rawRead;
3853                memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
3854                        (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
3855                nextPtr->nextRemoved -= extra;
3856                bufPtr->nextAdded -= extra;
3857            }
3858        }
3859    
3860        gsPtr->bufPtr = bufPtr;
3861        return 0;
3862    }
3863    
3864    /*
3865     *---------------------------------------------------------------------------
3866     *
3867     * PeekAhead --
3868     *
3869     *      Helper function used by Tcl_GetsObj().  Called when we've seen a
3870     *      \r at the end of the UTF-8 string and want to look ahead one
3871     *      character to see if it is a \n.
3872     *
3873     * Results:
3874     *      *gsPtr->dstPtr is filled with a pointer to the start of the range of
3875     *      UTF-8 characters that were found by peeking and *dstEndPtr is filled
3876     *      with a pointer to the bytes just after the end of the range.
3877     *
3878     * Side effects:
3879     *      If no more raw bytes were available in one of the channel buffers,
3880     *      tries to perform a non-blocking read to get more bytes from the
3881     *      channel device.
3882     *
3883     *---------------------------------------------------------------------------
3884     */
3885    
3886    static void
3887    PeekAhead(chanPtr, dstEndPtr, gsPtr)
3888        Channel *chanPtr;           /* The channel to read. */
3889        char **dstEndPtr;           /* Filled with pointer to end of new range
3890                                     * of UTF-8 characters. */
3891        GetsState *gsPtr;           /* Current state of gets operation. */
3892    {
3893        ChannelBuffer *bufPtr;
3894        Tcl_DriverBlockModeProc *blockModeProc;
3895        int bytesLeft;
3896    
3897        bufPtr = gsPtr->bufPtr;
3898    
3899        /*
3900         * If there's any more raw input that's still buffered, we'll peek into
3901         * that.  Otherwise, only get more data from the channel driver if it
3902         * looks like there might actually be more data.  The assumption is that
3903         * if the channel buffer is filled right up to the end, then there
3904         * might be more data to read.
3905         */
3906    
3907        blockModeProc = NULL;
3908        if (bufPtr->nextPtr == NULL) {
3909            bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
3910            if (bytesLeft == 0) {
3911                if (bufPtr->nextAdded < bufPtr->bufLength) {
3912                    /*
3913                     * Don't peek ahead if last read was short read.
3914                     */
3915                    
3916                    goto cleanup;
3917                }
3918                if ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) {
3919                    blockModeProc = chanPtr->typePtr->blockModeProc;
3920                    if (blockModeProc == NULL) {
3921                        /*
3922                         * Don't peek ahead if cannot set non-blocking mode.
3923                         */
3924    
3925                        goto cleanup;
3926                    }
3927                    (*blockModeProc)(chanPtr->instanceData, TCL_MODE_NONBLOCKING);
3928                }
3929            }
3930        }
3931        if (FilterInputBytes(chanPtr, gsPtr) == 0) {
3932            *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;
3933        }
3934        if (blockModeProc != NULL) {
3935            (*blockModeProc)(chanPtr->instanceData, TCL_MODE_BLOCKING);
3936        }
3937        return;
3938    
3939        cleanup:
3940        bufPtr->nextRemoved += gsPtr->rawRead;
3941        gsPtr->rawRead = 0;
3942        gsPtr->totalChars += gsPtr->charsWrote;
3943        gsPtr->bytesWrote = 0;
3944        gsPtr->charsWrote = 0;
3945    }
3946    
3947    /*
3948     *---------------------------------------------------------------------------
3949     *
3950     * CommonGetsCleanup --
3951     *
3952     *      Helper function for Tcl_GetsObj() to restore the channel after
3953     *      a "gets" operation.
3954     *
3955     * Results:
3956     *      None.
3957     *
3958     * Side effects:
3959     *      Encoding may be freed.
3960     *
3961     *---------------------------------------------------------------------------
3962     */
3963    
3964    static void
3965    CommonGetsCleanup(chanPtr, encoding)
3966        Channel *chanPtr;
3967        Tcl_Encoding encoding;
3968    {
3969        ChannelBuffer *bufPtr, *nextPtr;
3970        
3971        bufPtr = chanPtr->inQueueHead;
3972        for ( ; bufPtr != NULL; bufPtr = nextPtr) {
3973            nextPtr = bufPtr->nextPtr;
3974            if (bufPtr->nextRemoved < bufPtr->nextAdded) {
3975                break;
3976            }
3977            RecycleBuffer(chanPtr, bufPtr, 0);
3978        }
3979        chanPtr->inQueueHead = bufPtr;
3980        if (bufPtr == NULL) {
3981            chanPtr->inQueueTail = NULL;
3982        } else {
3983            /*
3984             * If any multi-byte characters were split across channel buffer
3985             * boundaries, the split-up bytes were moved to the next channel
3986             * buffer by FilterInputBytes().  Move the bytes back to their
3987             * original buffer because the caller could change the channel's
3988             * encoding which could change the interpretation of whether those
3989             * bytes really made up multi-byte characters after all.
3990             */
3991            
3992            nextPtr = bufPtr->nextPtr;
3993            for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
3994                int extra;
3995    
3996                extra = bufPtr->bufLength - bufPtr->nextAdded;
3997                if (extra > 0) {
3998                    memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
3999                            (VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
4000                            (size_t) extra);
4001                    bufPtr->nextAdded += extra;
4002                    nextPtr->nextRemoved = BUFFER_PADDING;
4003                }
4004                bufPtr = nextPtr;
4005            }
4006        }
4007        if (chanPtr->encoding == NULL) {
4008            Tcl_FreeEncoding(encoding);
4009        }
4010    }
4011    
4012    /*
4013     *----------------------------------------------------------------------
4014     *
4015     * Tcl_Read --
4016     *
4017     *      Reads a given number of bytes from a channel.  EOL and EOF
4018     *      translation is done on the bytes being read, so the the number
4019     *      of bytes consumed from the channel may not be equal to the
4020     *      number of bytes stored in the destination buffer.
4021     *
4022     *      No encoding conversions are applied to the bytes being read.
4023     *
4024     * Results:
4025     *      The number of bytes read, or -1 on error. Use Tcl_GetErrno()
4026     *      to retrieve the error code for the error that occurred.
4027     *
4028     * Side effects:
4029     *      May cause input to be buffered.
4030     *
4031     *----------------------------------------------------------------------
4032     */
4033    
4034    int
4035    Tcl_Read(chan, dst, bytesToRead)
4036        Tcl_Channel chan;           /* The channel from which to read. */
4037        char *dst;                  /* Where to store input read. */
4038        int bytesToRead;            /* Maximum number of bytes to read. */
4039    {
4040        Channel *chanPtr;          
4041        
4042        chanPtr = (Channel *) chan;
4043        if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4044            return -1;
4045        }
4046    
4047        return DoRead(chanPtr, dst, bytesToRead);
4048    }
4049    
4050    /*
4051     *---------------------------------------------------------------------------
4052     *
4053     * Tcl_ReadChars --
4054     *
4055     *      Reads from the channel until the requested number of characters
4056     *      have been seen, EOF is seen, or the channel would block.  EOL
4057     *      and EOF translation is done.  If reading binary data, the raw
4058     *      bytes are wrapped in a Tcl byte array object.  Otherwise, the raw
4059     *      bytes are converted to UTF-8 using the channel's current encoding
4060     *      and stored in a Tcl string object.
4061     *
4062     * Results:
4063     *      The number of characters read, or -1 on error. Use Tcl_GetErrno()
4064     *      to retrieve the error code for the error that occurred.
4065     *
4066     * Side effects:
4067     *      May cause input to be buffered.
4068     *
4069     *---------------------------------------------------------------------------
4070     */
4071    
4072    int
4073    Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
4074        Tcl_Channel chan;           /* The channel to read. */
4075        Tcl_Obj *objPtr;            /* Input data is stored in this object. */
4076        int toRead;                 /* Maximum number of characters to store,
4077                                     * or -1 to read all available data (up to EOF
4078                                     * or when channel blocks). */
4079        int appendFlag;             /* If non-zero, data read from the channel
4080                                     * will be appended to the object.  Otherwise,
4081                                     * the data will replace the existing contents
4082                                     * of the object. */
4083    
4084    {
4085        Channel *chanPtr;
4086        int offset, factor, copied, copiedNow, result;
4087        ChannelBuffer *bufPtr;
4088        Tcl_Encoding encoding;
4089    #define UTF_EXPANSION_FACTOR    1024
4090        
4091        chanPtr = (Channel *) chan;
4092        if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4093            copied = -1;
4094            goto done;
4095        }
4096    
4097        encoding = chanPtr->encoding;
4098        factor = UTF_EXPANSION_FACTOR;
4099    
4100        if (appendFlag == 0) {
4101            if (encoding == NULL) {
4102                Tcl_SetByteArrayLength(objPtr, 0);
4103            } else {
4104                Tcl_SetObjLength(objPtr, 0);
4105            }
4106            offset = 0;
4107        } else {
4108            if (encoding == NULL) {
4109                Tcl_GetByteArrayFromObj(objPtr, &offset);
4110            } else {
4111                Tcl_GetStringFromObj(objPtr, &offset);
4112            }
4113        }
4114    
4115        for (copied = 0; (unsigned) toRead > 0; ) {
4116            copiedNow = -1;
4117            if (chanPtr->inQueueHead != NULL) {
4118                if (encoding == NULL) {
4119                    copiedNow = ReadBytes(chanPtr, objPtr, toRead, &offset);
4120                } else {
4121                    copiedNow = ReadChars(chanPtr, objPtr, toRead, &offset,
4122                            &factor);
4123                }
4124    
4125                /*
4126                 * If the current buffer is empty recycle it.
4127                 */
4128    
4129                bufPtr = chanPtr->inQueueHead;
4130                if (bufPtr->nextRemoved == bufPtr->nextAdded) {
4131                    ChannelBuffer *nextPtr;
4132    
4133                    nextPtr = bufPtr->nextPtr;
4134                    RecycleBuffer(chanPtr, bufPtr, 0);
4135                    chanPtr->inQueueHead = nextPtr;
4136                    if (nextPtr == NULL) {
4137                        chanPtr->inQueueTail = nextPtr;
4138                    }
4139                }
4140            }
4141            if (copiedNow < 0) {
4142                if (chanPtr->flags & CHANNEL_EOF) {
4143                    break;
4144                }
4145                if (chanPtr->flags & CHANNEL_BLOCKED) {
4146                    if (chanPtr->flags & CHANNEL_NONBLOCKING) {
4147                        break;
4148                    }
4149                    chanPtr->flags &= ~CHANNEL_BLOCKED;
4150                }
4151                result = GetInput(chanPtr);
4152                if (result != 0) {
4153                    if (result == EAGAIN) {
4154                        break;
4155                    }
4156                    copied = -1;
4157                    goto done;
4158                }
4159            } else {
4160                copied += copiedNow;
4161                toRead -= copiedNow;
4162            }
4163        }
4164        chanPtr->flags &= ~CHANNEL_BLOCKED;
4165        if (encoding == NULL) {
4166            Tcl_SetByteArrayLength(objPtr, offset);
4167        } else {
4168            Tcl_SetObjLength(objPtr, offset);
4169        }
4170    
4171        done:
4172        /*
4173         * Update the notifier state so we don't block while there is still
4174         * data in the buffers.
4175         */
4176    
4177        UpdateInterest(chanPtr);
4178        return copied;
4179    }
4180    /*
4181     *---------------------------------------------------------------------------
4182     *
4183     * ReadBytes --
4184     *
4185     *      Reads from the channel until the requested number of bytes have
4186     *      been seen, EOF is seen, or the channel would block.  Bytes from
4187     *      the channel are stored in objPtr as a ByteArray object.  EOL
4188     *      and EOF translation are done.
4189     *
4190     *      'bytesToRead' can safely be a very large number because
4191     *      space is only allocated to hold data read from the channel
4192     *      as needed.
4193     *
4194     * Results:
4195     *      The return value is the number of bytes appended to the object
4196     *      and *offsetPtr is filled with the total number of bytes in the
4197     *      object (greater than the return value if there were already bytes
4198     *      in the object).
4199     *
4200     * Side effects:
4201     *      None.
4202     *
4203     *---------------------------------------------------------------------------
4204     */
4205    
4206    static int
4207    ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)
4208        Channel *chanPtr;           /* The channel to read. */
4209        int bytesToRead;            /* Maximum number of characters to store,
4210                                     * or < 0 to get all available characters.
4211                                     * Characters are obtained from the first
4212                                     * buffer in the queue -- even if this number
4213                                     * is larger than the number of characters
4214                                     * available in the first buffer, only the
4215                                     * characters from the first buffer are
4216                                     * returned. */
4217        Tcl_Obj *objPtr;            /* Input data is appended to this ByteArray
4218                                     * object.  Its length is how much space
4219                                     * has been allocated to hold data, not how
4220                                     * many bytes of data have been stored in the
4221                                     * object. */
4222        int *offsetPtr;             /* On input, contains how many bytes of
4223                                     * objPtr have been used to hold data.  On
4224                                     * output, filled with how many bytes are now
4225                                     * being used. */
4226    {
4227        int toRead, srcLen, srcRead, dstWrote, offset, length;
4228        ChannelBuffer *bufPtr;
4229        char *src, *dst;
4230    
4231        offset = *offsetPtr;
4232    
4233        bufPtr = chanPtr->inQueueHead;
4234        src = bufPtr->buf + bufPtr->nextRemoved;
4235        srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
4236    
4237        toRead = bytesToRead;
4238        if ((unsigned) toRead > (unsigned) srcLen) {
4239            toRead = srcLen;
4240        }
4241    
4242        dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
4243        if (toRead > length - offset - 1) {
4244            /*
4245             * Double the existing size of the object or make enough room to
4246             * hold all the characters we may get from the source buffer,
4247             * whichever is larger.
4248             */
4249    
4250            length = offset * 2;
4251            if (offset < toRead) {
4252                length = offset + toRead + 1;
4253            }
4254            dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
4255        }
4256        dst += offset;
4257    
4258        if (chanPtr->flags & INPUT_NEED_NL) {
4259            chanPtr->flags &= ~INPUT_NEED_NL;
4260            if ((srcLen == 0) || (*src != '\n')) {
4261                *dst = '\r';
4262                *offsetPtr += 1;
4263                return 1;
4264            }
4265            *dst++ = '\n';
4266            src++;
4267            srcLen--;
4268            toRead--;
4269        }
4270    
4271        srcRead = srcLen;
4272        dstWrote = toRead;
4273        if (TranslateInputEOL(chanPtr, dst, src, &dstWrote, &srcRead) != 0) {
4274            if (dstWrote == 0) {
4275                return -1;
4276            }
4277        }
4278        bufPtr->nextRemoved += srcRead;
4279        *offsetPtr += dstWrote;
4280        return dstWrote;
4281    }
4282    
4283    /*
4284     *---------------------------------------------------------------------------
4285     *
4286     * ReadChars --
4287     *
4288     *      Reads from the channel until the requested number of UTF-8
4289     *      characters have been seen, EOF is seen, or the channel would
4290     *      block.  Raw bytes from the channel are converted to UTF-8
4291     *      and stored in objPtr.  EOL and EOF translation is done.
4292     *
4293     *      'charsToRead' can safely be a very large number because
4294     *      space is only allocated to hold data read from the channel
4295     *      as needed.
4296     *
4297     * Results:
4298     *      The return value is the number of characters appended to
4299     *      the object, *offsetPtr is filled with the number of bytes that
4300     *      were appended, and *factorPtr is filled with the expansion
4301     *      factor used to guess how many bytes of UTF-8 to allocate to
4302     *      hold N source bytes.
4303     *
4304     * Side effects:
4305     *      None.
4306     *
4307     *---------------------------------------------------------------------------
4308     */
4309    
4310    static int
4311    ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
4312        Channel *chanPtr;           /* The channel to read. */
4313        int charsToRead;            /* Maximum number of characters to store,
4314                                     * or -1 to get all available characters.
4315                                     * Characters are obtained from the first
4316                                     * buffer in the queue -- even if this number
4317                                     * is larger than the number of characters
4318                                     * available in the first buffer, only the
4319                                     * characters from the first buffer are
4320                                     * returned. */
4321        Tcl_Obj *objPtr;            /* Input data is appended to this object.
4322                                     * objPtr->length is how much space has been
4323                                     * allocated to hold data, not how many bytes
4324                                     * of data have been stored in the object. */
4325        int *offsetPtr;             /* On input, contains how many bytes of
4326                                     * objPtr have been used to hold data.  On
4327                                     * output, filled with how many bytes are now
4328                                     * being used. */
4329        int *factorPtr;             /* On input, contains a guess of how many
4330                                     * bytes need to be allocated to hold the
4331                                     * result of converting N source bytes to
4332                                     * UTF-8.  On output, contains another guess
4333                                     * based on the data seen so far. */
4334    {
4335        int toRead, factor, offset, spaceLeft, length;
4336        int srcLen, srcRead, dstNeeded, dstRead, dstWrote, numChars;
4337        ChannelBuffer *bufPtr;
4338        char *src, *dst;
4339        Tcl_EncodingState oldState;
4340    
4341        factor = *factorPtr;
4342        offset = *offsetPtr;
4343    
4344        bufPtr = chanPtr->inQueueHead;
4345        src = bufPtr->buf + bufPtr->nextRemoved;
4346        srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
4347    
4348        toRead = charsToRead;
4349        if ((unsigned) toRead > (unsigned) srcLen) {
4350            toRead = srcLen;
4351        }
4352    
4353        /*
4354         * 'factor' is how much we guess that the bytes in the source buffer
4355         * will expand when converted to UTF-8 chars.  This guess comes from
4356         * analyzing how many characters were produced by the previous
4357         * pass.
4358         */
4359    
4360        dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
4361        spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
4362    
4363        if (dstNeeded > spaceLeft) {
4364            /*
4365             * Double the existing size of the object or make enough room to
4366             * hold all the characters we want from the source buffer,
4367             * whichever is larger.
4368             */
4369    
4370            length = offset * 2;
4371            if (offset < dstNeeded) {
4372                length = offset + dstNeeded;
4373            }
4374            spaceLeft = length - offset;
4375            length += TCL_UTF_MAX + 1;
4376            Tcl_SetObjLength(objPtr, length);
4377        }
4378        if (toRead == srcLen) {
4379            /*
4380             * Want to convert the whole buffer in one pass.  If we have
4381             * enough space, convert it using all available space in object
4382             * rather than using the factor.
4383             */
4384    
4385            dstNeeded = spaceLeft;
4386        }
4387        dst = objPtr->bytes + offset;
4388    
4389        oldState = chanPtr->inputEncodingState;
4390        if (chanPtr->flags & INPUT_NEED_NL) {
4391            /*
4392             * We want a '\n' because the last character we saw was '\r'.
4393             */
4394            
4395            chanPtr->flags &= ~INPUT_NEED_NL;
4396            Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4397                    chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4398                    dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
4399            if ((dstWrote > 0) && (*dst == '\n')) {
4400                /*
4401                 * The next char was a '\n'.  Consume it and produce a '\n'.
4402                 */
4403                
4404                bufPtr->nextRemoved += srcRead;
4405            } else {
4406                /*
4407                 * The next char was not a '\n'.  Produce a '\r'.
4408                 */
4409    
4410                *dst = '\r';
4411            }
4412            chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4413            *offsetPtr += 1;
4414            return 1;
4415        }
4416    
4417        Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4418                chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState, dst,
4419                dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4420        if (srcRead == 0) {
4421            /*
4422             * Not enough bytes in src buffer to make a complete char.  Copy
4423             * the bytes to the next buffer to make a new contiguous string,
4424             * then tell the caller to fill the buffer with more bytes.
4425             */
4426    
4427            ChannelBuffer *nextPtr;
4428            
4429            nextPtr = bufPtr->nextPtr;
4430            if (nextPtr == NULL) {
4431                /*
4432                 * There isn't enough data in the buffers to complete the next
4433                 * character, so we need to wait for more data before the next
4434                 * file event can be delivered.
4435                 */
4436    
4437                chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
4438                return -1;
4439            }
4440            nextPtr->nextRemoved -= srcLen;
4441            memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
4442                    (size_t) srcLen);
4443            RecycleBuffer(chanPtr, bufPtr, 0);
4444            chanPtr->inQueueHead = nextPtr;
4445            return ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr);
4446        }
4447    
4448        dstRead = dstWrote;
4449        if (TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead) != 0) {
4450            /*
4451             * Hit EOF char.  How many bytes of src correspond to where the
4452             * EOF was located in dst?
4453             */
4454            
4455            if (dstWrote == 0) {
4456                return -1;
4457            }
4458            chanPtr->inputEncodingState = oldState;
4459            Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4460                    chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4461                    dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4462            TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
4463        }
4464    
4465        /*
4466         * The number of characters that we got may be less than the number
4467         * that we started with because "\r\n" sequences may have been
4468         * turned into just '\n' in dst.
4469         */
4470    
4471        numChars -= (dstRead - dstWrote);
4472    
4473        if ((unsigned) numChars > (unsigned) toRead) {
4474            /*
4475             * Got too many chars.
4476             */
4477    
4478            char *eof;
4479    
4480            eof = Tcl_UtfAtIndex(dst, toRead);
4481            chanPtr->inputEncodingState = oldState;
4482            Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4483                    chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4484                    dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4485            dstRead = dstWrote;
4486            TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
4487            numChars -= (dstRead - dstWrote);
4488        }
4489        chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4490    
4491        bufPtr->nextRemoved += srcRead;
4492        if (dstWrote > srcRead + 1) {
4493            *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
4494        }
4495        *offsetPtr += dstWrote;
4496        return numChars;
4497    }
4498    
4499    /*
4500     *---------------------------------------------------------------------------
4501     *
4502     * TranslateInputEOL --
4503     *
4504     *      Perform input EOL and EOF translation on the source buffer,
4505     *      leaving the translated result in the destination buffer.  
4506     *
4507     * Results:
4508     *      The return value is 1 if the EOF character was found when copying
4509     *      bytes to the destination buffer, 0 otherwise.  
4510     *
4511     * Side effects:
4512     *      None.
4513     *
4514     *---------------------------------------------------------------------------
4515     */
4516    
4517    static int
4518    TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
4519        Channel *chanPtr;           /* Channel being read, for EOL translation
4520                                     * and EOF character. */
4521        char *dstStart;             /* Output buffer filled with chars by
4522                                     * applying appropriate EOL translation to
4523                                     * source characters. */
4524        CONST char *srcStart;       /* Source characters. */
4525        int *dstLenPtr;             /* On entry, the maximum length of output
4526                                     * buffer in bytes; must be <= *srcLenPtr.  On
4527                                     * exit, the number of bytes actually used in
4528                                     * output buffer. */
4529        int *srcLenPtr;             /* On entry, the length of source buffer.
4530                                     * On exit, the number of bytes read from
4531                                     * the source buffer. */
4532    {
4533        int dstLen, srcLen, inEofChar;
4534        CONST char *eof;
4535    
4536        dstLen = *dstLenPtr;
4537    
4538        eof = NULL;
4539        inEofChar = chanPtr->inEofChar;
4540        if (inEofChar != '\0') {
4541            /*
4542             * Find EOF in translated buffer then compress out the EOL.  The
4543             * source buffer may be much longer than the destination buffer --
4544             * we only want to return EOF if the EOF has been copied to the
4545             * destination buffer.
4546             */
4547    
4548            CONST char *src, *srcMax;
4549    
4550            srcMax = srcStart + *srcLenPtr;
4551            for (src = srcStart; src < srcMax; src++) {
4552                if (*src == inEofChar) {
4553                    eof = src;
4554                    srcLen = src - srcStart;
4555                    if (srcLen < dstLen) {
4556                        dstLen = srcLen;
4557                    }
4558                    *srcLenPtr = srcLen;
4559                    break;
4560                }
4561            }
4562        }
4563        switch (chanPtr->inputTranslation) {
4564            case TCL_TRANSLATE_LF: {
4565                if (dstStart != srcStart) {
4566                    memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
4567                }
4568                srcLen = dstLen;
4569                break;
4570            }
4571            case TCL_TRANSLATE_CR: {
4572                char *dst, *dstEnd;
4573                
4574                if (dstStart != srcStart) {
4575                    memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
4576                }
4577                dstEnd = dstStart + dstLen;
4578                for (dst = dstStart; dst < dstEnd; dst++) {
4579                    if (*dst == '\r') {
4580                        *dst = '\n';
4581                    }
4582                }
4583                srcLen = dstLen;
4584                break;
4585            }
4586            case TCL_TRANSLATE_CRLF: {
4587                char *dst;
4588                CONST char *src, *srcEnd, *srcMax;
4589                
4590                dst = dstStart;
4591                src = srcStart;
4592                srcEnd = srcStart + dstLen;
4593                srcMax = srcStart + *srcLenPtr;
4594    
4595                for ( ; src < srcEnd; ) {
4596                    if (*src == '\r') {
4597                        src++;
4598                        if (src >= srcMax) {
4599                            chanPtr->flags |= INPUT_NEED_NL;
4600                        } else if (*src == '\n') {
4601                            *dst++ = *src++;
4602                        } else {
4603                            *dst++ = '\r';
4604                        }
4605                    } else {
4606                        *dst++ = *src++;
4607                    }
4608                }
4609                srcLen = src - srcStart;
4610                dstLen = dst - dstStart;
4611                break;
4612            }
4613            case TCL_TRANSLATE_AUTO: {
4614                char *dst;
4615                CONST char *src, *srcEnd, *srcMax;
4616    
4617                dst = dstStart;
4618                src = srcStart;
4619                srcEnd = srcStart + dstLen;
4620                srcMax = srcStart + *srcLenPtr;
4621    
4622                if ((chanPtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
4623                    if (*src == '\n') {
4624                        src++;
4625                    }
4626                    chanPtr->flags &= ~INPUT_SAW_CR;
4627                }
4628                for ( ; src < srcEnd; ) {
4629                    if (*src == '\r') {
4630                        src++;
4631                        if (src >= srcMax) {
4632                            chanPtr->flags |= INPUT_SAW_CR;
4633                        } else if (*src == '\n') {
4634                            if (srcEnd < srcMax) {
4635                                srcEnd++;
4636                            }
4637                            src++;
4638                        }
4639                        *dst++ = '\n';
4640                    } else {
4641                        *dst++ = *src++;
4642                    }
4643                }
4644                srcLen = src - srcStart;
4645                dstLen = dst - dstStart;
4646                break;
4647            }
4648            default: {              /* lint. */
4649                return 0;
4650            }
4651        }
4652        *dstLenPtr = dstLen;
4653    
4654        if ((eof != NULL) && (srcStart + srcLen >= eof)) {
4655            /*
4656             * EOF character was seen in EOL translated range.  Leave current
4657             * file position pointing at the EOF character, but don't store the
4658             * EOF character in the output string.
4659             */
4660    
4661            chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
4662            chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
4663            chanPtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
4664            return 1;
4665        }
4666    
4667        *srcLenPtr = srcLen;
4668        return 0;
4669    }
4670    
4671    /*
4672     *----------------------------------------------------------------------
4673     *
4674     * Tcl_Ungets --
4675     *
4676     *      Causes the supplied string to be added to the input queue of
4677     *      the channel, at either the head or tail of the queue.
4678     *
4679     * Results:
4680     *      The number of bytes stored in the channel, or -1 on error.
4681     *
4682     * Side effects:
4683     *      Adds input to the input queue of a channel.
4684     *
4685     *----------------------------------------------------------------------
4686     */
4687    
4688    int
4689    Tcl_Ungets(chan, str, len, atEnd)
4690        Tcl_Channel chan;           /* The channel for which to add the input. */
4691        char *str;                  /* The input itself. */
4692        int len;                    /* The length of the input. */
4693        int atEnd;                  /* If non-zero, add at end of queue; otherwise
4694                                     * add at head of queue. */    
4695    {
4696        Channel *chanPtr;           /* The real IO channel. */
4697        ChannelBuffer *bufPtr;      /* Buffer to contain the data. */
4698        int i, flags;
4699    
4700        chanPtr = (Channel *) chan;
4701        
4702        /*
4703         * CheckChannelErrors clears too many flag bits in this one case.
4704         */
4705        
4706        flags = chanPtr->flags;
4707        if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4708            len = -1;
4709            goto done;
4710        }
4711        chanPtr->flags = flags;
4712    
4713        /*
4714         * If we have encountered a sticky EOF, just punt without storing.
4715         * (sticky EOF is set if we have seen the input eofChar, to prevent
4716         * reading beyond the eofChar). Otherwise, clear the EOF flags, and
4717         * clear the BLOCKED bit. We want to discover these conditions anew
4718         * in each operation.
4719         */
4720    
4721        if (chanPtr->flags & CHANNEL_STICKY_EOF) {
4722            goto done;
4723        }
4724        chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
4725    
4726        bufPtr = AllocChannelBuffer(len);
4727        for (i = 0; i < len; i++) {
4728            bufPtr->buf[i] = str[i];
4729        }
4730        bufPtr->nextAdded += len;
4731    
4732        if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
4733            bufPtr->nextPtr = (ChannelBuffer *) NULL;
4734            chanPtr->inQueueHead = bufPtr;
4735            chanPtr->inQueueTail = bufPtr;
4736        } else if (atEnd) {
4737            bufPtr->nextPtr = (ChannelBuffer *) NULL;
4738            chanPtr->inQueueTail->nextPtr = bufPtr;
4739            chanPtr->inQueueTail = bufPtr;
4740        } else {
4741            bufPtr->nextPtr = chanPtr->inQueueHead;
4742            chanPtr->inQueueHead = bufPtr;
4743        }
4744    
4745        done:
4746        /*
4747         * Update the notifier state so we don't block while there is still
4748         * data in the buffers.
4749         */
4750    
4751        UpdateInterest(chanPtr);
4752        return len;
4753    }
4754    
4755    /*
4756     *----------------------------------------------------------------------
4757     *
4758     * Tcl_Flush --
4759     *
4760     *      Flushes output data on a channel.
4761     *
4762     * Results:
4763     *      A standard Tcl result.
4764     *
4765     * Side effects:
4766     *      May flush output queued on this channel.
4767     *
4768     *----------------------------------------------------------------------
4769     */
4770    
4771    int
4772    Tcl_Flush(chan)
4773        Tcl_Channel chan;                   /* The Channel to flush. */
4774    {
4775        int result;                         /* Of calling FlushChannel. */
4776        Channel *chanPtr;                   /* The actual channel. */
4777    
4778        chanPtr = (Channel *) chan;
4779        if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
4780            return -1;
4781        }
4782    
4783        /*
4784         * Force current output buffer to be output also.
4785         */
4786        
4787        if ((chanPtr->curOutPtr != NULL)
4788                && (chanPtr->curOutPtr->nextAdded > 0)) {
4789            chanPtr->flags |= BUFFER_READY;
4790        }
4791        
4792        result = FlushChannel(NULL, chanPtr, 0);
4793        if (result != 0) {
4794            return TCL_ERROR;
4795        }
4796    
4797        return TCL_OK;
4798    }
4799    
4800    /*
4801     *----------------------------------------------------------------------
4802     *
4803     * DiscardInputQueued --
4804     *
4805     *      Discards any input read from the channel but not yet consumed
4806     *      by Tcl reading commands.
4807     *
4808     * Results:
4809     *      None.
4810     *
4811     * Side effects:
4812     *      May discard input from the channel. If discardLastBuffer is zero,
4813     *      leaves one buffer in place for back-filling.
4814     *
4815     *----------------------------------------------------------------------
4816     */
4817    
4818    static void
4819    DiscardInputQueued(chanPtr, discardSavedBuffers)
4820        Channel *chanPtr;           /* Channel on which to discard
4821                                     * the queued input. */
4822        int discardSavedBuffers;    /* If non-zero, discard all buffers including
4823                                     * last one. */
4824    {
4825        ChannelBuffer *bufPtr, *nxtPtr;     /* Loop variables. */
4826    
4827        bufPtr = chanPtr->inQueueHead;
4828        chanPtr->inQueueHead = (ChannelBuffer *) NULL;
4829        chanPtr->inQueueTail = (ChannelBuffer *) NULL;
4830        for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
4831            nxtPtr = bufPtr->nextPtr;
4832            RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
4833        }
4834    
4835        /*
4836         * If discardSavedBuffers is nonzero, must also discard any previously
4837         * saved buffer in the saveInBufPtr field.
4838         */
4839        
4840        if (discardSavedBuffers) {
4841            if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
4842                ckfree((char *) chanPtr->saveInBufPtr);
4843                chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
4844            }
4845        }
4846    }
4847    
4848    /*
4849     *---------------------------------------------------------------------------
4850     *
4851     * GetInput --
4852     *
4853     *      Reads input data from a device into a channel buffer.  
4854     *
4855     * Results:
4856     *      The return value is the Posix error code if an error occurred while
4857     *      reading from the file, or 0 otherwise.  
4858     *
4859     * Side effects:
4860     *      Reads from the underlying device.
4861     *
4862     *---------------------------------------------------------------------------
4863     */
4864    
4865    static int
4866    GetInput(chanPtr)
4867        Channel *chanPtr;           /* Channel to read input from. */
4868    {
4869        int toRead;                 /* How much to read? */
4870        int result;                 /* Of calling driver. */
4871        int nread;                  /* How much was read from channel? */
4872        ChannelBuffer *bufPtr;      /* New buffer to add to input queue. */
4873    
4874        /*
4875         * Prevent reading from a dead channel -- a channel that has been closed
4876         * but not yet deallocated, which can happen if the exit handler for
4877         * channel cleanup has run but the channel is still registered in some
4878         * interpreter.
4879         */
4880        
4881        if (CheckForDeadChannel(NULL, chanPtr)) {
4882            return EINVAL;
4883        }
4884    
4885        /*
4886         * See if we can fill an existing buffer. If we can, read only
4887         * as much as will fit in it. Otherwise allocate a new buffer,
4888         * add it to the input queue and attempt to fill it to the max.
4889         */
4890    
4891        bufPtr = chanPtr->inQueueTail;
4892        if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
4893            toRead = bufPtr->bufLength - bufPtr->nextAdded;
4894        } else {
4895            bufPtr = chanPtr->saveInBufPtr;
4896            chanPtr->saveInBufPtr = NULL;
4897            if (bufPtr == NULL) {
4898                bufPtr = AllocChannelBuffer(chanPtr->bufSize);
4899            }
4900            bufPtr->nextPtr = (ChannelBuffer *) NULL;
4901    
4902            toRead = chanPtr->bufSize;
4903            if (chanPtr->inQueueTail == NULL) {
4904                chanPtr->inQueueHead = bufPtr;
4905            } else {
4906                chanPtr->inQueueTail->nextPtr = bufPtr;
4907            }
4908            chanPtr->inQueueTail = bufPtr;
4909        }
4910          
4911        /*
4912         * If EOF is set, we should avoid calling the driver because on some
4913         * platforms it is impossible to read from a device after EOF.
4914         */
4915    
4916        if (chanPtr->flags & CHANNEL_EOF) {
4917            return 0;
4918        }
4919    
4920        nread = (*chanPtr->typePtr->inputProc)(chanPtr->instanceData,
4921                bufPtr->buf + bufPtr->nextAdded, toRead, &result);
4922    
4923        if (nread > 0) {
4924            bufPtr->nextAdded += nread;
4925    
4926            /*
4927             * If we get a short read, signal up that we may be BLOCKED. We
4928             * should avoid calling the driver because on some platforms we
4929             * will block in the low level reading code even though the
4930             * channel is set into nonblocking mode.
4931             */
4932                
4933            if (nread < toRead) {
4934                chanPtr->flags |= CHANNEL_BLOCKED;
4935            }
4936        } else if (nread == 0) {
4937            chanPtr->flags |= CHANNEL_EOF;
4938            chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
4939        } else if (nread < 0) {
4940            if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
4941                chanPtr->flags |= CHANNEL_BLOCKED;
4942                result = EAGAIN;
4943            }
4944            Tcl_SetErrno(result);
4945            return result;
4946        }
4947        return 0;
4948    }
4949    
4950    /*
4951     *----------------------------------------------------------------------
4952     *
4953     * Tcl_Seek --
4954     *
4955     *      Implements seeking on Tcl Channels. This is a public function
4956     *      so that other C facilities may be implemented on top of it.
4957     *
4958     * Results:
4959     *      The new access point or -1 on error. If error, use Tcl_GetErrno()
4960     *      to retrieve the POSIX error code for the error that occurred.
4961     *
4962     * Side effects:
4963     *      May flush output on the channel. May discard queued input.
4964     *
4965     *----------------------------------------------------------------------
4966     */
4967    
4968    int
4969    Tcl_Seek(chan, offset, mode)
4970        Tcl_Channel chan;           /* The channel on which to seek. */
4971        int offset;                 /* Offset to seek to. */
4972        int mode;                   /* Relative to which location to seek? */
4973    {
4974        Channel *chanPtr;           /* The real IO channel. */
4975        ChannelBuffer *bufPtr;
4976        int inputBuffered, outputBuffered;
4977        int result;                 /* Of device driver operations. */
4978        int curPos;                 /* Position on the device. */
4979        int wasAsync;               /* Was the channel nonblocking before the
4980                                     * seek operation? If so, must restore to
4981                                     * nonblocking mode after the seek. */
4982    
4983        chanPtr = (Channel *) chan;
4984        if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
4985            return -1;
4986        }
4987    
4988        /*
4989         * Disallow seek on dead channels -- channels that have been closed but
4990         * not yet been deallocated. Such channels can be found if the exit
4991         * handler for channel cleanup has run but the channel is still
4992         * registered in an interpreter.
4993         */
4994    
4995        if (CheckForDeadChannel(NULL,chanPtr)) return -1;
4996    
4997        /*
4998         * Disallow seek on channels whose type does not have a seek procedure
4999         * defined. This means that the channel does not support seeking.
5000         */
5001    
5002        if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
5003            Tcl_SetErrno(EINVAL);
5004            return -1;
5005        }
5006    
5007        /*
5008         * Compute how much input and output is buffered. If both input and
5009         * output is buffered, cannot compute the current position.
5010         */
5011    
5012        for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
5013                 bufPtr != (ChannelBuffer *) NULL;
5014                 bufPtr = bufPtr->nextPtr) {
5015            inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5016        }
5017        for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
5018                 bufPtr != (ChannelBuffer *) NULL;
5019                 bufPtr = bufPtr->nextPtr) {
5020            outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5021        }
5022        if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
5023               (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
5024            chanPtr->flags |= BUFFER_READY;
5025            outputBuffered +=
5026                (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
5027        }
5028    
5029        if ((inputBuffered != 0) && (outputBuffered != 0)) {
5030            Tcl_SetErrno(EFAULT);
5031            return -1;
5032        }
5033    
5034        /*
5035         * If we are seeking relative to the current position, compute the
5036         * corrected offset taking into account the amount of unread input.
5037         */
5038    
5039        if (mode == SEEK_CUR) {
5040            offset -= inputBuffered;
5041        }
5042    
5043        /*
5044         * Discard any queued input - this input should not be read after
5045         * the seek.
5046         */
5047    
5048        DiscardInputQueued(chanPtr, 0);
5049    
5050        /*
5051         * Reset EOF and BLOCKED flags. We invalidate them by moving the
5052         * access point. Also clear CR related flags.
5053         */
5054    
5055        chanPtr->flags &=
5056            (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
5057        
5058        /*
5059         * If the channel is in asynchronous output mode, switch it back
5060         * to synchronous mode and cancel any async flush that may be
5061         * scheduled. After the flush, the channel will be put back into
5062         * asynchronous output mode.
5063         */
5064    
5065        wasAsync = 0;
5066        if (chanPtr->flags & CHANNEL_NONBLOCKING) {
5067            wasAsync = 1;
5068            result = 0;
5069            if (chanPtr->typePtr->blockModeProc != NULL) {
5070                result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
5071                        TCL_MODE_BLOCKING);
5072            }
5073            if (result != 0) {
5074                Tcl_SetErrno(result);
5075                return -1;
5076            }
5077            chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
5078            if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
5079                chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
5080            }
5081        }
5082        
5083        /*
5084         * If the flush fails we cannot recover the original position. In
5085         * that case the seek is not attempted because we do not know where
5086         * the access position is - instead we return the error. FlushChannel
5087         * has already called Tcl_SetErrno() to report the error upwards.
5088         * If the flush succeeds we do the seek also.
5089         */
5090        
5091        if (FlushChannel(NULL, chanPtr, 0) != 0) {
5092            curPos = -1;
5093        } else {
5094    
5095            /*
5096             * Now seek to the new position in the channel as requested by the
5097             * caller.
5098             */
5099    
5100            curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
5101                    (long) offset, mode, &result);
5102            if (curPos == -1) {
5103                Tcl_SetErrno(result);
5104            }
5105        }
5106        
5107        /*
5108         * Restore to nonblocking mode if that was the previous behavior.
5109         *
5110         * NOTE: Even if there was an async flush active we do not restore
5111         * it now because we already flushed all the queued output, above.
5112         */
5113        
5114        if (wasAsync) {
5115            chanPtr->flags |= CHANNEL_NONBLOCKING;
5116            result = 0;
5117            if (chanPtr->typePtr->blockModeProc != NULL) {
5118                result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
5119                        TCL_MODE_NONBLOCKING);
5120            }
5121            if (result != 0) {
5122                Tcl_SetErrno(result);
5123                return -1;
5124            }
5125        }
5126    
5127        return curPos;
5128    }
5129    
5130    /*
5131     *----------------------------------------------------------------------
5132     *
5133     * Tcl_Tell --
5134     *
5135     *      Returns the position of the next character to be read/written on
5136     *      this channel.
5137     *
5138     * Results:
5139     *      A nonnegative integer on success, -1 on failure. If failed,
5140     *      use Tcl_GetErrno() to retrieve the POSIX error code for the
5141     *      error that occurred.
5142     *
5143     * Side effects:
5144     *      None.
5145     *
5146     *----------------------------------------------------------------------
5147     */
5148    
5149    int
5150    Tcl_Tell(chan)
5151        Tcl_Channel chan;                   /* The channel to return pos for. */
5152    {
5153        Channel *chanPtr;                   /* The actual channel to tell on. */
5154        ChannelBuffer *bufPtr;
5155        int inputBuffered, outputBuffered;
5156        int result;                         /* Of calling device driver. */
5157        int curPos;                         /* Position on device. */
5158    
5159        chanPtr = (Channel *) chan;
5160        if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
5161            return -1;
5162        }
5163    
5164        /*
5165         * Disallow tell on dead channels -- channels that have been closed but
5166         * not yet been deallocated. Such channels can be found if the exit
5167         * handler for channel cleanup has run but the channel is still
5168         * registered in an interpreter.
5169         */
5170    
5171        if (CheckForDeadChannel(NULL,chanPtr)) {
5172            return -1;
5173        }
5174    
5175        /*
5176         * Disallow tell on channels whose type does not have a seek procedure
5177         * defined. This means that the channel does not support seeking.
5178         */
5179    
5180        if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
5181            Tcl_SetErrno(EINVAL);
5182            return -1;
5183        }
5184    
5185        /*
5186         * Compute how much input and output is buffered. If both input and
5187         * output is buffered, cannot compute the current position.
5188         */
5189    
5190        for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
5191                 bufPtr != (ChannelBuffer *) NULL;
5192                 bufPtr = bufPtr->nextPtr) {
5193            inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5194        }
5195        for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
5196                 bufPtr != (ChannelBuffer *) NULL;
5197                 bufPtr = bufPtr->nextPtr) {
5198            outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5199        }
5200        if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
5201               (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
5202            chanPtr->flags |= BUFFER_READY;
5203            outputBuffered +=
5204                (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
5205        }
5206    
5207        if ((inputBuffered != 0) && (outputBuffered != 0)) {
5208            Tcl_SetErrno(EFAULT);
5209            return -1;
5210        }
5211    
5212        /*
5213         * Get the current position in the device and compute the position
5214         * where the next character will be read or written.
5215         */
5216    
5217        curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
5218                (long) 0, SEEK_CUR, &result);
5219        if (curPos == -1) {
5220            Tcl_SetErrno(result);
5221            return -1;
5222        }
5223        if (inputBuffered != 0) {
5224            return (curPos - inputBuffered);
5225        }
5226        return (curPos + outputBuffered);
5227    }
5228    
5229    /*
5230     *---------------------------------------------------------------------------
5231     *
5232     * CheckChannelErrors --
5233     *
5234     *      See if the channel is in an ready state and can perform the
5235     *      desired operation.
5236     *
5237     * Results:
5238     *      The return value is 0 if the channel is OK, otherwise the
5239     *      return value is -1 and errno is set to indicate the error.
5240     *
5241     * Side effects:
5242     *      May clear the EOF and/or BLOCKED bits if reading from channel.
5243     *
5244     *---------------------------------------------------------------------------
5245     */
5246    
5247    static int
5248    CheckChannelErrors(chanPtr, direction)
5249        Channel *chanPtr;       /* Channel to check. */
5250        int direction;          /* Test if channel supports desired operation:
5251                                 * TCL_READABLE, TCL_WRITABLE. */
5252    {
5253        /*
5254         * Check for unreported error.
5255         */
5256    
5257        if (chanPtr->unreportedError != 0) {
5258            Tcl_SetErrno(chanPtr->unreportedError);
5259            chanPtr->unreportedError = 0;
5260            return -1;
5261        }
5262    
5263        /*
5264         * Fail if the channel is not opened for desired operation.
5265         */
5266    
5267        if ((chanPtr->flags & direction) == 0) {
5268            Tcl_SetErrno(EACCES);
5269            return -1;
5270        }
5271    
5272        /*
5273         * Fail if the channel is in the middle of a background copy.
5274         */
5275    
5276        if (chanPtr->csPtr != NULL) {
5277            Tcl_SetErrno(EBUSY);
5278            return -1;
5279        }
5280    
5281        if (direction == TCL_READABLE) {
5282            /*
5283             * If we have not encountered a sticky EOF, clear the EOF bit
5284             * (sticky EOF is set if we have seen the input eofChar, to prevent
5285             * reading beyond the eofChar). Also, always clear the BLOCKED bit.
5286             * We want to discover these conditions anew in each operation.
5287             */
5288            
5289            if ((chanPtr->flags & CHANNEL_STICKY_EOF) == 0) {
5290                chanPtr->flags &= ~CHANNEL_EOF;
5291            }
5292            chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
5293        }
5294    
5295        return 0;
5296    }
5297    
5298    /*
5299     *----------------------------------------------------------------------
5300     *
5301     * Tcl_Eof --
5302     *
5303     *      Returns 1 if the channel is at EOF, 0 otherwise.
5304     *
5305     * Results:
5306     *      1 or 0, always.
5307     *
5308     * Side effects:
5309     *      None.
5310     *
5311     *----------------------------------------------------------------------
5312     */
5313    
5314    int
5315    Tcl_Eof(chan)
5316        Tcl_Channel chan;                   /* Does this channel have EOF? */
5317    {
5318        Channel *chanPtr;           /* The real channel structure. */
5319    
5320        chanPtr = (Channel *) chan;
5321        return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
5322                ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
5323            ? 1 : 0;
5324    }
5325    
5326    /*
5327     *----------------------------------------------------------------------
5328     *
5329     * Tcl_InputBlocked --
5330     *
5331     *      Returns 1 if input is blocked on this channel, 0 otherwise.
5332     *
5333     * Results:
5334     *      0 or 1, always.
5335     *
5336     * Side effects:
5337     *      None.
5338     *
5339     *----------------------------------------------------------------------
5340     */
5341    
5342    int
5343    Tcl_InputBlocked(chan)
5344        Tcl_Channel chan;                   /* Is this channel blocked? */
5345    {
5346        Channel *chanPtr;           /* The real channel structure. */
5347    
5348        chanPtr = (Channel *) chan;
5349        return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
5350    }
5351    
5352    /*
5353     *----------------------------------------------------------------------
5354     *
5355     * Tcl_InputBuffered --
5356     *
5357     *      Returns the number of bytes of input currently buffered in the
5358     *      internal buffer of a channel.
5359     *
5360     * Results:
5361     *      The number of input bytes buffered, or zero if the channel is not
5362     *      open for reading.
5363     *
5364     * Side effects:
5365     *      None.
5366     *
5367     *----------------------------------------------------------------------
5368     */
5369    
5370    int
5371    Tcl_InputBuffered(chan)
5372        Tcl_Channel chan;                   /* The channel to query. */
5373    {
5374        Channel *chanPtr;
5375        int bytesBuffered;
5376        ChannelBuffer *bufPtr;
5377    
5378        chanPtr = (Channel *) chan;
5379        for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
5380                 bufPtr != (ChannelBuffer *) NULL;
5381                 bufPtr = bufPtr->nextPtr) {
5382            bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5383        }
5384        return bytesBuffered;
5385    }
5386    
5387    /*
5388     *----------------------------------------------------------------------
5389     *
5390     * Tcl_SetChannelBufferSize --
5391     *
5392     *      Sets the size of buffers to allocate to store input or output
5393     *      in the channel. The size must be between 10 bytes and 1 MByte.
5394     *
5395     * Results:
5396     *      None.
5397     *
5398     * Side effects:
5399     *      Sets the size of buffers subsequently allocated for this channel.
5400     *
5401     *----------------------------------------------------------------------
5402     */
5403    
5404    void
5405    Tcl_SetChannelBufferSize(chan, sz)
5406        Tcl_Channel chan;                   /* The channel whose buffer size
5407                                             * to set. */
5408        int sz;                             /* The size to set. */
5409    {
5410        Channel *chanPtr;
5411        
5412        /*
5413         * If the buffer size is smaller than 10 bytes or larger than one MByte,
5414         * do not accept the requested size and leave the current buffer size.
5415         */
5416        
5417        if (sz < 10) {
5418            return;
5419        }
5420        if (sz > (1024 * 1024)) {
5421            return;
5422        }
5423    
5424        chanPtr = (Channel *) chan;
5425        chanPtr->bufSize = sz;
5426    
5427        if (chanPtr->outputStage != NULL) {
5428            ckfree((char *) chanPtr->outputStage);
5429            chanPtr->outputStage = NULL;
5430        }
5431        if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
5432            chanPtr->outputStage = (char *)
5433                    ckalloc((unsigned) (chanPtr->bufSize + 2));
5434        }
5435    }
5436    
5437    /*
5438     *----------------------------------------------------------------------
5439     *
5440     * Tcl_GetChannelBufferSize --
5441     *
5442     *      Retrieves the size of buffers to allocate for this channel.
5443     *
5444     * Results:
5445     *      The size.
5446     *
5447     * Side effects:
5448     *      None.
5449     *
5450     *----------------------------------------------------------------------
5451     */
5452    
5453    int
5454    Tcl_GetChannelBufferSize(chan)
5455        Tcl_Channel chan;           /* The channel for which to find the
5456                                     * buffer size. */
5457    {
5458        Channel *chanPtr;
5459    
5460        chanPtr = (Channel *) chan;
5461        return chanPtr->bufSize;
5462    }
5463    
5464    /*
5465     *----------------------------------------------------------------------
5466     *
5467     * Tcl_BadChannelOption --
5468     *
5469     *      This procedure generates a "bad option" error message in an
5470     *      (optional) interpreter.  It is used by channel drivers when
5471     *      a invalid Set/Get option is requested. Its purpose is to concatenate
5472     *      the generic options list to the specific ones and factorize
5473     *      the generic options error message string.
5474     *
5475     * Results:
5476     *      TCL_ERROR.
5477     *
5478     * Side effects:
5479     *      An error message is generated in interp's result object to
5480     *      indicate that a command was invoked with the a bad option
5481     *      The message has the form
5482     *              bad option "blah": should be one of
5483     *              <...generic options...>+<...specific options...>
5484     *      "blah" is the optionName argument and "<specific options>"
5485     *      is a space separated list of specific option words.
5486     *      The function takes good care of inserting minus signs before
5487     *      each option, commas after, and an "or" before the last option.
5488     *
5489     *----------------------------------------------------------------------
5490     */
5491    
5492    int
5493    Tcl_BadChannelOption(interp, optionName, optionList)
5494        Tcl_Interp *interp;                 /* Current interpreter. (can be NULL)*/
5495        char *optionName;                   /* 'bad option' name */
5496        char *optionList;                   /* Specific options list to append
5497                                             * to the standard generic options.
5498                                             * can be NULL for generic options
5499                                             * only.
5500                                             */
5501    {
5502        if (interp) {
5503            CONST char *genericopt =
5504                    "blocking buffering buffersize encoding eofchar translation";
5505            char **argv;
5506            int  argc, i;
5507            Tcl_DString ds;
5508    
5509            Tcl_DStringInit(&ds);
5510            Tcl_DStringAppend(&ds, (char *) genericopt, -1);
5511            if (optionList && (*optionList)) {
5512                Tcl_DStringAppend(&ds, " ", 1);
5513                Tcl_DStringAppend(&ds, optionList, -1);
5514            }
5515            if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
5516                      &argc, &argv) != TCL_OK) {
5517                panic("malformed option list in channel driver");
5518            }
5519            Tcl_ResetResult(interp);
5520            Tcl_AppendResult(interp, "bad option \"", optionName,
5521                     "\": should be one of ", (char *) NULL);
5522            argc--;
5523            for (i = 0; i < argc; i++) {
5524                Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
5525            }
5526            Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
5527            Tcl_DStringFree(&ds);
5528            ckfree((char *) argv);
5529        }
5530        Tcl_SetErrno(EINVAL);
5531        return TCL_ERROR;
5532    }
5533    
5534    /*
5535     *----------------------------------------------------------------------
5536     *
5537     * Tcl_GetChannelOption --
5538     *
5539     *      Gets a mode associated with an IO channel. If the optionName arg
5540     *      is non NULL, retrieves the value of that option. If the optionName
5541     *      arg is NULL, retrieves a list of alternating option names and
5542     *      values for the given channel.
5543     *
5544     * Results:
5545     *      A standard Tcl result. Also sets the supplied DString to the
5546     *      string value of the option(s) returned.
5547     *
5548     * Side effects:
5549     *      None.
5550     *
5551     *----------------------------------------------------------------------
5552     */
5553    
5554    int
5555    Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
5556        Tcl_Interp *interp;         /* For error reporting - can be NULL. */
5557        Tcl_Channel chan;           /* Channel on which to get option. */
5558        char *optionName;           /* Option to get. */
5559        Tcl_DString *dsPtr;         /* Where to store value(s). */
5560    {
5561        size_t len;                 /* Length of optionName string. */
5562        char optionVal[128];        /* Buffer for sprintf. */
5563        Channel *chanPtr = (Channel *) chan;
5564        int flags;
5565    
5566        /*
5567         * If we are in the middle of a background copy, use the saved flags.
5568         */
5569    
5570        if (chanPtr->csPtr) {
5571            if (chanPtr == chanPtr->csPtr->readPtr) {
5572                flags = chanPtr->csPtr->readFlags;
5573            } else {
5574                flags = chanPtr->csPtr->writeFlags;
5575            }
5576        } else {
5577            flags = chanPtr->flags;
5578        }
5579    
5580        /*
5581         * Disallow options on dead channels -- channels that have been closed but
5582         * not yet been deallocated. Such channels can be found if the exit
5583         * handler for channel cleanup has run but the channel is still
5584         * registered in an interpreter.
5585         */
5586    
5587        if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;
5588    
5589        /*
5590         * If the optionName is NULL it means that we want a list of all
5591         * options and values.
5592         */
5593        
5594        if (optionName == (char *) NULL) {
5595            len = 0;
5596        } else {
5597            len = strlen(optionName);
5598        }
5599        
5600        if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
5601                (strncmp(optionName, "-blocking", len) == 0))) {
5602            if (len == 0) {
5603                Tcl_DStringAppendElement(dsPtr, "-blocking");
5604            }
5605            Tcl_DStringAppendElement(dsPtr,
5606                    (flags & CHANNEL_NONBLOCKING) ? "0" : "1");
5607            if (len > 0) {
5608                return TCL_OK;
5609            }
5610        }
5611        if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
5612                (strncmp(optionName, "-buffering", len) == 0))) {
5613            if (len == 0) {
5614                Tcl_DStringAppendElement(dsPtr, "-buffering");
5615            }
5616            if (flags & CHANNEL_LINEBUFFERED) {
5617                Tcl_DStringAppendElement(dsPtr, "line");
5618            } else if (flags & CHANNEL_UNBUFFERED) {
5619                Tcl_DStringAppendElement(dsPtr, "none");
5620            } else {
5621                Tcl_DStringAppendElement(dsPtr, "full");
5622            }
5623            if (len > 0) {
5624                return TCL_OK;
5625            }
5626        }
5627        if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
5628                (strncmp(optionName, "-buffersize", len) == 0))) {
5629            if (len == 0) {
5630                Tcl_DStringAppendElement(dsPtr, "-buffersize");
5631            }
5632            TclFormatInt(optionVal, chanPtr->bufSize);
5633            Tcl_DStringAppendElement(dsPtr, optionVal);
5634            if (len > 0) {
5635                return TCL_OK;
5636            }
5637        }
5638        if ((len == 0) ||
5639                ((len > 2) && (optionName[1] == 'e') &&
5640                        (strncmp(optionName, "-encoding", len) == 0))) {
5641            if (len == 0) {
5642                Tcl_DStringAppendElement(dsPtr, "-encoding");
5643            }
5644            if (chanPtr->encoding == NULL) {
5645                Tcl_DStringAppendElement(dsPtr, "binary");
5646            } else {
5647                Tcl_DStringAppendElement(dsPtr,
5648                        Tcl_GetEncodingName(chanPtr->encoding));
5649            }
5650            if (len > 0) {
5651                return TCL_OK;
5652            }
5653        }
5654        if ((len == 0) ||
5655                ((len > 2) && (optionName[1] == 'e') &&
5656                        (strncmp(optionName, "-eofchar", len) == 0))) {
5657            if (len == 0) {
5658                Tcl_DStringAppendElement(dsPtr, "-eofchar");
5659            }
5660            if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5661                    (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5662                Tcl_DStringStartSublist(dsPtr);
5663            }
5664            if (flags & TCL_READABLE) {
5665                if (chanPtr->inEofChar == 0) {
5666                    Tcl_DStringAppendElement(dsPtr, "");
5667                } else {
5668                    char buf[4];
5669    
5670                    sprintf(buf, "%c", chanPtr->inEofChar);
5671                    Tcl_DStringAppendElement(dsPtr, buf);
5672                }
5673            }
5674            if (flags & TCL_WRITABLE) {
5675                if (chanPtr->outEofChar == 0) {
5676                    Tcl_DStringAppendElement(dsPtr, "");
5677                } else {
5678                    char buf[4];
5679    
5680                    sprintf(buf, "%c", chanPtr->outEofChar);
5681                    Tcl_DStringAppendElement(dsPtr, buf);
5682                }
5683            }
5684            if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5685                    (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5686                Tcl_DStringEndSublist(dsPtr);
5687            }
5688            if (len > 0) {
5689                return TCL_OK;
5690            }
5691        }
5692        if ((len == 0) ||
5693                ((len > 1) && (optionName[1] == 't') &&
5694                        (strncmp(optionName, "-translation", len) == 0))) {
5695            if (len == 0) {
5696                Tcl_DStringAppendElement(dsPtr, "-translation");
5697            }
5698            if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5699                    (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5700                Tcl_DStringStartSublist(dsPtr);
5701            }
5702            if (flags & TCL_READABLE) {
5703                if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
5704                    Tcl_DStringAppendElement(dsPtr, "auto");
5705                } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
5706                    Tcl_DStringAppendElement(dsPtr, "cr");
5707                } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
5708                    Tcl_DStringAppendElement(dsPtr, "crlf");
5709                } else {
5710                    Tcl_DStringAppendElement(dsPtr, "lf");
5711                }
5712            }
5713            if (flags & TCL_WRITABLE) {
5714                if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
5715                    Tcl_DStringAppendElement(dsPtr, "auto");
5716                } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
5717                    Tcl_DStringAppendElement(dsPtr, "cr");
5718                } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
5719                    Tcl_DStringAppendElement(dsPtr, "crlf");
5720                } else {
5721                    Tcl_DStringAppendElement(dsPtr, "lf");
5722                }
5723            }
5724            if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5725                    (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5726                Tcl_DStringEndSublist(dsPtr);
5727            }
5728            if (len > 0) {
5729                return TCL_OK;
5730            }
5731        }
5732        if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
5733            /*
5734             * let the driver specific handle additional options
5735             * and result code and message.
5736             */
5737    
5738            return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
5739                      interp, optionName, dsPtr);
5740        } else {
5741            /*
5742             * no driver specific options case.
5743             */
5744    
5745            if (len == 0) {
5746                return TCL_OK;
5747            }
5748            return Tcl_BadChannelOption(interp, optionName, NULL);
5749        }
5750    }
5751    
5752    /*
5753     *---------------------------------------------------------------------------
5754     *
5755     * Tcl_SetChannelOption --
5756     *
5757     *      Sets an option on a channel.
5758     *
5759     * Results:
5760     *      A standard Tcl result.  On error, sets interp's result object
5761     *      if interp is not NULL.
5762     *
5763     * Side effects:
5764     *      May modify an option on a device.
5765     *
5766     *---------------------------------------------------------------------------
5767     */
5768    
5769    int
5770    Tcl_SetChannelOption(interp, chan, optionName, newValue)
5771        Tcl_Interp *interp;         /* For error reporting - can be NULL. */
5772        Tcl_Channel chan;           /* Channel on which to set mode. */
5773        char *optionName;           /* Which option to set? */
5774        char *newValue;             /* New value for option. */
5775    {
5776        int newMode;                /* New (numeric) mode to sert. */
5777        Channel *chanPtr;           /* The real IO channel. */
5778        size_t len;                 /* Length of optionName string. */
5779        int argc;
5780        char **argv;
5781        
5782        chanPtr = (Channel *) chan;
5783    
5784        /*
5785         * If the channel is in the middle of a background copy, fail.
5786         */
5787    
5788        if (chanPtr->csPtr) {
5789            if (interp) {
5790                Tcl_AppendResult(interp,
5791                     "unable to set channel options: background copy in progress",
5792                     (char *) NULL);
5793            }
5794            return TCL_ERROR;
5795        }
5796    
5797    
5798        /*
5799         * Disallow options on dead channels -- channels that have been closed but
5800         * not yet been deallocated. Such channels can be found if the exit
5801         * handler for channel cleanup has run but the channel is still
5802         * registered in an interpreter.
5803         */
5804    
5805        if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;
5806        
5807        len = strlen(optionName);
5808    
5809        if ((len > 2) && (optionName[1] == 'b') &&
5810                (strncmp(optionName, "-blocking", len) == 0)) {
5811            if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
5812                return TCL_ERROR;
5813            }
5814            if (newMode) {
5815                newMode = TCL_MODE_BLOCKING;
5816            } else {
5817                newMode = TCL_MODE_NONBLOCKING;
5818            }
5819            return SetBlockMode(interp, chanPtr, newMode);
5820        } else if ((len > 7) && (optionName[1] == 'b') &&
5821                (strncmp(optionName, "-buffering", len) == 0)) {
5822            len = strlen(newValue);
5823            if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
5824                chanPtr->flags &=
5825                    (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
5826            } else if ((newValue[0] == 'l') &&
5827                    (strncmp(newValue, "line", len) == 0)) {
5828                chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
5829                chanPtr->flags |= CHANNEL_LINEBUFFERED;
5830            } else if ((newValue[0] == 'n') &&
5831                    (strncmp(newValue, "none", len) == 0)) {
5832                chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
5833                chanPtr->flags |= CHANNEL_UNBUFFERED;
5834            } else {
5835                if (interp) {
5836                    Tcl_AppendResult(interp, "bad value for -buffering: ",
5837                            "must be one of full, line, or none",
5838                            (char *) NULL);
5839                    return TCL_ERROR;
5840                }
5841            }
5842            return TCL_OK;
5843        } else if ((len > 7) && (optionName[1] == 'b') &&
5844                (strncmp(optionName, "-buffersize", len) == 0)) {
5845            chanPtr->bufSize = atoi(newValue);      /* INTL: "C", UTF safe. */
5846            if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
5847                chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
5848            }
5849        } else if ((len > 2) && (optionName[1] == 'e') &&
5850                (strncmp(optionName, "-encoding", len) == 0)) {
5851            Tcl_Encoding encoding;
5852    
5853            if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
5854                encoding = NULL;
5855            } else {
5856                encoding = Tcl_GetEncoding(interp, newValue);
5857                if (encoding == NULL) {
5858                    return TCL_ERROR;
5859                }
5860            }
5861            Tcl_FreeEncoding(chanPtr->encoding);
5862            chanPtr->encoding = encoding;
5863            chanPtr->inputEncodingState = NULL;
5864            chanPtr->inputEncodingFlags = TCL_ENCODING_START;
5865            chanPtr->outputEncodingState = NULL;
5866            chanPtr->outputEncodingFlags = TCL_ENCODING_START;
5867            chanPtr->flags &= ~CHANNEL_NEED_MORE_DATA;
5868            UpdateInterest(chanPtr);
5869        } else if ((len > 2) && (optionName[1] == 'e') &&
5870                (strncmp(optionName, "-eofchar", len) == 0)) {
5871            if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
5872                return TCL_ERROR;
5873            }
5874            if (argc == 0) {
5875                chanPtr->inEofChar = 0;
5876                chanPtr->outEofChar = 0;
5877            } else if (argc == 1) {
5878                if (chanPtr->flags & TCL_WRITABLE) {
5879                    chanPtr->outEofChar = (int) argv[0][0];
5880                }
5881                if (chanPtr->flags & TCL_READABLE) {
5882                    chanPtr->inEofChar = (int) argv[0][0];
5883                }
5884            } else if (argc != 2) {
5885                if (interp) {
5886                    Tcl_AppendResult(interp,
5887                            "bad value for -eofchar: should be a list of one or",
5888                            " two elements", (char *) NULL);
5889                }
5890                ckfree((char *) argv);
5891                return TCL_ERROR;
5892            } else {
5893                if (chanPtr->flags & TCL_READABLE) {
5894                    chanPtr->inEofChar = (int) argv[0][0];
5895                }
5896                if (chanPtr->flags & TCL_WRITABLE) {
5897                    chanPtr->outEofChar = (int) argv[1][0];
5898                }
5899            }
5900            if (argv != (char **) NULL) {
5901                ckfree((char *) argv);
5902            }
5903            return TCL_OK;
5904        } else if ((len > 1) && (optionName[1] == 't') &&
5905                (strncmp(optionName, "-translation", len) == 0)) {
5906            char *readMode, *writeMode;
5907    
5908            if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
5909                return TCL_ERROR;
5910            }
5911    
5912            if (argc == 1) {
5913                readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
5914                writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
5915            } else if (argc == 2) {
5916                readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
5917                writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
5918            } else {
5919                if (interp) {
5920                    Tcl_AppendResult(interp,
5921                            "bad value for -translation: must be a one or two",
5922                            " element list", (char *) NULL);
5923                }
5924                ckfree((char *) argv);
5925                return TCL_ERROR;
5926            }
5927    
5928            if (readMode) {
5929                if (*readMode == '\0') {
5930                    newMode = chanPtr->inputTranslation;
5931                } else if (strcmp(readMode, "auto") == 0) {
5932                    newMode = TCL_TRANSLATE_AUTO;
5933                } else if (strcmp(readMode, "binary") == 0) {
5934                    newMode = TCL_TRANSLATE_LF;
5935                    chanPtr->inEofChar = 0;
5936                    Tcl_FreeEncoding(chanPtr->encoding);                
5937                    chanPtr->encoding = NULL;
5938                } else if (strcmp(readMode, "lf") == 0) {
5939                    newMode = TCL_TRANSLATE_LF;
5940                } else if (strcmp(readMode, "cr") == 0) {
5941                    newMode = TCL_TRANSLATE_CR;
5942                } else if (strcmp(readMode, "crlf") == 0) {
5943                    newMode = TCL_TRANSLATE_CRLF;
5944                } else if (strcmp(readMode, "platform") == 0) {
5945                    newMode = TCL_PLATFORM_TRANSLATION;
5946                } else {
5947                    if (interp) {
5948                        Tcl_AppendResult(interp,
5949                                "bad value for -translation: ",
5950                                "must be one of auto, binary, cr, lf, crlf,",
5951                                " or platform", (char *) NULL);
5952                    }
5953                    ckfree((char *) argv);
5954                    return TCL_ERROR;
5955                }
5956    
5957                /*
5958                 * Reset the EOL flags since we need to look at any buffered
5959                 * data to see if the new translation mode allows us to
5960                 * complete the line.
5961                 */
5962    
5963                if (newMode != chanPtr->inputTranslation) {
5964                    chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;
5965                    chanPtr->flags &= ~(INPUT_SAW_CR);
5966                    chanPtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
5967                    UpdateInterest(chanPtr);
5968                }
5969            }
5970            if (writeMode) {
5971                if (*writeMode == '\0') {
5972                    /* Do nothing. */
5973                } else if (strcmp(writeMode, "auto") == 0) {
5974                    /*
5975                     * This is a hack to get TCP sockets to produce output
5976                     * in CRLF mode if they are being set into AUTO mode.
5977                     * A better solution for achieving this effect will be
5978                     * coded later.
5979                     */
5980    
5981                    if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
5982                        chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
5983                    } else {
5984                        chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
5985                    }
5986                } else if (strcmp(writeMode, "binary") == 0) {
5987                    chanPtr->outEofChar = 0;
5988                    chanPtr->outputTranslation = TCL_TRANSLATE_LF;
5989                    Tcl_FreeEncoding(chanPtr->encoding);                
5990                    chanPtr->encoding = NULL;
5991                } else if (strcmp(writeMode, "lf") == 0) {
5992                    chanPtr->outputTranslation = TCL_TRANSLATE_LF;
5993                } else if (strcmp(writeMode, "cr") == 0) {
5994                    chanPtr->outputTranslation = TCL_TRANSLATE_CR;
5995                } else if (strcmp(writeMode, "crlf") == 0) {
5996                    chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
5997                } else if (strcmp(writeMode, "platform") == 0) {
5998                    chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
5999                } else {
6000                    if (interp) {
6001                        Tcl_AppendResult(interp,
6002                                "bad value for -translation: ",
6003                                "must be one of auto, binary, cr, lf, crlf,",
6004                                " or platform", (char *) NULL);
6005                    }
6006                    ckfree((char *) argv);
6007                    return TCL_ERROR;
6008                }
6009            }
6010            ckfree((char *) argv);            
6011            return TCL_OK;
6012        } else if (chanPtr->typePtr->setOptionProc != NULL) {
6013            return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
6014                    interp, optionName, newValue);
6015        } else {
6016            return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
6017        }
6018    
6019        /*
6020         * If bufsize changes, need to get rid of old utility buffer.
6021         */
6022    
6023        if (chanPtr->saveInBufPtr != NULL) {
6024            RecycleBuffer(chanPtr, chanPtr->saveInBufPtr, 1);
6025            chanPtr->saveInBufPtr = NULL;
6026        }
6027        if (chanPtr->inQueueHead != NULL) {
6028            if ((chanPtr->inQueueHead->nextPtr == NULL)
6029                    && (chanPtr->inQueueHead->nextAdded ==
6030                            chanPtr->inQueueHead->nextRemoved)) {
6031                RecycleBuffer(chanPtr, chanPtr->inQueueHead, 1);
6032                chanPtr->inQueueHead = NULL;
6033                chanPtr->inQueueTail = NULL;
6034            }
6035        }
6036    
6037        /*
6038         * If encoding or bufsize changes, need to update output staging buffer.
6039         */
6040    
6041        if (chanPtr->outputStage != NULL) {
6042            ckfree((char *) chanPtr->outputStage);
6043            chanPtr->outputStage = NULL;
6044        }
6045        if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
6046            chanPtr->outputStage = (char *)
6047                    ckalloc((unsigned) (chanPtr->bufSize + 2));
6048        }
6049        return TCL_OK;
6050    }
6051    
6052    /*
6053     *----------------------------------------------------------------------
6054     *
6055     * CleanupChannelHandlers --
6056     *
6057     *      Removes channel handlers that refer to the supplied interpreter,
6058     *      so that if the actual channel is not closed now, these handlers
6059     *      will not run on subsequent events on the channel. This would be
6060     *      erroneous, because the interpreter no longer has a reference to
6061     *      this channel.
6062     *
6063     * Results:
6064     *      None.
6065     *
6066     * Side effects:
6067     *      Removes channel handlers.
6068     *
6069     *----------------------------------------------------------------------
6070     */
6071    
6072    static void
6073    CleanupChannelHandlers(interp, chanPtr)
6074        Tcl_Interp *interp;
6075        Channel *chanPtr;
6076    {
6077        EventScriptRecord *sPtr, *prevPtr, *nextPtr;
6078    
6079        /*
6080         * Remove fileevent records on this channel that refer to the
6081         * given interpreter.
6082         */
6083        
6084        for (sPtr = chanPtr->scriptRecordPtr,
6085                 prevPtr = (EventScriptRecord *) NULL;
6086                 sPtr != (EventScriptRecord *) NULL;
6087                 sPtr = nextPtr) {
6088            nextPtr = sPtr->nextPtr;
6089            if (sPtr->interp == interp) {
6090                if (prevPtr == (EventScriptRecord *) NULL) {
6091                    chanPtr->scriptRecordPtr = nextPtr;
6092                } else {
6093                    prevPtr->nextPtr = nextPtr;
6094                }
6095    
6096                Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
6097                        ChannelEventScriptInvoker, (ClientData) sPtr);
6098    
6099                Tcl_DecrRefCount(sPtr->scriptPtr);
6100                ckfree((char *) sPtr);
6101            } else {
6102                prevPtr = sPtr;
6103            }
6104        }
6105    }
6106    
6107    /*
6108     *----------------------------------------------------------------------
6109     *
6110     * Tcl_NotifyChannel --
6111     *
6112     *      This procedure is called by a channel driver when a driver
6113     *      detects an event on a channel.  This procedure is responsible
6114     *      for actually handling the event by invoking any channel
6115     *      handler callbacks.
6116     *
6117     * Results:
6118     *      None.
6119     *
6120     * Side effects:
6121     *      Whatever the channel handler callback procedure does.
6122     *
6123     *----------------------------------------------------------------------
6124     */
6125    
6126    void
6127    Tcl_NotifyChannel(channel, mask)
6128        Tcl_Channel channel;        /* Channel that detected an event. */
6129        int mask;                   /* OR'ed combination of TCL_READABLE,
6130                                     * TCL_WRITABLE, or TCL_EXCEPTION: indicates
6131                                     * which events were detected. */
6132    {
6133        Channel *chanPtr = (Channel *) channel;
6134        ChannelHandler *chPtr;
6135        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
6136        NextChannelHandler nh;
6137    
6138        /* Walk all channels in a stack ! and notify them in order.
6139         */
6140    
6141        while (chanPtr !=  (Channel *) NULL) {
6142            /*
6143             * Preserve the channel struct in case the script closes it.
6144             */
6145        
6146            Tcl_Preserve((ClientData) channel);
6147    
6148            /*
6149             * If we are flushing in the background, be sure to call FlushChannel
6150             * for writable events.  Note that we have to discard the writable
6151             * event so we don't call any write handlers before the flush is
6152             * complete.
6153             */
6154    
6155            if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
6156                FlushChannel(NULL, chanPtr, 1);
6157                mask &= ~TCL_WRITABLE;
6158            }
6159    
6160            /*
6161             * Add this invocation to the list of recursive invocations of
6162             * ChannelHandlerEventProc.
6163             */
6164        
6165            nh.nextHandlerPtr = (ChannelHandler *) NULL;
6166            nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
6167            tsdPtr->nestedHandlerPtr = &nh;
6168        
6169            for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
6170    
6171                /*
6172                 * If this channel handler is interested in any of the events that
6173                 * have occurred on the channel, invoke its procedure.
6174                 */
6175            
6176              if ((chPtr->mask & mask) != 0) {
6177                  nh.nextHandlerPtr = chPtr->nextPtr;
6178                  (*(chPtr->proc))(chPtr->clientData, mask);
6179                  chPtr = nh.nextHandlerPtr;
6180              } else {
6181                  chPtr = chPtr->nextPtr;
6182              }
6183            }
6184    
6185            /*
6186             * Update the notifier interest, since it may have changed after
6187             * invoking event handlers. Skip that if the channel was deleted
6188             * in the call to the channel handler.
6189             */
6190    
6191            if (chanPtr->typePtr != NULL) {
6192                UpdateInterest(chanPtr);
6193    
6194                /* Walk down the stack.
6195                 */
6196              chanPtr = chanPtr-> supercedes;
6197            } else {
6198                /* Stop walking the chain, the whole stack was destroyed!
6199                 */
6200                chanPtr = (Channel*) NULL;
6201            }
6202    
6203            Tcl_Release((ClientData) channel);
6204    
6205            tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
6206    
6207            channel = (Tcl_Channel) chanPtr;
6208        }
6209    }
6210    
6211    /*
6212     *----------------------------------------------------------------------
6213     *
6214     * UpdateInterest --
6215     *
6216     *      Arrange for the notifier to call us back at appropriate times
6217     *      based on the current state of the channel.
6218     *
6219     * Results:
6220     *      None.
6221     *
6222     * Side effects:
6223     *      May schedule a timer or driver handler.
6224     *
6225     *----------------------------------------------------------------------
6226     */
6227    
6228    static void
6229    UpdateInterest(chanPtr)
6230        Channel *chanPtr;           /* Channel to update. */
6231    {
6232        int mask = chanPtr->interestMask;
6233    
6234        /*
6235         * If there are flushed buffers waiting to be written, then
6236         * we need to watch for the channel to become writable.
6237         */
6238    
6239        if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
6240            mask |= TCL_WRITABLE;
6241        }
6242    
6243        /*
6244         * If there is data in the input queue, and we aren't waiting for more
6245         * data, then we need to schedule a timer so we don't block in the
6246         * notifier.  Also, cancel the read interest so we don't get duplicate
6247         * events.
6248         */
6249    
6250        if (mask & TCL_READABLE) {
6251            if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
6252                    && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
6253                    && (chanPtr->inQueueHead->nextRemoved <
6254                            chanPtr->inQueueHead->nextAdded)) {
6255                mask &= ~TCL_READABLE;
6256                if (!chanPtr->timer) {
6257                    chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
6258                            (ClientData) chanPtr);
6259                }
6260            }
6261        }
6262        (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
6263    }
6264    
6265    /*
6266     *----------------------------------------------------------------------
6267     *
6268     * ChannelTimerProc --
6269     *
6270     *      Timer handler scheduled by UpdateInterest to monitor the
6271     *      channel buffers until they are empty.
6272     *
6273     * Results:
6274     *      None.
6275     *
6276     * Side effects:
6277     *      May invoke channel handlers.
6278     *
6279     *----------------------------------------------------------------------
6280     */
6281    
6282    static void
6283    ChannelTimerProc(clientData)
6284        ClientData clientData;
6285    {
6286        Channel *chanPtr = (Channel *) clientData;
6287    
6288        if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
6289                && (chanPtr->interestMask & TCL_READABLE)
6290                && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
6291                && (chanPtr->inQueueHead->nextRemoved <
6292                        chanPtr->inQueueHead->nextAdded)) {
6293            /*
6294             * Restart the timer in case a channel handler reenters the
6295             * event loop before UpdateInterest gets called by Tcl_NotifyChannel.
6296             */
6297    
6298            chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
6299                            (ClientData) chanPtr);
6300            Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
6301    
6302       } else {
6303            chanPtr->timer = NULL;
6304            UpdateInterest(chanPtr);
6305        }
6306    }
6307    
6308    /*
6309     *----------------------------------------------------------------------
6310     *
6311     * Tcl_CreateChannelHandler --
6312     *
6313     *      Arrange for a given procedure to be invoked whenever the
6314     *      channel indicated by the chanPtr arg becomes readable or
6315     *      writable.
6316     *
6317     * Results:
6318     *      None.
6319     *
6320     * Side effects:
6321     *      From now on, whenever the I/O channel given by chanPtr becomes
6322     *      ready in the way indicated by mask, proc will be invoked.
6323     *      See the manual entry for details on the calling sequence
6324     *      to proc.  If there is already an event handler for chan, proc
6325     *      and clientData, then the mask will be updated.
6326     *
6327     *----------------------------------------------------------------------
6328     */
6329    
6330    void
6331    Tcl_CreateChannelHandler(chan, mask, proc, clientData)
6332        Tcl_Channel chan;           /* The channel to create the handler for. */
6333        int mask;                   /* OR'ed combination of TCL_READABLE,
6334                                     * TCL_WRITABLE, and TCL_EXCEPTION:
6335                                     * indicates conditions under which
6336                                     * proc should be called. Use 0 to
6337                                     * disable a registered handler. */
6338        Tcl_ChannelProc *proc;      /* Procedure to call for each
6339                                     * selected event. */
6340        ClientData clientData;      /* Arbitrary data to pass to proc. */
6341    {
6342        ChannelHandler *chPtr;
6343        Channel *chanPtr;
6344    
6345        chanPtr = (Channel *) chan;
6346        
6347        /*
6348         * Check whether this channel handler is not already registered. If
6349         * it is not, create a new record, else reuse existing record (smash
6350         * current values).
6351         */
6352    
6353        for (chPtr = chanPtr->chPtr;
6354                 chPtr != (ChannelHandler *) NULL;
6355                 chPtr = chPtr->nextPtr) {
6356            if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
6357                    (chPtr->clientData == clientData)) {
6358                break;
6359            }
6360        }
6361        if (chPtr == (ChannelHandler *) NULL) {
6362            chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
6363            chPtr->mask = 0;
6364            chPtr->proc = proc;
6365            chPtr->clientData = clientData;
6366            chPtr->chanPtr = chanPtr;
6367            chPtr->nextPtr = chanPtr->chPtr;
6368            chanPtr->chPtr = chPtr;
6369        }
6370    
6371        /*
6372         * The remainder of the initialization below is done regardless of
6373         * whether or not this is a new record or a modification of an old
6374         * one.
6375         */
6376    
6377        chPtr->mask = mask;
6378    
6379        /*
6380         * Recompute the interest mask for the channel - this call may actually
6381         * be disabling an existing handler.
6382         */
6383        
6384        chanPtr->interestMask = 0;
6385        for (chPtr = chanPtr->chPtr;
6386             chPtr != (ChannelHandler *) NULL;
6387             chPtr = chPtr->nextPtr) {
6388            chanPtr->interestMask |= chPtr->mask;
6389        }
6390    
6391        UpdateInterest(chanPtr);
6392    }
6393    
6394    /*
6395     *----------------------------------------------------------------------
6396     *
6397     * Tcl_DeleteChannelHandler --
6398     *
6399     *      Cancel a previously arranged callback arrangement for an IO
6400     *      channel.
6401     *
6402     * Results:
6403     *      None.
6404     *
6405     * Side effects:
6406     *      If a callback was previously registered for this chan, proc and
6407     *       clientData , it is removed and the callback will no longer be called
6408     *      when the channel becomes ready for IO.
6409     *
6410     *----------------------------------------------------------------------
6411     */
6412    
6413    void
6414    Tcl_DeleteChannelHandler(chan, proc, clientData)
6415        Tcl_Channel chan;           /* The channel for which to remove the
6416                                     * callback. */
6417        Tcl_ChannelProc *proc;      /* The procedure in the callback to delete. */
6418        ClientData clientData;      /* The client data in the callback
6419                                     * to delete. */
6420        
6421    {
6422        ChannelHandler *chPtr, *prevChPtr;
6423        Channel *chanPtr;
6424        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
6425        NextChannelHandler *nhPtr;
6426    
6427        chanPtr = (Channel *) chan;
6428    
6429        /*
6430         * Find the entry and the previous one in the list.
6431         */
6432    
6433        for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
6434                 chPtr != (ChannelHandler *) NULL;
6435                 chPtr = chPtr->nextPtr) {
6436            if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
6437                    && (chPtr->proc == proc)) {
6438                break;
6439            }
6440            prevChPtr = chPtr;
6441        }
6442        
6443        /*
6444         * If not found, return without doing anything.
6445         */
6446    
6447        if (chPtr == (ChannelHandler *) NULL) {
6448            return;
6449        }
6450    
6451        /*
6452         * If ChannelHandlerEventProc is about to process this handler, tell it to
6453         * process the next one instead - we are going to delete *this* one.
6454         */
6455    
6456        for (nhPtr = tsdPtr->nestedHandlerPtr;
6457                 nhPtr != (NextChannelHandler *) NULL;
6458                 nhPtr = nhPtr->nestedHandlerPtr) {
6459            if (nhPtr->nextHandlerPtr == chPtr) {
6460                nhPtr->nextHandlerPtr = chPtr->nextPtr;
6461            }
6462        }
6463    
6464        /*
6465         * Splice it out of the list of channel handlers.
6466         */
6467        
6468        if (prevChPtr == (ChannelHandler *) NULL) {
6469            chanPtr->chPtr = chPtr->nextPtr;
6470        } else {
6471            prevChPtr->nextPtr = chPtr->nextPtr;
6472        }
6473        ckfree((char *) chPtr);
6474    
6475        /*
6476         * Recompute the interest list for the channel, so that infinite loops
6477         * will not result if Tcl_DeleteChannelHandler is called inside an
6478         * event.
6479         */
6480    
6481        chanPtr->interestMask = 0;
6482        for (chPtr = chanPtr->chPtr;
6483                 chPtr != (ChannelHandler *) NULL;
6484                 chPtr = chPtr->nextPtr) {
6485            chanPtr->interestMask |= chPtr->mask;
6486        }
6487    
6488        UpdateInterest(chanPtr);
6489    }
6490    
6491    /*
6492     *----------------------------------------------------------------------
6493     *
6494     * DeleteScriptRecord --
6495     *
6496     *      Delete a script record for this combination of channel, interp
6497     *      and mask.
6498     *
6499     * Results:
6500     *      None.
6501     *
6502     * Side effects:
6503     *      Deletes a script record and cancels a channel event handler.
6504     *
6505     *----------------------------------------------------------------------
6506     */
6507    
6508    static void
6509    DeleteScriptRecord(interp, chanPtr, mask)
6510        Tcl_Interp *interp;         /* Interpreter in which script was to be
6511                                     * executed. */
6512        Channel *chanPtr;           /* The channel for which to delete the
6513                                     * script record (if any). */
6514        int mask;                   /* Events in mask must exactly match mask
6515                                     * of script to delete. */
6516    {
6517        EventScriptRecord *esPtr, *prevEsPtr;
6518    
6519        for (esPtr = chanPtr->scriptRecordPtr,
6520                 prevEsPtr = (EventScriptRecord *) NULL;
6521                 esPtr != (EventScriptRecord *) NULL;
6522                 prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
6523            if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6524                if (esPtr == chanPtr->scriptRecordPtr) {
6525                    chanPtr->scriptRecordPtr = esPtr->nextPtr;
6526                } else {
6527                    prevEsPtr->nextPtr = esPtr->nextPtr;
6528                }
6529    
6530                Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
6531                        ChannelEventScriptInvoker, (ClientData) esPtr);
6532                
6533                Tcl_DecrRefCount(esPtr->scriptPtr);
6534                ckfree((char *) esPtr);
6535    
6536                break;
6537            }
6538        }
6539    }
6540    
6541    /*
6542     *----------------------------------------------------------------------
6543     *
6544     * CreateScriptRecord --
6545     *
6546     *      Creates a record to store a script to be executed when a specific
6547     *      event fires on a specific channel.
6548     *
6549     * Results:
6550     *      None.
6551     *
6552     * Side effects:
6553     *      Causes the script to be stored for later execution.
6554     *
6555     *----------------------------------------------------------------------
6556     */
6557    
6558    static void
6559    CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
6560        Tcl_Interp *interp;                 /* Interpreter in which to execute
6561                                             * the stored script. */
6562        Channel *chanPtr;                   /* Channel for which script is to
6563                                             * be stored. */
6564        int mask;                           /* Set of events for which script
6565                                             * will be invoked. */
6566        Tcl_Obj *scriptPtr;                 /* Pointer to script object. */
6567    {
6568        EventScriptRecord *esPtr;
6569    
6570        for (esPtr = chanPtr->scriptRecordPtr;
6571                 esPtr != (EventScriptRecord *) NULL;
6572                 esPtr = esPtr->nextPtr) {
6573            if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6574                Tcl_DecrRefCount(esPtr->scriptPtr);
6575                esPtr->scriptPtr = (Tcl_Obj *) NULL;
6576                break;
6577            }
6578        }
6579        if (esPtr == (EventScriptRecord *) NULL) {
6580            esPtr = (EventScriptRecord *) ckalloc((unsigned)
6581                    sizeof(EventScriptRecord));
6582            Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
6583                    ChannelEventScriptInvoker, (ClientData) esPtr);
6584            esPtr->nextPtr = chanPtr->scriptRecordPtr;
6585            chanPtr->scriptRecordPtr = esPtr;
6586        }
6587        esPtr->chanPtr = chanPtr;
6588        esPtr->interp = interp;
6589        esPtr->mask = mask;
6590        Tcl_IncrRefCount(scriptPtr);
6591        esPtr->scriptPtr = scriptPtr;
6592    }
6593    
6594    /*
6595     *----------------------------------------------------------------------
6596     *
6597     * ChannelEventScriptInvoker --
6598     *
6599     *      Invokes a script scheduled by "fileevent" for when the channel
6600     *      becomes ready for IO. This function is invoked by the channel
6601     *      handler which was created by the Tcl "fileevent" command.
6602     *
6603     * Results:
6604     *      None.
6605     *
6606     * Side effects:
6607     *      Whatever the script does.
6608     *
6609     *----------------------------------------------------------------------
6610     */
6611    
6612    static void
6613    ChannelEventScriptInvoker(clientData, mask)
6614        ClientData clientData;      /* The script+interp record. */
6615        int mask;                   /* Not used. */
6616    {
6617        Tcl_Interp *interp;         /* Interpreter in which to eval the script. */
6618        Channel *chanPtr;           /* The channel for which this handler is
6619                                     * registered. */
6620        EventScriptRecord *esPtr;   /* The event script + interpreter to eval it
6621                                     * in. */
6622        int result;                 /* Result of call to eval script. */
6623    
6624        esPtr = (EventScriptRecord *) clientData;
6625    
6626        chanPtr = esPtr->chanPtr;
6627        mask = esPtr->mask;
6628        interp = esPtr->interp;
6629        
6630        /*
6631         * We must preserve the interpreter so we can report errors on it
6632         * later.  Note that we do not need to preserve the channel because
6633         * that is done by Tcl_NotifyChannel before calling channel handlers.
6634         */
6635        
6636        Tcl_Preserve((ClientData) interp);
6637        result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
6638    
6639        /*
6640         * On error, cause a background error and remove the channel handler
6641         * and the script record.
6642         *
6643         * NOTE: Must delete channel handler before causing the background error
6644         * because the background error may want to reinstall the handler.
6645         */
6646        
6647        if (result != TCL_OK) {
6648            if (chanPtr->typePtr != NULL) {
6649                DeleteScriptRecord(interp, chanPtr, mask);
6650            }
6651            Tcl_BackgroundError(interp);
6652        }
6653        Tcl_Release((ClientData) interp);
6654    }
6655    
6656    /*
6657     *----------------------------------------------------------------------
6658     *
6659     * Tcl_FileEventObjCmd --
6660     *
6661     *      This procedure implements the "fileevent" Tcl command. See the
6662     *      user documentation for details on what it does. This command is
6663     *      based on the Tk command "fileevent" which in turn is based on work
6664     *      contributed by Mark Diekhans.
6665     *
6666     * Results:
6667     *      A standard Tcl result.
6668     *
6669     * Side effects:
6670     *      May create a channel handler for the specified channel.
6671     *
6672     *----------------------------------------------------------------------
6673     */
6674    
6675            /* ARGSUSED */
6676    int
6677    Tcl_FileEventObjCmd(clientData, interp, objc, objv)
6678        ClientData clientData;              /* Not used. */
6679        Tcl_Interp *interp;                 /* Interpreter in which the channel
6680                                             * for which to create the handler
6681                                             * is found. */
6682        int objc;                           /* Number of arguments. */
6683        Tcl_Obj *CONST objv[];              /* Argument objects. */
6684    {
6685        Channel *chanPtr;                   /* The channel to create
6686                                             * the handler for. */
6687        Tcl_Channel chan;                   /* The opaque type for the channel. */
6688        char *chanName;
6689        int modeIndex;                      /* Index of mode argument. */
6690        int mask;
6691        static char *modeOptions[] = {"readable", "writable", NULL};
6692        static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
6693    
6694        if ((objc != 3) && (objc != 4)) {
6695            Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
6696            return TCL_ERROR;
6697        }
6698        if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
6699                &modeIndex) != TCL_OK) {
6700            return TCL_ERROR;
6701        }
6702        mask = maskArray[modeIndex];
6703    
6704        chanName = Tcl_GetString(objv[1]);
6705        chan = Tcl_GetChannel(interp, chanName, NULL);
6706        if (chan == (Tcl_Channel) NULL) {
6707            return TCL_ERROR;
6708        }
6709        chanPtr = (Channel *) chan;
6710        if ((chanPtr->flags & mask) == 0) {
6711            Tcl_AppendResult(interp, "channel is not ",
6712                    (mask == TCL_READABLE) ? "readable" : "writable",
6713                    (char *) NULL);
6714            return TCL_ERROR;
6715        }
6716        
6717        /*
6718         * If we are supposed to return the script, do so.
6719         */
6720    
6721        if (objc == 3) {
6722            EventScriptRecord *esPtr;
6723            for (esPtr = chanPtr->scriptRecordPtr;
6724                 esPtr != (EventScriptRecord *) NULL;
6725                 esPtr = esPtr->nextPtr) {
6726                if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6727                    Tcl_SetObjResult(interp, esPtr->scriptPtr);
6728                    break;
6729                }
6730            }
6731            return TCL_OK;
6732        }
6733    
6734        /*
6735         * If we are supposed to delete a stored script, do so.
6736         */
6737    
6738        if (*(Tcl_GetString(objv[3])) == '\0') {
6739            DeleteScriptRecord(interp, chanPtr, mask);
6740            return TCL_OK;
6741        }
6742    
6743        /*
6744         * Make the script record that will link between the event and the
6745         * script to invoke. This also creates a channel event handler which
6746         * will evaluate the script in the supplied interpreter.
6747         */
6748    
6749        CreateScriptRecord(interp, chanPtr, mask, objv[3]);
6750        
6751        return TCL_OK;
6752    }
6753    
6754    /*
6755     *----------------------------------------------------------------------
6756     *
6757     * TclTestChannelCmd --
6758     *
6759     *      Implements the Tcl "testchannel" debugging command and its
6760     *      subcommands. This is part of the testing environment but must be
6761     *      in this file instead of tclTest.c because it needs access to the
6762     *      fields of struct Channel.
6763     *
6764     * Results:
6765     *      A standard Tcl result.
6766     *
6767     * Side effects:
6768     *      None.
6769     *
6770     *----------------------------------------------------------------------
6771     */
6772    
6773            /* ARGSUSED */
6774    int
6775    TclTestChannelCmd(clientData, interp, argc, argv)
6776        ClientData clientData;      /* Not used. */
6777        Tcl_Interp *interp;         /* Interpreter for result. */
6778        int argc;                   /* Count of additional args. */
6779        char **argv;                /* Additional arg strings. */
6780    {
6781        char *cmdName;              /* Sub command. */
6782        Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
6783        Tcl_HashSearch hSearch;     /* Search variable. */
6784        Tcl_HashEntry *hPtr;        /* Search variable. */
6785        Channel *chanPtr;           /* The actual channel. */
6786        Tcl_Channel chan;           /* The opaque type. */
6787        size_t len;                 /* Length of subcommand string. */
6788        int IOQueued;               /* How much IO is queued inside channel? */
6789        ChannelBuffer *bufPtr;      /* For iterating over queued IO. */
6790        char buf[TCL_INTEGER_SPACE];/* For sprintf. */
6791        
6792        if (argc < 2) {
6793            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6794                    " subcommand ?additional args..?\"", (char *) NULL);
6795            return TCL_ERROR;
6796        }
6797        cmdName = argv[1];
6798        len = strlen(cmdName);
6799    
6800        chanPtr = (Channel *) NULL;
6801    
6802        if (argc > 2) {
6803            chan = Tcl_GetChannel(interp, argv[2], NULL);
6804            if (chan == (Tcl_Channel) NULL) {
6805                return TCL_ERROR;
6806            }
6807            chanPtr = (Channel *) chan;
6808        }
6809    
6810    
6811        if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
6812            if (argc != 3) {
6813                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6814                        " info channelName\"", (char *) NULL);
6815                return TCL_ERROR;
6816            }
6817            Tcl_AppendElement(interp, argv[2]);
6818            Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
6819            if (chanPtr->flags & TCL_READABLE) {
6820                Tcl_AppendElement(interp, "read");
6821            } else {
6822                Tcl_AppendElement(interp, "");
6823            }
6824            if (chanPtr->flags & TCL_WRITABLE) {
6825                Tcl_AppendElement(interp, "write");
6826            } else {
6827                Tcl_AppendElement(interp, "");
6828            }
6829            if (chanPtr->flags & CHANNEL_NONBLOCKING) {
6830                Tcl_AppendElement(interp, "nonblocking");
6831            } else {
6832                Tcl_AppendElement(interp, "blocking");
6833            }
6834            if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
6835                Tcl_AppendElement(interp, "line");
6836            } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
6837                Tcl_AppendElement(interp, "none");
6838            } else {
6839                Tcl_AppendElement(interp, "full");
6840            }
6841            if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
6842                Tcl_AppendElement(interp, "async_flush");
6843            } else {
6844                Tcl_AppendElement(interp, "");
6845            }
6846            if (chanPtr->flags & CHANNEL_EOF) {
6847                Tcl_AppendElement(interp, "eof");
6848            } else {
6849                Tcl_AppendElement(interp, "");
6850            }
6851            if (chanPtr->flags & CHANNEL_BLOCKED) {
6852                Tcl_AppendElement(interp, "blocked");
6853            } else {
6854                Tcl_AppendElement(interp, "unblocked");
6855            }
6856            if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
6857                Tcl_AppendElement(interp, "auto");
6858                if (chanPtr->flags & INPUT_SAW_CR) {
6859                    Tcl_AppendElement(interp, "saw_cr");
6860                } else {
6861                    Tcl_AppendElement(interp, "");
6862                }
6863            } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
6864                Tcl_AppendElement(interp, "lf");
6865                Tcl_AppendElement(interp, "");
6866            } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
6867                Tcl_AppendElement(interp, "cr");
6868                Tcl_AppendElement(interp, "");
6869            } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
6870                Tcl_AppendElement(interp, "crlf");
6871                if (chanPtr->flags & INPUT_SAW_CR) {
6872                    Tcl_AppendElement(interp, "queued_cr");
6873                } else {
6874                    Tcl_AppendElement(interp, "");
6875                }
6876            }
6877            if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
6878                Tcl_AppendElement(interp, "auto");
6879            } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
6880                Tcl_AppendElement(interp, "lf");
6881            } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
6882                Tcl_AppendElement(interp, "cr");
6883            } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
6884                Tcl_AppendElement(interp, "crlf");
6885            }
6886            for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
6887                     bufPtr != (ChannelBuffer *) NULL;
6888                     bufPtr = bufPtr->nextPtr) {
6889                IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
6890            }
6891            TclFormatInt(buf, IOQueued);
6892            Tcl_AppendElement(interp, buf);
6893            
6894            IOQueued = 0;
6895            if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
6896                IOQueued = chanPtr->curOutPtr->nextAdded -
6897                    chanPtr->curOutPtr->nextRemoved;
6898            }
6899            for (bufPtr = chanPtr->outQueueHead;
6900                     bufPtr != (ChannelBuffer *) NULL;
6901                     bufPtr = bufPtr->nextPtr) {
6902                IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
6903            }
6904            TclFormatInt(buf, IOQueued);
6905            Tcl_AppendElement(interp, buf);
6906            
6907            TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
6908            Tcl_AppendElement(interp, buf);
6909    
6910            TclFormatInt(buf, chanPtr->refCount);
6911            Tcl_AppendElement(interp, buf);
6912    
6913            return TCL_OK;
6914        }
6915    
6916        if ((cmdName[0] == 'i') &&
6917                (strncmp(cmdName, "inputbuffered", len) == 0)) {
6918            if (argc != 3) {
6919                Tcl_AppendResult(interp, "channel name required",
6920                        (char *) NULL);
6921                return TCL_ERROR;
6922            }
6923            
6924            for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
6925                     bufPtr != (ChannelBuffer *) NULL;
6926                     bufPtr = bufPtr->nextPtr) {
6927                IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
6928            }
6929            TclFormatInt(buf, IOQueued);
6930            Tcl_AppendResult(interp, buf, (char *) NULL);
6931            return TCL_OK;
6932        }
6933            
6934        if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
6935            if (argc != 3) {
6936                Tcl_AppendResult(interp, "channel name required",
6937                        (char *) NULL);
6938                return TCL_ERROR;
6939            }
6940            
6941            if (chanPtr->flags & TCL_READABLE) {
6942                Tcl_AppendElement(interp, "read");
6943            } else {
6944                Tcl_AppendElement(interp, "");
6945            }
6946            if (chanPtr->flags & TCL_WRITABLE) {
6947                Tcl_AppendElement(interp, "write");
6948            } else {
6949                Tcl_AppendElement(interp, "");
6950            }
6951            return TCL_OK;
6952        }
6953        
6954        if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
6955            if (argc != 3) {
6956                Tcl_AppendResult(interp, "channel name required",
6957                        (char *) NULL);
6958                return TCL_ERROR;
6959            }
6960            Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
6961            return TCL_OK;
6962        }
6963        
6964        if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
6965            hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
6966            if (hTblPtr == (Tcl_HashTable *) NULL) {
6967                return TCL_OK;
6968            }
6969            for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
6970                     hPtr != (Tcl_HashEntry *) NULL;
6971                     hPtr = Tcl_NextHashEntry(&hSearch)) {
6972                Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
6973            }
6974            return TCL_OK;
6975        }
6976    
6977        if ((cmdName[0] == 'o') &&
6978                (strncmp(cmdName, "outputbuffered", len) == 0)) {
6979            if (argc != 3) {
6980                Tcl_AppendResult(interp, "channel name required",
6981                        (char *) NULL);
6982                return TCL_ERROR;
6983            }
6984            
6985            IOQueued = 0;
6986            if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
6987                IOQueued = chanPtr->curOutPtr->nextAdded -
6988                    chanPtr->curOutPtr->nextRemoved;
6989            }
6990            for (bufPtr = chanPtr->outQueueHead;
6991                     bufPtr != (ChannelBuffer *) NULL;
6992                     bufPtr = bufPtr->nextPtr) {
6993                IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
6994            }
6995            TclFormatInt(buf, IOQueued);
6996            Tcl_AppendResult(interp, buf, (char *) NULL);
6997            return TCL_OK;
6998        }
6999            
7000        if ((cmdName[0] == 'q') &&
7001                (strncmp(cmdName, "queuedcr", len) == 0)) {
7002            if (argc != 3) {
7003                Tcl_AppendResult(interp, "channel name required",
7004                        (char *) NULL);
7005                return TCL_ERROR;
7006            }
7007            
7008            Tcl_AppendResult(interp,
7009                    (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
7010                    (char *) NULL);
7011            return TCL_OK;
7012        }
7013        
7014        if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
7015            hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
7016            if (hTblPtr == (Tcl_HashTable *) NULL) {
7017                return TCL_OK;
7018            }
7019            for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
7020                     hPtr != (Tcl_HashEntry *) NULL;
7021                     hPtr = Tcl_NextHashEntry(&hSearch)) {
7022                chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
7023                if (chanPtr->flags & TCL_READABLE) {
7024                    Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
7025                }
7026            }
7027            return TCL_OK;
7028        }
7029    
7030        if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
7031            if (argc != 3) {
7032                Tcl_AppendResult(interp, "channel name required",
7033                        (char *) NULL);
7034                return TCL_ERROR;
7035            }
7036            
7037            TclFormatInt(buf, chanPtr->refCount);
7038            Tcl_AppendResult(interp, buf, (char *) NULL);
7039            return TCL_OK;
7040        }
7041        
7042        if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
7043            if (argc != 3) {
7044                Tcl_AppendResult(interp, "channel name required",
7045                        (char *) NULL);
7046                return TCL_ERROR;
7047            }
7048            Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
7049            return TCL_OK;
7050        }
7051        
7052        if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
7053            hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
7054            if (hTblPtr == (Tcl_HashTable *) NULL) {
7055                return TCL_OK;
7056            }
7057            for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
7058                     hPtr != (Tcl_HashEntry *) NULL;
7059                     hPtr = Tcl_NextHashEntry(&hSearch)) {
7060                chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
7061                if (chanPtr->flags & TCL_WRITABLE) {
7062                    Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
7063                }
7064            }
7065            return TCL_OK;
7066        }
7067    
7068        Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
7069                "info, open, readable, or writable",
7070                (char *) NULL);
7071        return TCL_ERROR;
7072    }
7073    
7074    /*
7075     *----------------------------------------------------------------------
7076     *
7077     * TclTestChannelEventCmd --
7078     *
7079     *      This procedure implements the "testchannelevent" command. It is
7080     *      used to test the Tcl channel event mechanism. It is present in
7081     *      this file instead of tclTest.c because it needs access to the
7082     *      internal structure of the channel.
7083     *
7084     * Results:
7085     *      A standard Tcl result.
7086     *
7087     * Side effects:
7088     *      Creates, deletes and returns channel event handlers.
7089     *
7090     *----------------------------------------------------------------------
7091     */
7092    
7093            /* ARGSUSED */
7094    int
7095    TclTestChannelEventCmd(dummy, interp, argc, argv)
7096        ClientData dummy;                   /* Not used. */
7097        Tcl_Interp *interp;                 /* Current interpreter. */
7098        int argc;                           /* Number of arguments. */
7099        char **argv;                        /* Argument strings. */
7100    {
7101        Tcl_Obj *resultListPtr;
7102        Channel *chanPtr;
7103        EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
7104        char *cmd;
7105        int index, i, mask, len;
7106    
7107        if ((argc < 3) || (argc > 5)) {
7108            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7109                    " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
7110            return TCL_ERROR;
7111        }
7112        chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
7113        if (chanPtr == (Channel *) NULL) {
7114            return TCL_ERROR;
7115        }
7116        cmd = argv[2];
7117        len = strlen(cmd);
7118        if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
7119            if (argc != 5) {
7120                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7121                        " channelName add eventSpec script\"", (char *) NULL);
7122                return TCL_ERROR;
7123            }
7124            if (strcmp(argv[3], "readable") == 0) {
7125                mask = TCL_READABLE;
7126            } else if (strcmp(argv[3], "writable") == 0) {
7127                mask = TCL_WRITABLE;
7128            } else if (strcmp(argv[3], "none") == 0) {
7129                mask = 0;
7130            } else {
7131                Tcl_AppendResult(interp, "bad event name \"", argv[3],
7132                        "\": must be readable, writable, or none", (char *) NULL);
7133                return TCL_ERROR;
7134            }
7135    
7136            esPtr = (EventScriptRecord *) ckalloc((unsigned)
7137                    sizeof(EventScriptRecord));
7138            esPtr->nextPtr = chanPtr->scriptRecordPtr;
7139            chanPtr->scriptRecordPtr = esPtr;
7140            
7141            esPtr->chanPtr = chanPtr;
7142            esPtr->interp = interp;
7143            esPtr->mask = mask;
7144            esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
7145            Tcl_IncrRefCount(esPtr->scriptPtr);
7146    
7147            Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
7148                    ChannelEventScriptInvoker, (ClientData) esPtr);
7149            
7150            return TCL_OK;
7151        }
7152    
7153        if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
7154            if (argc != 4) {
7155                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7156                        " channelName delete index\"", (char *) NULL);
7157                return TCL_ERROR;
7158            }
7159            if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
7160                return TCL_ERROR;
7161            }
7162            if (index < 0) {
7163                Tcl_AppendResult(interp, "bad event index: ", argv[3],
7164                        ": must be nonnegative", (char *) NULL);
7165                return TCL_ERROR;
7166            }
7167            for (i = 0, esPtr = chanPtr->scriptRecordPtr;
7168                     (i < index) && (esPtr != (EventScriptRecord *) NULL);
7169                     i++, esPtr = esPtr->nextPtr) {
7170                /* Empty loop body. */
7171            }
7172            if (esPtr == (EventScriptRecord *) NULL) {
7173                Tcl_AppendResult(interp, "bad event index ", argv[3],
7174                        ": out of range", (char *) NULL);
7175                return TCL_ERROR;
7176            }
7177            if (esPtr == chanPtr->scriptRecordPtr) {
7178                chanPtr->scriptRecordPtr = esPtr->nextPtr;
7179            } else {
7180                for (prevEsPtr = chanPtr->scriptRecordPtr;
7181                         (prevEsPtr != (EventScriptRecord *) NULL) &&
7182                             (prevEsPtr->nextPtr != esPtr);
7183                         prevEsPtr = prevEsPtr->nextPtr) {
7184                    /* Empty loop body. */
7185                }
7186                if (prevEsPtr == (EventScriptRecord *) NULL) {
7187                    panic("TclTestChannelEventCmd: damaged event script list");
7188                }
7189                prevEsPtr->nextPtr = esPtr->nextPtr;
7190            }
7191            Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
7192                    ChannelEventScriptInvoker, (ClientData) esPtr);
7193            Tcl_DecrRefCount(esPtr->scriptPtr);
7194            ckfree((char *) esPtr);
7195    
7196            return TCL_OK;
7197        }
7198    
7199        if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
7200            if (argc != 3) {
7201                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7202                        " channelName list\"", (char *) NULL);
7203                return TCL_ERROR;
7204            }
7205            resultListPtr = Tcl_GetObjResult(interp);
7206            for (esPtr = chanPtr->scriptRecordPtr;
7207                     esPtr != (EventScriptRecord *) NULL;
7208                     esPtr = esPtr->nextPtr) {
7209                if (esPtr->mask) {
7210                    Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
7211                        (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
7212                } else {
7213                    Tcl_ListObjAppendElement(interp, resultListPtr,
7214                        Tcl_NewStringObj("none", -1));
7215                }
7216                Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
7217            }
7218            Tcl_SetObjResult(interp, resultListPtr);
7219            return TCL_OK;
7220        }
7221    
7222        if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
7223            if (argc != 3) {
7224                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7225                        " channelName removeall\"", (char *) NULL);
7226                return TCL_ERROR;
7227            }
7228            for (esPtr = chanPtr->scriptRecordPtr;
7229                     esPtr != (EventScriptRecord *) NULL;
7230                     esPtr = nextEsPtr) {
7231                nextEsPtr = esPtr->nextPtr;
7232                Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
7233                        ChannelEventScriptInvoker, (ClientData) esPtr);
7234                Tcl_DecrRefCount(esPtr->scriptPtr);
7235                ckfree((char *) esPtr);
7236            }
7237            chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
7238            return TCL_OK;
7239        }
7240    
7241        if  ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
7242            if (argc != 5) {
7243                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7244                        " channelName delete index event\"", (char *) NULL);
7245                return TCL_ERROR;
7246            }
7247            if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
7248                return TCL_ERROR;
7249            }
7250            if (index < 0) {
7251                Tcl_AppendResult(interp, "bad event index: ", argv[3],
7252                        ": must be nonnegative", (char *) NULL);
7253                return TCL_ERROR;
7254            }
7255            for (i = 0, esPtr = chanPtr->scriptRecordPtr;
7256                     (i < index) && (esPtr != (EventScriptRecord *) NULL);
7257                     i++, esPtr = esPtr->nextPtr) {
7258                /* Empty loop body. */
7259            }
7260            if (esPtr == (EventScriptRecord *) NULL) {
7261                Tcl_AppendResult(interp, "bad event index ", argv[3],
7262                        ": out of range", (char *) NULL);
7263                return TCL_ERROR;
7264            }
7265    
7266            if (strcmp(argv[4], "readable") == 0) {
7267                mask = TCL_READABLE;
7268            } else if (strcmp(argv[4], "writable") == 0) {
7269                mask = TCL_WRITABLE;
7270            } else if (strcmp(argv[4], "none") == 0) {
7271                mask = 0;
7272            } else {
7273                Tcl_AppendResult(interp, "bad event name \"", argv[4],
7274                        "\": must be readable, writable, or none", (char *) NULL);
7275                return TCL_ERROR;
7276            }
7277            esPtr->mask = mask;
7278            Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
7279                    ChannelEventScriptInvoker, (ClientData) esPtr);
7280            return TCL_OK;
7281        }    
7282        Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
7283                "add, delete, list, set, or removeall", (char *) NULL);
7284        return TCL_ERROR;
7285    }
7286    
7287    /*
7288     *----------------------------------------------------------------------
7289     *
7290     * TclCopyChannel --
7291     *
7292     *      This routine copies data from one channel to another, either
7293     *      synchronously or asynchronously.  If a command script is
7294     *      supplied, the operation runs in the background.  The script
7295     *      is invoked when the copy completes.  Otherwise the function
7296     *      waits until the copy is completed before returning.
7297     *
7298     * Results:
7299     *      A standard Tcl result.
7300     *
7301     * Side effects:
7302     *      May schedule a background copy operation that causes both
7303     *      channels to be marked busy.
7304     *
7305     *----------------------------------------------------------------------
7306     */
7307    
7308    int
7309    TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
7310        Tcl_Interp *interp;         /* Current interpreter. */
7311        Tcl_Channel inChan;         /* Channel to read from. */
7312        Tcl_Channel outChan;        /* Channel to write to. */
7313        int toRead;                 /* Amount of data to copy, or -1 for all. */
7314        Tcl_Obj *cmdPtr;            /* Pointer to script to execute or NULL. */
7315    {
7316        Channel *inPtr = (Channel *) inChan;
7317        Channel *outPtr = (Channel *) outChan;
7318        int readFlags, writeFlags;
7319        CopyState *csPtr;
7320        int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
7321    
7322        if (inPtr->csPtr) {
7323            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7324                    Tcl_GetChannelName(inChan), "\" is busy", NULL);
7325            return TCL_ERROR;
7326        }
7327        if (outPtr->csPtr) {
7328            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7329                    Tcl_GetChannelName(outChan), "\" is busy", NULL);
7330            return TCL_ERROR;
7331        }
7332    
7333        readFlags = inPtr->flags;
7334        writeFlags = outPtr->flags;
7335    
7336        /*
7337         * Set up the blocking mode appropriately.  Background copies need
7338         * non-blocking channels.  Foreground copies need blocking channels.
7339         * If there is an error, restore the old blocking mode.
7340         */
7341    
7342        if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7343            if (SetBlockMode(interp, inPtr,
7344                    nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
7345                    != TCL_OK) {
7346                return TCL_ERROR;
7347            }
7348        }      
7349        if (inPtr != outPtr) {
7350            if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
7351                if (SetBlockMode(NULL, outPtr,
7352                        nonBlocking ? TCL_MODE_BLOCKING : TCL_MODE_NONBLOCKING)
7353                        != TCL_OK) {
7354                    if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7355                        SetBlockMode(NULL, inPtr,
7356                                (readFlags & CHANNEL_NONBLOCKING)
7357                                ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
7358                        return TCL_ERROR;
7359                    }
7360                }
7361            }
7362        }
7363    
7364        /*
7365         * Make sure the output side is unbuffered.
7366         */
7367    
7368        outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))
7369            | CHANNEL_UNBUFFERED;
7370    
7371        /*
7372         * Allocate a new CopyState to maintain info about the current copy in
7373         * progress.  This structure will be deallocated when the copy is
7374         * completed.
7375         */
7376    
7377        csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);
7378        csPtr->bufSize = inPtr->bufSize;
7379        csPtr->readPtr = inPtr;
7380        csPtr->writePtr = outPtr;
7381        csPtr->readFlags = readFlags;
7382        csPtr->writeFlags = writeFlags;
7383        csPtr->toRead = toRead;
7384        csPtr->total = 0;
7385        csPtr->interp = interp;
7386        if (cmdPtr) {
7387            Tcl_IncrRefCount(cmdPtr);
7388        }
7389        csPtr->cmdPtr = cmdPtr;
7390        inPtr->csPtr = csPtr;
7391        outPtr->csPtr = csPtr;
7392    
7393        /*
7394         * Start copying data between the channels.
7395         */
7396    
7397        return CopyData(csPtr, 0);
7398    }
7399    
7400    /*
7401     *----------------------------------------------------------------------
7402     *
7403     * CopyData --
7404     *
7405     *      This function implements the lowest level of the copying
7406     *      mechanism for TclCopyChannel.
7407     *
7408     * Results:
7409     *      Returns TCL_OK on success, else TCL_ERROR.
7410     *
7411     * Side effects:
7412     *      Moves data between channels, may create channel handlers.
7413     *
7414     *----------------------------------------------------------------------
7415     */
7416    
7417    static int
7418    CopyData(csPtr, mask)
7419        CopyState *csPtr;           /* State of copy operation. */
7420        int mask;                   /* Current channel event flags. */
7421    {
7422        Tcl_Interp *interp;
7423        Tcl_Obj *cmdPtr, *errObj = NULL;
7424        Tcl_Channel inChan, outChan;
7425        int result = TCL_OK;
7426        int size;
7427        int total;
7428    
7429        inChan = (Tcl_Channel)csPtr->readPtr;
7430        outChan = (Tcl_Channel)csPtr->writePtr;
7431        interp = csPtr->interp;
7432        cmdPtr = csPtr->cmdPtr;
7433    
7434        /*
7435         * Copy the data the slow way, using the translation mechanism.
7436         */
7437    
7438        while (csPtr->toRead != 0) {
7439    
7440            /*
7441             * Check for unreported background errors.
7442             */
7443    
7444            if (csPtr->readPtr->unreportedError != 0) {
7445                Tcl_SetErrno(csPtr->readPtr->unreportedError);
7446                csPtr->readPtr->unreportedError = 0;
7447                goto readError;
7448            }
7449            if (csPtr->writePtr->unreportedError != 0) {
7450                Tcl_SetErrno(csPtr->writePtr->unreportedError);
7451                csPtr->writePtr->unreportedError = 0;
7452                goto writeError;
7453            }
7454            
7455            /*
7456             * Read up to bufSize bytes.
7457             */
7458    
7459            if ((csPtr->toRead == -1)
7460                    || (csPtr->toRead > csPtr->bufSize)) {
7461                size = csPtr->bufSize;
7462            } else {
7463                size = csPtr->toRead;
7464            }
7465            size = DoRead(csPtr->readPtr, csPtr->buffer, size);
7466    
7467            if (size < 0) {
7468                readError:
7469                errObj = Tcl_NewObj();
7470                Tcl_AppendStringsToObj(errObj, "error reading \"",
7471                        Tcl_GetChannelName(inChan), "\": ",
7472                        Tcl_PosixError(interp), (char *) NULL);
7473                break;
7474            } else if (size == 0) {
7475                /*
7476                 * We had an underflow on the read side.  If we are at EOF,
7477                 * then the copying is done, otherwise set up a channel
7478                 * handler to detect when the channel becomes readable again.
7479                 */
7480                
7481                if (Tcl_Eof(inChan)) {
7482                    break;
7483                } else if (!(mask & TCL_READABLE)) {
7484                    if (mask & TCL_WRITABLE) {
7485                        Tcl_DeleteChannelHandler(outChan, CopyEventProc,
7486                                (ClientData) csPtr);
7487                    }
7488                    Tcl_CreateChannelHandler(inChan, TCL_READABLE,
7489                            CopyEventProc, (ClientData) csPtr);
7490                }
7491                return TCL_OK;
7492            }
7493    
7494            /*
7495             * Now write the buffer out.
7496             */
7497    
7498            size = DoWrite(csPtr->writePtr, csPtr->buffer, size);
7499            if (size < 0) {
7500                writeError:
7501                errObj = Tcl_NewObj();
7502                Tcl_AppendStringsToObj(errObj, "error writing \"",
7503                        Tcl_GetChannelName(outChan), "\": ",
7504                        Tcl_PosixError(interp), (char *) NULL);
7505                break;
7506            }
7507    
7508            /*
7509             * Check to see if the write is happening in the background.  If so,
7510             * stop copying and wait for the channel to become writable again.
7511             */
7512    
7513            if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {
7514                if (!(mask & TCL_WRITABLE)) {
7515                    if (mask & TCL_READABLE) {
7516                        Tcl_DeleteChannelHandler(outChan, CopyEventProc,
7517                                (ClientData) csPtr);
7518                    }
7519                    Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7520                            CopyEventProc, (ClientData) csPtr);
7521                }
7522                return TCL_OK;
7523            }
7524    
7525            /*
7526             * Update the current byte count if we care.
7527             */
7528    
7529            if (csPtr->toRead != -1) {
7530                csPtr->toRead -= size;
7531            }
7532            csPtr->total += size;
7533    
7534            /*
7535             * For background copies, we only do one buffer per invocation so
7536             * we don't starve the rest of the system.
7537             */
7538    
7539            if (cmdPtr) {
7540                /*
7541                 * The first time we enter this code, there won't be a
7542                 * channel handler established yet, so do it here.
7543                 */
7544    
7545                if (mask == 0) {
7546                    Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7547                            CopyEventProc, (ClientData) csPtr);
7548                }
7549                return TCL_OK;
7550            }
7551        }
7552    
7553        /*
7554         * Make the callback or return the number of bytes transferred.
7555         * The local total is used because StopCopy frees csPtr.
7556         */
7557    
7558        total = csPtr->total;
7559        if (cmdPtr) {
7560            /*
7561             * Get a private copy of the command so we can mutate it
7562             * by adding arguments.  Note that StopCopy frees our saved
7563             * reference to the original command obj.
7564             */
7565    
7566            cmdPtr = Tcl_DuplicateObj(cmdPtr);
7567            Tcl_IncrRefCount(cmdPtr);
7568            StopCopy(csPtr);
7569            Tcl_Preserve((ClientData) interp);
7570    
7571            Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
7572            if (errObj) {
7573                Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
7574            }
7575            if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
7576                Tcl_BackgroundError(interp);
7577                result = TCL_ERROR;
7578            }
7579            Tcl_DecrRefCount(cmdPtr);
7580            Tcl_Release((ClientData) interp);
7581        } else {
7582            StopCopy(csPtr);
7583            if (errObj) {
7584                Tcl_SetObjResult(interp, errObj);
7585                result = TCL_ERROR;
7586            } else {
7587                Tcl_ResetResult(interp);
7588                Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
7589            }
7590        }
7591        return result;
7592    }
7593    
7594    /*
7595     *----------------------------------------------------------------------
7596     *
7597     * DoRead --
7598     *
7599     *      Reads a given number of bytes from a channel.
7600     *
7601     * Results:
7602     *      The number of characters read, or -1 on error. Use Tcl_GetErrno()
7603     *      to retrieve the error code for the error that occurred.
7604     *
7605     * Side effects:
7606     *      May cause input to be buffered.
7607     *
7608     *----------------------------------------------------------------------
7609     */
7610    
7611    static int
7612    DoRead(chanPtr, bufPtr, toRead)
7613        Channel *chanPtr;           /* The channel from which to read. */
7614        char *bufPtr;               /* Where to store input read. */
7615        int toRead;                 /* Maximum number of bytes to read. */
7616    {
7617        int copied;                 /* How many characters were copied into
7618                                     * the result string? */
7619        int copiedNow;              /* How many characters were copied from
7620                                     * the current input buffer? */
7621        int result;                 /* Of calling GetInput. */
7622        
7623        /*
7624         * If we have not encountered a sticky EOF, clear the EOF bit. Either
7625         * way clear the BLOCKED bit. We want to discover these anew during
7626         * each operation.
7627         */
7628    
7629        if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
7630            chanPtr->flags &= ~CHANNEL_EOF;
7631        }
7632        chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
7633        
7634        for (copied = 0; copied < toRead; copied += copiedNow) {
7635            copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
7636                    toRead - copied);
7637            if (copiedNow == 0) {
7638                if (chanPtr->flags & CHANNEL_EOF) {
7639                    goto done;
7640                }
7641                if (chanPtr->flags & CHANNEL_BLOCKED) {
7642                    if (chanPtr->flags & CHANNEL_NONBLOCKING) {
7643                        goto done;
7644                    }
7645                    chanPtr->flags &= (~(CHANNEL_BLOCKED));
7646                }
7647                result = GetInput(chanPtr);
7648                if (result != 0) {
7649                    if (result != EAGAIN) {
7650                        copied = -1;
7651                    }
7652                    goto done;
7653                }
7654            }
7655        }
7656    
7657        chanPtr->flags &= (~(CHANNEL_BLOCKED));
7658    
7659        done:
7660        /*
7661         * Update the notifier state so we don't block while there is still
7662         * data in the buffers.
7663         */
7664    
7665        UpdateInterest(chanPtr);
7666        return copied;
7667    }
7668    
7669    /*
7670     *----------------------------------------------------------------------
7671     *
7672     * CopyAndTranslateBuffer --
7673     *
7674     *      Copy at most one buffer of input to the result space, doing
7675     *      eol translations according to mode in effect currently.
7676     *
7677     * Results:
7678     *      Number of bytes stored in the result buffer (as opposed to the
7679     *      number of bytes read from the channel).  May return
7680     *      zero if no input is available to be translated.
7681     *
7682     * Side effects:
7683     *      Consumes buffered input. May deallocate one buffer.
7684     *
7685     *----------------------------------------------------------------------
7686     */
7687    
7688    static int
7689    CopyAndTranslateBuffer(chanPtr, result, space)
7690        Channel *chanPtr;           /* The channel from which to read input. */
7691        char *result;               /* Where to store the copied input. */
7692        int space;                  /* How many bytes are available in result
7693                                     * to store the copied input? */
7694    {
7695        int bytesInBuffer;          /* How many bytes are available to be
7696                                     * copied in the current input buffer? */
7697        int copied;                 /* How many characters were already copied
7698                                     * into the destination space? */
7699        ChannelBuffer *bufPtr;      /* The buffer from which to copy bytes. */
7700        int i;                      /* Iterates over the copied input looking
7701                                     * for the input eofChar. */
7702        
7703        /*
7704         * If there is no input at all, return zero. The invariant is that either
7705         * there is no buffer in the queue, or if the first buffer is empty, it
7706         * is also the last buffer (and thus there is no input in the queue).
7707         * Note also that if the buffer is empty, we leave it in the queue.
7708         */
7709        
7710        if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
7711            return 0;
7712        }
7713        bufPtr = chanPtr->inQueueHead;
7714        bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
7715    
7716        copied = 0;
7717        switch (chanPtr->inputTranslation) {
7718            case TCL_TRANSLATE_LF: {
7719                if (bytesInBuffer == 0) {
7720                    return 0;
7721                }
7722    
7723                /*
7724                 * Copy the current chunk into the result buffer.
7725                 */
7726    
7727                if (bytesInBuffer < space) {
7728                    space = bytesInBuffer;
7729                }
7730                memcpy((VOID *) result,
7731                        (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7732                        (size_t) space);
7733                bufPtr->nextRemoved += space;
7734                copied = space;
7735                break;
7736            }
7737            case TCL_TRANSLATE_CR: {
7738                char *end;
7739                
7740                if (bytesInBuffer == 0) {
7741                    return 0;
7742                }
7743    
7744                /*
7745                 * Copy the current chunk into the result buffer, then
7746                 * replace all \r with \n.
7747                 */
7748    
7749                if (bytesInBuffer < space) {
7750                    space = bytesInBuffer;
7751                }
7752                memcpy((VOID *) result,
7753                        (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7754                        (size_t) space);
7755                bufPtr->nextRemoved += space;
7756                copied = space;
7757    
7758                for (end = result + copied; result < end; result++) {
7759                    if (*result == '\r') {
7760                        *result = '\n';
7761                    }
7762                }
7763                break;
7764            }
7765            case TCL_TRANSLATE_CRLF: {
7766                char *src, *end, *dst;
7767                int curByte;
7768                
7769                /*
7770                 * If there is a held-back "\r" at EOF, produce it now.
7771                 */
7772                
7773                if (bytesInBuffer == 0) {
7774                    if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
7775                            (INPUT_SAW_CR | CHANNEL_EOF)) {
7776                        result[0] = '\r';
7777                        chanPtr->flags &= ~INPUT_SAW_CR;
7778                        return 1;
7779                    }
7780                    return 0;
7781                }
7782    
7783                /*
7784                 * Copy the current chunk and replace "\r\n" with "\n"
7785                 * (but not standalone "\r"!).
7786                 */
7787    
7788                if (bytesInBuffer < space) {
7789                    space = bytesInBuffer;
7790                }
7791                memcpy((VOID *) result,
7792                        (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7793                        (size_t) space);
7794                bufPtr->nextRemoved += space;
7795                copied = space;
7796    
7797                end = result + copied;
7798                dst = result;
7799                for (src = result; src < end; src++) {
7800                    curByte = *src;
7801                    if (curByte == '\n') {
7802                        chanPtr->flags &= ~INPUT_SAW_CR;
7803                    } else if (chanPtr->flags & INPUT_SAW_CR) {
7804                        chanPtr->flags &= ~INPUT_SAW_CR;
7805                        *dst = '\r';
7806                        dst++;
7807                    }
7808                    if (curByte == '\r') {
7809                        chanPtr->flags |= INPUT_SAW_CR;
7810                    } else {
7811                        *dst = (char) curByte;
7812                        dst++;
7813                    }
7814                }
7815                copied = dst - result;
7816                break;
7817            }
7818            case TCL_TRANSLATE_AUTO: {
7819                char *src, *end, *dst;
7820                int curByte;
7821            
7822                if (bytesInBuffer == 0) {
7823                    return 0;
7824                }
7825    
7826                /*
7827                 * Loop over the current buffer, converting "\r" and "\r\n"
7828                 * to "\n".
7829                 */
7830    
7831                if (bytesInBuffer < space) {
7832                    space = bytesInBuffer;
7833                }
7834                memcpy((VOID *) result,
7835                        (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7836                        (size_t) space);
7837                bufPtr->nextRemoved += space;
7838                copied = space;
7839    
7840                end = result + copied;
7841                dst = result;
7842                for (src = result; src < end; src++) {
7843                    curByte = *src;
7844                    if (curByte == '\r') {
7845                        chanPtr->flags |= INPUT_SAW_CR;
7846                        *dst = '\n';
7847                        dst++;
7848                    } else {
7849                        if ((curByte != '\n') ||
7850                                !(chanPtr->flags & INPUT_SAW_CR)) {
7851                            *dst = (char) curByte;
7852                            dst++;
7853                        }
7854                        chanPtr->flags &= ~INPUT_SAW_CR;
7855                    }
7856                }
7857                copied = dst - result;
7858                break;
7859            }
7860            default: {
7861                panic("unknown eol translation mode");
7862            }
7863        }
7864    
7865        /*
7866         * If an in-stream EOF character is set for this channel, check that
7867         * the input we copied so far does not contain the EOF char.  If it does,
7868         * copy only up to and excluding that character.
7869         */
7870        
7871        if (chanPtr->inEofChar != 0) {
7872            for (i = 0; i < copied; i++) {
7873                if (result[i] == (char) chanPtr->inEofChar) {
7874                    /*
7875                     * Set sticky EOF so that no further input is presented
7876                     * to the caller.
7877                     */
7878                    
7879                    chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
7880                    chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
7881                    copied = i;
7882                    break;
7883                }
7884            }
7885        }
7886    
7887        /*
7888         * If the current buffer is empty recycle it.
7889         */
7890    
7891        if (bufPtr->nextRemoved == bufPtr->nextAdded) {
7892            chanPtr->inQueueHead = bufPtr->nextPtr;
7893            if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
7894                chanPtr->inQueueTail = (ChannelBuffer *) NULL;
7895            }
7896            RecycleBuffer(chanPtr, bufPtr, 0);
7897        }
7898    
7899        /*
7900         * Return the number of characters copied into the result buffer.
7901         * This may be different from the number of bytes consumed, because
7902         * of EOL translations.
7903         */
7904    
7905        return copied;
7906    }
7907    
7908    /*
7909     *----------------------------------------------------------------------
7910     *
7911     * DoWrite --
7912     *
7913     *      Puts a sequence of characters into an output buffer, may queue the
7914     *      buffer for output if it gets full, and also remembers whether the
7915     *      current buffer is ready e.g. if it contains a newline and we are in
7916     *      line buffering mode.
7917     *
7918     * Results:
7919     *      The number of bytes written or -1 in case of error. If -1,
7920     *      Tcl_GetErrno will return the error code.
7921     *
7922     * Side effects:
7923     *      May buffer up output and may cause output to be produced on the
7924     *      channel.
7925     *
7926     *----------------------------------------------------------------------
7927     */
7928    
7929    static int
7930    DoWrite(chanPtr, src, srcLen)
7931        Channel *chanPtr;                   /* The channel to buffer output for. */
7932        char *src;                          /* Data to write. */
7933        int srcLen;                         /* Number of bytes to write. */
7934    {
7935        ChannelBuffer *outBufPtr;           /* Current output buffer. */
7936        int foundNewline;                   /* Did we find a newline in output? */
7937        char *dPtr;
7938        char *sPtr;                         /* Search variables for newline. */
7939        int crsent;                         /* In CRLF eol translation mode,
7940                                             * remember the fact that a CR was
7941                                             * output to the channel without
7942                                             * its following NL. */
7943        int i;                              /* Loop index for newline search. */
7944        int destCopied;                     /* How many bytes were used in this
7945                                             * destination buffer to hold the
7946                                             * output? */
7947        int totalDestCopied;                /* How many bytes total were
7948                                             * copied to the channel buffer? */
7949        int srcCopied;                      /* How many bytes were copied from
7950                                             * the source string? */
7951        char *destPtr;                      /* Where in line to copy to? */
7952    
7953        /*
7954         * If we are in network (or windows) translation mode, record the fact
7955         * that we have not yet sent a CR to the channel.
7956         */
7957    
7958        crsent = 0;
7959        
7960        /*
7961         * Loop filling buffers and flushing them until all output has been
7962         * consumed.
7963         */
7964    
7965        srcCopied = 0;
7966        totalDestCopied = 0;
7967    
7968        while (srcLen > 0) {
7969            
7970            /*
7971             * Make sure there is a current output buffer to accept output.
7972             */
7973    
7974            if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
7975                chanPtr->curOutPtr = AllocChannelBuffer(chanPtr->bufSize);
7976            }
7977    
7978            outBufPtr = chanPtr->curOutPtr;
7979    
7980            destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
7981            if (destCopied > srcLen) {
7982                destCopied = srcLen;
7983            }
7984            
7985            destPtr = outBufPtr->buf + outBufPtr->nextAdded;
7986            switch (chanPtr->outputTranslation) {
7987                case TCL_TRANSLATE_LF:
7988                    srcCopied = destCopied;
7989                    memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
7990                    break;
7991                case TCL_TRANSLATE_CR:
7992                    srcCopied = destCopied;
7993                    memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
7994                    for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
7995                        if (*dPtr == '\n') {
7996                            *dPtr = '\r';
7997                        }
7998                    }
7999                    break;
8000                case TCL_TRANSLATE_CRLF:
8001                    for (srcCopied = 0, dPtr = destPtr, sPtr = src;
8002                         dPtr < destPtr + destCopied;
8003                         dPtr++, sPtr++, srcCopied++) {
8004                        if (*sPtr == '\n') {
8005                            if (crsent) {
8006                                *dPtr = '\n';
8007                                crsent = 0;
8008                            } else {
8009                                *dPtr = '\r';
8010                                crsent = 1;
8011                                sPtr--, srcCopied--;
8012                            }
8013                        } else {
8014                            *dPtr = *sPtr;
8015                        }
8016                    }
8017                    break;
8018                case TCL_TRANSLATE_AUTO:
8019                    panic("Tcl_Write: AUTO output translation mode not supported");
8020                default:
8021                    panic("Tcl_Write: unknown output translation mode");
8022            }
8023    
8024            /*
8025             * The current buffer is ready for output if it is full, or if it
8026             * contains a newline and this channel is line-buffered, or if it
8027             * contains any output and this channel is unbuffered.
8028             */
8029    
8030            outBufPtr->nextAdded += destCopied;
8031            if (!(chanPtr->flags & BUFFER_READY)) {
8032                if (outBufPtr->nextAdded == outBufPtr->bufLength) {
8033                    chanPtr->flags |= BUFFER_READY;
8034                } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
8035                    for (sPtr = src, i = 0, foundNewline = 0;
8036                             (i < srcCopied) && (!foundNewline);
8037                             i++, sPtr++) {
8038                        if (*sPtr == '\n') {
8039                            foundNewline = 1;
8040                            break;
8041                        }
8042                    }
8043                    if (foundNewline) {
8044                        chanPtr->flags |= BUFFER_READY;
8045                    }
8046                } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
8047                    chanPtr->flags |= BUFFER_READY;
8048                }
8049            }
8050            
8051            totalDestCopied += srcCopied;
8052            src += srcCopied;
8053            srcLen -= srcCopied;
8054    
8055            if (chanPtr->flags & BUFFER_READY) {
8056                if (FlushChannel(NULL, chanPtr, 0) != 0) {
8057                    return -1;
8058                }
8059            }
8060        } /* Closes "while" */
8061    
8062        return totalDestCopied;
8063    }
8064    
8065    /*
8066     *----------------------------------------------------------------------
8067     *
8068     * CopyEventProc --
8069     *
8070     *      This routine is invoked as a channel event handler for
8071     *      the background copy operation.  It is just a trivial wrapper
8072     *      around the CopyData routine.
8073     *
8074     * Results:
8075     *      None.
8076     *
8077     * Side effects:
8078     *      None.
8079     *
8080     *----------------------------------------------------------------------
8081     */
8082    
8083    static void
8084    CopyEventProc(clientData, mask)
8085        ClientData clientData;
8086        int mask;
8087    {
8088        (void) CopyData((CopyState *)clientData, mask);
8089    }
8090    
8091    /*
8092     *----------------------------------------------------------------------
8093     *
8094     * StopCopy --
8095     *
8096     *      This routine halts a copy that is in progress.
8097     *
8098     * Results:
8099     *      None.
8100     *
8101     * Side effects:
8102     *      Removes any pending channel handlers and restores the blocking
8103     *      and buffering modes of the channels.  The CopyState is freed.
8104     *
8105     *----------------------------------------------------------------------
8106     */
8107    
8108    static void
8109    StopCopy(csPtr)
8110        CopyState *csPtr;           /* State for bg copy to stop . */
8111    {
8112        int nonBlocking;
8113    
8114        if (!csPtr) {
8115            return;
8116        }
8117    
8118        /*
8119         * Restore the old blocking mode and output buffering mode.
8120         */
8121    
8122        nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
8123        if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {
8124            SetBlockMode(NULL, csPtr->readPtr,
8125                    nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
8126        }
8127        if (csPtr->writePtr != csPtr->writePtr) {
8128            if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {
8129                SetBlockMode(NULL, csPtr->writePtr,
8130                        nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
8131            }
8132        }
8133        csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
8134        csPtr->writePtr->flags |=
8135            csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
8136                
8137    
8138        if (csPtr->cmdPtr) {
8139            Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
8140                (ClientData)csPtr);
8141            if (csPtr->readPtr != csPtr->writePtr) {
8142                Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
8143                        CopyEventProc, (ClientData)csPtr);
8144            }
8145            Tcl_DecrRefCount(csPtr->cmdPtr);
8146        }
8147        csPtr->readPtr->csPtr = NULL;
8148        csPtr->writePtr->csPtr = NULL;
8149        ckfree((char*) csPtr);
8150    }
8151    
8152    /*
8153     *----------------------------------------------------------------------
8154     *
8155     * SetBlockMode --
8156     *
8157     *      This function sets the blocking mode for a channel and updates
8158     *      the state flags.
8159     *
8160     * Results:
8161     *      A standard Tcl result.
8162     *
8163     * Side effects:
8164     *      Modifies the blocking mode of the channel and possibly generates
8165     *      an error.
8166     *
8167     *----------------------------------------------------------------------
8168     */
8169    
8170    static int
8171    SetBlockMode(interp, chanPtr, mode)
8172        Tcl_Interp *interp;         /* Interp for error reporting. */
8173        Channel *chanPtr;           /* Channel to modify. */
8174        int mode;                   /* One of TCL_MODE_BLOCKING or
8175                                     * TCL_MODE_NONBLOCKING. */
8176    {
8177        int result = 0;
8178        if (chanPtr->typePtr->blockModeProc != NULL) {
8179            result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
8180                    mode);
8181        }
8182        if (result != 0) {
8183            Tcl_SetErrno(result);
8184            if (interp != (Tcl_Interp *) NULL) {
8185                Tcl_AppendResult(interp, "error setting blocking mode: ",
8186                        Tcl_PosixError(interp), (char *) NULL);
8187            }
8188            return TCL_ERROR;
8189        }
8190        if (mode == TCL_MODE_BLOCKING) {
8191            chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
8192        } else {
8193            chanPtr->flags |= CHANNEL_NONBLOCKING;
8194        }
8195        return TCL_OK;
8196    }
8197    
8198    /*
8199     *----------------------------------------------------------------------
8200     *
8201     * Tcl_GetChannelNames --
8202     *
8203     *      Return the names of all open channels in the interp.
8204     *
8205     * Results:
8206     *      TCL_OK or TCL_ERROR.
8207     *
8208     * Side effects:
8209     *      Interp result modified with list of channel names.
8210     *
8211     *----------------------------------------------------------------------
8212     */
8213    
8214    int
8215    Tcl_GetChannelNames(interp)
8216        Tcl_Interp *interp;         /* Interp for error reporting. */
8217    {
8218        return Tcl_GetChannelNamesEx(interp, (char *) NULL);
8219    }
8220    
8221    /*
8222     *----------------------------------------------------------------------
8223     *
8224     * Tcl_GetChannelNamesEx --
8225     *
8226     *      Return the names of open channels in the interp filtered
8227     *      filtered through a pattern.  If pattern is NULL, it returns
8228     *      all the open channels.
8229     *
8230     * Results:
8231     *      TCL_OK or TCL_ERROR.
8232     *
8233     * Side effects:
8234     *      Interp result modified with list of channel names.
8235     *
8236     *----------------------------------------------------------------------
8237     */
8238    
8239    int
8240    Tcl_GetChannelNamesEx(interp, pattern)
8241        Tcl_Interp *interp;         /* Interp for error reporting. */
8242        char *pattern;              /* pattern to filter on. */
8243    {
8244        Channel *chanPtr;
8245        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
8246        char *name;
8247        Tcl_Obj *resultPtr;
8248    
8249        resultPtr = Tcl_GetObjResult(interp);
8250        for (chanPtr = tsdPtr->firstChanPtr;
8251             chanPtr != NULL;
8252             chanPtr = chanPtr->nextChanPtr) {
8253            if (chanPtr == (Channel *) tsdPtr->stdinChannel) {
8254                name = "stdin";
8255            } else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {
8256                name = "stdout";
8257            } else if (chanPtr == (Channel *) tsdPtr->stderrChannel) {
8258                name = "stderr";
8259            } else {
8260                name = chanPtr->channelName;
8261            }
8262            if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
8263                    (Tcl_ListObjAppendElement(interp, resultPtr,
8264                            Tcl_NewStringObj(name, -1)) != TCL_OK)) {
8265                return TCL_ERROR;
8266            }
8267        }
8268        return TCL_OK;
8269    }
8270    
8271    /* End of tclio.c */
Legend:
Removed from v.44  
changed lines
  Added in v.220
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25