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

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclio.c

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

revision 64 by dashley, Sun Oct 30 04:21:11 2016 UTC revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
1  /*$Header$ */  /* $Header$ */
2  /*  /*
3   * tclIO.c --   * tclIO.c --
4   *   *
5   *      This file provides the generic portions (those that are the same on   *      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.   *      all platforms and for all channel types) of Tcl's IO facilities.
7   *   *
8   * Copyright (c) 1998 Scriptics Corporation   * Copyright (c) 1998 Scriptics Corporation
9   * Copyright (c) 1995-1997 Sun Microsystems, Inc.   * Copyright (c) 1995-1997 Sun Microsystems, Inc.
10   *   *
11   * See the file "license.terms" for information on usage and redistribution   * See the file "license.terms" for information on usage and redistribution
12   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.   * 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 $   * RCS: @(#) $Id: tclio.c,v 1.1.1.1 2001/06/13 04:42:01 dtashley Exp $
15   */   */
16    
17  #include "tclInt.h"  #include "tclInt.h"
18  #include "tclPort.h"  #include "tclPort.h"
19    
20  /*  /*
21   * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not   * 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   * 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   * 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   * both because there may be systems on which both are defined and have
25   * different values.   * different values.
26   */   */
27    
28  #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))  #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
29  #   define EWOULDBLOCK EAGAIN  #   define EWOULDBLOCK EAGAIN
30  #endif  #endif
31  #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))  #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
32  #   define EAGAIN EWOULDBLOCK  #   define EAGAIN EWOULDBLOCK
33  #endif  #endif
34  #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))  #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
35      error one of EWOULDBLOCK or EAGAIN must be defined      error one of EWOULDBLOCK or EAGAIN must be defined
36  #endif  #endif
37    
38  /*  /*
39   * The following structure encapsulates the state for a background channel   * 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   * copy.  Note that the data buffer for the copy will be appended to this
41   * structure.   * structure.
42   */   */
43    
44  typedef struct CopyState {  typedef struct CopyState {
45      struct Channel *readPtr;    /* Pointer to input channel. */      struct Channel *readPtr;    /* Pointer to input channel. */
46      struct Channel *writePtr;   /* Pointer to output channel. */      struct Channel *writePtr;   /* Pointer to output channel. */
47      int readFlags;              /* Original read channel flags. */      int readFlags;              /* Original read channel flags. */
48      int writeFlags;             /* Original write channel flags. */      int writeFlags;             /* Original write channel flags. */
49      int toRead;                 /* Number of bytes to copy, or -1. */      int toRead;                 /* Number of bytes to copy, or -1. */
50      int total;                  /* Total bytes transferred (written). */      int total;                  /* Total bytes transferred (written). */
51      Tcl_Interp *interp;         /* Interp that started the copy. */      Tcl_Interp *interp;         /* Interp that started the copy. */
52      Tcl_Obj *cmdPtr;            /* Command to be invoked at completion. */      Tcl_Obj *cmdPtr;            /* Command to be invoked at completion. */
53      int bufSize;                /* Size of appended buffer. */      int bufSize;                /* Size of appended buffer. */
54      char buffer[1];             /* Copy buffer, this must be the last      char buffer[1];             /* Copy buffer, this must be the last
55                                   * field. */                                   * field. */
56  } CopyState;  } CopyState;
57    
58  /*  /*
59   * struct ChannelBuffer:   * struct ChannelBuffer:
60   *   *
61   * Buffers data being sent to or from a channel.   * Buffers data being sent to or from a channel.
62   */   */
63    
64  typedef struct ChannelBuffer {  typedef struct ChannelBuffer {
65      int nextAdded;              /* The next position into which a character      int nextAdded;              /* The next position into which a character
66                                   * will be put in the buffer. */                                   * will be put in the buffer. */
67      int nextRemoved;            /* Position of next byte to be removed      int nextRemoved;            /* Position of next byte to be removed
68                                   * from the buffer. */                                   * from the buffer. */
69      int bufLength;              /* How big is the buffer? */      int bufLength;              /* How big is the buffer? */
70      struct ChannelBuffer *nextPtr;      struct ChannelBuffer *nextPtr;
71                                  /* Next buffer in chain. */                                  /* Next buffer in chain. */
72      char buf[4];                /* Placeholder for real buffer. The real      char buf[4];                /* Placeholder for real buffer. The real
73                                   * buffer occuppies this space + bufSize-4                                   * buffer occuppies this space + bufSize-4
74                                   * bytes. This must be the last field in                                   * bytes. This must be the last field in
75                                   * the structure. */                                   * the structure. */
76  } ChannelBuffer;  } ChannelBuffer;
77    
78  #define CHANNELBUFFER_HEADER_SIZE       (sizeof(ChannelBuffer) - 4)  #define CHANNELBUFFER_HEADER_SIZE       (sizeof(ChannelBuffer) - 4)
79    
80  /*  /*
81   * How much extra space to allocate in buffer to hold bytes from previous   * 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   * buffer (when converting to UTF-8) or to hold bytes that will go to
83   * next buffer (when converting from UTF-8).   * next buffer (when converting from UTF-8).
84   */   */
85    
86  #define BUFFER_PADDING      16  #define BUFFER_PADDING      16
87    
88  /*  /*
89   * The following defines the *default* buffer size for channels.   * The following defines the *default* buffer size for channels.
90   */   */
91    
92  #define CHANNELBUFFER_DEFAULT_SIZE      (1024 * 4)  #define CHANNELBUFFER_DEFAULT_SIZE      (1024 * 4)
93    
94  /*  /*
95   * Structure to record a close callback. One such record exists for   * Structure to record a close callback. One such record exists for
96   * each close callback registered for a channel.   * each close callback registered for a channel.
97   */   */
98    
99  typedef struct CloseCallback {  typedef struct CloseCallback {
100      Tcl_CloseProc *proc;                /* The procedure to call. */      Tcl_CloseProc *proc;                /* The procedure to call. */
101      ClientData clientData;              /* Arbitrary one-word data to pass      ClientData clientData;              /* Arbitrary one-word data to pass
102                                           * to the callback. */                                           * to the callback. */
103      struct CloseCallback *nextPtr;      /* For chaining close callbacks. */      struct CloseCallback *nextPtr;      /* For chaining close callbacks. */
104  } CloseCallback;  } CloseCallback;
105    
106  /*  /*
107   * The following structure describes the information saved from a call to   * The following structure describes the information saved from a call to
108   * "fileevent". This is used later when the event being waited for to   * "fileevent". This is used later when the event being waited for to
109   * invoke the saved script in the interpreter designed in this record.   * invoke the saved script in the interpreter designed in this record.
110   */   */
111    
112  typedef struct EventScriptRecord {  typedef struct EventScriptRecord {
113      struct Channel *chanPtr;    /* The channel for which this script is      struct Channel *chanPtr;    /* The channel for which this script is
114                                   * registered. This is used only when an                                   * registered. This is used only when an
115                                   * error occurs during evaluation of the                                   * error occurs during evaluation of the
116                                   * script, to delete the handler. */                                   * script, to delete the handler. */
117      Tcl_Obj *scriptPtr;         /* Script to invoke. */      Tcl_Obj *scriptPtr;         /* Script to invoke. */
118      Tcl_Interp *interp;         /* In what interpreter to invoke script? */      Tcl_Interp *interp;         /* In what interpreter to invoke script? */
119      int mask;                   /* Events must overlap current mask for the      int mask;                   /* Events must overlap current mask for the
120                                   * stored script to be invoked. */                                   * stored script to be invoked. */
121      struct EventScriptRecord *nextPtr;      struct EventScriptRecord *nextPtr;
122                                  /* Next in chain of records. */                                  /* Next in chain of records. */
123  } EventScriptRecord;  } EventScriptRecord;
124    
125  /*  /*
126   * struct Channel:   * struct Channel:
127   *   *
128   * One of these structures is allocated for each open channel. It contains data   * 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   * 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   * channel mechanism, and it points at an instance specific (and type
131   * specific) * instance data, and at a channel type structure.   * specific) * instance data, and at a channel type structure.
132   */   */
133    
134  typedef struct Channel {  typedef struct Channel {
135      char *channelName;          /* The name of the channel instance in Tcl      char *channelName;          /* The name of the channel instance in Tcl
136                                   * commands. Storage is owned by the generic IO                                   * commands. Storage is owned by the generic IO
137                                   * code,  is dynamically allocated. */                                   * code,  is dynamically allocated. */
138      int flags;                  /* ORed combination of the flags defined      int flags;                  /* ORed combination of the flags defined
139                                   * below. */                                   * below. */
140      Tcl_Encoding encoding;      /* Encoding to apply when reading or writing      Tcl_Encoding encoding;      /* Encoding to apply when reading or writing
141                                   * data on this channel.  NULL means no                                   * data on this channel.  NULL means no
142                                   * encoding is applied to data. */                                   * encoding is applied to data. */
143      Tcl_EncodingState inputEncodingState;      Tcl_EncodingState inputEncodingState;
144                                  /* Current encoding state, used when converting                                  /* Current encoding state, used when converting
145                                   * input data bytes to UTF-8. */                                   * input data bytes to UTF-8. */
146      int inputEncodingFlags;     /* Encoding flags to pass to conversion      int inputEncodingFlags;     /* Encoding flags to pass to conversion
147                                   * routine when converting input data bytes to                                   * routine when converting input data bytes to
148                                   * UTF-8.  May be TCL_ENCODING_START before                                   * UTF-8.  May be TCL_ENCODING_START before
149                                   * converting first byte and TCL_ENCODING_END                                   * converting first byte and TCL_ENCODING_END
150                                   * when EOF is seen. */                                   * when EOF is seen. */
151      Tcl_EncodingState outputEncodingState;      Tcl_EncodingState outputEncodingState;
152                                  /* Current encoding state, used when converting                                  /* Current encoding state, used when converting
153                                   * UTF-8 to output data bytes. */                                   * UTF-8 to output data bytes. */
154      int outputEncodingFlags;    /* Encoding flags to pass to conversion      int outputEncodingFlags;    /* Encoding flags to pass to conversion
155                                   * routine when converting UTF-8 to output                                   * routine when converting UTF-8 to output
156                                   * data bytes.  May be TCL_ENCODING_START                                   * data bytes.  May be TCL_ENCODING_START
157                                   * before converting first byte and                                   * before converting first byte and
158                                   * TCL_ENCODING_END when EOF is seen. */                                   * TCL_ENCODING_END when EOF is seen. */
159      Tcl_EolTranslation inputTranslation;      Tcl_EolTranslation inputTranslation;
160                                  /* What translation to apply for end of line                                  /* What translation to apply for end of line
161                                   * sequences on input? */                                       * sequences on input? */    
162      Tcl_EolTranslation outputTranslation;      Tcl_EolTranslation outputTranslation;
163                                  /* What translation to use for generating                                  /* What translation to use for generating
164                                   * end of line sequences in output? */                                   * end of line sequences in output? */
165      int inEofChar;              /* If nonzero, use this as a signal of EOF      int inEofChar;              /* If nonzero, use this as a signal of EOF
166                                   * on input. */                                   * on input. */
167      int outEofChar;             /* If nonzero, append this to the channel      int outEofChar;             /* If nonzero, append this to the channel
168                                   * when it is closed if it is open for                                   * when it is closed if it is open for
169                                   * writing. */                                   * writing. */
170      int unreportedError;        /* Non-zero if an error report was deferred      int unreportedError;        /* Non-zero if an error report was deferred
171                                   * because it happened in the background. The                                   * because it happened in the background. The
172                                   * value is the POSIX error code. */                                   * value is the POSIX error code. */
173      ClientData instanceData;    /* Instance-specific data provided by      ClientData instanceData;    /* Instance-specific data provided by
174                                   * creator of channel. */                                   * creator of channel. */
175    
176      Tcl_ChannelType *typePtr;   /* Pointer to channel type structure. */      Tcl_ChannelType *typePtr;   /* Pointer to channel type structure. */
177      int refCount;               /* How many interpreters hold references to      int refCount;               /* How many interpreters hold references to
178                                   * this IO channel? */                                   * this IO channel? */
179      CloseCallback *closeCbPtr;  /* Callbacks registered to be called when the      CloseCallback *closeCbPtr;  /* Callbacks registered to be called when the
180                                   * channel is closed. */                                   * channel is closed. */
181      char *outputStage;          /* Temporary staging buffer used when      char *outputStage;          /* Temporary staging buffer used when
182                                   * translating EOL before converting from                                   * translating EOL before converting from
183                                   * UTF-8 to external form. */                                   * UTF-8 to external form. */
184      ChannelBuffer *curOutPtr;   /* Current output buffer being filled. */      ChannelBuffer *curOutPtr;   /* Current output buffer being filled. */
185      ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */      ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
186      ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */      ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
187    
188      ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates      ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
189                                   * need to allocate a new buffer for "gets"                                   * need to allocate a new buffer for "gets"
190                                   * that crosses buffer boundaries. */                                   * that crosses buffer boundaries. */
191      ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */      ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */
192      ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */      ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */
193    
194      struct ChannelHandler *chPtr;/* List of channel handlers registered      struct ChannelHandler *chPtr;/* List of channel handlers registered
195                                    * for this channel. */                                    * for this channel. */
196      int interestMask;           /* Mask of all events this channel has      int interestMask;           /* Mask of all events this channel has
197                                   * handlers for. */                                   * handlers for. */
198      struct Channel *nextChanPtr;/* Next in list of channels currently open. */      struct Channel *nextChanPtr;/* Next in list of channels currently open. */
199      EventScriptRecord *scriptRecordPtr;      EventScriptRecord *scriptRecordPtr;
200                                  /* Chain of all scripts registered for                                  /* Chain of all scripts registered for
201                                   * event handlers ("fileevent") on this                                   * event handlers ("fileevent") on this
202                                   * channel. */                                   * channel. */
203      int bufSize;                /* What size buffers to allocate? */      int bufSize;                /* What size buffers to allocate? */
204      Tcl_TimerToken timer;       /* Handle to wakeup timer for this channel. */      Tcl_TimerToken timer;       /* Handle to wakeup timer for this channel. */
205      CopyState *csPtr;           /* State of background copy, or NULL. */      CopyState *csPtr;           /* State of background copy, or NULL. */
206      struct Channel* supercedes; /* Refers to channel this one was stacked upon.      struct Channel* supercedes; /* Refers to channel this one was stacked upon.
207                                     This reference is NULL for normal channels.                                     This reference is NULL for normal channels.
208                                     See Tcl_StackChannel. */                                     See Tcl_StackChannel. */
209    
210  } Channel;  } Channel;
211            
212  /*  /*
213   * Values for the flags field in Channel. Any ORed combination of the   * 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   * 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,   * 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.   * 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  #define CHANNEL_NONBLOCKING     (1<<3)  /* Channel is currently in
220                                           * nonblocking mode. */                                           * nonblocking mode. */
221  #define CHANNEL_LINEBUFFERED    (1<<4)  /* Output to the channel must be  #define CHANNEL_LINEBUFFERED    (1<<4)  /* Output to the channel must be
222                                           * flushed after every newline. */                                           * flushed after every newline. */
223  #define CHANNEL_UNBUFFERED      (1<<5)  /* Output to the channel must always  #define CHANNEL_UNBUFFERED      (1<<5)  /* Output to the channel must always
224                                           * be flushed immediately. */                                           * be flushed immediately. */
225  #define BUFFER_READY            (1<<6)  /* Current output buffer (the  #define BUFFER_READY            (1<<6)  /* Current output buffer (the
226                                           * curOutPtr field in the                                           * curOutPtr field in the
227                                           * channel structure) should be                                           * channel structure) should be
228                                           * output as soon as possible even                                           * output as soon as possible even
229                                           * though it may not be full. */                                           * though it may not be full. */
230  #define BG_FLUSH_SCHEDULED      (1<<7)  /* A background flush of the  #define BG_FLUSH_SCHEDULED      (1<<7)  /* A background flush of the
231                                           * queued output buffers has been                                           * queued output buffers has been
232                                           * scheduled. */                                           * scheduled. */
233  #define CHANNEL_CLOSED          (1<<8)  /* Channel has been closed. No  #define CHANNEL_CLOSED          (1<<8)  /* Channel has been closed. No
234                                           * further Tcl-level IO on the                                           * further Tcl-level IO on the
235                                           * channel is allowed. */                                           * channel is allowed. */
236  #define CHANNEL_EOF             (1<<9)  /* EOF occurred on this channel.  #define CHANNEL_EOF             (1<<9)  /* EOF occurred on this channel.
237                                           * This bit is cleared before every                                           * This bit is cleared before every
238                                           * input operation. */                                           * input operation. */
239  #define CHANNEL_STICKY_EOF      (1<<10) /* EOF occurred on this channel because  #define CHANNEL_STICKY_EOF      (1<<10) /* EOF occurred on this channel because
240                                           * we saw the input eofChar. This bit                                           * we saw the input eofChar. This bit
241                                           * prevents clearing of the EOF bit                                           * prevents clearing of the EOF bit
242                                           * before every input operation. */                                           * before every input operation. */
243  #define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred  #define CHANNEL_BLOCKED (1<<11) /* EWOULDBLOCK or EAGAIN occurred
244                                           * on this channel. This bit is                                           * on this channel. This bit is
245                                           * cleared before every input or                                           * cleared before every input or
246                                           * output operation. */                                           * output operation. */
247  #define INPUT_SAW_CR            (1<<12) /* Channel is in CRLF eol input  #define INPUT_SAW_CR            (1<<12) /* Channel is in CRLF eol input
248                                           * translation mode and the last                                           * translation mode and the last
249                                           * byte seen was a "\r". */                                           * byte seen was a "\r". */
250  #define INPUT_NEED_NL           (1<<15) /* Saw a '\r' at end of last buffer,  #define INPUT_NEED_NL           (1<<15) /* Saw a '\r' at end of last buffer,
251                                           * and there should be a '\n' at                                           * and there should be a '\n' at
252                                           * beginning of next buffer. */                                           * beginning of next buffer. */
253  #define CHANNEL_DEAD            (1<<13) /* The channel has been closed by  #define CHANNEL_DEAD            (1<<13) /* The channel has been closed by
254                                           * the exit handler (on exit) but                                           * the exit handler (on exit) but
255                                           * not deallocated. When any IO                                           * not deallocated. When any IO
256                                           * operation sees this flag on a                                           * operation sees this flag on a
257                                           * channel, it does not call driver                                           * channel, it does not call driver
258                                           * level functions to avoid referring                                           * level functions to avoid referring
259                                           * to deallocated data. */                                           * to deallocated data. */
260  #define CHANNEL_NEED_MORE_DATA  (1<<14) /* The last input operation failed  #define CHANNEL_NEED_MORE_DATA  (1<<14) /* The last input operation failed
261                                           * because there was not enough data                                           * because there was not enough data
262                                           * to complete the operation.  This                                           * to complete the operation.  This
263                                           * flag is set when gets fails to                                           * flag is set when gets fails to
264                                           * get a complete line or when read                                           * get a complete line or when read
265                                           * fails to get a complete character.                                           * fails to get a complete character.
266                                           * When set, file events will not be                                           * When set, file events will not be
267                                           * delivered for buffered data until                                           * delivered for buffered data until
268                                           * the state of the channel changes. */                                           * the state of the channel changes. */
269    
270  /*  /*
271   * For each channel handler registered in a call to Tcl_CreateChannelHandler,   * 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   * 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   * channel are chained together in a singly linked list which is stored in
274   * the channel structure.   * the channel structure.
275   */   */
276    
277  typedef struct ChannelHandler {  typedef struct ChannelHandler {
278      Channel *chanPtr;           /* The channel structure for this channel. */      Channel *chanPtr;           /* The channel structure for this channel. */
279      int mask;                   /* Mask of desired events. */      int mask;                   /* Mask of desired events. */
280      Tcl_ChannelProc *proc;      /* Procedure to call in the type of      Tcl_ChannelProc *proc;      /* Procedure to call in the type of
281                                   * Tcl_CreateChannelHandler. */                                   * Tcl_CreateChannelHandler. */
282      ClientData clientData;      /* Argument to pass to procedure. */      ClientData clientData;      /* Argument to pass to procedure. */
283      struct ChannelHandler *nextPtr;      struct ChannelHandler *nextPtr;
284                                  /* Next one in list of registered handlers. */                                  /* Next one in list of registered handlers. */
285  } ChannelHandler;  } ChannelHandler;
286    
287  /*  /*
288   * This structure keeps track of the current ChannelHandler being invoked in   * This structure keeps track of the current ChannelHandler being invoked in
289   * the current invocation of ChannelHandlerEventProc. There is a potential   * the current invocation of ChannelHandlerEventProc. There is a potential
290   * problem if a ChannelHandler is deleted while it is the current one, since   * 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   * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
292   * problem, structures of the type below indicate the next handler to be   * problem, structures of the type below indicate the next handler to be
293   * processed for any (recursively nested) dispatches in progress. The   * processed for any (recursively nested) dispatches in progress. The
294   * nextHandlerPtr field is updated if the handler being pointed to is deleted.   * 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   * The nextPtr field is used to chain together all recursive invocations, so
296   * that Tcl_DeleteChannelHandler can find all the recursively nested   * that Tcl_DeleteChannelHandler can find all the recursively nested
297   * invocations of ChannelHandlerEventProc and compare the handler being   * invocations of ChannelHandlerEventProc and compare the handler being
298   * deleted against the NEXT handler to be invoked in that invocation; when it   * deleted against the NEXT handler to be invoked in that invocation; when it
299   * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr   * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
300   * field of the structure to the next handler.   * field of the structure to the next handler.
301   */   */
302    
303  typedef struct NextChannelHandler {  typedef struct NextChannelHandler {
304      ChannelHandler *nextHandlerPtr;     /* The next handler to be invoked in      ChannelHandler *nextHandlerPtr;     /* The next handler to be invoked in
305                                           * this invocation. */                                           * this invocation. */
306      struct NextChannelHandler *nestedHandlerPtr;      struct NextChannelHandler *nestedHandlerPtr;
307                                          /* Next nested invocation of                                          /* Next nested invocation of
308                                           * ChannelHandlerEventProc. */                                           * ChannelHandlerEventProc. */
309  } NextChannelHandler;  } NextChannelHandler;
310    
311    
312  /*  /*
313   * The following structure describes the event that is added to the Tcl   * The following structure describes the event that is added to the Tcl
314   * event queue by the channel handler check procedure.   * event queue by the channel handler check procedure.
315   */   */
316    
317  typedef struct ChannelHandlerEvent {  typedef struct ChannelHandlerEvent {
318      Tcl_Event header;           /* Standard header for all events. */      Tcl_Event header;           /* Standard header for all events. */
319      Channel *chanPtr;           /* The channel that is ready. */      Channel *chanPtr;           /* The channel that is ready. */
320      int readyMask;              /* Events that have occurred. */      int readyMask;              /* Events that have occurred. */
321  } ChannelHandlerEvent;  } ChannelHandlerEvent;
322    
323  /*  /*
324   * The following structure is used by Tcl_GetsObj() to encapsulates the   * The following structure is used by Tcl_GetsObj() to encapsulates the
325   * state for a "gets" operation.   * state for a "gets" operation.
326   */   */
327    
328  typedef struct GetsState {  typedef struct GetsState {
329      Tcl_Obj *objPtr;            /* The object to which UTF-8 characters      Tcl_Obj *objPtr;            /* The object to which UTF-8 characters
330                                   * will be appended. */                                   * will be appended. */
331      char **dstPtr;              /* Pointer into objPtr's string rep where      char **dstPtr;              /* Pointer into objPtr's string rep where
332                                   * next character should be stored. */                                   * next character should be stored. */
333      Tcl_Encoding encoding;      /* The encoding to use to convert raw bytes      Tcl_Encoding encoding;      /* The encoding to use to convert raw bytes
334                                   * to UTF-8.  */                                   * to UTF-8.  */
335      ChannelBuffer *bufPtr;      /* The current buffer of raw bytes being      ChannelBuffer *bufPtr;      /* The current buffer of raw bytes being
336                                   * emptied. */                                   * emptied. */
337      Tcl_EncodingState state;    /* The encoding state just before the last      Tcl_EncodingState state;    /* The encoding state just before the last
338                                   * external to UTF-8 conversion in                                   * external to UTF-8 conversion in
339                                   * FilterInputBytes(). */                                   * FilterInputBytes(). */
340      int rawRead;                /* The number of bytes removed from bufPtr      int rawRead;                /* The number of bytes removed from bufPtr
341                                   * in the last call to FilterInputBytes(). */                                   * in the last call to FilterInputBytes(). */
342      int bytesWrote;             /* The number of bytes of UTF-8 data      int bytesWrote;             /* The number of bytes of UTF-8 data
343                                   * appended to objPtr during the last call to                                   * appended to objPtr during the last call to
344                                   * FilterInputBytes(). */                                   * FilterInputBytes(). */
345      int charsWrote;             /* The corresponding number of UTF-8      int charsWrote;             /* The corresponding number of UTF-8
346                                   * characters appended to objPtr during the                                   * characters appended to objPtr during the
347                                   * last call to FilterInputBytes(). */                                   * last call to FilterInputBytes(). */
348      int totalChars;             /* The total number of UTF-8 characters      int totalChars;             /* The total number of UTF-8 characters
349                                   * appended to objPtr so far, just before the                                   * appended to objPtr so far, just before the
350                                   * last call to FilterInputBytes(). */                                   * last call to FilterInputBytes(). */
351  } GetsState;  } GetsState;
352    
353  /*  /*
354   * All static variables used in this file are collected into a single   * All static variables used in this file are collected into a single
355   * instance of the following structure.  For multi-threaded implementations,   * instance of the following structure.  For multi-threaded implementations,
356   * there is one instance of this structure for each thread.   * there is one instance of this structure for each thread.
357   *   *
358   * Notice that different structures with the same name appear in other   * Notice that different structures with the same name appear in other
359   * files.  The structure defined below is used in this file only.   * files.  The structure defined below is used in this file only.
360   */   */
361    
362  typedef struct ThreadSpecificData {  typedef struct ThreadSpecificData {
363    
364      /*      /*
365       * This variable holds the list of nested ChannelHandlerEventProc       * This variable holds the list of nested ChannelHandlerEventProc
366       * invocations.       * invocations.
367       */       */
368      NextChannelHandler *nestedHandlerPtr;      NextChannelHandler *nestedHandlerPtr;
369    
370      /*      /*
371       * List of all channels currently open.       * List of all channels currently open.
372       */       */
373      Channel *firstChanPtr;      Channel *firstChanPtr;
374  #ifdef oldcode  #ifdef oldcode
375      /*      /*
376       * Has a channel exit handler been created yet?       * Has a channel exit handler been created yet?
377       */       */
378      int channelExitHandlerCreated;      int channelExitHandlerCreated;
379    
380      /*      /*
381       * Has the channel event source been created and registered with the       * Has the channel event source been created and registered with the
382       * notifier?       * notifier?
383       */       */
384      int channelEventSourceCreated;      int channelEventSourceCreated;
385  #endif  #endif
386      /*      /*
387       * Static variables to hold channels for stdin, stdout and stderr.       * Static variables to hold channels for stdin, stdout and stderr.
388       */       */
389      Tcl_Channel stdinChannel;      Tcl_Channel stdinChannel;
390      int stdinInitialized;      int stdinInitialized;
391      Tcl_Channel stdoutChannel;      Tcl_Channel stdoutChannel;
392      int stdoutInitialized;      int stdoutInitialized;
393      Tcl_Channel stderrChannel;      Tcl_Channel stderrChannel;
394      int stderrInitialized;      int stderrInitialized;
395    
396  } ThreadSpecificData;  } ThreadSpecificData;
397    
398  static Tcl_ThreadDataKey dataKey;  static Tcl_ThreadDataKey dataKey;
399    
400    
401  /*  /*
402   * Static functions in this file:   * Static functions in this file:
403   */   */
404    
405  static ChannelBuffer *  AllocChannelBuffer _ANSI_ARGS_((int length));  static ChannelBuffer *  AllocChannelBuffer _ANSI_ARGS_((int length));
406  static void             ChannelEventScriptInvoker _ANSI_ARGS_((  static void             ChannelEventScriptInvoker _ANSI_ARGS_((
407                              ClientData clientData, int flags));                              ClientData clientData, int flags));
408  static void             ChannelTimerProc _ANSI_ARGS_((  static void             ChannelTimerProc _ANSI_ARGS_((
409                              ClientData clientData));                              ClientData clientData));
410  static int              CheckChannelErrors _ANSI_ARGS_((Channel *chanPtr,  static int              CheckChannelErrors _ANSI_ARGS_((Channel *chanPtr,
411                              int direction));                              int direction));
412  static int              CheckFlush _ANSI_ARGS_((Channel *chanPtr,  static int              CheckFlush _ANSI_ARGS_((Channel *chanPtr,
413                              ChannelBuffer *bufPtr, int newlineFlag));                              ChannelBuffer *bufPtr, int newlineFlag));
414  static int              CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,  static int              CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
415                              Channel *chan));                              Channel *chan));
416  static void             CheckForStdChannelsBeingClosed _ANSI_ARGS_((  static void             CheckForStdChannelsBeingClosed _ANSI_ARGS_((
417                              Tcl_Channel chan));                              Tcl_Channel chan));
418  static void             CleanupChannelHandlers _ANSI_ARGS_((  static void             CleanupChannelHandlers _ANSI_ARGS_((
419                              Tcl_Interp *interp, Channel *chanPtr));                              Tcl_Interp *interp, Channel *chanPtr));
420  static int              CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,  static int              CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
421                              Channel *chanPtr, int errorCode));                              Channel *chanPtr, int errorCode));
422  static void             CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,  static void             CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
423                              Tcl_Encoding encoding));                              Tcl_Encoding encoding));
424  static int              CopyAndTranslateBuffer _ANSI_ARGS_((  static int              CopyAndTranslateBuffer _ANSI_ARGS_((
425                              Channel *chanPtr, char *result, int space));                              Channel *chanPtr, char *result, int space));
426  static int              CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));  static int              CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
427  static void             CopyEventProc _ANSI_ARGS_((ClientData clientData,  static void             CopyEventProc _ANSI_ARGS_((ClientData clientData,
428                              int mask));                              int mask));
429  static void             CreateScriptRecord _ANSI_ARGS_((  static void             CreateScriptRecord _ANSI_ARGS_((
430                              Tcl_Interp *interp, Channel *chanPtr,                              Tcl_Interp *interp, Channel *chanPtr,
431                              int mask, Tcl_Obj *scriptPtr));                              int mask, Tcl_Obj *scriptPtr));
432  static void             DeleteChannelTable _ANSI_ARGS_((  static void             DeleteChannelTable _ANSI_ARGS_((
433                              ClientData clientData, Tcl_Interp *interp));                              ClientData clientData, Tcl_Interp *interp));
434  static void             DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,  static void             DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
435                              Channel *chanPtr, int mask));                              Channel *chanPtr, int mask));
436  static void             DiscardInputQueued _ANSI_ARGS_((  static void             DiscardInputQueued _ANSI_ARGS_((
437                              Channel *chanPtr, int discardSavedBuffers));                              Channel *chanPtr, int discardSavedBuffers));
438  static void             DiscardOutputQueued _ANSI_ARGS_((  static void             DiscardOutputQueued _ANSI_ARGS_((
439                              Channel *chanPtr));                              Channel *chanPtr));
440  static int              DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,  static int              DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
441                              int slen));                              int slen));
442  static int              DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,  static int              DoWrite _ANSI_ARGS_((Channel *chanPtr, char *src,
443                              int srcLen));                              int srcLen));
444  static int              FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,  static int              FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
445                              GetsState *statePtr));                              GetsState *statePtr));
446  static int              FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,  static int              FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
447                              Channel *chanPtr, int calledFromAsyncFlush));                              Channel *chanPtr, int calledFromAsyncFlush));
448  static Tcl_HashTable *  GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));  static Tcl_HashTable *  GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
449  static int              GetInput _ANSI_ARGS_((Channel *chanPtr));  static int              GetInput _ANSI_ARGS_((Channel *chanPtr));
450  static void             PeekAhead _ANSI_ARGS_((Channel *chanPtr,  static void             PeekAhead _ANSI_ARGS_((Channel *chanPtr,
451                              char **dstEndPtr, GetsState *gsPtr));                              char **dstEndPtr, GetsState *gsPtr));
452  static int              ReadBytes _ANSI_ARGS_((Channel *chanPtr,  static int              ReadBytes _ANSI_ARGS_((Channel *chanPtr,
453                              Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));                              Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));
454  static int              ReadChars _ANSI_ARGS_((Channel *chanPtr,  static int              ReadChars _ANSI_ARGS_((Channel *chanPtr,
455                              Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,                              Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
456                              int *factorPtr));                              int *factorPtr));
457  static void             RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,  static void             RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
458                              ChannelBuffer *bufPtr, int mustDiscard));                              ChannelBuffer *bufPtr, int mustDiscard));
459  static int              SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,  static int              SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
460                              Channel *chanPtr, int mode));                              Channel *chanPtr, int mode));
461  static void             StopCopy _ANSI_ARGS_((CopyState *csPtr));  static void             StopCopy _ANSI_ARGS_((CopyState *csPtr));
462  static int              TranslateInputEOL _ANSI_ARGS_((Channel *chanPtr,  static int              TranslateInputEOL _ANSI_ARGS_((Channel *chanPtr,
463                              char *dst, CONST char *src, int *dstLenPtr,                              char *dst, CONST char *src, int *dstLenPtr,
464                              int *srcLenPtr));                              int *srcLenPtr));
465  static int              TranslateOutputEOL _ANSI_ARGS_((Channel *chanPtr,  static int              TranslateOutputEOL _ANSI_ARGS_((Channel *chanPtr,
466                              char *dst, CONST char *src, int *dstLenPtr,                              char *dst, CONST char *src, int *dstLenPtr,
467                              int *srcLenPtr));                              int *srcLenPtr));
468  static void             UpdateInterest _ANSI_ARGS_((Channel *chanPtr));  static void             UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
469  static int              WriteBytes _ANSI_ARGS_((Channel *chanPtr,  static int              WriteBytes _ANSI_ARGS_((Channel *chanPtr,
470                              CONST char *src, int srcLen));                              CONST char *src, int srcLen));
471  static int              WriteChars _ANSI_ARGS_((Channel *chanPtr,  static int              WriteChars _ANSI_ARGS_((Channel *chanPtr,
472                              CONST char *src, int srcLen));                              CONST char *src, int srcLen));
473    
474    
475  /*  /*
476   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
477   *   *
478   * TclInitIOSubsystem --   * TclInitIOSubsystem --
479   *   *
480   *      Initialize all resources used by this subsystem on a per-process   *      Initialize all resources used by this subsystem on a per-process
481   *      basis.     *      basis.  
482   *   *
483   * Results:   * Results:
484   *      None.   *      None.
485   *   *
486   * Side effects:   * Side effects:
487   *      Depends on the memory subsystems.   *      Depends on the memory subsystems.
488   *   *
489   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
490   */   */
491    
492  void  void
493  TclInitIOSubsystem()  TclInitIOSubsystem()
494  {  {
495      /*      /*
496       * By fetching thread local storage we take care of       * By fetching thread local storage we take care of
497       * allocating it for each thread.       * allocating it for each thread.
498       */       */
499      (void) TCL_TSD_INIT(&dataKey);      (void) TCL_TSD_INIT(&dataKey);
500  }    }  
501    
502  /*  /*
503   *-------------------------------------------------------------------------   *-------------------------------------------------------------------------
504   *   *
505   * TclFinalizeIOSubsystem --   * TclFinalizeIOSubsystem --
506   *   *
507   *      Releases all resources used by this subsystem on a per-process   *      Releases all resources used by this subsystem on a per-process
508   *      basis.  Closes all extant channels that have not already been   *      basis.  Closes all extant channels that have not already been
509   *      closed because they were not owned by any interp.     *      closed because they were not owned by any interp.  
510   *   *
511   * Results:   * Results:
512   *      None.   *      None.
513   *   *
514   * Side effects:   * Side effects:
515   *      Depends on encoding and memory subsystems.   *      Depends on encoding and memory subsystems.
516   *   *
517   *-------------------------------------------------------------------------   *-------------------------------------------------------------------------
518   */   */
519    
520          /* ARGSUSED */          /* ARGSUSED */
521  void  void
522  TclFinalizeIOSubsystem()  TclFinalizeIOSubsystem()
523  {  {
524      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
525      Channel *chanPtr;                   /* Iterates over open channels. */      Channel *chanPtr;                   /* Iterates over open channels. */
526      Channel *nextChanPtr;               /* Iterates over open channels. */      Channel *nextChanPtr;               /* Iterates over open channels. */
527    
528    
529      for (chanPtr = tsdPtr->firstChanPtr; chanPtr != (Channel *) NULL;      for (chanPtr = tsdPtr->firstChanPtr; chanPtr != (Channel *) NULL;
530               chanPtr = nextChanPtr) {               chanPtr = nextChanPtr) {
531          nextChanPtr = chanPtr->nextChanPtr;          nextChanPtr = chanPtr->nextChanPtr;
532    
533          /*          /*
534           * Set the channel back into blocking mode to ensure that we wait           * Set the channel back into blocking mode to ensure that we wait
535           * for all data to flush out.           * for all data to flush out.
536           */           */
537                    
538          (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,          (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
539                  "-blocking", "on");                  "-blocking", "on");
540    
541          if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||          if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
542                  (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||                  (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
543                  (chanPtr == (Channel *) tsdPtr->stderrChannel)) {                  (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
544    
545              /*              /*
546               * Decrement the refcount which was earlier artificially bumped               * Decrement the refcount which was earlier artificially bumped
547               * up to keep the channel from being closed.               * up to keep the channel from being closed.
548               */               */
549    
550              chanPtr->refCount--;              chanPtr->refCount--;
551          }          }
552    
553          if (chanPtr->refCount <= 0) {          if (chanPtr->refCount <= 0) {
554    
555              /*              /*
556               * Close it only if the refcount indicates that the channel is not               * Close it only if the refcount indicates that the channel is not
557               * referenced from any interpreter. If it is, that interpreter will               * referenced from any interpreter. If it is, that interpreter will
558               * close the channel when it gets destroyed.               * close the channel when it gets destroyed.
559               */               */
560    
561              (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);              (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
562    
563          } else {          } else {
564    
565              /*              /*
566               * The refcount is greater than zero, so flush the channel.               * The refcount is greater than zero, so flush the channel.
567               */               */
568    
569              Tcl_Flush((Tcl_Channel) chanPtr);              Tcl_Flush((Tcl_Channel) chanPtr);
570    
571              /*              /*
572               * Call the device driver to actually close the underlying               * Call the device driver to actually close the underlying
573               * device for this channel.               * device for this channel.
574               */               */
575                            
576              if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {              if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
577                  (chanPtr->typePtr->closeProc)(chanPtr->instanceData,                  (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
578                          (Tcl_Interp *) NULL);                          (Tcl_Interp *) NULL);
579              } else {              } else {
580                  (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,                  (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
581                          (Tcl_Interp *) NULL, 0);                          (Tcl_Interp *) NULL, 0);
582              }              }
583    
584              /*              /*
585               * Finally, we clean up the fields in the channel data structure               * Finally, we clean up the fields in the channel data structure
586               * since all of them have been deleted already. We mark the               * since all of them have been deleted already. We mark the
587               * channel with CHANNEL_DEAD to prevent any further IO operations               * channel with CHANNEL_DEAD to prevent any further IO operations
588               * on it.               * on it.
589               */               */
590    
591              chanPtr->instanceData = (ClientData) NULL;              chanPtr->instanceData = (ClientData) NULL;
592              chanPtr->flags |= CHANNEL_DEAD;              chanPtr->flags |= CHANNEL_DEAD;
593          }          }
594      }      }
595  }  }
596    
597    
598  /*  /*
599   *----------------------------------------------------------------------   *----------------------------------------------------------------------
600   *   *
601   * Tcl_SetStdChannel --   * Tcl_SetStdChannel --
602   *   *
603   *      This function is used to change the channels that are used   *      This function is used to change the channels that are used
604   *      for stdin/stdout/stderr in new interpreters.   *      for stdin/stdout/stderr in new interpreters.
605   *   *
606   * Results:   * Results:
607   *      None   *      None
608   *   *
609   * Side effects:   * Side effects:
610   *      None.   *      None.
611   *   *
612   *----------------------------------------------------------------------   *----------------------------------------------------------------------
613   */   */
614    
615  void  void
616  Tcl_SetStdChannel(channel, type)  Tcl_SetStdChannel(channel, type)
617      Tcl_Channel channel;      Tcl_Channel channel;
618      int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */      int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
619  {  {
620      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
621      switch (type) {      switch (type) {
622          case TCL_STDIN:          case TCL_STDIN:
623              tsdPtr->stdinInitialized = 1;              tsdPtr->stdinInitialized = 1;
624              tsdPtr->stdinChannel = channel;              tsdPtr->stdinChannel = channel;
625              break;              break;
626          case TCL_STDOUT:          case TCL_STDOUT:
627              tsdPtr->stdoutInitialized = 1;              tsdPtr->stdoutInitialized = 1;
628              tsdPtr->stdoutChannel = channel;              tsdPtr->stdoutChannel = channel;
629              break;              break;
630          case TCL_STDERR:          case TCL_STDERR:
631              tsdPtr->stderrInitialized = 1;              tsdPtr->stderrInitialized = 1;
632              tsdPtr->stderrChannel = channel;              tsdPtr->stderrChannel = channel;
633              break;              break;
634      }      }
635  }  }
636    
637  /*  /*
638   *----------------------------------------------------------------------   *----------------------------------------------------------------------
639   *   *
640   * Tcl_GetStdChannel --   * Tcl_GetStdChannel --
641   *   *
642   *      Returns the specified standard channel.   *      Returns the specified standard channel.
643   *   *
644   * Results:   * Results:
645   *      Returns the specified standard channel, or NULL.   *      Returns the specified standard channel, or NULL.
646   *   *
647   * Side effects:   * Side effects:
648   *      May cause the creation of a standard channel and the underlying   *      May cause the creation of a standard channel and the underlying
649   *      file.   *      file.
650   *   *
651   *----------------------------------------------------------------------   *----------------------------------------------------------------------
652   */   */
653  Tcl_Channel  Tcl_Channel
654  Tcl_GetStdChannel(type)  Tcl_GetStdChannel(type)
655      int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */      int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
656  {  {
657      Tcl_Channel channel = NULL;      Tcl_Channel channel = NULL;
658      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
659    
660      /*      /*
661       * If the channels were not created yet, create them now and       * If the channels were not created yet, create them now and
662       * store them in the static variables.       * store them in the static variables.
663       */       */
664    
665      switch (type) {      switch (type) {
666          case TCL_STDIN:          case TCL_STDIN:
667              if (!tsdPtr->stdinInitialized) {              if (!tsdPtr->stdinInitialized) {
668                  tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);                  tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
669                  tsdPtr->stdinInitialized = 1;                  tsdPtr->stdinInitialized = 1;
670    
671                  /*                  /*
672                   * Artificially bump the refcount to ensure that the channel                   * Artificially bump the refcount to ensure that the channel
673                   * is only closed on exit.                   * is only closed on exit.
674                   *                   *
675                   * NOTE: Must only do this if stdinChannel is not NULL. It                   * NOTE: Must only do this if stdinChannel is not NULL. It
676                   * can be NULL in situations where Tcl is unable to connect                   * can be NULL in situations where Tcl is unable to connect
677                   * to the standard input.                   * to the standard input.
678                   */                   */
679    
680                  if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {                  if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
681                      (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,                      (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
682                              tsdPtr->stdinChannel);                              tsdPtr->stdinChannel);
683                  }                  }
684              }              }
685              channel = tsdPtr->stdinChannel;              channel = tsdPtr->stdinChannel;
686              break;              break;
687          case TCL_STDOUT:          case TCL_STDOUT:
688              if (!tsdPtr->stdoutInitialized) {              if (!tsdPtr->stdoutInitialized) {
689                  tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);                  tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
690                  tsdPtr->stdoutInitialized = 1;                  tsdPtr->stdoutInitialized = 1;
691                  if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {                  if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
692                      (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,                      (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
693                              tsdPtr->stdoutChannel);                              tsdPtr->stdoutChannel);
694                  }                  }
695              }              }
696              channel = tsdPtr->stdoutChannel;              channel = tsdPtr->stdoutChannel;
697              break;              break;
698          case TCL_STDERR:          case TCL_STDERR:
699              if (!tsdPtr->stderrInitialized) {              if (!tsdPtr->stderrInitialized) {
700                  tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);                  tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
701                  tsdPtr->stderrInitialized = 1;                  tsdPtr->stderrInitialized = 1;
702                  if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {                  if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
703                      (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,                      (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
704                              tsdPtr->stderrChannel);                              tsdPtr->stderrChannel);
705                  }                  }
706              }              }
707              channel = tsdPtr->stderrChannel;              channel = tsdPtr->stderrChannel;
708              break;              break;
709      }      }
710      return channel;      return channel;
711  }  }
712    
713    
714  /*  /*
715   *----------------------------------------------------------------------   *----------------------------------------------------------------------
716   *   *
717   * Tcl_CreateCloseHandler   * Tcl_CreateCloseHandler
718   *   *
719   *      Creates a close callback which will be called when the channel is   *      Creates a close callback which will be called when the channel is
720   *      closed.   *      closed.
721   *   *
722   * Results:   * Results:
723   *      None.   *      None.
724   *   *
725   * Side effects:   * Side effects:
726   *      Causes the callback to be called in the future when the channel   *      Causes the callback to be called in the future when the channel
727   *      will be closed.   *      will be closed.
728   *   *
729   *----------------------------------------------------------------------   *----------------------------------------------------------------------
730   */   */
731    
732  void  void
733  Tcl_CreateCloseHandler(chan, proc, clientData)  Tcl_CreateCloseHandler(chan, proc, clientData)
734      Tcl_Channel chan;           /* The channel for which to create the      Tcl_Channel chan;           /* The channel for which to create the
735                                   * close callback. */                                   * close callback. */
736      Tcl_CloseProc *proc;        /* The callback routine to call when the      Tcl_CloseProc *proc;        /* The callback routine to call when the
737                                   * channel will be closed. */                                   * channel will be closed. */
738      ClientData clientData;      /* Arbitrary data to pass to the      ClientData clientData;      /* Arbitrary data to pass to the
739                                   * close callback. */                                   * close callback. */
740  {  {
741      Channel *chanPtr;      Channel *chanPtr;
742      CloseCallback *cbPtr;      CloseCallback *cbPtr;
743    
744      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
745    
746      cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));      cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
747      cbPtr->proc = proc;      cbPtr->proc = proc;
748      cbPtr->clientData = clientData;      cbPtr->clientData = clientData;
749    
750      cbPtr->nextPtr = chanPtr->closeCbPtr;      cbPtr->nextPtr = chanPtr->closeCbPtr;
751      chanPtr->closeCbPtr = cbPtr;      chanPtr->closeCbPtr = cbPtr;
752  }  }
753    
754  /*  /*
755   *----------------------------------------------------------------------   *----------------------------------------------------------------------
756   *   *
757   * Tcl_DeleteCloseHandler --   * Tcl_DeleteCloseHandler --
758   *   *
759   *      Removes a callback that would have been called on closing   *      Removes a callback that would have been called on closing
760   *      the channel. If there is no matching callback then this   *      the channel. If there is no matching callback then this
761   *      function has no effect.   *      function has no effect.
762   *   *
763   * Results:   * Results:
764   *      None.   *      None.
765   *   *
766   * Side effects:   * Side effects:
767   *      The callback will not be called in the future when the channel   *      The callback will not be called in the future when the channel
768   *      is eventually closed.   *      is eventually closed.
769   *   *
770   *----------------------------------------------------------------------   *----------------------------------------------------------------------
771   */   */
772    
773  void  void
774  Tcl_DeleteCloseHandler(chan, proc, clientData)  Tcl_DeleteCloseHandler(chan, proc, clientData)
775      Tcl_Channel chan;           /* The channel for which to cancel the      Tcl_Channel chan;           /* The channel for which to cancel the
776                                   * close callback. */                                   * close callback. */
777      Tcl_CloseProc *proc;        /* The procedure for the callback to      Tcl_CloseProc *proc;        /* The procedure for the callback to
778                                   * remove. */                                   * remove. */
779      ClientData clientData;      /* The callback data for the callback      ClientData clientData;      /* The callback data for the callback
780                                   * to remove. */                                   * to remove. */
781  {  {
782      Channel *chanPtr;      Channel *chanPtr;
783      CloseCallback *cbPtr, *cbPrevPtr;      CloseCallback *cbPtr, *cbPrevPtr;
784    
785      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
786      for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;      for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
787               cbPtr != (CloseCallback *) NULL;               cbPtr != (CloseCallback *) NULL;
788               cbPtr = cbPtr->nextPtr) {               cbPtr = cbPtr->nextPtr) {
789          if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {          if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
790              if (cbPrevPtr == (CloseCallback *) NULL) {              if (cbPrevPtr == (CloseCallback *) NULL) {
791                  chanPtr->closeCbPtr = cbPtr->nextPtr;                  chanPtr->closeCbPtr = cbPtr->nextPtr;
792              }              }
793              ckfree((char *) cbPtr);              ckfree((char *) cbPtr);
794              break;              break;
795          } else {          } else {
796              cbPrevPtr = cbPtr;              cbPrevPtr = cbPtr;
797          }          }
798      }      }
799  }  }
800    
801  /*  /*
802   *----------------------------------------------------------------------   *----------------------------------------------------------------------
803   *   *
804   * GetChannelTable --   * GetChannelTable --
805   *   *
806   *      Gets and potentially initializes the channel table for an   *      Gets and potentially initializes the channel table for an
807   *      interpreter. If it is initializing the table it also inserts   *      interpreter. If it is initializing the table it also inserts
808   *      channels for stdin, stdout and stderr if the interpreter is   *      channels for stdin, stdout and stderr if the interpreter is
809   *      trusted.   *      trusted.
810   *   *
811   * Results:   * Results:
812   *      A pointer to the hash table created, for use by the caller.   *      A pointer to the hash table created, for use by the caller.
813   *   *
814   * Side effects:   * Side effects:
815   *      Initializes the channel table for an interpreter. May create   *      Initializes the channel table for an interpreter. May create
816   *      channels for stdin, stdout and stderr.   *      channels for stdin, stdout and stderr.
817   *   *
818   *----------------------------------------------------------------------   *----------------------------------------------------------------------
819   */   */
820    
821  static Tcl_HashTable *  static Tcl_HashTable *
822  GetChannelTable(interp)  GetChannelTable(interp)
823      Tcl_Interp *interp;      Tcl_Interp *interp;
824  {  {
825      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
826      Tcl_Channel stdinChan, stdoutChan, stderrChan;      Tcl_Channel stdinChan, stdoutChan, stderrChan;
827    
828      hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);      hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
829      if (hTblPtr == (Tcl_HashTable *) NULL) {      if (hTblPtr == (Tcl_HashTable *) NULL) {
830          hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));          hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
831          Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);          Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
832    
833          (void) Tcl_SetAssocData(interp, "tclIO",          (void) Tcl_SetAssocData(interp, "tclIO",
834                  (Tcl_InterpDeleteProc *) DeleteChannelTable,                  (Tcl_InterpDeleteProc *) DeleteChannelTable,
835                  (ClientData) hTblPtr);                  (ClientData) hTblPtr);
836    
837          /*          /*
838           * If the interpreter is trusted (not "safe"), insert channels           * If the interpreter is trusted (not "safe"), insert channels
839           * for stdin, stdout and stderr (possibly creating them in the           * for stdin, stdout and stderr (possibly creating them in the
840           * process).           * process).
841           */           */
842    
843          if (Tcl_IsSafe(interp) == 0) {          if (Tcl_IsSafe(interp) == 0) {
844              stdinChan = Tcl_GetStdChannel(TCL_STDIN);              stdinChan = Tcl_GetStdChannel(TCL_STDIN);
845              if (stdinChan != NULL) {              if (stdinChan != NULL) {
846                  Tcl_RegisterChannel(interp, stdinChan);                  Tcl_RegisterChannel(interp, stdinChan);
847              }              }
848              stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);              stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
849              if (stdoutChan != NULL) {              if (stdoutChan != NULL) {
850                  Tcl_RegisterChannel(interp, stdoutChan);                  Tcl_RegisterChannel(interp, stdoutChan);
851              }              }
852              stderrChan = Tcl_GetStdChannel(TCL_STDERR);              stderrChan = Tcl_GetStdChannel(TCL_STDERR);
853              if (stderrChan != NULL) {              if (stderrChan != NULL) {
854                  Tcl_RegisterChannel(interp, stderrChan);                  Tcl_RegisterChannel(interp, stderrChan);
855              }              }
856          }          }
857    
858      }      }
859      return hTblPtr;      return hTblPtr;
860  }  }
861    
862  /*  /*
863   *----------------------------------------------------------------------   *----------------------------------------------------------------------
864   *   *
865   * DeleteChannelTable --   * DeleteChannelTable --
866   *   *
867   *      Deletes the channel table for an interpreter, closing any open   *      Deletes the channel table for an interpreter, closing any open
868   *      channels whose refcount reaches zero. This procedure is invoked   *      channels whose refcount reaches zero. This procedure is invoked
869   *      when an interpreter is deleted, via the AssocData cleanup   *      when an interpreter is deleted, via the AssocData cleanup
870   *      mechanism.   *      mechanism.
871   *   *
872   * Results:   * Results:
873   *      None.   *      None.
874   *   *
875   * Side effects:   * Side effects:
876   *      Deletes the hash table of channels. May close channels. May flush   *      Deletes the hash table of channels. May close channels. May flush
877   *      output on closed channels. Removes any channeEvent handlers that were   *      output on closed channels. Removes any channeEvent handlers that were
878   *      registered in this interpreter.   *      registered in this interpreter.
879   *   *
880   *----------------------------------------------------------------------   *----------------------------------------------------------------------
881   */   */
882    
883  static void  static void
884  DeleteChannelTable(clientData, interp)  DeleteChannelTable(clientData, interp)
885      ClientData clientData;      /* The per-interpreter data structure. */      ClientData clientData;      /* The per-interpreter data structure. */
886      Tcl_Interp *interp;         /* The interpreter being deleted. */      Tcl_Interp *interp;         /* The interpreter being deleted. */
887  {  {
888      Tcl_HashTable *hTblPtr;     /* The hash table. */      Tcl_HashTable *hTblPtr;     /* The hash table. */
889      Tcl_HashSearch hSearch;     /* Search variable. */      Tcl_HashSearch hSearch;     /* Search variable. */
890      Tcl_HashEntry *hPtr;        /* Search variable. */      Tcl_HashEntry *hPtr;        /* Search variable. */
891      Channel *chanPtr;   /* Channel being deleted. */      Channel *chanPtr;   /* Channel being deleted. */
892      EventScriptRecord *sPtr, *prevPtr, *nextPtr;      EventScriptRecord *sPtr, *prevPtr, *nextPtr;
893                                  /* Variables to loop over all channel events                                  /* Variables to loop over all channel events
894                                   * registered, to delete the ones that refer                                   * registered, to delete the ones that refer
895                                   * to the interpreter being deleted. */                                   * to the interpreter being deleted. */
896            
897      /*      /*
898       * Delete all the registered channels - this will close channels whose       * Delete all the registered channels - this will close channels whose
899       * refcount reaches zero.       * refcount reaches zero.
900       */       */
901            
902      hTblPtr = (Tcl_HashTable *) clientData;      hTblPtr = (Tcl_HashTable *) clientData;
903      for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);      for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
904               hPtr != (Tcl_HashEntry *) NULL;               hPtr != (Tcl_HashEntry *) NULL;
905               hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {               hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
906    
907          chanPtr = (Channel *) Tcl_GetHashValue(hPtr);          chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
908    
909          /*          /*
910           * Remove any fileevents registered in this interpreter.           * Remove any fileevents registered in this interpreter.
911           */           */
912                    
913          for (sPtr = chanPtr->scriptRecordPtr,          for (sPtr = chanPtr->scriptRecordPtr,
914                   prevPtr = (EventScriptRecord *) NULL;                   prevPtr = (EventScriptRecord *) NULL;
915                   sPtr != (EventScriptRecord *) NULL;                   sPtr != (EventScriptRecord *) NULL;
916                   sPtr = nextPtr) {                   sPtr = nextPtr) {
917              nextPtr = sPtr->nextPtr;              nextPtr = sPtr->nextPtr;
918              if (sPtr->interp == interp) {              if (sPtr->interp == interp) {
919                  if (prevPtr == (EventScriptRecord *) NULL) {                  if (prevPtr == (EventScriptRecord *) NULL) {
920                      chanPtr->scriptRecordPtr = nextPtr;                      chanPtr->scriptRecordPtr = nextPtr;
921                  } else {                  } else {
922                      prevPtr->nextPtr = nextPtr;                      prevPtr->nextPtr = nextPtr;
923                  }                  }
924    
925                  Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,                  Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
926                          ChannelEventScriptInvoker, (ClientData) sPtr);                          ChannelEventScriptInvoker, (ClientData) sPtr);
927    
928                  Tcl_DecrRefCount(sPtr->scriptPtr);                  Tcl_DecrRefCount(sPtr->scriptPtr);
929                  ckfree((char *) sPtr);                  ckfree((char *) sPtr);
930              } else {              } else {
931                  prevPtr = sPtr;                  prevPtr = sPtr;
932              }              }
933          }          }
934    
935          /*          /*
936           * Cannot call Tcl_UnregisterChannel because that procedure calls           * Cannot call Tcl_UnregisterChannel because that procedure calls
937           * Tcl_GetAssocData to get the channel table, which might already           * Tcl_GetAssocData to get the channel table, which might already
938           * be inaccessible from the interpreter structure. Instead, we           * be inaccessible from the interpreter structure. Instead, we
939           * emulate the behavior of Tcl_UnregisterChannel directly here.           * emulate the behavior of Tcl_UnregisterChannel directly here.
940           */           */
941    
942          Tcl_DeleteHashEntry(hPtr);          Tcl_DeleteHashEntry(hPtr);
943          chanPtr->refCount--;          chanPtr->refCount--;
944          if (chanPtr->refCount <= 0) {          if (chanPtr->refCount <= 0) {
945              if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {              if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
946                  (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);                  (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
947              }              }
948          }          }
949      }      }
950      Tcl_DeleteHashTable(hTblPtr);      Tcl_DeleteHashTable(hTblPtr);
951      ckfree((char *) hTblPtr);      ckfree((char *) hTblPtr);
952  }  }
953    
954  /*  /*
955   *----------------------------------------------------------------------   *----------------------------------------------------------------------
956   *   *
957   * CheckForStdChannelsBeingClosed --   * CheckForStdChannelsBeingClosed --
958   *   *
959   *      Perform special handling for standard channels being closed. When   *      Perform special handling for standard channels being closed. When
960   *      given a standard channel, if the refcount is now 1, it means that   *      given a standard channel, if the refcount is now 1, it means that
961   *      the last reference to the standard channel is being explicitly   *      the last reference to the standard channel is being explicitly
962   *      closed. Now bump the refcount artificially down to 0, to ensure the   *      closed. Now bump the refcount artificially down to 0, to ensure the
963   *      normal handling of channels being closed will occur. Also reset the   *      normal handling of channels being closed will occur. Also reset the
964   *      static pointer to the channel to NULL, to avoid dangling references.   *      static pointer to the channel to NULL, to avoid dangling references.
965   *   *
966   * Results:   * Results:
967   *      None.   *      None.
968   *   *
969   * Side effects:   * Side effects:
970   *      Manipulates the refcount on standard channels. May smash the global   *      Manipulates the refcount on standard channels. May smash the global
971   *      static pointer to a standard channel.   *      static pointer to a standard channel.
972   *   *
973   *----------------------------------------------------------------------   *----------------------------------------------------------------------
974   */   */
975    
976  static void  static void
977  CheckForStdChannelsBeingClosed(chan)  CheckForStdChannelsBeingClosed(chan)
978      Tcl_Channel chan;      Tcl_Channel chan;
979  {  {
980      Channel *chanPtr = (Channel *) chan;      Channel *chanPtr = (Channel *) chan;
981      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
982    
983      if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {      if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
984          if (chanPtr->refCount < 2) {          if (chanPtr->refCount < 2) {
985              chanPtr->refCount = 0;              chanPtr->refCount = 0;
986              tsdPtr->stdinChannel = NULL;              tsdPtr->stdinChannel = NULL;
987              return;              return;
988          }          }
989      } else if ((chan == tsdPtr->stdoutChannel) && (tsdPtr->stdoutInitialized)) {      } else if ((chan == tsdPtr->stdoutChannel) && (tsdPtr->stdoutInitialized)) {
990          if (chanPtr->refCount < 2) {          if (chanPtr->refCount < 2) {
991              chanPtr->refCount = 0;              chanPtr->refCount = 0;
992              tsdPtr->stdoutChannel = NULL;              tsdPtr->stdoutChannel = NULL;
993              return;              return;
994          }          }
995      } else if ((chan == tsdPtr->stderrChannel) && (tsdPtr->stderrInitialized)) {      } else if ((chan == tsdPtr->stderrChannel) && (tsdPtr->stderrInitialized)) {
996          if (chanPtr->refCount < 2) {          if (chanPtr->refCount < 2) {
997              chanPtr->refCount = 0;              chanPtr->refCount = 0;
998              tsdPtr->stderrChannel = NULL;              tsdPtr->stderrChannel = NULL;
999              return;              return;
1000          }          }
1001      }      }
1002  }  }
1003    
1004  /*  /*
1005   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1006   *   *
1007   * Tcl_RegisterChannel --   * Tcl_RegisterChannel --
1008   *   *
1009   *      Adds an already-open channel to the channel table of an interpreter.   *      Adds an already-open channel to the channel table of an interpreter.
1010   *      If the interpreter passed as argument is NULL, it only increments   *      If the interpreter passed as argument is NULL, it only increments
1011   *      the channel refCount.   *      the channel refCount.
1012   *   *
1013   * Results:   * Results:
1014   *      None.   *      None.
1015   *   *
1016   * Side effects:   * Side effects:
1017   *      May increment the reference count of a channel.   *      May increment the reference count of a channel.
1018   *   *
1019   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1020   */   */
1021    
1022  void  void
1023  Tcl_RegisterChannel(interp, chan)  Tcl_RegisterChannel(interp, chan)
1024      Tcl_Interp *interp;         /* Interpreter in which to add the channel. */      Tcl_Interp *interp;         /* Interpreter in which to add the channel. */
1025      Tcl_Channel chan;           /* The channel to add to this interpreter      Tcl_Channel chan;           /* The channel to add to this interpreter
1026                                   * channel table. */                                   * channel table. */
1027  {  {
1028      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
1029      Tcl_HashEntry *hPtr;        /* Search variable. */      Tcl_HashEntry *hPtr;        /* Search variable. */
1030      int new;                    /* Is the hash entry new or does it exist? */      int new;                    /* Is the hash entry new or does it exist? */
1031      Channel *chanPtr;           /* The actual channel. */      Channel *chanPtr;           /* The actual channel. */
1032    
1033      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
1034    
1035      if (chanPtr->channelName == (char *) NULL) {      if (chanPtr->channelName == (char *) NULL) {
1036          panic("Tcl_RegisterChannel: channel without name");          panic("Tcl_RegisterChannel: channel without name");
1037      }      }
1038      if (interp != (Tcl_Interp *) NULL) {      if (interp != (Tcl_Interp *) NULL) {
1039          hTblPtr = GetChannelTable(interp);          hTblPtr = GetChannelTable(interp);
1040          hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);          hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
1041          if (new == 0) {          if (new == 0) {
1042              if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {              if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
1043                  return;                  return;
1044              }              }
1045    
1046              /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998              /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
1047               * "Trf-Patch for filtering channels"               * "Trf-Patch for filtering channels"
1048               *               *
1049               * This is the change to 'Tcl_RegisterChannel'.               * This is the change to 'Tcl_RegisterChannel'.
1050               *               *
1051               * Explanation:               * Explanation:
1052               *          The moment a channel is stacked upon another he               *          The moment a channel is stacked upon another he
1053               *          takes the identity of the channel he supercedes,               *          takes the identity of the channel he supercedes,
1054               *          i.e. he gets the *same* name. Because of this we               *          i.e. he gets the *same* name. Because of this we
1055               *          cannot check for duplicate names anymore, they               *          cannot check for duplicate names anymore, they
1056               *          have to be allowed now.               *          have to be allowed now.
1057               */               */
1058    
1059              /* panic("Tcl_RegisterChannel: duplicate channel names"); */              /* panic("Tcl_RegisterChannel: duplicate channel names"); */
1060          }          }
1061          Tcl_SetHashValue(hPtr, (ClientData) chanPtr);          Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
1062      }      }
1063      chanPtr->refCount++;      chanPtr->refCount++;
1064  }  }
1065    
1066  /*  /*
1067   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1068   *   *
1069   * Tcl_UnregisterChannel --   * Tcl_UnregisterChannel --
1070   *   *
1071   *      Deletes the hash entry for a channel associated with an interpreter.   *      Deletes the hash entry for a channel associated with an interpreter.
1072   *      If the interpreter given as argument is NULL, it only decrements the   *      If the interpreter given as argument is NULL, it only decrements the
1073   *      reference count.   *      reference count.
1074   *   *
1075   * Results:   * Results:
1076   *      A standard Tcl result.   *      A standard Tcl result.
1077   *   *
1078   * Side effects:   * Side effects:
1079   *      Deletes the hash entry for a channel associated with an interpreter.   *      Deletes the hash entry for a channel associated with an interpreter.
1080   *   *
1081   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1082   */   */
1083    
1084  int  int
1085  Tcl_UnregisterChannel(interp, chan)  Tcl_UnregisterChannel(interp, chan)
1086      Tcl_Interp *interp;         /* Interpreter in which channel is defined. */      Tcl_Interp *interp;         /* Interpreter in which channel is defined. */
1087      Tcl_Channel chan;           /* Channel to delete. */      Tcl_Channel chan;           /* Channel to delete. */
1088  {  {
1089      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
1090      Tcl_HashEntry *hPtr;        /* Search variable. */      Tcl_HashEntry *hPtr;        /* Search variable. */
1091      Channel *chanPtr;           /* The real IO channel. */      Channel *chanPtr;           /* The real IO channel. */
1092    
1093      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
1094            
1095      if (interp != (Tcl_Interp *) NULL) {      if (interp != (Tcl_Interp *) NULL) {
1096          hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);          hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
1097          if (hTblPtr == (Tcl_HashTable *) NULL) {          if (hTblPtr == (Tcl_HashTable *) NULL) {
1098              return TCL_OK;              return TCL_OK;
1099          }          }
1100          hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);          hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
1101          if (hPtr == (Tcl_HashEntry *) NULL) {          if (hPtr == (Tcl_HashEntry *) NULL) {
1102              return TCL_OK;              return TCL_OK;
1103          }          }
1104          if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {          if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
1105              return TCL_OK;              return TCL_OK;
1106          }          }
1107          Tcl_DeleteHashEntry(hPtr);          Tcl_DeleteHashEntry(hPtr);
1108    
1109          /*          /*
1110           * Remove channel handlers that refer to this interpreter, so that they           * 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           * 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           * happen on the channel. This may occur if the channel is shared
1113           * between several interpreters, or if the channel has async           * between several interpreters, or if the channel has async
1114           * flushing active.           * flushing active.
1115           */           */
1116            
1117          CleanupChannelHandlers(interp, chanPtr);          CleanupChannelHandlers(interp, chanPtr);
1118      }      }
1119    
1120      chanPtr->refCount--;      chanPtr->refCount--;
1121            
1122      /*      /*
1123       * Perform special handling for standard channels being closed. If the       * Perform special handling for standard channels being closed. If the
1124       * refCount is now 1 it means that the last reference to the standard       * refCount is now 1 it means that the last reference to the standard
1125       * channel is being explicitly closed, so bump the refCount down       * channel is being explicitly closed, so bump the refCount down
1126       * artificially to 0. This will ensure that the channel is actually       * artificially to 0. This will ensure that the channel is actually
1127       * closed, below. Also set the static pointer to NULL for the channel.       * closed, below. Also set the static pointer to NULL for the channel.
1128       */       */
1129    
1130      CheckForStdChannelsBeingClosed(chan);      CheckForStdChannelsBeingClosed(chan);
1131    
1132      /*      /*
1133       * If the refCount reached zero, close the actual channel.       * If the refCount reached zero, close the actual channel.
1134       */       */
1135    
1136      if (chanPtr->refCount <= 0) {      if (chanPtr->refCount <= 0) {
1137    
1138          /*          /*
1139           * Ensure that if there is another buffer, it gets flushed           * Ensure that if there is another buffer, it gets flushed
1140           * whether or not we are doing a background flush.           * whether or not we are doing a background flush.
1141           */           */
1142    
1143          if ((chanPtr->curOutPtr != NULL) &&          if ((chanPtr->curOutPtr != NULL) &&
1144                  (chanPtr->curOutPtr->nextAdded >                  (chanPtr->curOutPtr->nextAdded >
1145                          chanPtr->curOutPtr->nextRemoved)) {                          chanPtr->curOutPtr->nextRemoved)) {
1146              chanPtr->flags |= BUFFER_READY;              chanPtr->flags |= BUFFER_READY;
1147          }          }
1148          chanPtr->flags |= CHANNEL_CLOSED;          chanPtr->flags |= CHANNEL_CLOSED;
1149          if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {          if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
1150              if (Tcl_Close(interp, chan) != TCL_OK) {              if (Tcl_Close(interp, chan) != TCL_OK) {
1151                  return TCL_ERROR;                  return TCL_ERROR;
1152              }              }
1153          }          }
1154      }      }
1155      return TCL_OK;      return TCL_OK;
1156  }  }
1157    
1158  /*  /*
1159   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
1160   *   *
1161   * Tcl_GetChannel --   * Tcl_GetChannel --
1162   *   *
1163   *      Finds an existing Tcl_Channel structure by name in a given   *      Finds an existing Tcl_Channel structure by name in a given
1164   *      interpreter. This function is public because it is used by   *      interpreter. This function is public because it is used by
1165   *      channel-type-specific functions.   *      channel-type-specific functions.
1166   *   *
1167   * Results:   * Results:
1168   *      A Tcl_Channel or NULL on failure. If failed, interp's result   *      A Tcl_Channel or NULL on failure. If failed, interp's result
1169   *      object contains an error message.  *modePtr is filled with the   *      object contains an error message.  *modePtr is filled with the
1170   *      modes in which the channel was opened.   *      modes in which the channel was opened.
1171   *   *
1172   * Side effects:   * Side effects:
1173   *      None.   *      None.
1174   *   *
1175   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
1176   */   */
1177    
1178  Tcl_Channel  Tcl_Channel
1179  Tcl_GetChannel(interp, chanName, modePtr)  Tcl_GetChannel(interp, chanName, modePtr)
1180      Tcl_Interp *interp;         /* Interpreter in which to find or create      Tcl_Interp *interp;         /* Interpreter in which to find or create
1181                                   * the channel. */                                   * the channel. */
1182      char *chanName;             /* The name of the channel. */      char *chanName;             /* The name of the channel. */
1183      int *modePtr;               /* Where to store the mode in which the      int *modePtr;               /* Where to store the mode in which the
1184                                   * channel was opened? Will contain an ORed                                   * channel was opened? Will contain an ORed
1185                                   * combination of TCL_READABLE and                                   * combination of TCL_READABLE and
1186                                   * TCL_WRITABLE, if non-NULL. */                                   * TCL_WRITABLE, if non-NULL. */
1187  {  {
1188      Channel *chanPtr;           /* The actual channel. */      Channel *chanPtr;           /* The actual channel. */
1189      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
1190      Tcl_HashEntry *hPtr;        /* Search variable. */      Tcl_HashEntry *hPtr;        /* Search variable. */
1191      char *name;                 /* Translated name. */      char *name;                 /* Translated name. */
1192    
1193      /*      /*
1194       * Substitute "stdin", etc.  Note that even though we immediately       * Substitute "stdin", etc.  Note that even though we immediately
1195       * find the channel using Tcl_GetStdChannel, we still need to look       * find the channel using Tcl_GetStdChannel, we still need to look
1196       * it up in the specified interpreter to ensure that it is present       * it up in the specified interpreter to ensure that it is present
1197       * in the channel table.  Otherwise, safe interpreters would always       * in the channel table.  Otherwise, safe interpreters would always
1198       * have access to the standard channels.       * have access to the standard channels.
1199       */       */
1200    
1201      name = chanName;      name = chanName;
1202      if ((chanName[0] == 's') && (chanName[1] == 't')) {      if ((chanName[0] == 's') && (chanName[1] == 't')) {
1203          chanPtr = NULL;          chanPtr = NULL;
1204          if (strcmp(chanName, "stdin") == 0) {          if (strcmp(chanName, "stdin") == 0) {
1205              chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);              chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
1206          } else if (strcmp(chanName, "stdout") == 0) {          } else if (strcmp(chanName, "stdout") == 0) {
1207              chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);              chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
1208          } else if (strcmp(chanName, "stderr") == 0) {          } else if (strcmp(chanName, "stderr") == 0) {
1209              chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);              chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
1210          }          }
1211          if (chanPtr != NULL) {          if (chanPtr != NULL) {
1212              name = chanPtr->channelName;              name = chanPtr->channelName;
1213          }          }
1214      }      }
1215            
1216      hTblPtr = GetChannelTable(interp);      hTblPtr = GetChannelTable(interp);
1217      hPtr = Tcl_FindHashEntry(hTblPtr, name);      hPtr = Tcl_FindHashEntry(hTblPtr, name);
1218      if (hPtr == (Tcl_HashEntry *) NULL) {      if (hPtr == (Tcl_HashEntry *) NULL) {
1219          Tcl_AppendResult(interp, "can not find channel named \"",          Tcl_AppendResult(interp, "can not find channel named \"",
1220                  chanName, "\"", (char *) NULL);                  chanName, "\"", (char *) NULL);
1221          return NULL;          return NULL;
1222      }      }
1223    
1224      chanPtr = (Channel *) Tcl_GetHashValue(hPtr);      chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
1225      if (modePtr != NULL) {      if (modePtr != NULL) {
1226          *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));          *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
1227      }      }
1228            
1229      return (Tcl_Channel) chanPtr;      return (Tcl_Channel) chanPtr;
1230  }  }
1231    
1232  /*  /*
1233   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1234   *   *
1235   * Tcl_CreateChannel --   * Tcl_CreateChannel --
1236   *   *
1237   *      Creates a new entry in the hash table for a Tcl_Channel   *      Creates a new entry in the hash table for a Tcl_Channel
1238   *      record.   *      record.
1239   *   *
1240   * Results:   * Results:
1241   *      Returns the new Tcl_Channel.   *      Returns the new Tcl_Channel.
1242   *   *
1243   * Side effects:   * Side effects:
1244   *      Creates a new Tcl_Channel instance and inserts it into the   *      Creates a new Tcl_Channel instance and inserts it into the
1245   *      hash table.   *      hash table.
1246   *   *
1247   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1248   */   */
1249    
1250  Tcl_Channel  Tcl_Channel
1251  Tcl_CreateChannel(typePtr, chanName, instanceData, mask)  Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
1252      Tcl_ChannelType *typePtr;   /* The channel type record. */      Tcl_ChannelType *typePtr;   /* The channel type record. */
1253      char *chanName;             /* Name of channel to record. */      char *chanName;             /* Name of channel to record. */
1254      ClientData instanceData;    /* Instance specific data. */      ClientData instanceData;    /* Instance specific data. */
1255      int mask;                   /* TCL_READABLE & TCL_WRITABLE to indicate      int mask;                   /* TCL_READABLE & TCL_WRITABLE to indicate
1256                                   * if the channel is readable, writable. */                                   * if the channel is readable, writable. */
1257  {  {
1258      Channel *chanPtr;           /* The channel structure newly created. */      Channel *chanPtr;           /* The channel structure newly created. */
1259      CONST char *name;      CONST char *name;
1260      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1261    
1262      chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));      chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1263            
1264      if (chanName != (char *) NULL) {      if (chanName != (char *) NULL) {
1265          chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));          chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
1266          strcpy(chanPtr->channelName, chanName);          strcpy(chanPtr->channelName, chanName);
1267      } else {      } else {
1268          panic("Tcl_CreateChannel: NULL channel name");          panic("Tcl_CreateChannel: NULL channel name");
1269      }      }
1270    
1271      chanPtr->flags = mask;      chanPtr->flags = mask;
1272    
1273      /*      /*
1274       * Set the channel to system default encoding.       * Set the channel to system default encoding.
1275       */       */
1276    
1277      chanPtr->encoding = NULL;      chanPtr->encoding = NULL;
1278      name = Tcl_GetEncodingName(NULL);      name = Tcl_GetEncodingName(NULL);
1279      if (strcmp(name, "binary") != 0) {      if (strcmp(name, "binary") != 0) {
1280          chanPtr->encoding = Tcl_GetEncoding(NULL, name);          chanPtr->encoding = Tcl_GetEncoding(NULL, name);
1281      }      }
1282      chanPtr->inputEncodingState = NULL;      chanPtr->inputEncodingState = NULL;
1283      chanPtr->inputEncodingFlags = TCL_ENCODING_START;      chanPtr->inputEncodingFlags = TCL_ENCODING_START;
1284      chanPtr->outputEncodingState = NULL;      chanPtr->outputEncodingState = NULL;
1285      chanPtr->outputEncodingFlags = TCL_ENCODING_START;      chanPtr->outputEncodingFlags = TCL_ENCODING_START;
1286    
1287      /*      /*
1288       * Set the channel up initially in AUTO input translation mode to       * Set the channel up initially in AUTO input translation mode to
1289       * accept "\n", "\r" and "\r\n". Output translation mode is set to       * 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       * 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       * 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.       * indicator (e.g. ^Z) and does not append an EOF indicator to files.
1293       */       */
1294    
1295      chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;      chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
1296      chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;      chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
1297      chanPtr->inEofChar = 0;      chanPtr->inEofChar = 0;
1298      chanPtr->outEofChar = 0;      chanPtr->outEofChar = 0;
1299    
1300      chanPtr->unreportedError = 0;      chanPtr->unreportedError = 0;
1301      chanPtr->instanceData = instanceData;      chanPtr->instanceData = instanceData;
1302      chanPtr->typePtr = typePtr;      chanPtr->typePtr = typePtr;
1303      chanPtr->refCount = 0;      chanPtr->refCount = 0;
1304      chanPtr->closeCbPtr = (CloseCallback *) NULL;      chanPtr->closeCbPtr = (CloseCallback *) NULL;
1305      chanPtr->curOutPtr = (ChannelBuffer *) NULL;      chanPtr->curOutPtr = (ChannelBuffer *) NULL;
1306      chanPtr->outQueueHead = (ChannelBuffer *) NULL;      chanPtr->outQueueHead = (ChannelBuffer *) NULL;
1307      chanPtr->outQueueTail = (ChannelBuffer *) NULL;      chanPtr->outQueueTail = (ChannelBuffer *) NULL;
1308      chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;      chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
1309      chanPtr->inQueueHead = (ChannelBuffer *) NULL;      chanPtr->inQueueHead = (ChannelBuffer *) NULL;
1310      chanPtr->inQueueTail = (ChannelBuffer *) NULL;      chanPtr->inQueueTail = (ChannelBuffer *) NULL;
1311      chanPtr->chPtr = (ChannelHandler *) NULL;      chanPtr->chPtr = (ChannelHandler *) NULL;
1312      chanPtr->interestMask = 0;      chanPtr->interestMask = 0;
1313      chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;      chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
1314      chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;      chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
1315      chanPtr->timer = NULL;      chanPtr->timer = NULL;
1316      chanPtr->csPtr = NULL;      chanPtr->csPtr = NULL;
1317      chanPtr->supercedes = (Channel*) NULL;      chanPtr->supercedes = (Channel*) NULL;
1318    
1319      chanPtr->outputStage = NULL;      chanPtr->outputStage = NULL;
1320      if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {      if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1321          chanPtr->outputStage = (char *)          chanPtr->outputStage = (char *)
1322                  ckalloc((unsigned) (chanPtr->bufSize + 2));                  ckalloc((unsigned) (chanPtr->bufSize + 2));
1323      }      }
1324    
1325      /*      /*
1326       * Link the channel into the list of all channels; create an on-exit       * 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       * handler if there is not one already, to close off all the channels
1328       * in the list on exit.       * in the list on exit.
1329       */       */
1330    
1331      chanPtr->nextChanPtr = tsdPtr->firstChanPtr;      chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
1332      tsdPtr->firstChanPtr = chanPtr;      tsdPtr->firstChanPtr = chanPtr;
1333    
1334      /*      /*
1335       * Install this channel in the first empty standard channel slot, if       * Install this channel in the first empty standard channel slot, if
1336       * the channel was previously closed explicitly.       * the channel was previously closed explicitly.
1337       */       */
1338    
1339      if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {      if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
1340          Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);          Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
1341          Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);          Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1342      } else if ((tsdPtr->stdoutChannel == NULL) && (tsdPtr->stdoutInitialized == 1)) {      } else if ((tsdPtr->stdoutChannel == NULL) && (tsdPtr->stdoutInitialized == 1)) {
1343          Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);          Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
1344          Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);          Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1345      } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) {      } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) {
1346          Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);          Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
1347          Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);          Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
1348      }      }
1349      return (Tcl_Channel) chanPtr;      return (Tcl_Channel) chanPtr;
1350  }  }
1351    
1352  /*  /*
1353   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1354   *   *
1355   * Tcl_StackChannel --   * Tcl_StackChannel --
1356   *   *
1357   *      Replaces an entry in the hash table for a Tcl_Channel   *      Replaces an entry in the hash table for a Tcl_Channel
1358   *      record. The replacement is a new channel with same name,   *      record. The replacement is a new channel with same name,
1359   *      it supercedes the replaced channel. Input and output of   *      it supercedes the replaced channel. Input and output of
1360   *      the superceded channel is now going through the newly   *      the superceded channel is now going through the newly
1361   *      created channel and allows the arbitrary filtering/manipulation   *      created channel and allows the arbitrary filtering/manipulation
1362   *      of the dataflow.   *      of the dataflow.
1363   *   *
1364   *      Andreas Kupries <a.kupries@westend.com>, 12/13/1998   *      Andreas Kupries <a.kupries@westend.com>, 12/13/1998
1365   *      "Trf-Patch for filtering channels"   *      "Trf-Patch for filtering channels"
1366   *   *
1367   * Results:   * Results:
1368   *      Returns the new Tcl_Channel, which actually contains the   *      Returns the new Tcl_Channel, which actually contains the
1369   *      saved information about prevChan.   *      saved information about prevChan.
1370   *   *
1371   * Side effects:   * Side effects:
1372   *    A new channel structure is allocated and linked below   *    A new channel structure is allocated and linked below
1373   *    the existing channel.  The channel operations and client   *    the existing channel.  The channel operations and client
1374   *    data of the existing channel are copied down to the newly   *    data of the existing channel are copied down to the newly
1375   *    created channel, and the current channel has its operations   *    created channel, and the current channel has its operations
1376   *    replaced by the new typePtr.   *    replaced by the new typePtr.
1377   *   *
1378   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1379   */   */
1380    
1381  Tcl_Channel  Tcl_Channel
1382  Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)  Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
1383      Tcl_Interp*      interp;       /* The interpreter we are working in */      Tcl_Interp*      interp;       /* The interpreter we are working in */
1384      Tcl_ChannelType *typePtr;      /* The channel type record for the new      Tcl_ChannelType *typePtr;      /* The channel type record for the new
1385                                      * channel. */                                      * channel. */
1386      ClientData       instanceData; /* Instance specific data for the new      ClientData       instanceData; /* Instance specific data for the new
1387                                      * channel. */                                      * channel. */
1388      int              mask;         /* TCL_READABLE & TCL_WRITABLE to indicate      int              mask;         /* TCL_READABLE & TCL_WRITABLE to indicate
1389                                      * if the channel is readable, writable. */                                      * if the channel is readable, writable. */
1390      Tcl_Channel      prevChan;     /* The channel structure to replace */      Tcl_Channel      prevChan;     /* The channel structure to replace */
1391  {  {
1392      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1393      Channel            *chanPtr, *pt;      Channel            *chanPtr, *pt;
1394      int                 interest = 0;      int                 interest = 0;
1395    
1396      /*      /*
1397       * AK, 06/30/1999       * AK, 06/30/1999
1398       *       *
1399       * Tcl_StackChannel differs from Tcl_ReplaceChannel of the       * Tcl_StackChannel differs from Tcl_ReplaceChannel of the
1400       * original "Trf" patch. Instead of seeing the       * original "Trf" patch. Instead of seeing the
1401       * newly created structure as the *new* channel to cover the specified       * 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       * one use it to *save* the current state of the specified channel and
1403       * then reinitialize the current structure for the given transformation.       * then reinitialize the current structure for the given transformation.
1404       *       *
1405       * Advantages:       * Advantages:
1406       * - No splicing into the (thread-)global list of channels (or the per-       * - No splicing into the (thread-)global list of channels (or the per-
1407       *   interp hash-tables).       *   interp hash-tables).
1408       * - Users of the C-API still have valid channel references even after       * - Users of the C-API still have valid channel references even after
1409       *   the call to this procedure.       *   the call to this procedure.
1410       *       *
1411       * Disadvantages:       * Disadvantages:
1412       * - Untested code.       * - Untested code.
1413       */       */
1414    
1415      /*      /*
1416       * Find the given channel in the list of all channels.       * Find the given channel in the list of all channels.
1417       */       */
1418    
1419      pt     = (Channel*) tsdPtr->firstChanPtr;      pt     = (Channel*) tsdPtr->firstChanPtr;
1420    
1421      while (pt != (Channel *) prevChan) {      while (pt != (Channel *) prevChan) {
1422          pt = pt->nextChanPtr;          pt = pt->nextChanPtr;
1423      }      }
1424    
1425      /*      /*
1426       * 'pt == prevChan' now (or NULL, if not found).       * 'pt == prevChan' now (or NULL, if not found).
1427       */       */
1428    
1429      if (!pt) {      if (!pt) {
1430          return (Tcl_Channel) NULL;          return (Tcl_Channel) NULL;
1431      }      }
1432    
1433      /*      /*
1434       * Here we check if the given "mask" matches the "flags"       * Here we check if the given "mask" matches the "flags"
1435       * of the already existing channel.       * of the already existing channel.
1436       *       *
1437       *    | - | R | W | RW |       *    | - | R | W | RW |
1438       *  --+---+---+---+----+    <=>  0 != (chan->mask & prevChan->mask)       *  --+---+---+---+----+    <=>  0 != (chan->mask & prevChan->mask)
1439       *  - |   |   |   |    |       *  - |   |   |   |    |
1440       *  R |   | + |   | +  |    The superceding channel is allowed to       *  R |   | + |   | +  |    The superceding channel is allowed to
1441       *  W |   |   | + | +  |    restrict the capabilities of the       *  W |   |   | + | +  |    restrict the capabilities of the
1442       *  RW|   | + | + | +  |    superceded one !       *  RW|   | + | + | +  |    superceded one !
1443       *  --+---+---+---+----+       *  --+---+---+---+----+
1444       */       */
1445    
1446      if ((mask & Tcl_GetChannelMode (prevChan)) == 0) {      if ((mask & Tcl_GetChannelMode (prevChan)) == 0) {
1447          return (Tcl_Channel) NULL;          return (Tcl_Channel) NULL;
1448      }      }
1449    
1450      chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));      chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
1451    
1452      /*      /*
1453       * If there is some interest in the channel, remove it, break       * If there is some interest in the channel, remove it, break
1454       * down the whole chain. It will be reconstructed later.       * down the whole chain. It will be reconstructed later.
1455       */       */
1456    
1457      interest = pt->interestMask;      interest = pt->interestMask;
1458    
1459      pt->interestMask = 0;      pt->interestMask = 0;
1460    
1461      if (interest) {      if (interest) {
1462          (pt->typePtr->watchProc) (pt->instanceData, 0);          (pt->typePtr->watchProc) (pt->instanceData, 0);
1463      }      }
1464    
1465      /*      /*
1466       * Save some of the current state into the new structure,       * Save some of the current state into the new structure,
1467       * reinitialize the parts which will stay with the transformation.       * reinitialize the parts which will stay with the transformation.
1468       *       *
1469       * Remarks:       * Remarks:
1470       * - We cannot discard the buffers, and they cannot be used from the       * - We cannot discard the buffers, and they cannot be used from the
1471       *   transformation placed later into the 'pt' structure. Save them,       *   transformation placed later into the 'pt' structure. Save them,
1472       *   and believe that Tcl_SetChannelOption (buffering, none) will do       *   and believe that Tcl_SetChannelOption (buffering, none) will do
1473       *   the right thing.       *   the right thing.
1474       * - encoding and EOL-translation control information is initialized       * - encoding and EOL-translation control information is initialized
1475       *   to values for 'binary'. This is later reinforced via       *   to values for 'binary'. This is later reinforced via
1476       *   Tcl_SetChanneloption to get the handling of flags and the event       *   Tcl_SetChanneloption to get the handling of flags and the event
1477       *   system right.       *   system right.
1478       * - The 'interestMask' of the saved channel is cleared, but the       * - The 'interestMask' of the saved channel is cleared, but the
1479       *   transformations WatchProc is used to establish the connection       *   transformations WatchProc is used to establish the connection
1480       *   between transformation and underlying channel. This should       *   between transformation and underlying channel. This should
1481       *   reestablish the correct mask.       *   reestablish the correct mask.
1482       * - TTO = Transform Takes Over.   The hidden channel no longer       * - TTO = Transform Takes Over.   The hidden channel no longer
1483       *         needs to perform this function.       *         needs to perform this function.
1484       */       */
1485    
1486      chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);      chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1);
1487      strcpy (chanPtr->channelName, pt->channelName);      strcpy (chanPtr->channelName, pt->channelName);
1488    
1489      chanPtr->flags               = pt->flags;           /* Save */      chanPtr->flags               = pt->flags;           /* Save */
1490    
1491      chanPtr->encoding            = (Tcl_Encoding) NULL; /* == 'binary' */      chanPtr->encoding            = (Tcl_Encoding) NULL; /* == 'binary' */
1492      chanPtr->inputEncodingState  = (Tcl_EncodingState) NULL;      chanPtr->inputEncodingState  = (Tcl_EncodingState) NULL;
1493      chanPtr->inputEncodingFlags  = TCL_ENCODING_START;      chanPtr->inputEncodingFlags  = TCL_ENCODING_START;
1494      chanPtr->outputEncodingState = (Tcl_EncodingState) NULL;      chanPtr->outputEncodingState = (Tcl_EncodingState) NULL;
1495      chanPtr->outputEncodingFlags = TCL_ENCODING_START;      chanPtr->outputEncodingFlags = TCL_ENCODING_START;
1496    
1497      chanPtr->inputTranslation    = TCL_TRANSLATE_LF; /* == 'binary' */      chanPtr->inputTranslation    = TCL_TRANSLATE_LF; /* == 'binary' */
1498      chanPtr->outputTranslation   = TCL_TRANSLATE_LF; /* == 'binary' */      chanPtr->outputTranslation   = TCL_TRANSLATE_LF; /* == 'binary' */
1499      chanPtr->inEofChar           = pt->inEofChar;         /* Save */      chanPtr->inEofChar           = pt->inEofChar;         /* Save */
1500      chanPtr->outEofChar          = pt->outEofChar;        /* Save */      chanPtr->outEofChar          = pt->outEofChar;        /* Save */
1501    
1502      chanPtr->unreportedError     = pt->unreportedError;   /* Save */      chanPtr->unreportedError     = pt->unreportedError;   /* Save */
1503      chanPtr->instanceData        = pt->instanceData;      /* Save */      chanPtr->instanceData        = pt->instanceData;      /* Save */
1504      chanPtr->typePtr             = pt->typePtr;           /* Save */      chanPtr->typePtr             = pt->typePtr;           /* Save */
1505      chanPtr->refCount            = 0;   /* None, as the structure is covered */      chanPtr->refCount            = 0;   /* None, as the structure is covered */
1506      chanPtr->closeCbPtr          = (CloseCallback*) NULL; /* TTO */      chanPtr->closeCbPtr          = (CloseCallback*) NULL; /* TTO */
1507    
1508      chanPtr->outputStage         = (char*) NULL;      chanPtr->outputStage         = (char*) NULL;
1509      chanPtr->curOutPtr           = pt->curOutPtr;    /* Save */      chanPtr->curOutPtr           = pt->curOutPtr;    /* Save */
1510      chanPtr->outQueueHead        = pt->outQueueHead; /* Save */      chanPtr->outQueueHead        = pt->outQueueHead; /* Save */
1511      chanPtr->outQueueTail        = pt->outQueueTail; /* Save */      chanPtr->outQueueTail        = pt->outQueueTail; /* Save */
1512      chanPtr->saveInBufPtr        = pt->saveInBufPtr; /* Save */      chanPtr->saveInBufPtr        = pt->saveInBufPtr; /* Save */
1513      chanPtr->inQueueHead         = pt->inQueueHead;  /* Save */      chanPtr->inQueueHead         = pt->inQueueHead;  /* Save */
1514      chanPtr->inQueueTail         = pt->inQueueTail;  /* Save */      chanPtr->inQueueTail         = pt->inQueueTail;  /* Save */
1515    
1516      chanPtr->chPtr               = (ChannelHandler *) NULL;  /* TTO */      chanPtr->chPtr               = (ChannelHandler *) NULL;  /* TTO */
1517      chanPtr->interestMask        = 0;      chanPtr->interestMask        = 0;
1518      chanPtr->nextChanPtr         = (Channel*) NULL;     /* Is not in list! */      chanPtr->nextChanPtr         = (Channel*) NULL;     /* Is not in list! */
1519      chanPtr->scriptRecordPtr     = (EventScriptRecord *) NULL; /* TTO */      chanPtr->scriptRecordPtr     = (EventScriptRecord *) NULL; /* TTO */
1520      chanPtr->bufSize             = CHANNELBUFFER_DEFAULT_SIZE;      chanPtr->bufSize             = CHANNELBUFFER_DEFAULT_SIZE;
1521      chanPtr->timer               = (Tcl_TimerToken) NULL;      /* TTO */      chanPtr->timer               = (Tcl_TimerToken) NULL;      /* TTO */
1522      chanPtr->csPtr               = (CopyState*) NULL;          /* TTO */      chanPtr->csPtr               = (CopyState*) NULL;          /* TTO */
1523    
1524      /*      /*
1525       * Place new block at the head of a possibly existing list of previously       * Place new block at the head of a possibly existing list of previously
1526       * stacked channels, then do the missing initializations of translation       * stacked channels, then do the missing initializations of translation
1527       * and buffer system.       * and buffer system.
1528       */       */
1529    
1530      chanPtr->supercedes          = pt->supercedes;      chanPtr->supercedes          = pt->supercedes;
1531    
1532      Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,      Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1533          "-translation", "binary");          "-translation", "binary");
1534      Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,      Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1535          "-buffering",   "none");          "-buffering",   "none");
1536    
1537      /*      /*
1538       * Save accomplished, now reinitialize the (old) structure for the       * Save accomplished, now reinitialize the (old) structure for the
1539       * transformation.       * transformation.
1540       *       *
1541       * - The information about encoding and eol-translation is taken       * - The information about encoding and eol-translation is taken
1542       *   without change.  There is no need to fiddle with       *   without change.  There is no need to fiddle with
1543       *   refCount et. al.       *   refCount et. al.
1544       *       *
1545       * Don't forget to use the same blocking mode as the old channel.       * Don't forget to use the same blocking mode as the old channel.
1546       */       */
1547    
1548      pt->flags               = mask | (chanPtr->flags & CHANNEL_NONBLOCKING);      pt->flags               = mask | (chanPtr->flags & CHANNEL_NONBLOCKING);
1549    
1550      /*      /*
1551       * EDITORS NOTE:  all the lines with "take it as is" should get       * EDITORS NOTE:  all the lines with "take it as is" should get
1552       * deleted once this code has been debugged.       * deleted once this code has been debugged.
1553       */       */
1554    
1555      /* pt->encoding,            take it as is */      /* pt->encoding,            take it as is */
1556      /* pt->inputEncodingState,  take it as is */      /* pt->inputEncodingState,  take it as is */
1557      /* pt->inputEncodingFlags,  take it as is */      /* pt->inputEncodingFlags,  take it as is */
1558      /* pt->outputEncodingState, take it as is */      /* pt->outputEncodingState, take it as is */
1559      /* pt->outputEncodingFlags, take it as is */      /* pt->outputEncodingFlags, take it as is */
1560    
1561      /* pt->inputTranslation,    take it as is */      /* pt->inputTranslation,    take it as is */
1562      /* pt->outputTranslation,   take it as is */      /* pt->outputTranslation,   take it as is */
1563    
1564      /*      /*
1565       * No special EOF character, that condition is determined by the       * No special EOF character, that condition is determined by the
1566       * old channel       * old channel
1567       */       */
1568    
1569      pt->inEofChar           = 0;      pt->inEofChar           = 0;
1570      pt->outEofChar          = 0;      pt->outEofChar          = 0;
1571    
1572      pt->unreportedError     = 0; /* No errors yet */      pt->unreportedError     = 0; /* No errors yet */
1573      pt->instanceData        = instanceData; /* Transformation state */      pt->instanceData        = instanceData; /* Transformation state */
1574      pt->typePtr             = typePtr;      /* Transformation type */      pt->typePtr             = typePtr;      /* Transformation type */
1575      /* pt->refCount,            take it as it is */      /* pt->refCount,            take it as it is */
1576      /* pt->closeCbPtr,          take it as it is */      /* pt->closeCbPtr,          take it as it is */
1577    
1578      /* pt->outputStage,         take it as it is */      /* pt->outputStage,         take it as it is */
1579      pt->curOutPtr           = (ChannelBuffer *) NULL;      pt->curOutPtr           = (ChannelBuffer *) NULL;
1580      pt->outQueueHead        = (ChannelBuffer *) NULL;      pt->outQueueHead        = (ChannelBuffer *) NULL;
1581      pt->outQueueTail        = (ChannelBuffer *) NULL;      pt->outQueueTail        = (ChannelBuffer *) NULL;
1582      pt->saveInBufPtr        = (ChannelBuffer *) NULL;      pt->saveInBufPtr        = (ChannelBuffer *) NULL;
1583      pt->inQueueHead         = (ChannelBuffer *) NULL;      pt->inQueueHead         = (ChannelBuffer *) NULL;
1584      pt->inQueueTail         = (ChannelBuffer *) NULL;      pt->inQueueTail         = (ChannelBuffer *) NULL;
1585    
1586      /* pt->chPtr,               take it as it is */      /* pt->chPtr,               take it as it is */
1587      /* pt->interestMask,        take it as it is */      /* pt->interestMask,        take it as it is */
1588      /* pt->nextChanPtr,         take it as it is */      /* pt->nextChanPtr,         take it as it is */
1589      /* pt->scriptRecordPtr,     take it as it is */      /* pt->scriptRecordPtr,     take it as it is */
1590      pt->bufSize             = CHANNELBUFFER_DEFAULT_SIZE;      pt->bufSize             = CHANNELBUFFER_DEFAULT_SIZE;
1591      /* pt->timer,               take it as it is */      /* pt->timer,               take it as it is */
1592      /* pt->csPtr,               take it as it is */      /* pt->csPtr,               take it as it is */
1593    
1594      /*      /*
1595       * Have the transformation reference the new structure containing       * Have the transformation reference the new structure containing
1596       * the saved channel.       * the saved channel.
1597       */       */
1598    
1599      pt->supercedes          = chanPtr;      pt->supercedes          = chanPtr;
1600    
1601      /*      /*
1602       * Don't forget to reinitialize the output buffer used for encodings.       * Don't forget to reinitialize the output buffer used for encodings.
1603       */       */
1604    
1605      if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {      if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
1606          chanPtr->outputStage = (char *)          chanPtr->outputStage = (char *)
1607              ckalloc((unsigned) (chanPtr->bufSize + 2));              ckalloc((unsigned) (chanPtr->bufSize + 2));
1608      }      }
1609    
1610      /*      /*
1611       * Event handling: If the information in the old channel shows       * Event handling: If the information in the old channel shows
1612       * that there was interest in some events call the 'WatchProc'       * that there was interest in some events call the 'WatchProc'
1613       * of the transformation to establish the proper connection       * of the transformation to establish the proper connection
1614       * between them.       * between them.
1615       */       */
1616    
1617      if (interest) {      if (interest) {
1618          (pt->typePtr->watchProc) (pt->instanceData, interest);          (pt->typePtr->watchProc) (pt->instanceData, interest);
1619      }      }
1620    
1621      /*      /*
1622       * The superceded channel is effectively unregistered       * The superceded channel is effectively unregistered
1623       * We cannot decrement its reference count because that       * We cannot decrement its reference count because that
1624       * can cause it to get garbage collected out from under us.       * can cause it to get garbage collected out from under us.
1625       * Don't add the following code:       * Don't add the following code:
1626       *       *
1627       * chanPtr->supercedes->refCount --;       * chanPtr->supercedes->refCount --;
1628       */       */
1629    
1630      return (Tcl_Channel) chanPtr;      return (Tcl_Channel) chanPtr;
1631  }  }
1632    
1633  /*  /*
1634   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1635   *   *
1636   * Tcl_UnstackChannel --   * Tcl_UnstackChannel --
1637   *   *
1638   *      Unstacks an entry in the hash table for a Tcl_Channel   *      Unstacks an entry in the hash table for a Tcl_Channel
1639   *      record. This is the reverse to 'Tcl_StackChannel'.   *      record. This is the reverse to 'Tcl_StackChannel'.
1640   *      The old, superceded channel is uncovered and re-registered   *      The old, superceded channel is uncovered and re-registered
1641   *      in the appropriate data structures.   *      in the appropriate data structures.
1642   *   *
1643   * Results:   * Results:
1644   *      Returns the old Tcl_Channel, i.e. the one which was stacked over.   *      Returns the old Tcl_Channel, i.e. the one which was stacked over.
1645   *   *
1646   * Side effects:   * Side effects:
1647   *      See above.   *      See above.
1648   *   *
1649   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1650   */   */
1651    
1652  void  void
1653  Tcl_UnstackChannel (interp, chan)  Tcl_UnstackChannel (interp, chan)
1654      Tcl_Interp* interp; /* The interpreter we are working in */      Tcl_Interp* interp; /* The interpreter we are working in */
1655      Tcl_Channel chan;   /* The channel to unstack */      Tcl_Channel chan;   /* The channel to unstack */
1656  {  {
1657      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1658      Channel* chanPtr = (Channel*) chan;      Channel* chanPtr = (Channel*) chan;
1659    
1660      if (chanPtr->supercedes != (Channel*) NULL) {      if (chanPtr->supercedes != (Channel*) NULL) {
1661          /*          /*
1662           * Instead of manipulating the per-thread / per-interp list/hashtable           * Instead of manipulating the per-thread / per-interp list/hashtable
1663           * of registered channels we wind down the state of the transformation,           * of registered channels we wind down the state of the transformation,
1664           * and then restore the state of underlying channel into the old           * and then restore the state of underlying channel into the old
1665           * structure.           * structure.
1666           */           */
1667    
1668          Tcl_DString       dsTrans; /* storage to save option information */          Tcl_DString       dsTrans; /* storage to save option information */
1669          Tcl_DString       dsBuf;   /* storage to save option information */          Tcl_DString       dsBuf;   /* storage to save option information */
1670          Channel           top;     /* Save area for current transformation */          Channel           top;     /* Save area for current transformation */
1671          Channel*          chanDownPtr = chanPtr->supercedes;          Channel*          chanDownPtr = chanPtr->supercedes;
1672          int               interest;     /* interest mask of transformation          int               interest;     /* interest mask of transformation
1673                                           * before destruct. */                                           * before destruct. */
1674          int               saveInputEncodingFlags;  /* Save area for encoding */          int               saveInputEncodingFlags;  /* Save area for encoding */
1675          int               saveOutputEncodingFlags; /* related information */          int               saveOutputEncodingFlags; /* related information */
1676          Tcl_EncodingState saveInputEncodingState;          Tcl_EncodingState saveInputEncodingState;
1677          Tcl_EncodingState saveOutputEncodingState;          Tcl_EncodingState saveOutputEncodingState;
1678          Tcl_Encoding      saveEncoding;          Tcl_Encoding      saveEncoding;
1679    
1680          /*          /*
1681           * Event handling: Disallow the delivery of events from the           * Event handling: Disallow the delivery of events from the
1682           * old, now uncovered channel to the transformation.           * old, now uncovered channel to the transformation.
1683           *           *
1684           * This is done before everything else to avoid problems           * This is done before everything else to avoid problems
1685           * after our heavy-duty shuffling of pointers around.           * after our heavy-duty shuffling of pointers around.
1686           */           */
1687    
1688          interest = chanPtr->interestMask;          interest = chanPtr->interestMask;
1689          (chanPtr->typePtr->watchProc) (chanPtr->instanceData, 0);          (chanPtr->typePtr->watchProc) (chanPtr->instanceData, 0);
1690    
1691          /* 1. Swap the information in the top channel (the transformation)          /* 1. Swap the information in the top channel (the transformation)
1692           *    and the channel below, with some exceptions. This additionally           *    and the channel below, with some exceptions. This additionally
1693           *    cuts the top channel out of the chain. Without the latter           *    cuts the top channel out of the chain. Without the latter
1694           *    a Tcl_Close on the transformation would be impossible, as that           *    a Tcl_Close on the transformation would be impossible, as that
1695           *    procedure will free the structure, making 'top' unusable.           *    procedure will free the structure, making 'top' unusable.
1696           *           *
1697           * chanPtr     -> top channel, transformation.           * chanPtr     -> top channel, transformation.
1698           * chanDownPtr -> channel immediately below the transformation.           * chanDownPtr -> channel immediately below the transformation.
1699           */           */
1700    
1701          memcpy ((void*) &top,        (void*) chanPtr,     sizeof (Channel));          memcpy ((void*) &top,        (void*) chanPtr,     sizeof (Channel));
1702          memcpy ((void*) chanPtr,     (void*) chanDownPtr, sizeof (Channel));          memcpy ((void*) chanPtr,     (void*) chanDownPtr, sizeof (Channel));
1703          top.supercedes = (Channel*) NULL;          top.supercedes = (Channel*) NULL;
1704          memcpy ((void*) chanDownPtr, (void*) &top,        sizeof (Channel));          memcpy ((void*) chanDownPtr, (void*) &top,        sizeof (Channel));
1705    
1706          /* Now:          /* Now:
1707           * chanPtr     -> channel immediately below the transformation, now top           * chanPtr     -> channel immediately below the transformation, now top
1708           * chanDownPtr -> transformation, cut loose.           * chanDownPtr -> transformation, cut loose.
1709           *           *
1710           * Handle the exceptions mentioned above, i.e. move the information           * Handle the exceptions mentioned above, i.e. move the information
1711           * from the transformation into the new top, and reinitialize it to           * from the transformation into the new top, and reinitialize it to
1712           * safe values in the transformation.           * safe values in the transformation.
1713           */           */
1714    
1715          chanPtr->refCount        = chanDownPtr->refCount;          chanPtr->refCount        = chanDownPtr->refCount;
1716          chanPtr->closeCbPtr      = chanDownPtr->closeCbPtr;          chanPtr->closeCbPtr      = chanDownPtr->closeCbPtr;
1717          chanPtr->chPtr           = chanDownPtr->chPtr;          chanPtr->chPtr           = chanDownPtr->chPtr;
1718          chanPtr->nextChanPtr     = chanDownPtr->nextChanPtr;          chanPtr->nextChanPtr     = chanDownPtr->nextChanPtr;
1719          chanPtr->scriptRecordPtr = chanDownPtr->scriptRecordPtr;          chanPtr->scriptRecordPtr = chanDownPtr->scriptRecordPtr;
1720          chanPtr->timer           = chanDownPtr->timer;          chanPtr->timer           = chanDownPtr->timer;
1721          chanPtr->csPtr           = chanDownPtr->csPtr;          chanPtr->csPtr           = chanDownPtr->csPtr;
1722    
1723          chanDownPtr->refCount        = 0;          chanDownPtr->refCount        = 0;
1724          chanDownPtr->closeCbPtr      = (CloseCallback*) NULL;          chanDownPtr->closeCbPtr      = (CloseCallback*) NULL;
1725          chanDownPtr->chPtr           = (ChannelHandler*) NULL;          chanDownPtr->chPtr           = (ChannelHandler*) NULL;
1726          chanDownPtr->nextChanPtr     = (Channel*) NULL;          chanDownPtr->nextChanPtr     = (Channel*) NULL;
1727          chanDownPtr->scriptRecordPtr = (EventScriptRecord*) NULL;          chanDownPtr->scriptRecordPtr = (EventScriptRecord*) NULL;
1728          chanDownPtr->timer           = (Tcl_TimerToken) NULL;          chanDownPtr->timer           = (Tcl_TimerToken) NULL;
1729          chanDownPtr->csPtr           = (CopyState*) NULL;          chanDownPtr->csPtr           = (CopyState*) NULL;
1730    
1731          /* The now uncovered channel still has encoding and eol-translation          /* The now uncovered channel still has encoding and eol-translation
1732           * deactivated, i.e. switched to 'binary'. *Don't* touch this until           * deactivated, i.e. switched to 'binary'. *Don't* touch this until
1733           * after the transformation is closed for good, as it may write           * after the transformation is closed for good, as it may write
1734           * information into it during that (-> flushing of data waiting in           * information into it during that (-> flushing of data waiting in
1735           * internal buffers!) and rely on these settings. Thanks to Matt           * internal buffers!) and rely on these settings. Thanks to Matt
1736           * Newman <matt@sensus.org> for finding this goof.           * Newman <matt@sensus.org> for finding this goof.
1737           *           *
1738           * But we also have to protect the state of the encoding from removal           * 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.           * during the close. So we save it in some local variables.
1740           * Additionally the current value of the options is lost after we           * Additionally the current value of the options is lost after we
1741           * close, we have to save them now.           * close, we have to save them now.
1742           */           */
1743    
1744          saveEncoding            = chanDownPtr->encoding;          saveEncoding            = chanDownPtr->encoding;
1745          saveInputEncodingState  = chanDownPtr->inputEncodingState;          saveInputEncodingState  = chanDownPtr->inputEncodingState;
1746          saveInputEncodingFlags  = chanDownPtr->inputEncodingFlags;          saveInputEncodingFlags  = chanDownPtr->inputEncodingFlags;
1747          saveOutputEncodingState = chanDownPtr->outputEncodingState;          saveOutputEncodingState = chanDownPtr->outputEncodingState;
1748          saveOutputEncodingFlags = chanDownPtr->outputEncodingFlags;          saveOutputEncodingFlags = chanDownPtr->outputEncodingFlags;
1749    
1750          Tcl_DStringInit (&dsTrans);          Tcl_DStringInit (&dsTrans);
1751          Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,          Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
1752                  "-translation", &dsTrans);                  "-translation", &dsTrans);
1753    
1754          Tcl_DStringInit (&dsBuf);          Tcl_DStringInit (&dsBuf);
1755          Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,          Tcl_GetChannelOption (interp, (Tcl_Channel) chanDownPtr,
1756                  "-buffering", &dsBuf);                  "-buffering", &dsBuf);
1757    
1758          /*          /*
1759           * Prevent the accidential removal of the encoding during           * Prevent the accidential removal of the encoding during
1760           * the destruction of the transformation channel.           * the destruction of the transformation channel.
1761           */           */
1762    
1763          chanDownPtr->encoding            = (Tcl_Encoding) NULL;          chanDownPtr->encoding            = (Tcl_Encoding) NULL;
1764          chanDownPtr->inputEncodingState  = (Tcl_EncodingState) NULL;          chanDownPtr->inputEncodingState  = (Tcl_EncodingState) NULL;
1765          chanDownPtr->inputEncodingFlags  = TCL_ENCODING_START;          chanDownPtr->inputEncodingFlags  = TCL_ENCODING_START;
1766          chanDownPtr->outputEncodingState = (Tcl_EncodingState) NULL;          chanDownPtr->outputEncodingState = (Tcl_EncodingState) NULL;
1767          chanDownPtr->outputEncodingFlags = TCL_ENCODING_START;          chanDownPtr->outputEncodingFlags = TCL_ENCODING_START;
1768    
1769          /*          /*
1770           * A little trick: Add the transformation structure to the           * A little trick: Add the transformation structure to the
1771           * per-thread list of existing channels (which it never were           * per-thread list of existing channels (which it never were
1772           * part of so far), or Tcl_Close/FlushChannel will panic           * part of so far), or Tcl_Close/FlushChannel will panic
1773           * ("damaged channel list").           * ("damaged channel list").
1774           *           *
1775           * Afterward do a regular close upon the transformation.           * Afterward do a regular close upon the transformation.
1776           * This may cause flushing of data into the old channel (if the           * This may cause flushing of data into the old channel (if the
1777           * transformation remembered its own channel in itself).           * transformation remembered its own channel in itself).
1778           *           *
1779           * We know that its refCount dropped to 0.           * We know that its refCount dropped to 0.
1780           */           */
1781    
1782          chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr;          chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr;
1783          tsdPtr->firstChanPtr     = chanDownPtr;          tsdPtr->firstChanPtr     = chanDownPtr;
1784    
1785          Tcl_Close (interp, (Tcl_Channel)chanDownPtr);          Tcl_Close (interp, (Tcl_Channel)chanDownPtr);
1786    
1787          /*          /*
1788           * Now it is possible to wind down the transformation (in 'top'),           * Now it is possible to wind down the transformation (in 'top'),
1789           * especially to copy the current encoding and translation control           * especially to copy the current encoding and translation control
1790           * information down.           * information down.
1791           */           */
1792                    
1793          /*          /*
1794           * Move the currently active encoding from the save area           * Move the currently active encoding from the save area
1795           * to the now uncovered channel. We assume here that this           * to the now uncovered channel. We assume here that this
1796           * channel uses 'encoding binary' (==> encoding == NULL, etc.           * channel uses 'encoding binary' (==> encoding == NULL, etc.
1797           * This allows us to simply copy the pointers without having to           * This allows us to simply copy the pointers without having to
1798           * think about refcounts and deallocation of the old encoding.           * think about refcounts and deallocation of the old encoding.
1799           *           *
1800           * And don't forget to reenable the EOL-translation used by the           * And don't forget to reenable the EOL-translation used by the
1801           * transformation. Using a DString to do this *is* a bit awkward,           * transformation. Using a DString to do this *is* a bit awkward,
1802           * but still the best way to handle the complexities here, like           * but still the best way to handle the complexities here, like
1803           * flag manipulation and event system.           * flag manipulation and event system.
1804           */           */
1805    
1806          chanPtr->encoding            = saveEncoding;          chanPtr->encoding            = saveEncoding;
1807          chanPtr->inputEncodingState  = saveInputEncodingState;          chanPtr->inputEncodingState  = saveInputEncodingState;
1808          chanPtr->inputEncodingFlags  = saveInputEncodingFlags;          chanPtr->inputEncodingFlags  = saveInputEncodingFlags;
1809          chanPtr->outputEncodingState = saveOutputEncodingState;          chanPtr->outputEncodingState = saveOutputEncodingState;
1810          chanPtr->outputEncodingFlags = saveOutputEncodingFlags;          chanPtr->outputEncodingFlags = saveOutputEncodingFlags;
1811    
1812          Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,          Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1813                  "-translation", dsTrans.string);                  "-translation", dsTrans.string);
1814    
1815          Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,          Tcl_SetChannelOption (interp, (Tcl_Channel) chanPtr,
1816                  "-buffering", dsBuf.string);                  "-buffering", dsBuf.string);
1817    
1818          Tcl_DStringFree (&dsTrans);          Tcl_DStringFree (&dsTrans);
1819          Tcl_DStringFree (&dsBuf);          Tcl_DStringFree (&dsBuf);
1820    
1821          /*          /*
1822           * Event handling: If the information from the now destroyed           * Event handling: If the information from the now destroyed
1823           * transformation shows that there was interest in some events           * transformation shows that there was interest in some events
1824           * call the 'WatchProc' of the now uncovered channel to renew           * call the 'WatchProc' of the now uncovered channel to renew
1825           * that interest with underlying channels or the driver.           * that interest with underlying channels or the driver.
1826           */           */
1827    
1828          if (interest) {          if (interest) {
1829              chanPtr->interestMask = 0;              chanPtr->interestMask = 0;
1830              (chanPtr->typePtr->watchProc) (chanPtr->instanceData,              (chanPtr->typePtr->watchProc) (chanPtr->instanceData,
1831                  interest);                  interest);
1832              chanPtr->interestMask = interest;              chanPtr->interestMask = interest;
1833          }          }
1834    
1835      } else {      } else {
1836          /* This channel does not cover another one.          /* This channel does not cover another one.
1837           * Simply do a close, if necessary.           * Simply do a close, if necessary.
1838           */           */
1839    
1840          if (chanPtr->refCount == 0) {          if (chanPtr->refCount == 0) {
1841              Tcl_Close (interp, chan);              Tcl_Close (interp, chan);
1842          }          }
1843      }      }
1844  }  }
1845    
1846  /*  /*
1847   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1848   *   *
1849   * Tcl_GetStackedChannel --   * Tcl_GetStackedChannel --
1850   *   *
1851   *      Determines wether the specified channel is stacked upon another.   *      Determines wether the specified channel is stacked upon another.
1852   *   *
1853   * Results:   * Results:
1854   *      NULL if the channel is not stacked upon another one, or a reference   *      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   *      to the channel it is stacked upon. This reference can be used in
1856   *      queries, but modification is not allowed.   *      queries, but modification is not allowed.
1857   *   *
1858   * Side effects:   * Side effects:
1859   *      None.   *      None.
1860   *   *
1861   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1862   */   */
1863    
1864  Tcl_Channel  Tcl_Channel
1865  Tcl_GetStackedChannel(chan)  Tcl_GetStackedChannel(chan)
1866      Tcl_Channel chan;      Tcl_Channel chan;
1867  {  {
1868    Channel* chanPtr = (Channel*) chan;    Channel* chanPtr = (Channel*) chan;
1869    return (Tcl_Channel) chanPtr->supercedes;    return (Tcl_Channel) chanPtr->supercedes;
1870  }  }
1871    
1872  /*  /*
1873   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1874   *   *
1875   * Tcl_GetChannelMode --   * Tcl_GetChannelMode --
1876   *   *
1877   *      Computes a mask indicating whether the channel is open for   *      Computes a mask indicating whether the channel is open for
1878   *      reading and writing.   *      reading and writing.
1879   *   *
1880   * Results:   * Results:
1881   *      An OR-ed combination of TCL_READABLE and TCL_WRITABLE.   *      An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
1882   *   *
1883   * Side effects:   * Side effects:
1884   *      None.   *      None.
1885   *   *
1886   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1887   */   */
1888    
1889  int  int
1890  Tcl_GetChannelMode(chan)  Tcl_GetChannelMode(chan)
1891      Tcl_Channel chan;           /* The channel for which the mode is      Tcl_Channel chan;           /* The channel for which the mode is
1892                                   * being computed. */                                   * being computed. */
1893  {  {
1894      Channel *chanPtr;           /* The actual channel. */      Channel *chanPtr;           /* The actual channel. */
1895    
1896      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
1897      return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));      return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));
1898  }  }
1899    
1900  /*  /*
1901   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1902   *   *
1903   * Tcl_GetChannelName --   * Tcl_GetChannelName --
1904   *   *
1905   *      Returns the string identifying the channel name.   *      Returns the string identifying the channel name.
1906   *   *
1907   * Results:   * Results:
1908   *      The string containing the channel name. This memory is   *      The string containing the channel name. This memory is
1909   *      owned by the generic layer and should not be modified by   *      owned by the generic layer and should not be modified by
1910   *      the caller.   *      the caller.
1911   *   *
1912   * Side effects:   * Side effects:
1913   *      None.   *      None.
1914   *   *
1915   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1916   */   */
1917    
1918  char *  char *
1919  Tcl_GetChannelName(chan)  Tcl_GetChannelName(chan)
1920      Tcl_Channel chan;           /* The channel for which to return the name. */      Tcl_Channel chan;           /* The channel for which to return the name. */
1921  {  {
1922      Channel *chanPtr;           /* The actual channel. */      Channel *chanPtr;           /* The actual channel. */
1923    
1924      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
1925      return chanPtr->channelName;      return chanPtr->channelName;
1926  }  }
1927    
1928  /*  /*
1929   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1930   *   *
1931   * Tcl_GetChannelType --   * Tcl_GetChannelType --
1932   *   *
1933   *      Given a channel structure, returns the channel type structure.   *      Given a channel structure, returns the channel type structure.
1934   *   *
1935   * Results:   * Results:
1936   *      Returns a pointer to the channel type structure.   *      Returns a pointer to the channel type structure.
1937   *   *
1938   * Side effects:   * Side effects:
1939   *      None.   *      None.
1940   *   *
1941   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1942   */   */
1943    
1944  Tcl_ChannelType *  Tcl_ChannelType *
1945  Tcl_GetChannelType(chan)  Tcl_GetChannelType(chan)
1946      Tcl_Channel chan;           /* The channel to return type for. */      Tcl_Channel chan;           /* The channel to return type for. */
1947  {  {
1948      Channel *chanPtr;           /* The actual channel. */      Channel *chanPtr;           /* The actual channel. */
1949    
1950      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
1951      return chanPtr->typePtr;      return chanPtr->typePtr;
1952  }  }
1953    
1954  /*  /*
1955   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1956   *   *
1957   * Tcl_GetChannelHandle --   * Tcl_GetChannelHandle --
1958   *   *
1959   *      Returns an OS handle associated with a channel.   *      Returns an OS handle associated with a channel.
1960   *   *
1961   * Results:   * Results:
1962   *      Returns TCL_OK and places the handle in handlePtr, or returns   *      Returns TCL_OK and places the handle in handlePtr, or returns
1963   *      TCL_ERROR on failure.   *      TCL_ERROR on failure.
1964   *   *
1965   * Side effects:   * Side effects:
1966   *      None.   *      None.
1967   *   *
1968   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1969   */   */
1970    
1971  int  int
1972  Tcl_GetChannelHandle(chan, direction, handlePtr)  Tcl_GetChannelHandle(chan, direction, handlePtr)
1973      Tcl_Channel chan;           /* The channel to get file from. */      Tcl_Channel chan;           /* The channel to get file from. */
1974      int direction;              /* TCL_WRITABLE or TCL_READABLE. */      int direction;              /* TCL_WRITABLE or TCL_READABLE. */
1975      ClientData *handlePtr;      /* Where to store handle */      ClientData *handlePtr;      /* Where to store handle */
1976  {  {
1977      Channel *chanPtr;           /* The actual channel. */      Channel *chanPtr;           /* The actual channel. */
1978      ClientData handle;      ClientData handle;
1979      int result;      int result;
1980    
1981      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
1982      result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,      result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
1983              direction, &handle);              direction, &handle);
1984      if (handlePtr) {      if (handlePtr) {
1985          *handlePtr = handle;          *handlePtr = handle;
1986      }      }
1987      return result;      return result;
1988  }  }
1989    
1990  /*  /*
1991   *----------------------------------------------------------------------   *----------------------------------------------------------------------
1992   *   *
1993   * Tcl_GetChannelInstanceData --   * Tcl_GetChannelInstanceData --
1994   *   *
1995   *      Returns the client data associated with a channel.   *      Returns the client data associated with a channel.
1996   *   *
1997   * Results:   * Results:
1998   *      The client data.   *      The client data.
1999   *   *
2000   * Side effects:   * Side effects:
2001   *      None.   *      None.
2002   *   *
2003   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2004   */   */
2005    
2006  ClientData  ClientData
2007  Tcl_GetChannelInstanceData(chan)  Tcl_GetChannelInstanceData(chan)
2008      Tcl_Channel chan;           /* Channel for which to return client data. */      Tcl_Channel chan;           /* Channel for which to return client data. */
2009  {  {
2010      Channel *chanPtr;           /* The actual channel. */      Channel *chanPtr;           /* The actual channel. */
2011    
2012      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
2013      return chanPtr->instanceData;      return chanPtr->instanceData;
2014  }  }
2015    
2016  /*  /*
2017   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
2018   *   *
2019   * AllocChannelBuffer --   * AllocChannelBuffer --
2020   *   *
2021   *      A channel buffer has BUFFER_PADDING bytes extra at beginning to   *      A channel buffer has BUFFER_PADDING bytes extra at beginning to
2022   *      hold any bytes of a native-encoding character that got split by   *      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   *      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   *      beginning of the next buffer to make a contiguous string so it
2025   *      can be converted to UTF-8.   *      can be converted to UTF-8.
2026   *   *
2027   *      A channel buffer has BUFFER_PADDING bytes extra at the end to   *      A channel buffer has BUFFER_PADDING bytes extra at the end to
2028   *      hold any bytes of a native-encoding character (generated from a   *      hold any bytes of a native-encoding character (generated from a
2029   *      UTF-8 character) that overflow past the end of the buffer and   *      UTF-8 character) that overflow past the end of the buffer and
2030   *      need to be moved to the next buffer.   *      need to be moved to the next buffer.
2031   *   *
2032   * Results:   * Results:
2033   *      A newly allocated channel buffer.   *      A newly allocated channel buffer.
2034   *   *
2035   * Side effects:   * Side effects:
2036   *      None.   *      None.
2037   *   *
2038   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
2039   */   */
2040    
2041  static ChannelBuffer *  static ChannelBuffer *
2042  AllocChannelBuffer(length)  AllocChannelBuffer(length)
2043      int length;                 /* Desired length of channel buffer. */      int length;                 /* Desired length of channel buffer. */
2044  {  {
2045      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
2046      int n;      int n;
2047    
2048      n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;      n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
2049      bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);      bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
2050      bufPtr->nextAdded   = BUFFER_PADDING;      bufPtr->nextAdded   = BUFFER_PADDING;
2051      bufPtr->nextRemoved = BUFFER_PADDING;      bufPtr->nextRemoved = BUFFER_PADDING;
2052      bufPtr->bufLength   = length + BUFFER_PADDING;      bufPtr->bufLength   = length + BUFFER_PADDING;
2053      bufPtr->nextPtr     = (ChannelBuffer *) NULL;      bufPtr->nextPtr     = (ChannelBuffer *) NULL;
2054      return bufPtr;      return bufPtr;
2055  }  }
2056    
2057  /*  /*
2058   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2059   *   *
2060   * RecycleBuffer --   * RecycleBuffer --
2061   *   *
2062   *      Helper function to recycle input and output buffers. Ensures   *      Helper function to recycle input and output buffers. Ensures
2063   *      that two input buffers are saved (one in the input queue and   *      that two input buffers are saved (one in the input queue and
2064   *      another in the saveInBufPtr field) and that curOutPtr is set   *      another in the saveInBufPtr field) and that curOutPtr is set
2065   *      to a buffer. Only if these conditions are met is the buffer   *      to a buffer. Only if these conditions are met is the buffer
2066   *      freed to the OS.   *      freed to the OS.
2067   *   *
2068   * Results:   * Results:
2069   *      None.   *      None.
2070   *   *
2071   * Side effects:   * Side effects:
2072   *      May free a buffer to the OS.   *      May free a buffer to the OS.
2073   *   *
2074   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2075   */   */
2076    
2077  static void  static void
2078  RecycleBuffer(chanPtr, bufPtr, mustDiscard)  RecycleBuffer(chanPtr, bufPtr, mustDiscard)
2079      Channel *chanPtr;           /* Channel for which to recycle buffers. */      Channel *chanPtr;           /* Channel for which to recycle buffers. */
2080      ChannelBuffer *bufPtr;      /* The buffer to recycle. */      ChannelBuffer *bufPtr;      /* The buffer to recycle. */
2081      int mustDiscard;            /* If nonzero, free the buffer to the      int mustDiscard;            /* If nonzero, free the buffer to the
2082                                   * OS, always. */                                   * OS, always. */
2083  {  {
2084      /*      /*
2085       * Do we have to free the buffer to the OS?       * Do we have to free the buffer to the OS?
2086       */       */
2087    
2088      if (mustDiscard) {      if (mustDiscard) {
2089          ckfree((char *) bufPtr);          ckfree((char *) bufPtr);
2090          return;          return;
2091      }      }
2092            
2093      /*      /*
2094       * Only save buffers for the input queue if the channel is readable.       * Only save buffers for the input queue if the channel is readable.
2095       */       */
2096            
2097      if (chanPtr->flags & TCL_READABLE) {      if (chanPtr->flags & TCL_READABLE) {
2098          if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {          if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
2099              chanPtr->inQueueHead = bufPtr;              chanPtr->inQueueHead = bufPtr;
2100              chanPtr->inQueueTail = bufPtr;              chanPtr->inQueueTail = bufPtr;
2101              goto keepit;              goto keepit;
2102          }          }
2103          if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {          if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
2104              chanPtr->saveInBufPtr = bufPtr;              chanPtr->saveInBufPtr = bufPtr;
2105              goto keepit;              goto keepit;
2106          }          }
2107      }      }
2108    
2109      /*      /*
2110       * Only save buffers for the output queue if the channel is writable.       * Only save buffers for the output queue if the channel is writable.
2111       */       */
2112    
2113      if (chanPtr->flags & TCL_WRITABLE) {      if (chanPtr->flags & TCL_WRITABLE) {
2114          if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {          if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
2115              chanPtr->curOutPtr = bufPtr;              chanPtr->curOutPtr = bufPtr;
2116              goto keepit;              goto keepit;
2117          }          }
2118      }      }
2119    
2120      /*      /*
2121       * If we reached this code we return the buffer to the OS.       * If we reached this code we return the buffer to the OS.
2122       */       */
2123    
2124      ckfree((char *) bufPtr);      ckfree((char *) bufPtr);
2125      return;      return;
2126    
2127  keepit:  keepit:
2128      bufPtr->nextRemoved = BUFFER_PADDING;      bufPtr->nextRemoved = BUFFER_PADDING;
2129      bufPtr->nextAdded = BUFFER_PADDING;      bufPtr->nextAdded = BUFFER_PADDING;
2130      bufPtr->nextPtr = (ChannelBuffer *) NULL;      bufPtr->nextPtr = (ChannelBuffer *) NULL;
2131  }  }
2132    
2133  /*  /*
2134   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2135   *   *
2136   * DiscardOutputQueued --   * DiscardOutputQueued --
2137   *   *
2138   *      Discards all output queued in the output queue of a channel.   *      Discards all output queued in the output queue of a channel.
2139   *   *
2140   * Results:   * Results:
2141   *      None.   *      None.
2142   *   *
2143   * Side effects:   * Side effects:
2144   *      Recycles buffers.   *      Recycles buffers.
2145   *   *
2146   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2147   */   */
2148    
2149  static void  static void
2150  DiscardOutputQueued(chanPtr)  DiscardOutputQueued(chanPtr)
2151      Channel *chanPtr;           /* The channel for which to discard output. */      Channel *chanPtr;           /* The channel for which to discard output. */
2152  {  {
2153      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
2154            
2155      while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {      while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
2156          bufPtr = chanPtr->outQueueHead;          bufPtr = chanPtr->outQueueHead;
2157          chanPtr->outQueueHead = bufPtr->nextPtr;          chanPtr->outQueueHead = bufPtr->nextPtr;
2158          RecycleBuffer(chanPtr, bufPtr, 0);          RecycleBuffer(chanPtr, bufPtr, 0);
2159      }      }
2160      chanPtr->outQueueHead = (ChannelBuffer *) NULL;      chanPtr->outQueueHead = (ChannelBuffer *) NULL;
2161      chanPtr->outQueueTail = (ChannelBuffer *) NULL;      chanPtr->outQueueTail = (ChannelBuffer *) NULL;
2162  }  }
2163    
2164  /*  /*
2165   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2166   *   *
2167   * CheckForDeadChannel --   * CheckForDeadChannel --
2168   *   *
2169   *      This function checks is a given channel is Dead.   *      This function checks is a given channel is Dead.
2170   *      (A channel that has been closed but not yet deallocated.)   *      (A channel that has been closed but not yet deallocated.)
2171   *   *
2172   * Results:   * Results:
2173   *      True (1) if channel is Dead, False (0) if channel is Ok   *      True (1) if channel is Dead, False (0) if channel is Ok
2174   *   *
2175   * Side effects:   * Side effects:
2176   *      None   *      None
2177   *   *
2178   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2179   */   */
2180    
2181  static int  static int
2182  CheckForDeadChannel(interp, chanPtr)  CheckForDeadChannel(interp, chanPtr)
2183      Tcl_Interp *interp;         /* For error reporting (can be NULL) */      Tcl_Interp *interp;         /* For error reporting (can be NULL) */
2184      Channel    *chanPtr;        /* The channel to check. */      Channel    *chanPtr;        /* The channel to check. */
2185  {  {
2186      if (chanPtr->flags & CHANNEL_DEAD) {      if (chanPtr->flags & CHANNEL_DEAD) {
2187          Tcl_SetErrno(EINVAL);          Tcl_SetErrno(EINVAL);
2188          if (interp) {          if (interp) {
2189              Tcl_AppendResult(interp,              Tcl_AppendResult(interp,
2190                               "unable to access channel: invalid channel",                               "unable to access channel: invalid channel",
2191                               (char *) NULL);                                 (char *) NULL);  
2192          }          }
2193          return 1;          return 1;
2194      }      }
2195      return 0;      return 0;
2196  }  }
2197    
2198  /*  /*
2199   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2200   *   *
2201   * FlushChannel --   * FlushChannel --
2202   *   *
2203   *      This function flushes as much of the queued output as is possible   *      This function flushes as much of the queued output as is possible
2204   *      now. If calledFromAsyncFlush is nonzero, it is being called in an   *      now. If calledFromAsyncFlush is nonzero, it is being called in an
2205   *      event handler to flush channel output asynchronously.   *      event handler to flush channel output asynchronously.
2206   *   *
2207   * Results:   * Results:
2208   *      0 if successful, else the error code that was returned by the   *      0 if successful, else the error code that was returned by the
2209   *      channel type operation.   *      channel type operation.
2210   *   *
2211   * Side effects:   * Side effects:
2212   *      May produce output on a channel. May block indefinitely if the   *      May produce output on a channel. May block indefinitely if the
2213   *      channel is synchronous. May schedule an async flush on the channel.   *      channel is synchronous. May schedule an async flush on the channel.
2214   *      May recycle memory for buffers in the output queue.   *      May recycle memory for buffers in the output queue.
2215   *   *
2216   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2217   */   */
2218    
2219  static int  static int
2220  FlushChannel(interp, chanPtr, calledFromAsyncFlush)  FlushChannel(interp, chanPtr, calledFromAsyncFlush)
2221      Tcl_Interp *interp;                 /* For error reporting during close. */      Tcl_Interp *interp;                 /* For error reporting during close. */
2222      Channel *chanPtr;                   /* The channel to flush on. */      Channel *chanPtr;                   /* The channel to flush on. */
2223      int calledFromAsyncFlush;           /* If nonzero then we are being      int calledFromAsyncFlush;           /* If nonzero then we are being
2224                                           * called from an asynchronous                                           * called from an asynchronous
2225                                           * flush callback. */                                           * flush callback. */
2226  {  {
2227      ChannelBuffer *bufPtr;              /* Iterates over buffered output      ChannelBuffer *bufPtr;              /* Iterates over buffered output
2228                                           * queue. */                                           * queue. */
2229      int toWrite;                        /* Amount of output data in current      int toWrite;                        /* Amount of output data in current
2230                                           * buffer available to be written. */                                           * buffer available to be written. */
2231      int written;                        /* Amount of output data actually      int written;                        /* Amount of output data actually
2232                                           * written in current round. */                                           * written in current round. */
2233      int errorCode = 0;                  /* Stores POSIX error codes from      int errorCode = 0;                  /* Stores POSIX error codes from
2234                                           * channel driver operations. */                                           * channel driver operations. */
2235      int wroteSome = 0;                  /* Set to one if any data was      int wroteSome = 0;                  /* Set to one if any data was
2236                                           * written to the driver. */                                           * written to the driver. */
2237    
2238      /*      /*
2239       * Prevent writing on a dead channel -- a channel that has been closed       * 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       * but not yet deallocated. This can occur if the exit handler for the
2241       * channel deallocation runs before all channels are deregistered in       * channel deallocation runs before all channels are deregistered in
2242       * all interpreters.       * all interpreters.
2243       */       */
2244            
2245      if (CheckForDeadChannel(interp,chanPtr)) return -1;      if (CheckForDeadChannel(interp,chanPtr)) return -1;
2246            
2247      /*      /*
2248       * Loop over the queued buffers and attempt to flush as       * Loop over the queued buffers and attempt to flush as
2249       * much as possible of the queued output to the channel.       * much as possible of the queued output to the channel.
2250       */       */
2251    
2252      while (1) {      while (1) {
2253    
2254          /*          /*
2255           * If the queue is empty and there is a ready current buffer, OR if           * 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           * the current buffer is full, then move the current buffer to the
2257           * queue.           * queue.
2258           */           */
2259                    
2260          if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&          if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2261                  (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufLength))                  (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufLength))
2262                  || ((chanPtr->flags & BUFFER_READY) &&                  || ((chanPtr->flags & BUFFER_READY) &&
2263                          (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {                          (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
2264              chanPtr->flags &= (~(BUFFER_READY));              chanPtr->flags &= (~(BUFFER_READY));
2265              chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;              chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
2266              if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {              if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2267                  chanPtr->outQueueHead = chanPtr->curOutPtr;                  chanPtr->outQueueHead = chanPtr->curOutPtr;
2268              } else {              } else {
2269                  chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;                  chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
2270              }              }
2271              chanPtr->outQueueTail = chanPtr->curOutPtr;              chanPtr->outQueueTail = chanPtr->curOutPtr;
2272              chanPtr->curOutPtr = (ChannelBuffer *) NULL;              chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2273          }          }
2274          bufPtr = chanPtr->outQueueHead;          bufPtr = chanPtr->outQueueHead;
2275    
2276          /*          /*
2277           * If we are not being called from an async flush and an async           * If we are not being called from an async flush and an async
2278           * flush is active, we just return without producing any output.           * flush is active, we just return without producing any output.
2279           */           */
2280    
2281          if ((!calledFromAsyncFlush) &&          if ((!calledFromAsyncFlush) &&
2282                  (chanPtr->flags & BG_FLUSH_SCHEDULED)) {                  (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2283              return 0;              return 0;
2284          }          }
2285    
2286          /*          /*
2287           * If the output queue is still empty, break out of the while loop.           * If the output queue is still empty, break out of the while loop.
2288           */           */
2289    
2290          if (bufPtr == (ChannelBuffer *) NULL) {          if (bufPtr == (ChannelBuffer *) NULL) {
2291              break;      /* Out of the "while (1)". */              break;      /* Out of the "while (1)". */
2292          }          }
2293    
2294          /*          /*
2295           * Produce the output on the channel.           * Produce the output on the channel.
2296           */           */
2297                    
2298          toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;          toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
2299          written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,          written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
2300                  (char *) bufPtr->buf + bufPtr->nextRemoved, toWrite,                  (char *) bufPtr->buf + bufPtr->nextRemoved, toWrite,
2301                  &errorCode);                  &errorCode);
2302                            
2303          /*          /*
2304           * If the write failed completely attempt to start the asynchronous           * If the write failed completely attempt to start the asynchronous
2305           * flush mechanism and break out of this loop - do not attempt to           * flush mechanism and break out of this loop - do not attempt to
2306           * write any more output at this time.           * write any more output at this time.
2307           */           */
2308    
2309          if (written < 0) {          if (written < 0) {
2310                            
2311              /*              /*
2312               * If the last attempt to write was interrupted, simply retry.               * If the last attempt to write was interrupted, simply retry.
2313               */               */
2314                            
2315              if (errorCode == EINTR) {              if (errorCode == EINTR) {
2316                  errorCode = 0;                  errorCode = 0;
2317                  continue;                  continue;
2318              }              }
2319    
2320              /*              /*
2321               * If the channel is non-blocking and we would have blocked,               * If the channel is non-blocking and we would have blocked,
2322               * start a background flushing handler and break out of the loop.               * start a background flushing handler and break out of the loop.
2323               */               */
2324    
2325              if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {              if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
2326                  /*                  /*
2327                   * This used to check for CHANNEL_NONBLOCKING, and panic                   * This used to check for CHANNEL_NONBLOCKING, and panic
2328                   * if the channel was blocking.  However, it appears                   * if the channel was blocking.  However, it appears
2329                   * that setting stdin to -blocking 0 has some effect on                   * that setting stdin to -blocking 0 has some effect on
2330                   * the stdout when it's a tty channel (dup'ed underneath)                   * the stdout when it's a tty channel (dup'ed underneath)
2331                   */                   */
2332                  if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {                  if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
2333                      chanPtr->flags |= BG_FLUSH_SCHEDULED;                      chanPtr->flags |= BG_FLUSH_SCHEDULED;
2334                      UpdateInterest(chanPtr);                      UpdateInterest(chanPtr);
2335                  }                  }
2336                  errorCode = 0;                  errorCode = 0;
2337                  break;                  break;
2338              }              }
2339    
2340              /*              /*
2341               * Decide whether to report the error upwards or defer it.               * Decide whether to report the error upwards or defer it.
2342               */               */
2343    
2344              if (calledFromAsyncFlush) {              if (calledFromAsyncFlush) {
2345                  if (chanPtr->unreportedError == 0) {                  if (chanPtr->unreportedError == 0) {
2346                      chanPtr->unreportedError = errorCode;                      chanPtr->unreportedError = errorCode;
2347                  }                  }
2348              } else {              } else {
2349                  Tcl_SetErrno(errorCode);                  Tcl_SetErrno(errorCode);
2350                  if (interp != NULL) {                  if (interp != NULL) {
2351                      Tcl_SetResult(interp,                      Tcl_SetResult(interp,
2352                              Tcl_PosixError(interp), TCL_VOLATILE);                              Tcl_PosixError(interp), TCL_VOLATILE);
2353                  }                  }
2354              }              }
2355    
2356              /*              /*
2357               * When we get an error we throw away all the output               * When we get an error we throw away all the output
2358               * currently queued.               * currently queued.
2359               */               */
2360    
2361              DiscardOutputQueued(chanPtr);              DiscardOutputQueued(chanPtr);
2362              continue;              continue;
2363          } else {          } else {
2364              wroteSome = 1;              wroteSome = 1;
2365          }          }
2366    
2367          bufPtr->nextRemoved += written;          bufPtr->nextRemoved += written;
2368    
2369          /*          /*
2370           * If this buffer is now empty, recycle it.           * If this buffer is now empty, recycle it.
2371           */           */
2372    
2373          if (bufPtr->nextRemoved == bufPtr->nextAdded) {          if (bufPtr->nextRemoved == bufPtr->nextAdded) {
2374              chanPtr->outQueueHead = bufPtr->nextPtr;              chanPtr->outQueueHead = bufPtr->nextPtr;
2375              if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {              if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2376                  chanPtr->outQueueTail = (ChannelBuffer *) NULL;                  chanPtr->outQueueTail = (ChannelBuffer *) NULL;
2377              }              }
2378              RecycleBuffer(chanPtr, bufPtr, 0);              RecycleBuffer(chanPtr, bufPtr, 0);
2379          }          }
2380      }   /* Closes "while (1)". */      }   /* Closes "while (1)". */
2381    
2382      /*      /*
2383       * If we wrote some data while flushing in the background, we are done.       * 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       * 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       * the channel becomes writable again.  This ensures that all of the
2386       * pending data has been flushed at the system level.       * pending data has been flushed at the system level.
2387       */       */
2388    
2389      if (chanPtr->flags & BG_FLUSH_SCHEDULED) {      if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
2390          if (wroteSome) {          if (wroteSome) {
2391              return errorCode;              return errorCode;
2392          } else if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {          } else if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
2393              chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));              chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
2394              (chanPtr->typePtr->watchProc)(chanPtr->instanceData,              (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
2395                      chanPtr->interestMask);                      chanPtr->interestMask);
2396          }          }
2397      }      }
2398    
2399      /*      /*
2400       * If the channel is flagged as closed, delete it when the refCount       * 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       * drops to zero, the output queue is empty and there is no output
2402       * in the current output buffer.       * in the current output buffer.
2403       */       */
2404    
2405      if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&      if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
2406              (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&              (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
2407              ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||              ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
2408                      (chanPtr->curOutPtr->nextAdded ==                      (chanPtr->curOutPtr->nextAdded ==
2409                              chanPtr->curOutPtr->nextRemoved))) {                              chanPtr->curOutPtr->nextRemoved))) {
2410          return CloseChannel(interp, chanPtr, errorCode);          return CloseChannel(interp, chanPtr, errorCode);
2411      }      }
2412      return errorCode;      return errorCode;
2413  }  }
2414    
2415  /*  /*
2416   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2417   *   *
2418   * CloseChannel --   * CloseChannel --
2419   *   *
2420   *      Utility procedure to close a channel and free its associated   *      Utility procedure to close a channel and free its associated
2421   *      resources.   *      resources.
2422   *   *
2423   * Results:   * Results:
2424   *      0 on success or a POSIX error code if the operation failed.   *      0 on success or a POSIX error code if the operation failed.
2425   *   *
2426   * Side effects:   * Side effects:
2427   *      May close the actual channel; may free memory.   *      May close the actual channel; may free memory.
2428   *   *
2429   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2430   */   */
2431    
2432  static int  static int
2433  CloseChannel(interp, chanPtr, errorCode)  CloseChannel(interp, chanPtr, errorCode)
2434      Tcl_Interp *interp;                 /* For error reporting. */      Tcl_Interp *interp;                 /* For error reporting. */
2435      Channel *chanPtr;                   /* The channel to close. */      Channel *chanPtr;                   /* The channel to close. */
2436      int errorCode;                      /* Status of operation so far. */      int errorCode;                      /* Status of operation so far. */
2437  {  {
2438      int result = 0;                     /* Of calling driver close      int result = 0;                     /* Of calling driver close
2439                                           * operation. */                                           * operation. */
2440      Channel *prevChanPtr;               /* Preceding channel in list of      Channel *prevChanPtr;               /* Preceding channel in list of
2441                                           * all channels - used to splice a                                           * all channels - used to splice a
2442                                           * channel out of the list on close. */                                           * channel out of the list on close. */
2443      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2444    
2445      if (chanPtr == NULL) {      if (chanPtr == NULL) {
2446          return result;          return result;
2447      }      }
2448            
2449      /*      /*
2450       * No more input can be consumed so discard any leftover input.       * No more input can be consumed so discard any leftover input.
2451       */       */
2452    
2453      DiscardInputQueued(chanPtr, 1);      DiscardInputQueued(chanPtr, 1);
2454    
2455      /*      /*
2456       * Discard a leftover buffer in the current output buffer field.       * Discard a leftover buffer in the current output buffer field.
2457       */       */
2458    
2459      if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {      if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
2460          ckfree((char *) chanPtr->curOutPtr);          ckfree((char *) chanPtr->curOutPtr);
2461          chanPtr->curOutPtr = (ChannelBuffer *) NULL;          chanPtr->curOutPtr = (ChannelBuffer *) NULL;
2462      }      }
2463            
2464      /*      /*
2465       * The caller guarantees that there are no more buffers       * The caller guarantees that there are no more buffers
2466       * queued for output.       * queued for output.
2467       */       */
2468    
2469      if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {      if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
2470          panic("TclFlush, closed channel: queued output left");          panic("TclFlush, closed channel: queued output left");
2471      }      }
2472    
2473      /*      /*
2474       * If the EOF character is set in the channel, append that to the       * If the EOF character is set in the channel, append that to the
2475       * output device.       * output device.
2476       */       */
2477    
2478      if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {      if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
2479          int dummy;          int dummy;
2480          char c;          char c;
2481    
2482          c = (char) chanPtr->outEofChar;          c = (char) chanPtr->outEofChar;
2483          (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);          (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
2484      }      }
2485    
2486      /*      /*
2487       * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so       * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
2488       * that close callbacks can not do input or output (assuming they       * that close callbacks can not do input or output (assuming they
2489       * squirreled the channel away in their clientData). This also       * squirreled the channel away in their clientData). This also
2490       * prevents infinite loops if the callback calls any C API that       * prevents infinite loops if the callback calls any C API that
2491       * could call FlushChannel.       * could call FlushChannel.
2492       */       */
2493    
2494      chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));      chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
2495                    
2496      /*      /*
2497       * Splice this channel out of the list of all channels.       * Splice this channel out of the list of all channels.
2498       */       */
2499    
2500      if (chanPtr == tsdPtr->firstChanPtr) {      if (chanPtr == tsdPtr->firstChanPtr) {
2501          tsdPtr->firstChanPtr = chanPtr->nextChanPtr;          tsdPtr->firstChanPtr = chanPtr->nextChanPtr;
2502      } else {      } else {
2503          for (prevChanPtr = tsdPtr->firstChanPtr;          for (prevChanPtr = tsdPtr->firstChanPtr;
2504                   (prevChanPtr != (Channel *) NULL) &&                   (prevChanPtr != (Channel *) NULL) &&
2505                       (prevChanPtr->nextChanPtr != chanPtr);                       (prevChanPtr->nextChanPtr != chanPtr);
2506                   prevChanPtr = prevChanPtr->nextChanPtr) {                   prevChanPtr = prevChanPtr->nextChanPtr) {
2507              /* Empty loop body. */              /* Empty loop body. */
2508          }          }
2509          if (prevChanPtr == (Channel *) NULL) {          if (prevChanPtr == (Channel *) NULL) {
2510              panic("FlushChannel: damaged channel list");              panic("FlushChannel: damaged channel list");
2511          }          }
2512          prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;          prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
2513      }      }
2514    
2515      /*      /*
2516       * Close and free the channel driver state.       * Close and free the channel driver state.
2517       */       */
2518                            
2519      if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {      if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
2520          result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);          result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
2521      } else {      } else {
2522          result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,          result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2523                  0);                  0);
2524      }      }
2525            
2526      if (chanPtr->channelName != (char *) NULL) {      if (chanPtr->channelName != (char *) NULL) {
2527          ckfree(chanPtr->channelName);          ckfree(chanPtr->channelName);
2528      }      }
2529      Tcl_FreeEncoding(chanPtr->encoding);      Tcl_FreeEncoding(chanPtr->encoding);
2530      if (chanPtr->outputStage != NULL) {      if (chanPtr->outputStage != NULL) {
2531          ckfree((char *) chanPtr->outputStage);          ckfree((char *) chanPtr->outputStage);
2532      }      }
2533            
2534      /*      /*
2535       * If we are being called synchronously, report either       * If we are being called synchronously, report either
2536       * any latent error on the channel or the current error.       * any latent error on the channel or the current error.
2537       */       */
2538                    
2539      if (chanPtr->unreportedError != 0) {      if (chanPtr->unreportedError != 0) {
2540          errorCode = chanPtr->unreportedError;          errorCode = chanPtr->unreportedError;
2541      }      }
2542      if (errorCode == 0) {      if (errorCode == 0) {
2543          errorCode = result;          errorCode = result;
2544          if (errorCode != 0) {          if (errorCode != 0) {
2545              Tcl_SetErrno(errorCode);              Tcl_SetErrno(errorCode);
2546          }          }
2547      }      }
2548    
2549      /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998      /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998
2550       * "Trf-Patch for filtering channels"       * "Trf-Patch for filtering channels"
2551       *       *
2552       * This is the change to 'CloseChannel'.       * This is the change to 'CloseChannel'.
2553       *       *
2554       * Explanation       * Explanation
2555       *          Closing a filtering channel closes the one it       *          Closing a filtering channel closes the one it
2556       *          superceded too. This basically ripples through       *          superceded too. This basically ripples through
2557       *          the whole chain of filters until it reaches       *          the whole chain of filters until it reaches
2558       *          the underlying normal channel.       *          the underlying normal channel.
2559       *       *
2560       *          This is done by reintegrating the superceded       *          This is done by reintegrating the superceded
2561       *          channel into the (thread) global list of open       *          channel into the (thread) global list of open
2562       *          channels and then invoking a regular close.       *          channels and then invoking a regular close.
2563       *          There is no need to handle the complexities of       *          There is no need to handle the complexities of
2564       *          this process by ourselves.       *          this process by ourselves.
2565       *       *
2566       *          *Note*       *          *Note*
2567       *          This has to be done after the call to the       *          This has to be done after the call to the
2568       *          'closeProc' of the filtering channel to allow       *          'closeProc' of the filtering channel to allow
2569       *          that one to flush internal buffers into       *          that one to flush internal buffers into
2570       *          the underlying channel.       *          the underlying channel.
2571       */       */
2572    
2573      if (chanPtr->supercedes != (Channel*) NULL) {      if (chanPtr->supercedes != (Channel*) NULL) {
2574          /*          /*
2575           * Insert the channel we were stacked upon back into           * Insert the channel we were stacked upon back into
2576           * the list of open channels, then do a regular close.           * the list of open channels, then do a regular close.
2577           */           */
2578    
2579          chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;          chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr;
2580          tsdPtr->firstChanPtr             = chanPtr->supercedes;          tsdPtr->firstChanPtr             = chanPtr->supercedes;
2581          chanPtr->supercedes->refCount --; /* is deregistered */          chanPtr->supercedes->refCount --; /* is deregistered */
2582          Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);          Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes);
2583      }      }
2584    
2585      /*      /*
2586       * Cancel any outstanding timer.       * Cancel any outstanding timer.
2587       */       */
2588    
2589      Tcl_DeleteTimerHandler(chanPtr->timer);      Tcl_DeleteTimerHandler(chanPtr->timer);
2590    
2591      /*      /*
2592       * Mark the channel as deleted by clearing the type structure.       * Mark the channel as deleted by clearing the type structure.
2593       */       */
2594    
2595      chanPtr->typePtr = NULL;      chanPtr->typePtr = NULL;
2596    
2597      Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);      Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
2598    
2599      return errorCode;      return errorCode;
2600  }  }
2601    
2602  /*  /*
2603   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2604   *   *
2605   * Tcl_Close --   * Tcl_Close --
2606   *   *
2607   *      Closes a channel.   *      Closes a channel.
2608   *   *
2609   * Results:   * Results:
2610   *      A standard Tcl result.   *      A standard Tcl result.
2611   *   *
2612   * Side effects:   * Side effects:
2613   *      Closes the channel if this is the last reference.   *      Closes the channel if this is the last reference.
2614   *   *
2615   * NOTE:   * NOTE:
2616   *      Tcl_Close removes the channel as far as the user is concerned.   *      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   *      However, it may continue to exist for a while longer if it has
2618   *      a background flush scheduled. The device itself is eventually   *      a background flush scheduled. The device itself is eventually
2619   *      closed and the channel record removed, in CloseChannel, above.   *      closed and the channel record removed, in CloseChannel, above.
2620   *   *
2621   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2622   */   */
2623    
2624          /* ARGSUSED */          /* ARGSUSED */
2625  int  int
2626  Tcl_Close(interp, chan)  Tcl_Close(interp, chan)
2627      Tcl_Interp *interp;                 /* Interpreter for errors. */      Tcl_Interp *interp;                 /* Interpreter for errors. */
2628      Tcl_Channel chan;                   /* The channel being closed. Must      Tcl_Channel chan;                   /* The channel being closed. Must
2629                                           * not be referenced in any                                           * not be referenced in any
2630                                           * interpreter. */                                           * interpreter. */
2631  {  {
2632      ChannelHandler *chPtr, *chNext;     /* Iterate over channel handlers. */      ChannelHandler *chPtr, *chNext;     /* Iterate over channel handlers. */
2633      CloseCallback *cbPtr;               /* Iterate over close callbacks      CloseCallback *cbPtr;               /* Iterate over close callbacks
2634                                           * for this channel. */                                           * for this channel. */
2635      EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */      EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
2636      Channel *chanPtr;                   /* The real IO channel. */      Channel *chanPtr;                   /* The real IO channel. */
2637      int result;                         /* Of calling FlushChannel. */      int result;                         /* Of calling FlushChannel. */
2638      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2639      NextChannelHandler *nhPtr;      NextChannelHandler *nhPtr;
2640    
2641      if (chan == (Tcl_Channel) NULL) {      if (chan == (Tcl_Channel) NULL) {
2642          return TCL_OK;          return TCL_OK;
2643      }      }
2644            
2645      /*      /*
2646       * Perform special handling for standard channels being closed. If the       * Perform special handling for standard channels being closed. If the
2647       * refCount is now 1 it means that the last reference to the standard       * refCount is now 1 it means that the last reference to the standard
2648       * channel is being explicitly closed, so bump the refCount down       * channel is being explicitly closed, so bump the refCount down
2649       * artificially to 0. This will ensure that the channel is actually       * artificially to 0. This will ensure that the channel is actually
2650       * closed, below. Also set the static pointer to NULL for the channel.       * closed, below. Also set the static pointer to NULL for the channel.
2651       */       */
2652    
2653      CheckForStdChannelsBeingClosed(chan);      CheckForStdChannelsBeingClosed(chan);
2654    
2655      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
2656      if (chanPtr->refCount > 0) {      if (chanPtr->refCount > 0) {
2657          panic("called Tcl_Close on channel with refCount > 0");          panic("called Tcl_Close on channel with refCount > 0");
2658      }      }
2659    
2660      /*      /*
2661       * Remove any references to channel handlers for this channel that       * Remove any references to channel handlers for this channel that
2662       * may be about to be invoked.       * may be about to be invoked.
2663       */       */
2664    
2665      for (nhPtr = tsdPtr->nestedHandlerPtr;      for (nhPtr = tsdPtr->nestedHandlerPtr;
2666               nhPtr != (NextChannelHandler *) NULL;               nhPtr != (NextChannelHandler *) NULL;
2667               nhPtr = nhPtr->nestedHandlerPtr) {               nhPtr = nhPtr->nestedHandlerPtr) {
2668          if (nhPtr->nextHandlerPtr &&          if (nhPtr->nextHandlerPtr &&
2669                  (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {                  (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
2670              nhPtr->nextHandlerPtr = NULL;              nhPtr->nextHandlerPtr = NULL;
2671          }          }
2672      }      }
2673    
2674      /*      /*
2675       * Remove all the channel handler records attached to the channel       * Remove all the channel handler records attached to the channel
2676       * itself.       * itself.
2677       */       */
2678                    
2679      for (chPtr = chanPtr->chPtr;      for (chPtr = chanPtr->chPtr;
2680               chPtr != (ChannelHandler *) NULL;               chPtr != (ChannelHandler *) NULL;
2681               chPtr = chNext) {               chPtr = chNext) {
2682          chNext = chPtr->nextPtr;          chNext = chPtr->nextPtr;
2683          ckfree((char *) chPtr);          ckfree((char *) chPtr);
2684      }      }
2685      chanPtr->chPtr = (ChannelHandler *) NULL;      chanPtr->chPtr = (ChannelHandler *) NULL;
2686            
2687            
2688      /*      /*
2689       * Cancel any pending copy operation.       * Cancel any pending copy operation.
2690       */       */
2691    
2692      StopCopy(chanPtr->csPtr);      StopCopy(chanPtr->csPtr);
2693    
2694      /*      /*
2695       * Must set the interest mask now to 0, otherwise infinite loops       * Must set the interest mask now to 0, otherwise infinite loops
2696       * will occur if Tcl_DoOneEvent is called before the channel is       * will occur if Tcl_DoOneEvent is called before the channel is
2697       * finally deleted in FlushChannel. This can happen if the channel       * finally deleted in FlushChannel. This can happen if the channel
2698       * has a background flush active.       * has a background flush active.
2699       */       */
2700                    
2701      chanPtr->interestMask = 0;      chanPtr->interestMask = 0;
2702            
2703      /*      /*
2704       * Remove any EventScript records for this channel.       * Remove any EventScript records for this channel.
2705       */       */
2706    
2707      for (ePtr = chanPtr->scriptRecordPtr;      for (ePtr = chanPtr->scriptRecordPtr;
2708               ePtr != (EventScriptRecord *) NULL;               ePtr != (EventScriptRecord *) NULL;
2709               ePtr = eNextPtr) {               ePtr = eNextPtr) {
2710          eNextPtr = ePtr->nextPtr;          eNextPtr = ePtr->nextPtr;
2711          Tcl_DecrRefCount(ePtr->scriptPtr);          Tcl_DecrRefCount(ePtr->scriptPtr);
2712          ckfree((char *) ePtr);          ckfree((char *) ePtr);
2713      }      }
2714      chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;      chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
2715                    
2716      /*      /*
2717       * Invoke the registered close callbacks and delete their records.       * Invoke the registered close callbacks and delete their records.
2718       */       */
2719    
2720      while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {      while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
2721          cbPtr = chanPtr->closeCbPtr;          cbPtr = chanPtr->closeCbPtr;
2722          chanPtr->closeCbPtr = cbPtr->nextPtr;          chanPtr->closeCbPtr = cbPtr->nextPtr;
2723          (cbPtr->proc) (cbPtr->clientData);          (cbPtr->proc) (cbPtr->clientData);
2724          ckfree((char *) cbPtr);          ckfree((char *) cbPtr);
2725      }      }
2726    
2727      /*      /*
2728       * Ensure that the last output buffer will be flushed.       * Ensure that the last output buffer will be flushed.
2729       */       */
2730            
2731      if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&      if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
2732             (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {             (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
2733          chanPtr->flags |= BUFFER_READY;          chanPtr->flags |= BUFFER_READY;
2734      }      }
2735    
2736      /*      /*
2737       * If this channel supports it, close the read side, since we don't need it       * 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.       * anymore and this will help avoid deadlocks on some channel types.
2739       */       */
2740    
2741      if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {      if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
2742          result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,          result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
2743                  TCL_CLOSE_READ);                  TCL_CLOSE_READ);
2744      } else {      } else {
2745          result = 0;          result = 0;
2746      }      }
2747    
2748      /*      /*
2749       * The call to FlushChannel will flush any queued output and invoke       * 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       * the close function of the channel driver, or it will set up the
2751       * channel to be flushed and closed asynchronously.       * channel to be flushed and closed asynchronously.
2752       */       */
2753    
2754      chanPtr->flags |= CHANNEL_CLOSED;      chanPtr->flags |= CHANNEL_CLOSED;
2755      if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {      if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
2756          return TCL_ERROR;          return TCL_ERROR;
2757      }      }
2758      return TCL_OK;      return TCL_OK;
2759  }  }
2760    
2761  /*  /*
2762   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2763   *   *
2764   * Tcl_Write --   * Tcl_Write --
2765   *   *
2766   *      Puts a sequence of bytes into an output buffer, may queue the   *      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   *      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   *      current buffer is ready e.g. if it contains a newline and we are in
2769   *      line buffering mode.   *      line buffering mode.
2770   *   *
2771   * Results:   * Results:
2772   *      The number of bytes written or -1 in case of error. If -1,   *      The number of bytes written or -1 in case of error. If -1,
2773   *      Tcl_GetErrno will return the error code.   *      Tcl_GetErrno will return the error code.
2774   *   *
2775   * Side effects:   * Side effects:
2776   *      May buffer up output and may cause output to be produced on the   *      May buffer up output and may cause output to be produced on the
2777   *      channel.   *      channel.
2778   *   *
2779   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2780   */   */
2781    
2782  int  int
2783  Tcl_Write(chan, src, srcLen)  Tcl_Write(chan, src, srcLen)
2784      Tcl_Channel chan;                   /* The channel to buffer output for. */      Tcl_Channel chan;                   /* The channel to buffer output for. */
2785      char *src;                          /* Data to queue in output buffer. */      char *src;                          /* Data to queue in output buffer. */
2786      int srcLen;                         /* Length of data in bytes, or < 0 for      int srcLen;                         /* Length of data in bytes, or < 0 for
2787                                           * strlen(). */                                           * strlen(). */
2788  {  {
2789      Channel *chanPtr;      Channel *chanPtr;
2790    
2791      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
2792      if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2793          return -1;          return -1;
2794      }      }
2795      if (srcLen < 0) {      if (srcLen < 0) {
2796          srcLen = strlen(src);          srcLen = strlen(src);
2797      }      }
2798      return DoWrite(chanPtr, src, srcLen);      return DoWrite(chanPtr, src, srcLen);
2799  }  }
2800    
2801  /*  /*
2802   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
2803   *   *
2804   * Tcl_WriteChars --   * Tcl_WriteChars --
2805   *   *
2806   *      Takes a sequence of UTF-8 characters and converts them for output   *      Takes a sequence of UTF-8 characters and converts them for output
2807   *      using the channel's current encoding, may queue the buffer for   *      using the channel's current encoding, may queue the buffer for
2808   *      output if it gets full, and also remembers whether the current   *      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   *      buffer is ready e.g. if it contains a newline and we are in
2810   *      line buffering mode.   *      line buffering mode.
2811   *   *
2812   * Results:   * Results:
2813   *      The number of bytes written or -1 in case of error. If -1,   *      The number of bytes written or -1 in case of error. If -1,
2814   *      Tcl_GetErrno will return the error code.   *      Tcl_GetErrno will return the error code.
2815   *   *
2816   * Side effects:   * Side effects:
2817   *      May buffer up output and may cause output to be produced on the   *      May buffer up output and may cause output to be produced on the
2818   *      channel.   *      channel.
2819   *   *
2820   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2821   */   */
2822    
2823  int  int
2824  Tcl_WriteChars(chan, src, len)  Tcl_WriteChars(chan, src, len)
2825      Tcl_Channel chan;           /* The channel to buffer output for. */      Tcl_Channel chan;           /* The channel to buffer output for. */
2826      CONST char *src;            /* UTF-8 characters to queue in output buffer. */      CONST char *src;            /* UTF-8 characters to queue in output buffer. */
2827      int len;                    /* Length of string in bytes, or < 0 for      int len;                    /* Length of string in bytes, or < 0 for
2828                                   * strlen(). */                                   * strlen(). */
2829  {  {
2830      Channel *chanPtr;      Channel *chanPtr;
2831    
2832      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
2833      if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2834          return -1;          return -1;
2835      }      }
2836      if (len < 0) {      if (len < 0) {
2837          len = strlen(src);          len = strlen(src);
2838      }      }
2839      if (chanPtr->encoding == NULL) {      if (chanPtr->encoding == NULL) {
2840          /*          /*
2841           * Inefficient way to convert UTF-8 to byte-array, but the             * Inefficient way to convert UTF-8 to byte-array, but the  
2842           * code parallels the way it is done for objects.           * code parallels the way it is done for objects.
2843           */           */
2844    
2845          Tcl_Obj *objPtr;          Tcl_Obj *objPtr;
2846          int result;          int result;
2847    
2848          objPtr = Tcl_NewStringObj(src, len);          objPtr = Tcl_NewStringObj(src, len);
2849          src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);          src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
2850          result = WriteBytes(chanPtr, src, len);          result = WriteBytes(chanPtr, src, len);
2851          Tcl_DecrRefCount(objPtr);          Tcl_DecrRefCount(objPtr);
2852          return result;          return result;
2853      }      }
2854      return WriteChars(chanPtr, src, len);      return WriteChars(chanPtr, src, len);
2855  }  }
2856    
2857  /*  /*
2858   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
2859   *   *
2860   * Tcl_WriteObj --   * Tcl_WriteObj --
2861   *   *
2862   *      Takes the Tcl object and queues its contents for output.  If the   *      Takes the Tcl object and queues its contents for output.  If the
2863   *      encoding of the channel is NULL, takes the byte-array representation   *      encoding of the channel is NULL, takes the byte-array representation
2864   *      of the object and queues those bytes for output.  Otherwise, takes   *      of the object and queues those bytes for output.  Otherwise, takes
2865   *      the characters in the UTF-8 (string) representation of the object   *      the characters in the UTF-8 (string) representation of the object
2866   *      and converts them for output using the channel's current encoding.     *      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   *      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   *      for some other reason, e.g. if it contains a newline and the channel
2869   *      is in line buffering mode.   *      is in line buffering mode.
2870   *   *
2871   * Results:   * Results:
2872   *      The number of bytes written or -1 in case of error. If -1,   *      The number of bytes written or -1 in case of error. If -1,
2873   *      Tcl_GetErrno() will return the error code.   *      Tcl_GetErrno() will return the error code.
2874   *   *
2875   * Side effects:   * Side effects:
2876   *      May buffer up output and may cause output to be produced on the   *      May buffer up output and may cause output to be produced on the
2877   *      channel.   *      channel.
2878   *   *
2879   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2880   */   */
2881    
2882  int  int
2883  Tcl_WriteObj(chan, objPtr)  Tcl_WriteObj(chan, objPtr)
2884      Tcl_Channel chan;           /* The channel to buffer output for. */      Tcl_Channel chan;           /* The channel to buffer output for. */
2885      Tcl_Obj *objPtr;            /* The object to write. */      Tcl_Obj *objPtr;            /* The object to write. */
2886  {  {
2887      Channel *chanPtr;      Channel *chanPtr;
2888      char *src;      char *src;
2889      int srcLen;      int srcLen;
2890    
2891      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
2892      if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
2893          return -1;          return -1;
2894      }      }
2895      if (chanPtr->encoding == NULL) {      if (chanPtr->encoding == NULL) {
2896          src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);          src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
2897          return WriteBytes(chanPtr, src, srcLen);          return WriteBytes(chanPtr, src, srcLen);
2898      } else {      } else {
2899          src = Tcl_GetStringFromObj(objPtr, &srcLen);          src = Tcl_GetStringFromObj(objPtr, &srcLen);
2900          return WriteChars(chanPtr, src, srcLen);          return WriteChars(chanPtr, src, srcLen);
2901      }      }
2902  }  }
2903    
2904  /*  /*
2905   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2906   *   *
2907   * WriteBytes --   * WriteBytes --
2908   *   *
2909   *      Write a sequence of bytes into an output buffer, may queue the   *      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   *      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   *      current buffer is ready e.g. if it contains a newline and we are in
2912   *      line buffering mode.   *      line buffering mode.
2913   *   *
2914   * Results:   * Results:
2915   *      The number of bytes written or -1 in case of error. If -1,   *      The number of bytes written or -1 in case of error. If -1,
2916   *      Tcl_GetErrno will return the error code.   *      Tcl_GetErrno will return the error code.
2917   *   *
2918   * Side effects:   * Side effects:
2919   *      May buffer up output and may cause output to be produced on the   *      May buffer up output and may cause output to be produced on the
2920   *      channel.   *      channel.
2921   *   *
2922   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2923   */   */
2924    
2925  static int  static int
2926  WriteBytes(chanPtr, src, srcLen)  WriteBytes(chanPtr, src, srcLen)
2927      Channel *chanPtr;           /* The channel to buffer output for. */      Channel *chanPtr;           /* The channel to buffer output for. */
2928      CONST char *src;            /* Bytes to write. */      CONST char *src;            /* Bytes to write. */
2929      int srcLen;                 /* Number of bytes to write. */      int srcLen;                 /* Number of bytes to write. */
2930  {  {
2931      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
2932      char *dst;      char *dst;
2933      int dstLen, dstMax, sawLF, savedLF, total, toWrite;      int dstLen, dstMax, sawLF, savedLF, total, toWrite;
2934            
2935      total = 0;      total = 0;
2936      sawLF = 0;      sawLF = 0;
2937      savedLF = 0;      savedLF = 0;
2938    
2939      /*      /*
2940       * Loop over all bytes in src, storing them in output buffer with       * Loop over all bytes in src, storing them in output buffer with
2941       * proper EOL translation.       * proper EOL translation.
2942       */       */
2943    
2944      while (srcLen + savedLF > 0) {      while (srcLen + savedLF > 0) {
2945          bufPtr = chanPtr->curOutPtr;          bufPtr = chanPtr->curOutPtr;
2946          if (bufPtr == NULL) {          if (bufPtr == NULL) {
2947              bufPtr = AllocChannelBuffer(chanPtr->bufSize);              bufPtr = AllocChannelBuffer(chanPtr->bufSize);
2948              chanPtr->curOutPtr  = bufPtr;              chanPtr->curOutPtr  = bufPtr;
2949          }          }
2950          dst = bufPtr->buf + bufPtr->nextAdded;          dst = bufPtr->buf + bufPtr->nextAdded;
2951          dstMax = bufPtr->bufLength - bufPtr->nextAdded;          dstMax = bufPtr->bufLength - bufPtr->nextAdded;
2952          dstLen = dstMax;          dstLen = dstMax;
2953    
2954          toWrite = dstLen;          toWrite = dstLen;
2955          if (toWrite > srcLen) {          if (toWrite > srcLen) {
2956              toWrite = srcLen;              toWrite = srcLen;
2957          }          }
2958    
2959          if (savedLF) {          if (savedLF) {
2960              /*              /*
2961               * A '\n' was left over from last call to TranslateOutputEOL()               * A '\n' was left over from last call to TranslateOutputEOL()
2962               * and we need to store it in this buffer.  If the channel is               * and we need to store it in this buffer.  If the channel is
2963               * line-based, we will need to flush it.               * line-based, we will need to flush it.
2964               */               */
2965    
2966              *dst++ = '\n';              *dst++ = '\n';
2967              dstLen--;              dstLen--;
2968              sawLF++;              sawLF++;
2969          }          }
2970          sawLF += TranslateOutputEOL(chanPtr, dst, src, &dstLen, &toWrite);          sawLF += TranslateOutputEOL(chanPtr, dst, src, &dstLen, &toWrite);
2971          dstLen += savedLF;          dstLen += savedLF;
2972          savedLF = 0;          savedLF = 0;
2973    
2974          if (dstLen > dstMax) {          if (dstLen > dstMax) {
2975              savedLF = 1;              savedLF = 1;
2976              dstLen = dstMax;              dstLen = dstMax;
2977          }          }
2978          bufPtr->nextAdded += dstLen;          bufPtr->nextAdded += dstLen;
2979          if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {          if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
2980              return -1;              return -1;
2981          }          }
2982          total += dstLen;          total += dstLen;
2983          src += toWrite;          src += toWrite;
2984          srcLen -= toWrite;          srcLen -= toWrite;
2985          sawLF = 0;          sawLF = 0;
2986      }      }
2987      return total;      return total;
2988  }  }
2989    
2990  /*  /*
2991   *----------------------------------------------------------------------   *----------------------------------------------------------------------
2992   *   *
2993   * WriteChars --   * WriteChars --
2994   *   *
2995   *      Convert UTF-8 bytes to the channel's external encoding and   *      Convert UTF-8 bytes to the channel's external encoding and
2996   *      write the produced bytes into an output buffer, may queue the   *      write the produced bytes into an output buffer, may queue the
2997   *      buffer for output if it gets full, and also remembers whether the   *      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   *      current buffer is ready e.g. if it contains a newline and we are in
2999   *      line buffering mode.   *      line buffering mode.
3000   *   *
3001   * Results:   * Results:
3002   *      The number of bytes written or -1 in case of error. If -1,   *      The number of bytes written or -1 in case of error. If -1,
3003   *      Tcl_GetErrno will return the error code.   *      Tcl_GetErrno will return the error code.
3004   *   *
3005   * Side effects:   * Side effects:
3006   *      May buffer up output and may cause output to be produced on the   *      May buffer up output and may cause output to be produced on the
3007   *      channel.   *      channel.
3008   *   *
3009   *----------------------------------------------------------------------   *----------------------------------------------------------------------
3010   */   */
3011    
3012  static int  static int
3013  WriteChars(chanPtr, src, srcLen)  WriteChars(chanPtr, src, srcLen)
3014      Channel *chanPtr;           /* The channel to buffer output for. */      Channel *chanPtr;           /* The channel to buffer output for. */
3015      CONST char *src;            /* UTF-8 string to write. */      CONST char *src;            /* UTF-8 string to write. */
3016      int srcLen;                 /* Length of UTF-8 string in bytes. */      int srcLen;                 /* Length of UTF-8 string in bytes. */
3017  {  {
3018      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
3019      char *dst, *stage;      char *dst, *stage;
3020      int saved, savedLF, sawLF, total, toWrite, flags;      int saved, savedLF, sawLF, total, toWrite, flags;
3021      int dstWrote, dstLen, stageLen, stageMax, stageRead;      int dstWrote, dstLen, stageLen, stageMax, stageRead;
3022      Tcl_Encoding encoding;      Tcl_Encoding encoding;
3023      char safe[BUFFER_PADDING];      char safe[BUFFER_PADDING];
3024            
3025      total = 0;      total = 0;
3026      sawLF = 0;      sawLF = 0;
3027      savedLF = 0;      savedLF = 0;
3028      saved = 0;      saved = 0;
3029      encoding = chanPtr->encoding;      encoding = chanPtr->encoding;
3030    
3031      /*      /*
3032       * Loop over all UTF-8 characters in src, storing them in staging buffer       * Loop over all UTF-8 characters in src, storing them in staging buffer
3033       * with proper EOL translation.       * with proper EOL translation.
3034       */       */
3035    
3036      while (srcLen + savedLF > 0) {      while (srcLen + savedLF > 0) {
3037          stage = chanPtr->outputStage;          stage = chanPtr->outputStage;
3038          stageMax = chanPtr->bufSize;          stageMax = chanPtr->bufSize;
3039          stageLen = stageMax;          stageLen = stageMax;
3040    
3041          toWrite = stageLen;          toWrite = stageLen;
3042          if (toWrite > srcLen) {          if (toWrite > srcLen) {
3043              toWrite = srcLen;              toWrite = srcLen;
3044          }          }
3045    
3046          if (savedLF) {          if (savedLF) {
3047              /*              /*
3048               * A '\n' was left over from last call to TranslateOutputEOL()               * A '\n' was left over from last call to TranslateOutputEOL()
3049               * and we need to store it in the staging buffer.  If the               * and we need to store it in the staging buffer.  If the
3050               * channel is line-based, we will need to flush the output               * channel is line-based, we will need to flush the output
3051               * buffer (after translating the staging buffer).               * buffer (after translating the staging buffer).
3052               */               */
3053                            
3054              *stage++ = '\n';              *stage++ = '\n';
3055              stageLen--;              stageLen--;
3056              sawLF++;              sawLF++;
3057          }          }
3058          sawLF += TranslateOutputEOL(chanPtr, stage, src, &stageLen, &toWrite);          sawLF += TranslateOutputEOL(chanPtr, stage, src, &stageLen, &toWrite);
3059    
3060          stage -= savedLF;          stage -= savedLF;
3061          stageLen += savedLF;          stageLen += savedLF;
3062          savedLF = 0;          savedLF = 0;
3063    
3064          if (stageLen > stageMax) {          if (stageLen > stageMax) {
3065              savedLF = 1;              savedLF = 1;
3066              stageLen = stageMax;              stageLen = stageMax;
3067          }          }
3068          src += toWrite;          src += toWrite;
3069          srcLen -= toWrite;          srcLen -= toWrite;
3070    
3071          flags = chanPtr->outputEncodingFlags;          flags = chanPtr->outputEncodingFlags;
3072          if (srcLen == 0) {          if (srcLen == 0) {
3073              flags |= TCL_ENCODING_END;              flags |= TCL_ENCODING_END;
3074          }          }
3075    
3076          /*          /*
3077           * Loop over all UTF-8 characters in staging buffer, converting them           * Loop over all UTF-8 characters in staging buffer, converting them
3078           * to external encoding, storing them in output buffer.           * to external encoding, storing them in output buffer.
3079           */           */
3080    
3081          while (stageLen + saved > 0) {          while (stageLen + saved > 0) {
3082              bufPtr = chanPtr->curOutPtr;              bufPtr = chanPtr->curOutPtr;
3083              if (bufPtr == NULL) {              if (bufPtr == NULL) {
3084                  bufPtr = AllocChannelBuffer(chanPtr->bufSize);                  bufPtr = AllocChannelBuffer(chanPtr->bufSize);
3085                  chanPtr->curOutPtr = bufPtr;                  chanPtr->curOutPtr = bufPtr;
3086              }              }
3087              dst = bufPtr->buf + bufPtr->nextAdded;              dst = bufPtr->buf + bufPtr->nextAdded;
3088              dstLen = bufPtr->bufLength - bufPtr->nextAdded;              dstLen = bufPtr->bufLength - bufPtr->nextAdded;
3089    
3090              if (saved != 0) {              if (saved != 0) {
3091                  /*                  /*
3092                   * Here's some translated bytes left over from the last                   * Here's some translated bytes left over from the last
3093                   * buffer that we need to stick at the beginning of this                   * buffer that we need to stick at the beginning of this
3094                   * buffer.                   * buffer.
3095                   */                   */
3096                                    
3097                  memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);                  memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);
3098                  bufPtr->nextAdded += saved;                  bufPtr->nextAdded += saved;
3099                  dst += saved;                  dst += saved;
3100                  dstLen -= saved;                  dstLen -= saved;
3101                  saved = 0;                  saved = 0;
3102              }              }
3103    
3104              Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,              Tcl_UtfToExternal(NULL, encoding, stage, stageLen, flags,
3105                      &chanPtr->outputEncodingState, dst,                      &chanPtr->outputEncodingState, dst,
3106                      dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);                      dstLen + BUFFER_PADDING, &stageRead, &dstWrote, NULL);
3107              if (stageRead + dstWrote == 0) {              if (stageRead + dstWrote == 0) {
3108                  /*                  /*
3109                   * We have an incomplete UTF-8 character at the end of the                   * We have an incomplete UTF-8 character at the end of the
3110                   * staging buffer.  It will get moved to the beginning of the                   * staging buffer.  It will get moved to the beginning of the
3111                   * staging buffer followed by more bytes from src.                   * staging buffer followed by more bytes from src.
3112                   */                   */
3113    
3114                  src -= stageLen;                  src -= stageLen;
3115                  srcLen += stageLen;                  srcLen += stageLen;
3116                  stageLen = 0;                  stageLen = 0;
3117                  savedLF = 0;                  savedLF = 0;
3118                  break;                  break;
3119              }              }
3120              bufPtr->nextAdded += dstWrote;              bufPtr->nextAdded += dstWrote;
3121              if (bufPtr->nextAdded > bufPtr->bufLength) {              if (bufPtr->nextAdded > bufPtr->bufLength) {
3122                  /*                  /*
3123                   * When translating from UTF-8 to external encoding, we                   * When translating from UTF-8 to external encoding, we
3124                   * allowed the translation to produce a character that                   * allowed the translation to produce a character that
3125                   * crossed the end of the output buffer, so that we would                   * crossed the end of the output buffer, so that we would
3126                   * get a completely full buffer before flushing it.  The                   * get a completely full buffer before flushing it.  The
3127                   * extra bytes will be moved to the beginning of the next                   * extra bytes will be moved to the beginning of the next
3128                   * buffer.                   * buffer.
3129                   */                   */
3130    
3131                  saved = bufPtr->nextAdded - bufPtr->bufLength;                  saved = bufPtr->nextAdded - bufPtr->bufLength;
3132                  memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);                  memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
3133                  bufPtr->nextAdded = bufPtr->bufLength;                  bufPtr->nextAdded = bufPtr->bufLength;
3134              }              }
3135              if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {              if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
3136                  return -1;                  return -1;
3137              }              }
3138    
3139              total += dstWrote;              total += dstWrote;
3140              stage += stageRead;              stage += stageRead;
3141              stageLen -= stageRead;              stageLen -= stageRead;
3142              sawLF = 0;              sawLF = 0;
3143          }          }
3144      }      }
3145      return total;      return total;
3146  }  }
3147    
3148  /*  /*
3149   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3150   *   *
3151   * TranslateOutputEOL --   * TranslateOutputEOL --
3152   *   *
3153   *      Helper function for WriteBytes() and WriteChars().  Converts the   *      Helper function for WriteBytes() and WriteChars().  Converts the
3154   *      '\n' characters in the source buffer into the appropriate EOL   *      '\n' characters in the source buffer into the appropriate EOL
3155   *      form specified by the output translation mode.   *      form specified by the output translation mode.
3156   *   *
3157   *      EOL translation stops either when the source buffer is empty   *      EOL translation stops either when the source buffer is empty
3158   *      or the output buffer is full.   *      or the output buffer is full.
3159   *   *
3160   *      When converting to CRLF mode and there is only 1 byte left in   *      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   *      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   *      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   *      buffer.  The caller is responsible for passing in a buffer that
3164   *      is large enough to hold the extra byte.   *      is large enough to hold the extra byte.
3165   *   *
3166   * Results:   * Results:
3167   *      The return value is 1 if a '\n' was translated from the source   *      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   *      buffer, or 0 otherwise -- this can be used by the caller to
3169   *      decide to flush a line-based channel even though the channel   *      decide to flush a line-based channel even though the channel
3170   *      buffer is not full.   *      buffer is not full.
3171   *   *
3172   *      *dstLenPtr is filled with how many bytes of the output buffer   *      *dstLenPtr is filled with how many bytes of the output buffer
3173   *      were used.  As mentioned above, this can be one more that   *      were used.  As mentioned above, this can be one more that
3174   *      the output buffer's specified length if a CRLF was stored.   *      the output buffer's specified length if a CRLF was stored.
3175   *   *
3176   *      *srcLenPtr is filled with how many bytes of the source buffer   *      *srcLenPtr is filled with how many bytes of the source buffer
3177   *      were consumed.     *      were consumed.  
3178   *   *
3179   * Side effects:   * Side effects:
3180   *      It may be obvious, but bears mentioning that when converting   *      It may be obvious, but bears mentioning that when converting
3181   *      in CRLF mode (which requires two bytes of storage in the output   *      in CRLF mode (which requires two bytes of storage in the output
3182   *      buffer), the number of bytes consumed from the source buffer   *      buffer), the number of bytes consumed from the source buffer
3183   *      will be less than the number of bytes stored in the output buffer.   *      will be less than the number of bytes stored in the output buffer.
3184   *   *
3185   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3186   */   */
3187    
3188  static int  static int
3189  TranslateOutputEOL(chanPtr, dst, src, dstLenPtr, srcLenPtr)  TranslateOutputEOL(chanPtr, dst, src, dstLenPtr, srcLenPtr)
3190      Channel *chanPtr;           /* Channel being read, for translation and      Channel *chanPtr;           /* Channel being read, for translation and
3191                                   * buffering modes. */                                   * buffering modes. */
3192      char *dst;                  /* Output buffer filled with UTF-8 chars by      char *dst;                  /* Output buffer filled with UTF-8 chars by
3193                                   * applying appropriate EOL translation to                                   * applying appropriate EOL translation to
3194                                   * source characters. */                                   * source characters. */
3195      CONST char *src;            /* Source UTF-8 characters. */      CONST char *src;            /* Source UTF-8 characters. */
3196      int *dstLenPtr;             /* On entry, the maximum length of output      int *dstLenPtr;             /* On entry, the maximum length of output
3197                                   * buffer in bytes.  On exit, the number of                                   * buffer in bytes.  On exit, the number of
3198                                   * bytes actually used in output buffer. */                                   * bytes actually used in output buffer. */
3199      int *srcLenPtr;             /* On entry, the length of source buffer.      int *srcLenPtr;             /* On entry, the length of source buffer.
3200                                   * On exit, the number of bytes read from                                   * On exit, the number of bytes read from
3201                                   * the source buffer. */                                   * the source buffer. */
3202  {  {
3203      char *dstEnd;      char *dstEnd;
3204      int srcLen, newlineFound;      int srcLen, newlineFound;
3205            
3206      newlineFound = 0;      newlineFound = 0;
3207      srcLen = *srcLenPtr;      srcLen = *srcLenPtr;
3208    
3209      switch (chanPtr->outputTranslation) {      switch (chanPtr->outputTranslation) {
3210          case TCL_TRANSLATE_LF: {          case TCL_TRANSLATE_LF: {
3211              for (dstEnd = dst + srcLen; dst < dstEnd; ) {              for (dstEnd = dst + srcLen; dst < dstEnd; ) {
3212                  if (*src == '\n') {                  if (*src == '\n') {
3213                      newlineFound = 1;                      newlineFound = 1;
3214                  }                  }
3215                  *dst++ = *src++;                  *dst++ = *src++;
3216              }              }
3217              *dstLenPtr = srcLen;              *dstLenPtr = srcLen;
3218              break;              break;
3219          }          }
3220          case TCL_TRANSLATE_CR: {          case TCL_TRANSLATE_CR: {
3221              for (dstEnd = dst + srcLen; dst < dstEnd;) {              for (dstEnd = dst + srcLen; dst < dstEnd;) {
3222                  if (*src == '\n') {                  if (*src == '\n') {
3223                      *dst++ = '\r';                      *dst++ = '\r';
3224                      newlineFound = 1;                      newlineFound = 1;
3225                      src++;                      src++;
3226                  } else {                  } else {
3227                      *dst++ = *src++;                      *dst++ = *src++;
3228                  }                  }
3229              }              }
3230              *dstLenPtr = srcLen;              *dstLenPtr = srcLen;
3231              break;              break;
3232          }          }
3233          case TCL_TRANSLATE_CRLF: {          case TCL_TRANSLATE_CRLF: {
3234              /*              /*
3235               * Since this causes the number of bytes to grow, we               * Since this causes the number of bytes to grow, we
3236               * start off trying to put 'srcLen' bytes into the               * start off trying to put 'srcLen' bytes into the
3237               * output buffer, but allow it to store more bytes, as               * output buffer, but allow it to store more bytes, as
3238               * long as there's still source bytes and room in the               * long as there's still source bytes and room in the
3239               * output buffer.               * output buffer.
3240               */               */
3241    
3242              char *dstStart, *dstMax;              char *dstStart, *dstMax;
3243              CONST char *srcStart;              CONST char *srcStart;
3244                            
3245              dstStart = dst;              dstStart = dst;
3246              dstMax = dst + *dstLenPtr;              dstMax = dst + *dstLenPtr;
3247    
3248              srcStart = src;              srcStart = src;
3249                            
3250              if (srcLen < *dstLenPtr) {              if (srcLen < *dstLenPtr) {
3251                  dstEnd = dst + srcLen;                  dstEnd = dst + srcLen;
3252              } else {              } else {
3253                  dstEnd = dst + *dstLenPtr;                  dstEnd = dst + *dstLenPtr;
3254              }              }
3255              while (dst < dstEnd) {              while (dst < dstEnd) {
3256                  if (*src == '\n') {                  if (*src == '\n') {
3257                      if (dstEnd < dstMax) {                      if (dstEnd < dstMax) {
3258                          dstEnd++;                          dstEnd++;
3259                      }                      }
3260                      *dst++ = '\r';                      *dst++ = '\r';
3261                      newlineFound = 1;                      newlineFound = 1;
3262                  }                  }
3263                  *dst++ = *src++;                  *dst++ = *src++;
3264              }              }
3265              *srcLenPtr = src - srcStart;              *srcLenPtr = src - srcStart;
3266              *dstLenPtr = dst - dstStart;              *dstLenPtr = dst - dstStart;
3267              break;              break;
3268          }          }
3269          default: {          default: {
3270              break;              break;
3271          }          }
3272      }      }
3273      return newlineFound;      return newlineFound;
3274  }  }
3275    
3276  /*  /*
3277   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3278   *   *
3279   * CheckFlush --   * CheckFlush --
3280   *   *
3281   *      Helper function for WriteBytes() and WriteChars().  If the   *      Helper function for WriteBytes() and WriteChars().  If the
3282   *      channel buffer is ready to be flushed, flush it.   *      channel buffer is ready to be flushed, flush it.
3283   *   *
3284   * Results:   * Results:
3285   *      The return value is -1 if there was a problem flushing the   *      The return value is -1 if there was a problem flushing the
3286   *      channel buffer, or 0 otherwise.   *      channel buffer, or 0 otherwise.
3287   *   *
3288   * Side effects:   * Side effects:
3289   *      The buffer will be recycled if it is flushed.   *      The buffer will be recycled if it is flushed.
3290   *   *
3291   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3292   */   */
3293    
3294  static int  static int
3295  CheckFlush(chanPtr, bufPtr, newlineFlag)  CheckFlush(chanPtr, bufPtr, newlineFlag)
3296      Channel *chanPtr;           /* Channel being read, for buffering mode. */      Channel *chanPtr;           /* Channel being read, for buffering mode. */
3297      ChannelBuffer *bufPtr;      /* Channel buffer to possibly flush. */      ChannelBuffer *bufPtr;      /* Channel buffer to possibly flush. */
3298      int newlineFlag;            /* Non-zero if a the channel buffer      int newlineFlag;            /* Non-zero if a the channel buffer
3299                                   * contains a newline. */                                   * contains a newline. */
3300  {  {
3301      /*      /*
3302       * The current buffer is ready for output:       * The current buffer is ready for output:
3303       * 1. if it is full.       * 1. if it is full.
3304       * 2. if it contains a newline and this channel is line-buffered.       * 2. if it contains a newline and this channel is line-buffered.
3305       * 3. if it contains any output and this channel is unbuffered.       * 3. if it contains any output and this channel is unbuffered.
3306       */       */
3307    
3308      if ((chanPtr->flags & BUFFER_READY) == 0) {      if ((chanPtr->flags & BUFFER_READY) == 0) {
3309          if (bufPtr->nextAdded == bufPtr->bufLength) {          if (bufPtr->nextAdded == bufPtr->bufLength) {
3310              chanPtr->flags |= BUFFER_READY;              chanPtr->flags |= BUFFER_READY;
3311          } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {          } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
3312              if (newlineFlag != 0) {              if (newlineFlag != 0) {
3313                  chanPtr->flags |= BUFFER_READY;                  chanPtr->flags |= BUFFER_READY;
3314              }              }
3315          } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {          } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
3316              chanPtr->flags |= BUFFER_READY;              chanPtr->flags |= BUFFER_READY;
3317          }          }
3318      }      }
3319      if (chanPtr->flags & BUFFER_READY) {      if (chanPtr->flags & BUFFER_READY) {
3320          if (FlushChannel(NULL, chanPtr, 0) != 0) {          if (FlushChannel(NULL, chanPtr, 0) != 0) {
3321              return -1;              return -1;
3322          }          }
3323      }      }
3324      return 0;      return 0;
3325  }  }
3326    
3327  /*  /*
3328   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3329   *   *
3330   * Tcl_Gets --   * Tcl_Gets --
3331   *   *
3332   *      Reads a complete line of input from the channel into a Tcl_DString.   *      Reads a complete line of input from the channel into a Tcl_DString.
3333   *   *
3334   * Results:   * Results:
3335   *      Length of line read (in characters) or -1 if error, EOF, or blocked.   *      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   *      If -1, use Tcl_GetErrno() to retrieve the POSIX error code for the
3337   *      error or condition that occurred.   *      error or condition that occurred.
3338   *   *
3339   * Side effects:   * Side effects:
3340   *      May flush output on the channel.  May cause input to be consumed   *      May flush output on the channel.  May cause input to be consumed
3341   *      from the channel.   *      from the channel.
3342   *   *
3343   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3344   */   */
3345    
3346  int  int
3347  Tcl_Gets(chan, lineRead)  Tcl_Gets(chan, lineRead)
3348      Tcl_Channel chan;           /* Channel from which to read. */      Tcl_Channel chan;           /* Channel from which to read. */
3349      Tcl_DString *lineRead;      /* The line read will be appended to this      Tcl_DString *lineRead;      /* The line read will be appended to this
3350                                   * DString as UTF-8 characters.  The caller                                   * DString as UTF-8 characters.  The caller
3351                                   * must have initialized it and is responsible                                   * must have initialized it and is responsible
3352                                   * for managing the storage. */                                   * for managing the storage. */
3353  {  {
3354      Tcl_Obj *objPtr;      Tcl_Obj *objPtr;
3355      int charsStored, length;      int charsStored, length;
3356      char *string;      char *string;
3357    
3358      objPtr = Tcl_NewObj();      objPtr = Tcl_NewObj();
3359      charsStored = Tcl_GetsObj(chan, objPtr);      charsStored = Tcl_GetsObj(chan, objPtr);
3360      if (charsStored > 0) {      if (charsStored > 0) {
3361          string = Tcl_GetStringFromObj(objPtr, &length);          string = Tcl_GetStringFromObj(objPtr, &length);
3362          Tcl_DStringAppend(lineRead, string, length);          Tcl_DStringAppend(lineRead, string, length);
3363      }      }
3364      Tcl_DecrRefCount(objPtr);      Tcl_DecrRefCount(objPtr);
3365      return charsStored;      return charsStored;
3366  }  }
3367    
3368  /*  /*
3369   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3370   *   *
3371   * Tcl_GetsObj --   * Tcl_GetsObj --
3372   *   *
3373   *      Accumulate input from the input channel until end-of-line or   *      Accumulate input from the input channel until end-of-line or
3374   *      end-of-file has been seen.  Bytes read from the input channel   *      end-of-file has been seen.  Bytes read from the input channel
3375   *      are converted to UTF-8 using the encoding specified by the   *      are converted to UTF-8 using the encoding specified by the
3376   *      channel.   *      channel.
3377   *   *
3378   * Results:   * Results:
3379   *      Number of characters accumulated in the object or -1 if error,   *      Number of characters accumulated in the object or -1 if error,
3380   *      blocked, or EOF.  If -1, use Tcl_GetErrno() to retrieve the   *      blocked, or EOF.  If -1, use Tcl_GetErrno() to retrieve the
3381   *      POSIX error code for the error or condition that occurred.   *      POSIX error code for the error or condition that occurred.
3382   *   *
3383   * Side effects:   * Side effects:
3384   *      Consumes input from the channel.   *      Consumes input from the channel.
3385   *   *
3386   *      On reading EOF, leave channel pointing at EOF char.   *      On reading EOF, leave channel pointing at EOF char.
3387   *      On reading EOL, leave channel pointing after EOL, but don't   *      On reading EOL, leave channel pointing after EOL, but don't
3388   *      return EOL in dst buffer.   *      return EOL in dst buffer.
3389   *   *
3390   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3391   */   */
3392    
3393  int  int
3394  Tcl_GetsObj(chan, objPtr)  Tcl_GetsObj(chan, objPtr)
3395      Tcl_Channel chan;           /* Channel from which to read. */      Tcl_Channel chan;           /* Channel from which to read. */
3396      Tcl_Obj *objPtr;            /* The line read will be appended to this      Tcl_Obj *objPtr;            /* The line read will be appended to this
3397                                   * object as UTF-8 characters. */                                   * object as UTF-8 characters. */
3398  {  {
3399      GetsState gs;      GetsState gs;
3400      Channel *chanPtr;      Channel *chanPtr;
3401      int inEofChar, skip, copiedTotal;      int inEofChar, skip, copiedTotal;
3402      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
3403      Tcl_Encoding encoding;      Tcl_Encoding encoding;
3404      char *dst, *dstEnd, *eol, *eof;      char *dst, *dstEnd, *eol, *eof;
3405      Tcl_EncodingState oldState;      Tcl_EncodingState oldState;
3406      int oldLength, oldFlags, oldRemoved;      int oldLength, oldFlags, oldRemoved;
3407    
3408      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
3409      if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
3410          copiedTotal = -1;          copiedTotal = -1;
3411          goto done;          goto done;
3412      }      }
3413    
3414      bufPtr = chanPtr->inQueueHead;      bufPtr = chanPtr->inQueueHead;
3415      encoding = chanPtr->encoding;      encoding = chanPtr->encoding;
3416    
3417      /*      /*
3418       * Preserved so we can restore the channel's state in case we don't       * Preserved so we can restore the channel's state in case we don't
3419       * find a newline in the available input.       * find a newline in the available input.
3420       */       */
3421    
3422      Tcl_GetStringFromObj(objPtr, &oldLength);      Tcl_GetStringFromObj(objPtr, &oldLength);
3423      oldFlags = chanPtr->inputEncodingFlags;      oldFlags = chanPtr->inputEncodingFlags;
3424      oldState = chanPtr->inputEncodingState;      oldState = chanPtr->inputEncodingState;
3425      oldRemoved = BUFFER_PADDING;      oldRemoved = BUFFER_PADDING;
3426      if (bufPtr != NULL) {      if (bufPtr != NULL) {
3427          oldRemoved = bufPtr->nextRemoved;          oldRemoved = bufPtr->nextRemoved;
3428      }      }
3429    
3430      /*      /*
3431       * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't       * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
3432       * produce ByteArray objects.  To avoid circularity problems,       * produce ByteArray objects.  To avoid circularity problems,
3433       * "iso8859-1" is builtin to Tcl.       * "iso8859-1" is builtin to Tcl.
3434       */       */
3435    
3436      if (encoding == NULL) {      if (encoding == NULL) {
3437          encoding = Tcl_GetEncoding(NULL, "iso8859-1");          encoding = Tcl_GetEncoding(NULL, "iso8859-1");
3438      }      }
3439    
3440      /*      /*
3441       * Object used by FilterInputBytes to keep track of how much data has       * Object used by FilterInputBytes to keep track of how much data has
3442       * been consumed from the channel buffers.       * been consumed from the channel buffers.
3443       */       */
3444    
3445      gs.objPtr           = objPtr;      gs.objPtr           = objPtr;
3446      gs.dstPtr           = &dst;      gs.dstPtr           = &dst;
3447      gs.encoding         = encoding;      gs.encoding         = encoding;
3448      gs.bufPtr           = bufPtr;      gs.bufPtr           = bufPtr;
3449      gs.state            = oldState;      gs.state            = oldState;
3450      gs.rawRead          = 0;      gs.rawRead          = 0;
3451      gs.bytesWrote       = 0;      gs.bytesWrote       = 0;
3452      gs.charsWrote       = 0;      gs.charsWrote       = 0;
3453      gs.totalChars       = 0;      gs.totalChars       = 0;
3454    
3455      dst = objPtr->bytes + oldLength;      dst = objPtr->bytes + oldLength;
3456      dstEnd = dst;      dstEnd = dst;
3457    
3458      skip = 0;      skip = 0;
3459      eof = NULL;      eof = NULL;
3460      inEofChar = chanPtr->inEofChar;      inEofChar = chanPtr->inEofChar;
3461    
3462      while (1) {      while (1) {
3463          if (dst >= dstEnd) {          if (dst >= dstEnd) {
3464              if (FilterInputBytes(chanPtr, &gs) != 0) {              if (FilterInputBytes(chanPtr, &gs) != 0) {
3465                  goto restore;                  goto restore;
3466              }              }
3467              dstEnd = dst + gs.bytesWrote;              dstEnd = dst + gs.bytesWrote;
3468          }          }
3469                    
3470          /*          /*
3471           * Remember if EOF char is seen, then look for EOL anyhow, because           * Remember if EOF char is seen, then look for EOL anyhow, because
3472           * the EOL might be before the EOF char.           * the EOL might be before the EOF char.
3473           */           */
3474    
3475          if (inEofChar != '\0') {          if (inEofChar != '\0') {
3476              for (eol = dst; eol < dstEnd; eol++) {              for (eol = dst; eol < dstEnd; eol++) {
3477                  if (*eol == inEofChar) {                  if (*eol == inEofChar) {
3478                      dstEnd = eol;                      dstEnd = eol;
3479                      eof = eol;                      eof = eol;
3480                      break;                      break;
3481                  }                  }
3482              }              }
3483          }          }
3484    
3485          /*          /*
3486           * On EOL, leave current file position pointing after the EOL, but           * On EOL, leave current file position pointing after the EOL, but
3487           * don't store the EOL in the output string.           * don't store the EOL in the output string.
3488           */           */
3489    
3490          eol = dst;          eol = dst;
3491          switch (chanPtr->inputTranslation) {          switch (chanPtr->inputTranslation) {
3492              case TCL_TRANSLATE_LF: {              case TCL_TRANSLATE_LF: {
3493                  for (eol = dst; eol < dstEnd; eol++) {                  for (eol = dst; eol < dstEnd; eol++) {
3494                      if (*eol == '\n') {                      if (*eol == '\n') {
3495                          skip = 1;                          skip = 1;
3496                          goto goteol;                          goto goteol;
3497                      }                      }
3498                  }                  }
3499                  break;                  break;
3500              }              }
3501              case TCL_TRANSLATE_CR: {              case TCL_TRANSLATE_CR: {
3502                  for (eol = dst; eol < dstEnd; eol++) {                  for (eol = dst; eol < dstEnd; eol++) {
3503                      if (*eol == '\r') {                      if (*eol == '\r') {
3504                          skip = 1;                          skip = 1;
3505                          goto goteol;                          goto goteol;
3506                      }                      }
3507                  }                  }
3508                  break;                  break;
3509              }              }
3510              case TCL_TRANSLATE_CRLF: {              case TCL_TRANSLATE_CRLF: {
3511                  for (eol = dst; eol < dstEnd; eol++) {                  for (eol = dst; eol < dstEnd; eol++) {
3512                      if (*eol == '\r') {                      if (*eol == '\r') {
3513                          eol++;                          eol++;
3514                          if (eol >= dstEnd) {                          if (eol >= dstEnd) {
3515                              int offset;                              int offset;
3516                                                            
3517                              offset = eol - objPtr->bytes;                              offset = eol - objPtr->bytes;
3518                              dst = dstEnd;                              dst = dstEnd;
3519                              if (FilterInputBytes(chanPtr, &gs) != 0) {                              if (FilterInputBytes(chanPtr, &gs) != 0) {
3520                                  goto restore;                                  goto restore;
3521                              }                              }
3522                              dstEnd = dst + gs.bytesWrote;                              dstEnd = dst + gs.bytesWrote;
3523                              eol = objPtr->bytes + offset;                              eol = objPtr->bytes + offset;
3524                              if (eol >= dstEnd) {                              if (eol >= dstEnd) {
3525                                  skip = 0;                                  skip = 0;
3526                                  goto goteol;                                  goto goteol;
3527                              }                              }
3528                          }                          }
3529                          if (*eol == '\n') {                          if (*eol == '\n') {
3530                              eol--;                              eol--;
3531                              skip = 2;                              skip = 2;
3532                              goto goteol;                              goto goteol;
3533                          }                          }
3534                      }                      }
3535                  }                  }
3536                  break;                  break;
3537              }              }
3538              case TCL_TRANSLATE_AUTO: {              case TCL_TRANSLATE_AUTO: {
3539                  skip = 1;                  skip = 1;
3540                  if (chanPtr->flags & INPUT_SAW_CR) {                  if (chanPtr->flags & INPUT_SAW_CR) {
3541                      chanPtr->flags &= ~INPUT_SAW_CR;                      chanPtr->flags &= ~INPUT_SAW_CR;
3542                      if (*eol == '\n') {                      if (*eol == '\n') {
3543                          /*                          /*
3544                           * Skip the raw bytes that make up the '\n'.                           * Skip the raw bytes that make up the '\n'.
3545                           */                           */
3546    
3547                          char tmp[1 + TCL_UTF_MAX];                          char tmp[1 + TCL_UTF_MAX];
3548                          int rawRead;                          int rawRead;
3549    
3550                          bufPtr = gs.bufPtr;                          bufPtr = gs.bufPtr;
3551                          Tcl_ExternalToUtf(NULL, gs.encoding,                          Tcl_ExternalToUtf(NULL, gs.encoding,
3552                                  bufPtr->buf + bufPtr->nextRemoved,                                  bufPtr->buf + bufPtr->nextRemoved,
3553                                  gs.rawRead, chanPtr->inputEncodingFlags,                                  gs.rawRead, chanPtr->inputEncodingFlags,
3554                                  &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,                                  &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead,
3555                                  NULL, NULL);                                  NULL, NULL);
3556                          bufPtr->nextRemoved += rawRead;                          bufPtr->nextRemoved += rawRead;
3557                          gs.rawRead -= rawRead;                          gs.rawRead -= rawRead;
3558                          gs.bytesWrote--;                          gs.bytesWrote--;
3559                          gs.charsWrote--;                          gs.charsWrote--;
3560                          memmove(dst, dst + 1, (size_t) (dstEnd - dst));                          memmove(dst, dst + 1, (size_t) (dstEnd - dst));
3561                          dstEnd--;                          dstEnd--;
3562                      }                      }
3563                  }                  }
3564                  for (eol = dst; eol < dstEnd; eol++) {                  for (eol = dst; eol < dstEnd; eol++) {
3565                      if (*eol == '\r') {                      if (*eol == '\r') {
3566                          eol++;                          eol++;
3567                          if (eol == dstEnd) {                          if (eol == dstEnd) {
3568                              /*                              /*
3569                               * If buffer ended on \r, peek ahead to see if a                               * If buffer ended on \r, peek ahead to see if a
3570                               * \n is available.                               * \n is available.
3571                               */                               */
3572    
3573                              int offset;                              int offset;
3574                                                            
3575                              offset = eol - objPtr->bytes;                              offset = eol - objPtr->bytes;
3576                              dst = dstEnd;                              dst = dstEnd;
3577                              PeekAhead(chanPtr, &dstEnd, &gs);                              PeekAhead(chanPtr, &dstEnd, &gs);
3578                              eol = objPtr->bytes + offset;                              eol = objPtr->bytes + offset;
3579                              if (eol >= dstEnd) {                              if (eol >= dstEnd) {
3580                                  eol--;                                  eol--;
3581                                  chanPtr->flags |= INPUT_SAW_CR;                                  chanPtr->flags |= INPUT_SAW_CR;
3582                                  goto goteol;                                  goto goteol;
3583                              }                              }
3584                          }                          }
3585                          if (*eol == '\n') {                          if (*eol == '\n') {
3586                              skip++;                              skip++;
3587                          }                          }
3588                          eol--;                          eol--;
3589                          goto goteol;                          goto goteol;
3590                      } else if (*eol == '\n') {                      } else if (*eol == '\n') {
3591                          goto goteol;                          goto goteol;
3592                      }                      }
3593                  }                  }
3594              }              }
3595          }          }
3596          if (eof != NULL) {          if (eof != NULL) {
3597              /*              /*
3598               * EOF character was seen.  On EOF, leave current file position               * EOF character was seen.  On EOF, leave current file position
3599               * pointing at the EOF character, but don't store the EOF               * pointing at the EOF character, but don't store the EOF
3600               * character in the output string.               * character in the output string.
3601               */               */
3602    
3603              dstEnd = eof;              dstEnd = eof;
3604              chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);              chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
3605              chanPtr->inputEncodingFlags |= TCL_ENCODING_END;              chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
3606          }          }
3607          if (chanPtr->flags & CHANNEL_EOF) {          if (chanPtr->flags & CHANNEL_EOF) {
3608              skip = 0;              skip = 0;
3609              eol = dstEnd;              eol = dstEnd;
3610              if (eol == objPtr->bytes) {              if (eol == objPtr->bytes) {
3611                  /*                  /*
3612                   * If we didn't produce any bytes before encountering EOF,                   * If we didn't produce any bytes before encountering EOF,
3613                   * caller needs to see -1.                   * caller needs to see -1.
3614                   */                   */
3615    
3616                  Tcl_SetObjLength(objPtr, 0);                  Tcl_SetObjLength(objPtr, 0);
3617                  CommonGetsCleanup(chanPtr, encoding);                  CommonGetsCleanup(chanPtr, encoding);
3618                  copiedTotal = -1;                  copiedTotal = -1;
3619                  goto done;                  goto done;
3620              }              }
3621              goto goteol;              goto goteol;
3622          }          }
3623          dst = dstEnd;          dst = dstEnd;
3624      }      }
3625    
3626      /*      /*
3627       * Found EOL or EOF, but the output buffer may now contain too many       * 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       * 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       * 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       * correspond to the character(s) making up EOL (if any), so we can
3631       * remove the correct number of bytes from the channel buffer.       * remove the correct number of bytes from the channel buffer.
3632       */       */
3633            
3634      goteol:      goteol:
3635      bufPtr = gs.bufPtr;      bufPtr = gs.bufPtr;
3636      chanPtr->inputEncodingState = gs.state;      chanPtr->inputEncodingState = gs.state;
3637      Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,      Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
3638              gs.rawRead, chanPtr->inputEncodingFlags,              gs.rawRead, chanPtr->inputEncodingFlags,
3639              &chanPtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,              &chanPtr->inputEncodingState, dst, eol - dst + skip + TCL_UTF_MAX,
3640              &gs.rawRead, NULL, &gs.charsWrote);              &gs.rawRead, NULL, &gs.charsWrote);
3641      bufPtr->nextRemoved += gs.rawRead;      bufPtr->nextRemoved += gs.rawRead;
3642    
3643      /*      /*
3644       * Recycle all the emptied buffers.       * Recycle all the emptied buffers.
3645       */       */
3646    
3647      Tcl_SetObjLength(objPtr, eol - objPtr->bytes);      Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
3648      CommonGetsCleanup(chanPtr, encoding);      CommonGetsCleanup(chanPtr, encoding);
3649      chanPtr->flags &= ~CHANNEL_BLOCKED;      chanPtr->flags &= ~CHANNEL_BLOCKED;
3650      copiedTotal = gs.totalChars + gs.charsWrote - skip;      copiedTotal = gs.totalChars + gs.charsWrote - skip;
3651      goto done;      goto done;
3652    
3653      /*      /*
3654       * Couldn't get a complete line.  This only happens if we get a error       * 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       * reading from the channel or we are non-blocking and there wasn't
3656       * an EOL or EOF in the data available.       * an EOL or EOF in the data available.
3657       */       */
3658    
3659      restore:      restore:
3660      bufPtr = chanPtr->inQueueHead;      bufPtr = chanPtr->inQueueHead;
3661      bufPtr->nextRemoved = oldRemoved;      bufPtr->nextRemoved = oldRemoved;
3662    
3663      for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {      for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
3664          bufPtr->nextRemoved = BUFFER_PADDING;          bufPtr->nextRemoved = BUFFER_PADDING;
3665      }      }
3666      CommonGetsCleanup(chanPtr, encoding);      CommonGetsCleanup(chanPtr, encoding);
3667    
3668      chanPtr->inputEncodingState = oldState;      chanPtr->inputEncodingState = oldState;
3669      chanPtr->inputEncodingFlags = oldFlags;      chanPtr->inputEncodingFlags = oldFlags;
3670      Tcl_SetObjLength(objPtr, oldLength);      Tcl_SetObjLength(objPtr, oldLength);
3671    
3672      /*      /*
3673       * We didn't get a complete line so we need to indicate to UpdateInterest       * 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       * 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       * 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       * 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       * this channel until new data arrives or some operation is performed
3678       * on the channel (e.g. gets, read, fconfigure) that changes the blocking       * 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       * 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.       * though a read would be able to consume the buffered data.
3681       */       */
3682    
3683      chanPtr->flags |= CHANNEL_NEED_MORE_DATA;      chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
3684      copiedTotal = -1;      copiedTotal = -1;
3685    
3686      done:      done:
3687      /*      /*
3688       * Update the notifier state so we don't block while there is still       * Update the notifier state so we don't block while there is still
3689       * data in the buffers.       * data in the buffers.
3690       */       */
3691    
3692      UpdateInterest(chanPtr);      UpdateInterest(chanPtr);
3693      return copiedTotal;      return copiedTotal;
3694  }  }
3695    
3696  /*  /*
3697   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3698   *   *
3699   * FilterInputBytes --   * FilterInputBytes --
3700   *   *
3701   *      Helper function for Tcl_GetsObj.  Produces UTF-8 characters from   *      Helper function for Tcl_GetsObj.  Produces UTF-8 characters from
3702   *      raw bytes read from the channel.     *      raw bytes read from the channel.  
3703   *   *
3704   *      Consumes available bytes from channel buffers.  When channel   *      Consumes available bytes from channel buffers.  When channel
3705   *      buffers are exhausted, reads more bytes from channel device into   *      buffers are exhausted, reads more bytes from channel device into
3706   *      a new channel buffer.  It is the caller's responsibility to   *      a new channel buffer.  It is the caller's responsibility to
3707   *      free the channel buffers that have been exhausted.   *      free the channel buffers that have been exhausted.
3708   *   *
3709   * Results:   * Results:
3710   *      The return value is -1 if there was an error reading from the   *      The return value is -1 if there was an error reading from the
3711   *      channel, 0 otherwise.   *      channel, 0 otherwise.
3712   *   *
3713   * Side effects:   * Side effects:
3714   *      Status object keeps track of how much data from channel buffers   *      Status object keeps track of how much data from channel buffers
3715   *      has been consumed and where UTF-8 bytes should be stored.   *      has been consumed and where UTF-8 bytes should be stored.
3716   *   *
3717   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3718   */   */
3719    
3720  static int  static int
3721  FilterInputBytes(chanPtr, gsPtr)  FilterInputBytes(chanPtr, gsPtr)
3722      Channel *chanPtr;           /* Channel to read. */      Channel *chanPtr;           /* Channel to read. */
3723      GetsState *gsPtr;           /* Current state of gets operation. */      GetsState *gsPtr;           /* Current state of gets operation. */
3724  {  {
3725      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
3726      char *raw, *rawStart, *rawEnd;      char *raw, *rawStart, *rawEnd;
3727      char *dst;      char *dst;
3728      int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;      int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
3729      Tcl_Obj *objPtr;      Tcl_Obj *objPtr;
3730  #define ENCODING_LINESIZE   30  /* Lower bound on how many bytes to convert  #define ENCODING_LINESIZE   30  /* Lower bound on how many bytes to convert
3731                                   * at a time.  Since we don't know a priori                                   * at a time.  Since we don't know a priori
3732                                   * how many bytes of storage this many source                                   * how many bytes of storage this many source
3733                                   * bytes will use, we actually need at least                                   * bytes will use, we actually need at least
3734                                   * ENCODING_LINESIZE * TCL_MAX_UTF bytes of                                   * ENCODING_LINESIZE * TCL_MAX_UTF bytes of
3735                                   * room. */                                   * room. */
3736    
3737      objPtr = gsPtr->objPtr;      objPtr = gsPtr->objPtr;
3738    
3739      /*      /*
3740       * Subtract the number of bytes that were removed from channel buffer       * Subtract the number of bytes that were removed from channel buffer
3741       * during last call.       * during last call.
3742       */       */
3743    
3744      bufPtr = gsPtr->bufPtr;      bufPtr = gsPtr->bufPtr;
3745      if (bufPtr != NULL) {      if (bufPtr != NULL) {
3746          bufPtr->nextRemoved += gsPtr->rawRead;          bufPtr->nextRemoved += gsPtr->rawRead;
3747          if (bufPtr->nextRemoved >= bufPtr->nextAdded) {          if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
3748              bufPtr = bufPtr->nextPtr;              bufPtr = bufPtr->nextPtr;
3749          }          }
3750      }      }
3751      gsPtr->totalChars += gsPtr->charsWrote;      gsPtr->totalChars += gsPtr->charsWrote;
3752    
3753      if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {      if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
3754          /*          /*
3755           * All channel buffers were exhausted and the caller still hasn't           * All channel buffers were exhausted and the caller still hasn't
3756           * seen EOL.  Need to read more bytes from the channel device.           * seen EOL.  Need to read more bytes from the channel device.
3757           * Side effect is to allocate another channel buffer.           * Side effect is to allocate another channel buffer.
3758           */           */
3759                    
3760          read:          read:
3761          if (chanPtr->flags & CHANNEL_BLOCKED) {          if (chanPtr->flags & CHANNEL_BLOCKED) {
3762              if (chanPtr->flags & CHANNEL_NONBLOCKING) {              if (chanPtr->flags & CHANNEL_NONBLOCKING) {
3763                  gsPtr->charsWrote = 0;                  gsPtr->charsWrote = 0;
3764                  gsPtr->rawRead = 0;                  gsPtr->rawRead = 0;
3765                  return -1;                  return -1;
3766              }              }
3767              chanPtr->flags &= ~CHANNEL_BLOCKED;              chanPtr->flags &= ~CHANNEL_BLOCKED;
3768          }          }
3769          if (GetInput(chanPtr) != 0) {          if (GetInput(chanPtr) != 0) {
3770              gsPtr->charsWrote = 0;              gsPtr->charsWrote = 0;
3771              gsPtr->rawRead = 0;              gsPtr->rawRead = 0;
3772              return -1;              return -1;
3773          }          }
3774          bufPtr = chanPtr->inQueueTail;          bufPtr = chanPtr->inQueueTail;
3775          gsPtr->bufPtr = bufPtr;          gsPtr->bufPtr = bufPtr;
3776      }      }
3777    
3778      /*      /*
3779       * Convert some of the bytes from the channel buffer to UTF-8.  Space in       * 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       * objPtr's string rep is used to hold the UTF-8 characters.  Grow the
3781       * string rep if we need more space.       * string rep if we need more space.
3782       */       */
3783    
3784      rawStart = bufPtr->buf + bufPtr->nextRemoved;      rawStart = bufPtr->buf + bufPtr->nextRemoved;
3785      raw = rawStart;      raw = rawStart;
3786      rawEnd = bufPtr->buf + bufPtr->nextAdded;      rawEnd = bufPtr->buf + bufPtr->nextAdded;
3787      rawLen = rawEnd - rawStart;      rawLen = rawEnd - rawStart;
3788    
3789      dst = *gsPtr->dstPtr;      dst = *gsPtr->dstPtr;
3790      offset = dst - objPtr->bytes;      offset = dst - objPtr->bytes;
3791      toRead = ENCODING_LINESIZE;      toRead = ENCODING_LINESIZE;
3792      if (toRead > rawLen) {      if (toRead > rawLen) {
3793          toRead = rawLen;          toRead = rawLen;
3794      }      }
3795      dstNeeded = toRead * TCL_UTF_MAX + 1;      dstNeeded = toRead * TCL_UTF_MAX + 1;
3796      spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;      spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
3797      if (dstNeeded > spaceLeft) {      if (dstNeeded > spaceLeft) {
3798          length = offset * 2;          length = offset * 2;
3799          if (offset < dstNeeded) {          if (offset < dstNeeded) {
3800              length = offset + dstNeeded;              length = offset + dstNeeded;
3801          }          }
3802          length += TCL_UTF_MAX + 1;          length += TCL_UTF_MAX + 1;
3803          Tcl_SetObjLength(objPtr, length);          Tcl_SetObjLength(objPtr, length);
3804          spaceLeft = length - offset;          spaceLeft = length - offset;
3805          dst = objPtr->bytes + offset;          dst = objPtr->bytes + offset;
3806          *gsPtr->dstPtr = dst;          *gsPtr->dstPtr = dst;
3807      }      }
3808      gsPtr->state = chanPtr->inputEncodingState;      gsPtr->state = chanPtr->inputEncodingState;
3809      result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,      result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
3810              chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,              chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
3811              dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,              dst, spaceLeft, &gsPtr->rawRead, &gsPtr->bytesWrote,
3812              &gsPtr->charsWrote);              &gsPtr->charsWrote);
3813      if (result == TCL_CONVERT_MULTIBYTE) {      if (result == TCL_CONVERT_MULTIBYTE) {
3814          /*          /*
3815           * The last few bytes in this channel buffer were the start of a           * 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           * multibyte sequence.  If this buffer was full, then move them to
3817           * the next buffer so the bytes will be contiguous.             * the next buffer so the bytes will be contiguous.  
3818           */           */
3819    
3820          ChannelBuffer *nextPtr;          ChannelBuffer *nextPtr;
3821          int extra;          int extra;
3822                    
3823          nextPtr = bufPtr->nextPtr;          nextPtr = bufPtr->nextPtr;
3824          if (bufPtr->nextAdded < bufPtr->bufLength) {          if (bufPtr->nextAdded < bufPtr->bufLength) {
3825              if (gsPtr->rawRead > 0) {              if (gsPtr->rawRead > 0) {
3826                  /*                  /*
3827                   * Some raw bytes were converted to UTF-8.  Fall through,                   * Some raw bytes were converted to UTF-8.  Fall through,
3828                   * returning those UTF-8 characters because a EOL might be                   * returning those UTF-8 characters because a EOL might be
3829                   * present in them.                   * present in them.
3830                   */                   */
3831              } else if (chanPtr->flags & CHANNEL_EOF) {              } else if (chanPtr->flags & CHANNEL_EOF) {
3832                  /*                  /*
3833                   * There was a partial character followed by EOF on the                   * There was a partial character followed by EOF on the
3834                   * device.  Fall through, returning that nothing was found.                   * device.  Fall through, returning that nothing was found.
3835                   */                   */
3836    
3837                   bufPtr->nextRemoved = bufPtr->nextAdded;                   bufPtr->nextRemoved = bufPtr->nextAdded;
3838              } else {              } else {
3839                  /*                  /*
3840                   * There are no more cached raw bytes left.  See if we can                   * There are no more cached raw bytes left.  See if we can
3841                   * get some more.                   * get some more.
3842                   */                   */
3843    
3844                  goto read;                  goto read;
3845              }              }
3846          } else {          } else {
3847              if (nextPtr == NULL) {              if (nextPtr == NULL) {
3848                  nextPtr = AllocChannelBuffer(chanPtr->bufSize);                  nextPtr = AllocChannelBuffer(chanPtr->bufSize);
3849                  bufPtr->nextPtr = nextPtr;                  bufPtr->nextPtr = nextPtr;
3850                  chanPtr->inQueueTail = nextPtr;                  chanPtr->inQueueTail = nextPtr;
3851              }              }
3852              extra = rawLen - gsPtr->rawRead;              extra = rawLen - gsPtr->rawRead;
3853              memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),              memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
3854                      (VOID *) (raw + gsPtr->rawRead), (size_t) extra);                      (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
3855              nextPtr->nextRemoved -= extra;              nextPtr->nextRemoved -= extra;
3856              bufPtr->nextAdded -= extra;              bufPtr->nextAdded -= extra;
3857          }          }
3858      }      }
3859    
3860      gsPtr->bufPtr = bufPtr;      gsPtr->bufPtr = bufPtr;
3861      return 0;      return 0;
3862  }  }
3863    
3864  /*  /*
3865   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3866   *   *
3867   * PeekAhead --   * PeekAhead --
3868   *   *
3869   *      Helper function used by Tcl_GetsObj().  Called when we've seen a   *      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   *      \r at the end of the UTF-8 string and want to look ahead one
3871   *      character to see if it is a \n.   *      character to see if it is a \n.
3872   *   *
3873   * Results:   * Results:
3874   *      *gsPtr->dstPtr is filled with a pointer to the start of the range of   *      *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   *      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.   *      with a pointer to the bytes just after the end of the range.
3877   *   *
3878   * Side effects:   * Side effects:
3879   *      If no more raw bytes were available in one of the channel buffers,   *      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   *      tries to perform a non-blocking read to get more bytes from the
3881   *      channel device.   *      channel device.
3882   *   *
3883   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3884   */   */
3885    
3886  static void  static void
3887  PeekAhead(chanPtr, dstEndPtr, gsPtr)  PeekAhead(chanPtr, dstEndPtr, gsPtr)
3888      Channel *chanPtr;           /* The channel to read. */      Channel *chanPtr;           /* The channel to read. */
3889      char **dstEndPtr;           /* Filled with pointer to end of new range      char **dstEndPtr;           /* Filled with pointer to end of new range
3890                                   * of UTF-8 characters. */                                   * of UTF-8 characters. */
3891      GetsState *gsPtr;           /* Current state of gets operation. */      GetsState *gsPtr;           /* Current state of gets operation. */
3892  {  {
3893      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
3894      Tcl_DriverBlockModeProc *blockModeProc;      Tcl_DriverBlockModeProc *blockModeProc;
3895      int bytesLeft;      int bytesLeft;
3896    
3897      bufPtr = gsPtr->bufPtr;      bufPtr = gsPtr->bufPtr;
3898    
3899      /*      /*
3900       * If there's any more raw input that's still buffered, we'll peek into       * 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       * 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       * 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       * if the channel buffer is filled right up to the end, then there
3904       * might be more data to read.       * might be more data to read.
3905       */       */
3906    
3907      blockModeProc = NULL;      blockModeProc = NULL;
3908      if (bufPtr->nextPtr == NULL) {      if (bufPtr->nextPtr == NULL) {
3909          bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);          bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
3910          if (bytesLeft == 0) {          if (bytesLeft == 0) {
3911              if (bufPtr->nextAdded < bufPtr->bufLength) {              if (bufPtr->nextAdded < bufPtr->bufLength) {
3912                  /*                  /*
3913                   * Don't peek ahead if last read was short read.                   * Don't peek ahead if last read was short read.
3914                   */                   */
3915                                    
3916                  goto cleanup;                  goto cleanup;
3917              }              }
3918              if ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) {              if ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) {
3919                  blockModeProc = chanPtr->typePtr->blockModeProc;                  blockModeProc = chanPtr->typePtr->blockModeProc;
3920                  if (blockModeProc == NULL) {                  if (blockModeProc == NULL) {
3921                      /*                      /*
3922                       * Don't peek ahead if cannot set non-blocking mode.                       * Don't peek ahead if cannot set non-blocking mode.
3923                       */                       */
3924    
3925                      goto cleanup;                      goto cleanup;
3926                  }                  }
3927                  (*blockModeProc)(chanPtr->instanceData, TCL_MODE_NONBLOCKING);                  (*blockModeProc)(chanPtr->instanceData, TCL_MODE_NONBLOCKING);
3928              }              }
3929          }          }
3930      }      }
3931      if (FilterInputBytes(chanPtr, gsPtr) == 0) {      if (FilterInputBytes(chanPtr, gsPtr) == 0) {
3932          *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;          *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;
3933      }      }
3934      if (blockModeProc != NULL) {      if (blockModeProc != NULL) {
3935          (*blockModeProc)(chanPtr->instanceData, TCL_MODE_BLOCKING);          (*blockModeProc)(chanPtr->instanceData, TCL_MODE_BLOCKING);
3936      }      }
3937      return;      return;
3938    
3939      cleanup:      cleanup:
3940      bufPtr->nextRemoved += gsPtr->rawRead;      bufPtr->nextRemoved += gsPtr->rawRead;
3941      gsPtr->rawRead = 0;      gsPtr->rawRead = 0;
3942      gsPtr->totalChars += gsPtr->charsWrote;      gsPtr->totalChars += gsPtr->charsWrote;
3943      gsPtr->bytesWrote = 0;      gsPtr->bytesWrote = 0;
3944      gsPtr->charsWrote = 0;      gsPtr->charsWrote = 0;
3945  }  }
3946    
3947  /*  /*
3948   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3949   *   *
3950   * CommonGetsCleanup --   * CommonGetsCleanup --
3951   *   *
3952   *      Helper function for Tcl_GetsObj() to restore the channel after   *      Helper function for Tcl_GetsObj() to restore the channel after
3953   *      a "gets" operation.   *      a "gets" operation.
3954   *   *
3955   * Results:   * Results:
3956   *      None.   *      None.
3957   *   *
3958   * Side effects:   * Side effects:
3959   *      Encoding may be freed.   *      Encoding may be freed.
3960   *   *
3961   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
3962   */   */
3963    
3964  static void  static void
3965  CommonGetsCleanup(chanPtr, encoding)  CommonGetsCleanup(chanPtr, encoding)
3966      Channel *chanPtr;      Channel *chanPtr;
3967      Tcl_Encoding encoding;      Tcl_Encoding encoding;
3968  {  {
3969      ChannelBuffer *bufPtr, *nextPtr;      ChannelBuffer *bufPtr, *nextPtr;
3970            
3971      bufPtr = chanPtr->inQueueHead;      bufPtr = chanPtr->inQueueHead;
3972      for ( ; bufPtr != NULL; bufPtr = nextPtr) {      for ( ; bufPtr != NULL; bufPtr = nextPtr) {
3973          nextPtr = bufPtr->nextPtr;          nextPtr = bufPtr->nextPtr;
3974          if (bufPtr->nextRemoved < bufPtr->nextAdded) {          if (bufPtr->nextRemoved < bufPtr->nextAdded) {
3975              break;              break;
3976          }          }
3977          RecycleBuffer(chanPtr, bufPtr, 0);          RecycleBuffer(chanPtr, bufPtr, 0);
3978      }      }
3979      chanPtr->inQueueHead = bufPtr;      chanPtr->inQueueHead = bufPtr;
3980      if (bufPtr == NULL) {      if (bufPtr == NULL) {
3981          chanPtr->inQueueTail = NULL;          chanPtr->inQueueTail = NULL;
3982      } else {      } else {
3983          /*          /*
3984           * If any multi-byte characters were split across channel buffer           * If any multi-byte characters were split across channel buffer
3985           * boundaries, the split-up bytes were moved to the next channel           * boundaries, the split-up bytes were moved to the next channel
3986           * buffer by FilterInputBytes().  Move the bytes back to their           * buffer by FilterInputBytes().  Move the bytes back to their
3987           * original buffer because the caller could change the channel's           * original buffer because the caller could change the channel's
3988           * encoding which could change the interpretation of whether those           * encoding which could change the interpretation of whether those
3989           * bytes really made up multi-byte characters after all.           * bytes really made up multi-byte characters after all.
3990           */           */
3991                    
3992          nextPtr = bufPtr->nextPtr;          nextPtr = bufPtr->nextPtr;
3993          for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {          for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
3994              int extra;              int extra;
3995    
3996              extra = bufPtr->bufLength - bufPtr->nextAdded;              extra = bufPtr->bufLength - bufPtr->nextAdded;
3997              if (extra > 0) {              if (extra > 0) {
3998                  memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),                  memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
3999                          (VOID *) (nextPtr->buf + BUFFER_PADDING - extra),                          (VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
4000                          (size_t) extra);                          (size_t) extra);
4001                  bufPtr->nextAdded += extra;                  bufPtr->nextAdded += extra;
4002                  nextPtr->nextRemoved = BUFFER_PADDING;                  nextPtr->nextRemoved = BUFFER_PADDING;
4003              }              }
4004              bufPtr = nextPtr;              bufPtr = nextPtr;
4005          }          }
4006      }      }
4007      if (chanPtr->encoding == NULL) {      if (chanPtr->encoding == NULL) {
4008          Tcl_FreeEncoding(encoding);          Tcl_FreeEncoding(encoding);
4009      }      }
4010  }  }
4011    
4012  /*  /*
4013   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4014   *   *
4015   * Tcl_Read --   * Tcl_Read --
4016   *   *
4017   *      Reads a given number of bytes from a channel.  EOL and EOF   *      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   *      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   *      of bytes consumed from the channel may not be equal to the
4020   *      number of bytes stored in the destination buffer.   *      number of bytes stored in the destination buffer.
4021   *   *
4022   *      No encoding conversions are applied to the bytes being read.   *      No encoding conversions are applied to the bytes being read.
4023   *   *
4024   * Results:   * Results:
4025   *      The number of bytes read, or -1 on error. Use Tcl_GetErrno()   *      The number of bytes read, or -1 on error. Use Tcl_GetErrno()
4026   *      to retrieve the error code for the error that occurred.   *      to retrieve the error code for the error that occurred.
4027   *   *
4028   * Side effects:   * Side effects:
4029   *      May cause input to be buffered.   *      May cause input to be buffered.
4030   *   *
4031   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4032   */   */
4033    
4034  int  int
4035  Tcl_Read(chan, dst, bytesToRead)  Tcl_Read(chan, dst, bytesToRead)
4036      Tcl_Channel chan;           /* The channel from which to read. */      Tcl_Channel chan;           /* The channel from which to read. */
4037      char *dst;                  /* Where to store input read. */      char *dst;                  /* Where to store input read. */
4038      int bytesToRead;            /* Maximum number of bytes to read. */      int bytesToRead;            /* Maximum number of bytes to read. */
4039  {  {
4040      Channel *chanPtr;                Channel *chanPtr;          
4041            
4042      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
4043      if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4044          return -1;          return -1;
4045      }      }
4046    
4047      return DoRead(chanPtr, dst, bytesToRead);      return DoRead(chanPtr, dst, bytesToRead);
4048  }  }
4049    
4050  /*  /*
4051   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4052   *   *
4053   * Tcl_ReadChars --   * Tcl_ReadChars --
4054   *   *
4055   *      Reads from the channel until the requested number of characters   *      Reads from the channel until the requested number of characters
4056   *      have been seen, EOF is seen, or the channel would block.  EOL   *      have been seen, EOF is seen, or the channel would block.  EOL
4057   *      and EOF translation is done.  If reading binary data, the raw   *      and EOF translation is done.  If reading binary data, the raw
4058   *      bytes are wrapped in a Tcl byte array object.  Otherwise, the raw   *      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   *      bytes are converted to UTF-8 using the channel's current encoding
4060   *      and stored in a Tcl string object.   *      and stored in a Tcl string object.
4061   *   *
4062   * Results:   * Results:
4063   *      The number of characters read, or -1 on error. Use Tcl_GetErrno()   *      The number of characters read, or -1 on error. Use Tcl_GetErrno()
4064   *      to retrieve the error code for the error that occurred.   *      to retrieve the error code for the error that occurred.
4065   *   *
4066   * Side effects:   * Side effects:
4067   *      May cause input to be buffered.   *      May cause input to be buffered.
4068   *   *
4069   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4070   */   */
4071    
4072  int  int
4073  Tcl_ReadChars(chan, objPtr, toRead, appendFlag)  Tcl_ReadChars(chan, objPtr, toRead, appendFlag)
4074      Tcl_Channel chan;           /* The channel to read. */      Tcl_Channel chan;           /* The channel to read. */
4075      Tcl_Obj *objPtr;            /* Input data is stored in this object. */      Tcl_Obj *objPtr;            /* Input data is stored in this object. */
4076      int toRead;                 /* Maximum number of characters to store,      int toRead;                 /* Maximum number of characters to store,
4077                                   * or -1 to read all available data (up to EOF                                   * or -1 to read all available data (up to EOF
4078                                   * or when channel blocks). */                                   * or when channel blocks). */
4079      int appendFlag;             /* If non-zero, data read from the channel      int appendFlag;             /* If non-zero, data read from the channel
4080                                   * will be appended to the object.  Otherwise,                                   * will be appended to the object.  Otherwise,
4081                                   * the data will replace the existing contents                                   * the data will replace the existing contents
4082                                   * of the object. */                                   * of the object. */
4083    
4084  {  {
4085      Channel *chanPtr;      Channel *chanPtr;
4086      int offset, factor, copied, copiedNow, result;      int offset, factor, copied, copiedNow, result;
4087      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
4088      Tcl_Encoding encoding;      Tcl_Encoding encoding;
4089  #define UTF_EXPANSION_FACTOR    1024  #define UTF_EXPANSION_FACTOR    1024
4090            
4091      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
4092      if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4093          copied = -1;          copied = -1;
4094          goto done;          goto done;
4095      }      }
4096    
4097      encoding = chanPtr->encoding;      encoding = chanPtr->encoding;
4098      factor = UTF_EXPANSION_FACTOR;      factor = UTF_EXPANSION_FACTOR;
4099    
4100      if (appendFlag == 0) {      if (appendFlag == 0) {
4101          if (encoding == NULL) {          if (encoding == NULL) {
4102              Tcl_SetByteArrayLength(objPtr, 0);              Tcl_SetByteArrayLength(objPtr, 0);
4103          } else {          } else {
4104              Tcl_SetObjLength(objPtr, 0);              Tcl_SetObjLength(objPtr, 0);
4105          }          }
4106          offset = 0;          offset = 0;
4107      } else {      } else {
4108          if (encoding == NULL) {          if (encoding == NULL) {
4109              Tcl_GetByteArrayFromObj(objPtr, &offset);              Tcl_GetByteArrayFromObj(objPtr, &offset);
4110          } else {          } else {
4111              Tcl_GetStringFromObj(objPtr, &offset);              Tcl_GetStringFromObj(objPtr, &offset);
4112          }          }
4113      }      }
4114    
4115      for (copied = 0; (unsigned) toRead > 0; ) {      for (copied = 0; (unsigned) toRead > 0; ) {
4116          copiedNow = -1;          copiedNow = -1;
4117          if (chanPtr->inQueueHead != NULL) {          if (chanPtr->inQueueHead != NULL) {
4118              if (encoding == NULL) {              if (encoding == NULL) {
4119                  copiedNow = ReadBytes(chanPtr, objPtr, toRead, &offset);                  copiedNow = ReadBytes(chanPtr, objPtr, toRead, &offset);
4120              } else {              } else {
4121                  copiedNow = ReadChars(chanPtr, objPtr, toRead, &offset,                  copiedNow = ReadChars(chanPtr, objPtr, toRead, &offset,
4122                          &factor);                          &factor);
4123              }              }
4124    
4125              /*              /*
4126               * If the current buffer is empty recycle it.               * If the current buffer is empty recycle it.
4127               */               */
4128    
4129              bufPtr = chanPtr->inQueueHead;              bufPtr = chanPtr->inQueueHead;
4130              if (bufPtr->nextRemoved == bufPtr->nextAdded) {              if (bufPtr->nextRemoved == bufPtr->nextAdded) {
4131                  ChannelBuffer *nextPtr;                  ChannelBuffer *nextPtr;
4132    
4133                  nextPtr = bufPtr->nextPtr;                  nextPtr = bufPtr->nextPtr;
4134                  RecycleBuffer(chanPtr, bufPtr, 0);                  RecycleBuffer(chanPtr, bufPtr, 0);
4135                  chanPtr->inQueueHead = nextPtr;                  chanPtr->inQueueHead = nextPtr;
4136                  if (nextPtr == NULL) {                  if (nextPtr == NULL) {
4137                      chanPtr->inQueueTail = nextPtr;                      chanPtr->inQueueTail = nextPtr;
4138                  }                  }
4139              }              }
4140          }          }
4141          if (copiedNow < 0) {          if (copiedNow < 0) {
4142              if (chanPtr->flags & CHANNEL_EOF) {              if (chanPtr->flags & CHANNEL_EOF) {
4143                  break;                  break;
4144              }              }
4145              if (chanPtr->flags & CHANNEL_BLOCKED) {              if (chanPtr->flags & CHANNEL_BLOCKED) {
4146                  if (chanPtr->flags & CHANNEL_NONBLOCKING) {                  if (chanPtr->flags & CHANNEL_NONBLOCKING) {
4147                      break;                      break;
4148                  }                  }
4149                  chanPtr->flags &= ~CHANNEL_BLOCKED;                  chanPtr->flags &= ~CHANNEL_BLOCKED;
4150              }              }
4151              result = GetInput(chanPtr);              result = GetInput(chanPtr);
4152              if (result != 0) {              if (result != 0) {
4153                  if (result == EAGAIN) {                  if (result == EAGAIN) {
4154                      break;                      break;
4155                  }                  }
4156                  copied = -1;                  copied = -1;
4157                  goto done;                  goto done;
4158              }              }
4159          } else {          } else {
4160              copied += copiedNow;              copied += copiedNow;
4161              toRead -= copiedNow;              toRead -= copiedNow;
4162          }          }
4163      }      }
4164      chanPtr->flags &= ~CHANNEL_BLOCKED;      chanPtr->flags &= ~CHANNEL_BLOCKED;
4165      if (encoding == NULL) {      if (encoding == NULL) {
4166          Tcl_SetByteArrayLength(objPtr, offset);          Tcl_SetByteArrayLength(objPtr, offset);
4167      } else {      } else {
4168          Tcl_SetObjLength(objPtr, offset);          Tcl_SetObjLength(objPtr, offset);
4169      }      }
4170    
4171      done:      done:
4172      /*      /*
4173       * Update the notifier state so we don't block while there is still       * Update the notifier state so we don't block while there is still
4174       * data in the buffers.       * data in the buffers.
4175       */       */
4176    
4177      UpdateInterest(chanPtr);      UpdateInterest(chanPtr);
4178      return copied;      return copied;
4179  }  }
4180  /*  /*
4181   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4182   *   *
4183   * ReadBytes --   * ReadBytes --
4184   *   *
4185   *      Reads from the channel until the requested number of bytes have   *      Reads from the channel until the requested number of bytes have
4186   *      been seen, EOF is seen, or the channel would block.  Bytes from   *      been seen, EOF is seen, or the channel would block.  Bytes from
4187   *      the channel are stored in objPtr as a ByteArray object.  EOL   *      the channel are stored in objPtr as a ByteArray object.  EOL
4188   *      and EOF translation are done.   *      and EOF translation are done.
4189   *   *
4190   *      'bytesToRead' can safely be a very large number because   *      'bytesToRead' can safely be a very large number because
4191   *      space is only allocated to hold data read from the channel   *      space is only allocated to hold data read from the channel
4192   *      as needed.   *      as needed.
4193   *   *
4194   * Results:   * Results:
4195   *      The return value is the number of bytes appended to the object   *      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   *      and *offsetPtr is filled with the total number of bytes in the
4197   *      object (greater than the return value if there were already bytes   *      object (greater than the return value if there were already bytes
4198   *      in the object).   *      in the object).
4199   *   *
4200   * Side effects:   * Side effects:
4201   *      None.   *      None.
4202   *   *
4203   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4204   */   */
4205    
4206  static int  static int
4207  ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)  ReadBytes(chanPtr, objPtr, bytesToRead, offsetPtr)
4208      Channel *chanPtr;           /* The channel to read. */      Channel *chanPtr;           /* The channel to read. */
4209      int bytesToRead;            /* Maximum number of characters to store,      int bytesToRead;            /* Maximum number of characters to store,
4210                                   * or < 0 to get all available characters.                                   * or < 0 to get all available characters.
4211                                   * Characters are obtained from the first                                   * Characters are obtained from the first
4212                                   * buffer in the queue -- even if this number                                   * buffer in the queue -- even if this number
4213                                   * is larger than the number of characters                                   * is larger than the number of characters
4214                                   * available in the first buffer, only the                                   * available in the first buffer, only the
4215                                   * characters from the first buffer are                                   * characters from the first buffer are
4216                                   * returned. */                                   * returned. */
4217      Tcl_Obj *objPtr;            /* Input data is appended to this ByteArray      Tcl_Obj *objPtr;            /* Input data is appended to this ByteArray
4218                                   * object.  Its length is how much space                                   * object.  Its length is how much space
4219                                   * has been allocated to hold data, not how                                   * has been allocated to hold data, not how
4220                                   * many bytes of data have been stored in the                                   * many bytes of data have been stored in the
4221                                   * object. */                                   * object. */
4222      int *offsetPtr;             /* On input, contains how many bytes of      int *offsetPtr;             /* On input, contains how many bytes of
4223                                   * objPtr have been used to hold data.  On                                   * objPtr have been used to hold data.  On
4224                                   * output, filled with how many bytes are now                                   * output, filled with how many bytes are now
4225                                   * being used. */                                   * being used. */
4226  {  {
4227      int toRead, srcLen, srcRead, dstWrote, offset, length;      int toRead, srcLen, srcRead, dstWrote, offset, length;
4228      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
4229      char *src, *dst;      char *src, *dst;
4230    
4231      offset = *offsetPtr;      offset = *offsetPtr;
4232    
4233      bufPtr = chanPtr->inQueueHead;      bufPtr = chanPtr->inQueueHead;
4234      src = bufPtr->buf + bufPtr->nextRemoved;      src = bufPtr->buf + bufPtr->nextRemoved;
4235      srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;      srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
4236    
4237      toRead = bytesToRead;      toRead = bytesToRead;
4238      if ((unsigned) toRead > (unsigned) srcLen) {      if ((unsigned) toRead > (unsigned) srcLen) {
4239          toRead = srcLen;          toRead = srcLen;
4240      }      }
4241    
4242      dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);      dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
4243      if (toRead > length - offset - 1) {      if (toRead > length - offset - 1) {
4244          /*          /*
4245           * Double the existing size of the object or make enough room to           * Double the existing size of the object or make enough room to
4246           * hold all the characters we may get from the source buffer,           * hold all the characters we may get from the source buffer,
4247           * whichever is larger.           * whichever is larger.
4248           */           */
4249    
4250          length = offset * 2;          length = offset * 2;
4251          if (offset < toRead) {          if (offset < toRead) {
4252              length = offset + toRead + 1;              length = offset + toRead + 1;
4253          }          }
4254          dst = (char *) Tcl_SetByteArrayLength(objPtr, length);          dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
4255      }      }
4256      dst += offset;      dst += offset;
4257    
4258      if (chanPtr->flags & INPUT_NEED_NL) {      if (chanPtr->flags & INPUT_NEED_NL) {
4259          chanPtr->flags &= ~INPUT_NEED_NL;          chanPtr->flags &= ~INPUT_NEED_NL;
4260          if ((srcLen == 0) || (*src != '\n')) {          if ((srcLen == 0) || (*src != '\n')) {
4261              *dst = '\r';              *dst = '\r';
4262              *offsetPtr += 1;              *offsetPtr += 1;
4263              return 1;              return 1;
4264          }          }
4265          *dst++ = '\n';          *dst++ = '\n';
4266          src++;          src++;
4267          srcLen--;          srcLen--;
4268          toRead--;          toRead--;
4269      }      }
4270    
4271      srcRead = srcLen;      srcRead = srcLen;
4272      dstWrote = toRead;      dstWrote = toRead;
4273      if (TranslateInputEOL(chanPtr, dst, src, &dstWrote, &srcRead) != 0) {      if (TranslateInputEOL(chanPtr, dst, src, &dstWrote, &srcRead) != 0) {
4274          if (dstWrote == 0) {          if (dstWrote == 0) {
4275              return -1;              return -1;
4276          }          }
4277      }      }
4278      bufPtr->nextRemoved += srcRead;      bufPtr->nextRemoved += srcRead;
4279      *offsetPtr += dstWrote;      *offsetPtr += dstWrote;
4280      return dstWrote;      return dstWrote;
4281  }  }
4282    
4283  /*  /*
4284   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4285   *   *
4286   * ReadChars --   * ReadChars --
4287   *   *
4288   *      Reads from the channel until the requested number of UTF-8   *      Reads from the channel until the requested number of UTF-8
4289   *      characters have been seen, EOF is seen, or the channel would   *      characters have been seen, EOF is seen, or the channel would
4290   *      block.  Raw bytes from the channel are converted to UTF-8   *      block.  Raw bytes from the channel are converted to UTF-8
4291   *      and stored in objPtr.  EOL and EOF translation is done.   *      and stored in objPtr.  EOL and EOF translation is done.
4292   *   *
4293   *      'charsToRead' can safely be a very large number because   *      'charsToRead' can safely be a very large number because
4294   *      space is only allocated to hold data read from the channel   *      space is only allocated to hold data read from the channel
4295   *      as needed.   *      as needed.
4296   *   *
4297   * Results:   * Results:
4298   *      The return value is the number of characters appended to   *      The return value is the number of characters appended to
4299   *      the object, *offsetPtr is filled with the number of bytes that   *      the object, *offsetPtr is filled with the number of bytes that
4300   *      were appended, and *factorPtr is filled with the expansion   *      were appended, and *factorPtr is filled with the expansion
4301   *      factor used to guess how many bytes of UTF-8 to allocate to   *      factor used to guess how many bytes of UTF-8 to allocate to
4302   *      hold N source bytes.   *      hold N source bytes.
4303   *   *
4304   * Side effects:   * Side effects:
4305   *      None.   *      None.
4306   *   *
4307   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4308   */   */
4309    
4310  static int  static int
4311  ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)  ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
4312      Channel *chanPtr;           /* The channel to read. */      Channel *chanPtr;           /* The channel to read. */
4313      int charsToRead;            /* Maximum number of characters to store,      int charsToRead;            /* Maximum number of characters to store,
4314                                   * or -1 to get all available characters.                                   * or -1 to get all available characters.
4315                                   * Characters are obtained from the first                                   * Characters are obtained from the first
4316                                   * buffer in the queue -- even if this number                                   * buffer in the queue -- even if this number
4317                                   * is larger than the number of characters                                   * is larger than the number of characters
4318                                   * available in the first buffer, only the                                   * available in the first buffer, only the
4319                                   * characters from the first buffer are                                   * characters from the first buffer are
4320                                   * returned. */                                   * returned. */
4321      Tcl_Obj *objPtr;            /* Input data is appended to this object.      Tcl_Obj *objPtr;            /* Input data is appended to this object.
4322                                   * objPtr->length is how much space has been                                   * objPtr->length is how much space has been
4323                                   * allocated to hold data, not how many bytes                                   * allocated to hold data, not how many bytes
4324                                   * of data have been stored in the object. */                                   * of data have been stored in the object. */
4325      int *offsetPtr;             /* On input, contains how many bytes of      int *offsetPtr;             /* On input, contains how many bytes of
4326                                   * objPtr have been used to hold data.  On                                   * objPtr have been used to hold data.  On
4327                                   * output, filled with how many bytes are now                                   * output, filled with how many bytes are now
4328                                   * being used. */                                   * being used. */
4329      int *factorPtr;             /* On input, contains a guess of how many      int *factorPtr;             /* On input, contains a guess of how many
4330                                   * bytes need to be allocated to hold the                                   * bytes need to be allocated to hold the
4331                                   * result of converting N source bytes to                                   * result of converting N source bytes to
4332                                   * UTF-8.  On output, contains another guess                                   * UTF-8.  On output, contains another guess
4333                                   * based on the data seen so far. */                                   * based on the data seen so far. */
4334  {  {
4335      int toRead, factor, offset, spaceLeft, length;      int toRead, factor, offset, spaceLeft, length;
4336      int srcLen, srcRead, dstNeeded, dstRead, dstWrote, numChars;      int srcLen, srcRead, dstNeeded, dstRead, dstWrote, numChars;
4337      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
4338      char *src, *dst;      char *src, *dst;
4339      Tcl_EncodingState oldState;      Tcl_EncodingState oldState;
4340    
4341      factor = *factorPtr;      factor = *factorPtr;
4342      offset = *offsetPtr;      offset = *offsetPtr;
4343    
4344      bufPtr = chanPtr->inQueueHead;      bufPtr = chanPtr->inQueueHead;
4345      src = bufPtr->buf + bufPtr->nextRemoved;      src = bufPtr->buf + bufPtr->nextRemoved;
4346      srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;      srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
4347    
4348      toRead = charsToRead;      toRead = charsToRead;
4349      if ((unsigned) toRead > (unsigned) srcLen) {      if ((unsigned) toRead > (unsigned) srcLen) {
4350          toRead = srcLen;          toRead = srcLen;
4351      }      }
4352    
4353      /*      /*
4354       * 'factor' is how much we guess that the bytes in the source buffer       * '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       * will expand when converted to UTF-8 chars.  This guess comes from
4356       * analyzing how many characters were produced by the previous       * analyzing how many characters were produced by the previous
4357       * pass.       * pass.
4358       */       */
4359    
4360      dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;      dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
4361      spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;      spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
4362    
4363      if (dstNeeded > spaceLeft) {      if (dstNeeded > spaceLeft) {
4364          /*          /*
4365           * Double the existing size of the object or make enough room to           * Double the existing size of the object or make enough room to
4366           * hold all the characters we want from the source buffer,           * hold all the characters we want from the source buffer,
4367           * whichever is larger.           * whichever is larger.
4368           */           */
4369    
4370          length = offset * 2;          length = offset * 2;
4371          if (offset < dstNeeded) {          if (offset < dstNeeded) {
4372              length = offset + dstNeeded;              length = offset + dstNeeded;
4373          }          }
4374          spaceLeft = length - offset;          spaceLeft = length - offset;
4375          length += TCL_UTF_MAX + 1;          length += TCL_UTF_MAX + 1;
4376          Tcl_SetObjLength(objPtr, length);          Tcl_SetObjLength(objPtr, length);
4377      }      }
4378      if (toRead == srcLen) {      if (toRead == srcLen) {
4379          /*          /*
4380           * Want to convert the whole buffer in one pass.  If we have           * Want to convert the whole buffer in one pass.  If we have
4381           * enough space, convert it using all available space in object           * enough space, convert it using all available space in object
4382           * rather than using the factor.           * rather than using the factor.
4383           */           */
4384    
4385          dstNeeded = spaceLeft;          dstNeeded = spaceLeft;
4386      }      }
4387      dst = objPtr->bytes + offset;      dst = objPtr->bytes + offset;
4388    
4389      oldState = chanPtr->inputEncodingState;      oldState = chanPtr->inputEncodingState;
4390      if (chanPtr->flags & INPUT_NEED_NL) {      if (chanPtr->flags & INPUT_NEED_NL) {
4391          /*          /*
4392           * We want a '\n' because the last character we saw was '\r'.           * We want a '\n' because the last character we saw was '\r'.
4393           */           */
4394                    
4395          chanPtr->flags &= ~INPUT_NEED_NL;          chanPtr->flags &= ~INPUT_NEED_NL;
4396          Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,          Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4397                  chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,                  chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4398                  dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);                  dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
4399          if ((dstWrote > 0) && (*dst == '\n')) {          if ((dstWrote > 0) && (*dst == '\n')) {
4400              /*              /*
4401               * The next char was a '\n'.  Consume it and produce a '\n'.               * The next char was a '\n'.  Consume it and produce a '\n'.
4402               */               */
4403                            
4404              bufPtr->nextRemoved += srcRead;              bufPtr->nextRemoved += srcRead;
4405          } else {          } else {
4406              /*              /*
4407               * The next char was not a '\n'.  Produce a '\r'.               * The next char was not a '\n'.  Produce a '\r'.
4408               */               */
4409    
4410              *dst = '\r';              *dst = '\r';
4411          }          }
4412          chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;          chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4413          *offsetPtr += 1;          *offsetPtr += 1;
4414          return 1;          return 1;
4415      }      }
4416    
4417      Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,      Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4418              chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState, dst,              chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState, dst,
4419              dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);              dstNeeded + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4420      if (srcRead == 0) {      if (srcRead == 0) {
4421          /*          /*
4422           * Not enough bytes in src buffer to make a complete char.  Copy           * 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,           * the bytes to the next buffer to make a new contiguous string,
4424           * then tell the caller to fill the buffer with more bytes.           * then tell the caller to fill the buffer with more bytes.
4425           */           */
4426    
4427          ChannelBuffer *nextPtr;          ChannelBuffer *nextPtr;
4428                    
4429          nextPtr = bufPtr->nextPtr;          nextPtr = bufPtr->nextPtr;
4430          if (nextPtr == NULL) {          if (nextPtr == NULL) {
4431              /*              /*
4432               * There isn't enough data in the buffers to complete the next               * 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               * character, so we need to wait for more data before the next
4434               * file event can be delivered.               * file event can be delivered.
4435               */               */
4436    
4437              chanPtr->flags |= CHANNEL_NEED_MORE_DATA;              chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
4438              return -1;              return -1;
4439          }          }
4440          nextPtr->nextRemoved -= srcLen;          nextPtr->nextRemoved -= srcLen;
4441          memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,          memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
4442                  (size_t) srcLen);                  (size_t) srcLen);
4443          RecycleBuffer(chanPtr, bufPtr, 0);          RecycleBuffer(chanPtr, bufPtr, 0);
4444          chanPtr->inQueueHead = nextPtr;          chanPtr->inQueueHead = nextPtr;
4445          return ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr);          return ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr);
4446      }      }
4447    
4448      dstRead = dstWrote;      dstRead = dstWrote;
4449      if (TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead) != 0) {      if (TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead) != 0) {
4450          /*          /*
4451           * Hit EOF char.  How many bytes of src correspond to where the           * Hit EOF char.  How many bytes of src correspond to where the
4452           * EOF was located in dst?           * EOF was located in dst?
4453           */           */
4454                    
4455          if (dstWrote == 0) {          if (dstWrote == 0) {
4456              return -1;              return -1;
4457          }          }
4458          chanPtr->inputEncodingState = oldState;          chanPtr->inputEncodingState = oldState;
4459          Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,          Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4460                  chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,                  chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4461                  dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);                  dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4462          TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);          TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
4463      }      }
4464    
4465      /*      /*
4466       * The number of characters that we got may be less than the number       * 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       * that we started with because "\r\n" sequences may have been
4468       * turned into just '\n' in dst.       * turned into just '\n' in dst.
4469       */       */
4470    
4471      numChars -= (dstRead - dstWrote);      numChars -= (dstRead - dstWrote);
4472    
4473      if ((unsigned) numChars > (unsigned) toRead) {      if ((unsigned) numChars > (unsigned) toRead) {
4474          /*          /*
4475           * Got too many chars.           * Got too many chars.
4476           */           */
4477    
4478          char *eof;          char *eof;
4479    
4480          eof = Tcl_UtfAtIndex(dst, toRead);          eof = Tcl_UtfAtIndex(dst, toRead);
4481          chanPtr->inputEncodingState = oldState;          chanPtr->inputEncodingState = oldState;
4482          Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,          Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
4483                  chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,                  chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
4484                  dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);                  dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
4485          dstRead = dstWrote;          dstRead = dstWrote;
4486          TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);          TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
4487          numChars -= (dstRead - dstWrote);          numChars -= (dstRead - dstWrote);
4488      }      }
4489      chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;      chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
4490    
4491      bufPtr->nextRemoved += srcRead;      bufPtr->nextRemoved += srcRead;
4492      if (dstWrote > srcRead + 1) {      if (dstWrote > srcRead + 1) {
4493          *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;          *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
4494      }      }
4495      *offsetPtr += dstWrote;      *offsetPtr += dstWrote;
4496      return numChars;      return numChars;
4497  }  }
4498    
4499  /*  /*
4500   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4501   *   *
4502   * TranslateInputEOL --   * TranslateInputEOL --
4503   *   *
4504   *      Perform input EOL and EOF translation on the source buffer,   *      Perform input EOL and EOF translation on the source buffer,
4505   *      leaving the translated result in the destination buffer.     *      leaving the translated result in the destination buffer.  
4506   *   *
4507   * Results:   * Results:
4508   *      The return value is 1 if the EOF character was found when copying   *      The return value is 1 if the EOF character was found when copying
4509   *      bytes to the destination buffer, 0 otherwise.     *      bytes to the destination buffer, 0 otherwise.  
4510   *   *
4511   * Side effects:   * Side effects:
4512   *      None.   *      None.
4513   *   *
4514   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4515   */   */
4516    
4517  static int  static int
4518  TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)  TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
4519      Channel *chanPtr;           /* Channel being read, for EOL translation      Channel *chanPtr;           /* Channel being read, for EOL translation
4520                                   * and EOF character. */                                   * and EOF character. */
4521      char *dstStart;             /* Output buffer filled with chars by      char *dstStart;             /* Output buffer filled with chars by
4522                                   * applying appropriate EOL translation to                                   * applying appropriate EOL translation to
4523                                   * source characters. */                                   * source characters. */
4524      CONST char *srcStart;       /* Source characters. */      CONST char *srcStart;       /* Source characters. */
4525      int *dstLenPtr;             /* On entry, the maximum length of output      int *dstLenPtr;             /* On entry, the maximum length of output
4526                                   * buffer in bytes; must be <= *srcLenPtr.  On                                   * buffer in bytes; must be <= *srcLenPtr.  On
4527                                   * exit, the number of bytes actually used in                                   * exit, the number of bytes actually used in
4528                                   * output buffer. */                                   * output buffer. */
4529      int *srcLenPtr;             /* On entry, the length of source buffer.      int *srcLenPtr;             /* On entry, the length of source buffer.
4530                                   * On exit, the number of bytes read from                                   * On exit, the number of bytes read from
4531                                   * the source buffer. */                                   * the source buffer. */
4532  {  {
4533      int dstLen, srcLen, inEofChar;      int dstLen, srcLen, inEofChar;
4534      CONST char *eof;      CONST char *eof;
4535    
4536      dstLen = *dstLenPtr;      dstLen = *dstLenPtr;
4537    
4538      eof = NULL;      eof = NULL;
4539      inEofChar = chanPtr->inEofChar;      inEofChar = chanPtr->inEofChar;
4540      if (inEofChar != '\0') {      if (inEofChar != '\0') {
4541          /*          /*
4542           * Find EOF in translated buffer then compress out the EOL.  The           * Find EOF in translated buffer then compress out the EOL.  The
4543           * source buffer may be much longer than the destination buffer --           * 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           * we only want to return EOF if the EOF has been copied to the
4545           * destination buffer.           * destination buffer.
4546           */           */
4547    
4548          CONST char *src, *srcMax;          CONST char *src, *srcMax;
4549    
4550          srcMax = srcStart + *srcLenPtr;          srcMax = srcStart + *srcLenPtr;
4551          for (src = srcStart; src < srcMax; src++) {          for (src = srcStart; src < srcMax; src++) {
4552              if (*src == inEofChar) {              if (*src == inEofChar) {
4553                  eof = src;                  eof = src;
4554                  srcLen = src - srcStart;                  srcLen = src - srcStart;
4555                  if (srcLen < dstLen) {                  if (srcLen < dstLen) {
4556                      dstLen = srcLen;                      dstLen = srcLen;
4557                  }                  }
4558                  *srcLenPtr = srcLen;                  *srcLenPtr = srcLen;
4559                  break;                  break;
4560              }              }
4561          }          }
4562      }      }
4563      switch (chanPtr->inputTranslation) {      switch (chanPtr->inputTranslation) {
4564          case TCL_TRANSLATE_LF: {          case TCL_TRANSLATE_LF: {
4565              if (dstStart != srcStart) {              if (dstStart != srcStart) {
4566                  memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);                  memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
4567              }              }
4568              srcLen = dstLen;              srcLen = dstLen;
4569              break;              break;
4570          }          }
4571          case TCL_TRANSLATE_CR: {          case TCL_TRANSLATE_CR: {
4572              char *dst, *dstEnd;              char *dst, *dstEnd;
4573                            
4574              if (dstStart != srcStart) {              if (dstStart != srcStart) {
4575                  memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);                  memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
4576              }              }
4577              dstEnd = dstStart + dstLen;              dstEnd = dstStart + dstLen;
4578              for (dst = dstStart; dst < dstEnd; dst++) {              for (dst = dstStart; dst < dstEnd; dst++) {
4579                  if (*dst == '\r') {                  if (*dst == '\r') {
4580                      *dst = '\n';                      *dst = '\n';
4581                  }                  }
4582              }              }
4583              srcLen = dstLen;              srcLen = dstLen;
4584              break;              break;
4585          }          }
4586          case TCL_TRANSLATE_CRLF: {          case TCL_TRANSLATE_CRLF: {
4587              char *dst;              char *dst;
4588              CONST char *src, *srcEnd, *srcMax;              CONST char *src, *srcEnd, *srcMax;
4589                            
4590              dst = dstStart;              dst = dstStart;
4591              src = srcStart;              src = srcStart;
4592              srcEnd = srcStart + dstLen;              srcEnd = srcStart + dstLen;
4593              srcMax = srcStart + *srcLenPtr;              srcMax = srcStart + *srcLenPtr;
4594    
4595              for ( ; src < srcEnd; ) {              for ( ; src < srcEnd; ) {
4596                  if (*src == '\r') {                  if (*src == '\r') {
4597                      src++;                      src++;
4598                      if (src >= srcMax) {                      if (src >= srcMax) {
4599                          chanPtr->flags |= INPUT_NEED_NL;                          chanPtr->flags |= INPUT_NEED_NL;
4600                      } else if (*src == '\n') {                      } else if (*src == '\n') {
4601                          *dst++ = *src++;                          *dst++ = *src++;
4602                      } else {                      } else {
4603                          *dst++ = '\r';                          *dst++ = '\r';
4604                      }                      }
4605                  } else {                  } else {
4606                      *dst++ = *src++;                      *dst++ = *src++;
4607                  }                  }
4608              }              }
4609              srcLen = src - srcStart;              srcLen = src - srcStart;
4610              dstLen = dst - dstStart;              dstLen = dst - dstStart;
4611              break;              break;
4612          }          }
4613          case TCL_TRANSLATE_AUTO: {          case TCL_TRANSLATE_AUTO: {
4614              char *dst;              char *dst;
4615              CONST char *src, *srcEnd, *srcMax;              CONST char *src, *srcEnd, *srcMax;
4616    
4617              dst = dstStart;              dst = dstStart;
4618              src = srcStart;              src = srcStart;
4619              srcEnd = srcStart + dstLen;              srcEnd = srcStart + dstLen;
4620              srcMax = srcStart + *srcLenPtr;              srcMax = srcStart + *srcLenPtr;
4621    
4622              if ((chanPtr->flags & INPUT_SAW_CR) && (src < srcMax)) {              if ((chanPtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
4623                  if (*src == '\n') {                  if (*src == '\n') {
4624                      src++;                      src++;
4625                  }                  }
4626                  chanPtr->flags &= ~INPUT_SAW_CR;                  chanPtr->flags &= ~INPUT_SAW_CR;
4627              }              }
4628              for ( ; src < srcEnd; ) {              for ( ; src < srcEnd; ) {
4629                  if (*src == '\r') {                  if (*src == '\r') {
4630                      src++;                      src++;
4631                      if (src >= srcMax) {                      if (src >= srcMax) {
4632                          chanPtr->flags |= INPUT_SAW_CR;                          chanPtr->flags |= INPUT_SAW_CR;
4633                      } else if (*src == '\n') {                      } else if (*src == '\n') {
4634                          if (srcEnd < srcMax) {                          if (srcEnd < srcMax) {
4635                              srcEnd++;                              srcEnd++;
4636                          }                          }
4637                          src++;                          src++;
4638                      }                      }
4639                      *dst++ = '\n';                      *dst++ = '\n';
4640                  } else {                  } else {
4641                      *dst++ = *src++;                      *dst++ = *src++;
4642                  }                  }
4643              }              }
4644              srcLen = src - srcStart;              srcLen = src - srcStart;
4645              dstLen = dst - dstStart;              dstLen = dst - dstStart;
4646              break;              break;
4647          }          }
4648          default: {              /* lint. */          default: {              /* lint. */
4649              return 0;              return 0;
4650          }          }
4651      }      }
4652      *dstLenPtr = dstLen;      *dstLenPtr = dstLen;
4653    
4654      if ((eof != NULL) && (srcStart + srcLen >= eof)) {      if ((eof != NULL) && (srcStart + srcLen >= eof)) {
4655          /*          /*
4656           * EOF character was seen in EOL translated range.  Leave current           * EOF character was seen in EOL translated range.  Leave current
4657           * file position pointing at the EOF character, but don't store the           * file position pointing at the EOF character, but don't store the
4658           * EOF character in the output string.           * EOF character in the output string.
4659           */           */
4660    
4661          chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);          chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
4662          chanPtr->inputEncodingFlags |= TCL_ENCODING_END;          chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
4663          chanPtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);          chanPtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
4664          return 1;          return 1;
4665      }      }
4666    
4667      *srcLenPtr = srcLen;      *srcLenPtr = srcLen;
4668      return 0;      return 0;
4669  }  }
4670    
4671  /*  /*
4672   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4673   *   *
4674   * Tcl_Ungets --   * Tcl_Ungets --
4675   *   *
4676   *      Causes the supplied string to be added to the input queue of   *      Causes the supplied string to be added to the input queue of
4677   *      the channel, at either the head or tail of the queue.   *      the channel, at either the head or tail of the queue.
4678   *   *
4679   * Results:   * Results:
4680   *      The number of bytes stored in the channel, or -1 on error.   *      The number of bytes stored in the channel, or -1 on error.
4681   *   *
4682   * Side effects:   * Side effects:
4683   *      Adds input to the input queue of a channel.   *      Adds input to the input queue of a channel.
4684   *   *
4685   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4686   */   */
4687    
4688  int  int
4689  Tcl_Ungets(chan, str, len, atEnd)  Tcl_Ungets(chan, str, len, atEnd)
4690      Tcl_Channel chan;           /* The channel for which to add the input. */      Tcl_Channel chan;           /* The channel for which to add the input. */
4691      char *str;                  /* The input itself. */      char *str;                  /* The input itself. */
4692      int len;                    /* The length of the input. */      int len;                    /* The length of the input. */
4693      int atEnd;                  /* If non-zero, add at end of queue; otherwise      int atEnd;                  /* If non-zero, add at end of queue; otherwise
4694                                   * add at head of queue. */                                       * add at head of queue. */    
4695  {  {
4696      Channel *chanPtr;           /* The real IO channel. */      Channel *chanPtr;           /* The real IO channel. */
4697      ChannelBuffer *bufPtr;      /* Buffer to contain the data. */      ChannelBuffer *bufPtr;      /* Buffer to contain the data. */
4698      int i, flags;      int i, flags;
4699    
4700      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
4701            
4702      /*      /*
4703       * CheckChannelErrors clears too many flag bits in this one case.       * CheckChannelErrors clears too many flag bits in this one case.
4704       */       */
4705            
4706      flags = chanPtr->flags;      flags = chanPtr->flags;
4707      if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
4708          len = -1;          len = -1;
4709          goto done;          goto done;
4710      }      }
4711      chanPtr->flags = flags;      chanPtr->flags = flags;
4712    
4713      /*      /*
4714       * If we have encountered a sticky EOF, just punt without storing.       * 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       * (sticky EOF is set if we have seen the input eofChar, to prevent
4716       * reading beyond the eofChar). Otherwise, clear the EOF flags, and       * reading beyond the eofChar). Otherwise, clear the EOF flags, and
4717       * clear the BLOCKED bit. We want to discover these conditions anew       * clear the BLOCKED bit. We want to discover these conditions anew
4718       * in each operation.       * in each operation.
4719       */       */
4720    
4721      if (chanPtr->flags & CHANNEL_STICKY_EOF) {      if (chanPtr->flags & CHANNEL_STICKY_EOF) {
4722          goto done;          goto done;
4723      }      }
4724      chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));      chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
4725    
4726      bufPtr = AllocChannelBuffer(len);      bufPtr = AllocChannelBuffer(len);
4727      for (i = 0; i < len; i++) {      for (i = 0; i < len; i++) {
4728          bufPtr->buf[i] = str[i];          bufPtr->buf[i] = str[i];
4729      }      }
4730      bufPtr->nextAdded += len;      bufPtr->nextAdded += len;
4731    
4732      if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {      if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
4733          bufPtr->nextPtr = (ChannelBuffer *) NULL;          bufPtr->nextPtr = (ChannelBuffer *) NULL;
4734          chanPtr->inQueueHead = bufPtr;          chanPtr->inQueueHead = bufPtr;
4735          chanPtr->inQueueTail = bufPtr;          chanPtr->inQueueTail = bufPtr;
4736      } else if (atEnd) {      } else if (atEnd) {
4737          bufPtr->nextPtr = (ChannelBuffer *) NULL;          bufPtr->nextPtr = (ChannelBuffer *) NULL;
4738          chanPtr->inQueueTail->nextPtr = bufPtr;          chanPtr->inQueueTail->nextPtr = bufPtr;
4739          chanPtr->inQueueTail = bufPtr;          chanPtr->inQueueTail = bufPtr;
4740      } else {      } else {
4741          bufPtr->nextPtr = chanPtr->inQueueHead;          bufPtr->nextPtr = chanPtr->inQueueHead;
4742          chanPtr->inQueueHead = bufPtr;          chanPtr->inQueueHead = bufPtr;
4743      }      }
4744    
4745      done:      done:
4746      /*      /*
4747       * Update the notifier state so we don't block while there is still       * Update the notifier state so we don't block while there is still
4748       * data in the buffers.       * data in the buffers.
4749       */       */
4750    
4751      UpdateInterest(chanPtr);      UpdateInterest(chanPtr);
4752      return len;      return len;
4753  }  }
4754    
4755  /*  /*
4756   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4757   *   *
4758   * Tcl_Flush --   * Tcl_Flush --
4759   *   *
4760   *      Flushes output data on a channel.   *      Flushes output data on a channel.
4761   *   *
4762   * Results:   * Results:
4763   *      A standard Tcl result.   *      A standard Tcl result.
4764   *   *
4765   * Side effects:   * Side effects:
4766   *      May flush output queued on this channel.   *      May flush output queued on this channel.
4767   *   *
4768   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4769   */   */
4770    
4771  int  int
4772  Tcl_Flush(chan)  Tcl_Flush(chan)
4773      Tcl_Channel chan;                   /* The Channel to flush. */      Tcl_Channel chan;                   /* The Channel to flush. */
4774  {  {
4775      int result;                         /* Of calling FlushChannel. */      int result;                         /* Of calling FlushChannel. */
4776      Channel *chanPtr;                   /* The actual channel. */      Channel *chanPtr;                   /* The actual channel. */
4777    
4778      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
4779      if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
4780          return -1;          return -1;
4781      }      }
4782    
4783      /*      /*
4784       * Force current output buffer to be output also.       * Force current output buffer to be output also.
4785       */       */
4786            
4787      if ((chanPtr->curOutPtr != NULL)      if ((chanPtr->curOutPtr != NULL)
4788              && (chanPtr->curOutPtr->nextAdded > 0)) {              && (chanPtr->curOutPtr->nextAdded > 0)) {
4789          chanPtr->flags |= BUFFER_READY;          chanPtr->flags |= BUFFER_READY;
4790      }      }
4791            
4792      result = FlushChannel(NULL, chanPtr, 0);      result = FlushChannel(NULL, chanPtr, 0);
4793      if (result != 0) {      if (result != 0) {
4794          return TCL_ERROR;          return TCL_ERROR;
4795      }      }
4796    
4797      return TCL_OK;      return TCL_OK;
4798  }  }
4799    
4800  /*  /*
4801   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4802   *   *
4803   * DiscardInputQueued --   * DiscardInputQueued --
4804   *   *
4805   *      Discards any input read from the channel but not yet consumed   *      Discards any input read from the channel but not yet consumed
4806   *      by Tcl reading commands.   *      by Tcl reading commands.
4807   *   *
4808   * Results:   * Results:
4809   *      None.   *      None.
4810   *   *
4811   * Side effects:   * Side effects:
4812   *      May discard input from the channel. If discardLastBuffer is zero,   *      May discard input from the channel. If discardLastBuffer is zero,
4813   *      leaves one buffer in place for back-filling.   *      leaves one buffer in place for back-filling.
4814   *   *
4815   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4816   */   */
4817    
4818  static void  static void
4819  DiscardInputQueued(chanPtr, discardSavedBuffers)  DiscardInputQueued(chanPtr, discardSavedBuffers)
4820      Channel *chanPtr;           /* Channel on which to discard      Channel *chanPtr;           /* Channel on which to discard
4821                                   * the queued input. */                                   * the queued input. */
4822      int discardSavedBuffers;    /* If non-zero, discard all buffers including      int discardSavedBuffers;    /* If non-zero, discard all buffers including
4823                                   * last one. */                                   * last one. */
4824  {  {
4825      ChannelBuffer *bufPtr, *nxtPtr;     /* Loop variables. */      ChannelBuffer *bufPtr, *nxtPtr;     /* Loop variables. */
4826    
4827      bufPtr = chanPtr->inQueueHead;      bufPtr = chanPtr->inQueueHead;
4828      chanPtr->inQueueHead = (ChannelBuffer *) NULL;      chanPtr->inQueueHead = (ChannelBuffer *) NULL;
4829      chanPtr->inQueueTail = (ChannelBuffer *) NULL;      chanPtr->inQueueTail = (ChannelBuffer *) NULL;
4830      for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {      for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
4831          nxtPtr = bufPtr->nextPtr;          nxtPtr = bufPtr->nextPtr;
4832          RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);          RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
4833      }      }
4834    
4835      /*      /*
4836       * If discardSavedBuffers is nonzero, must also discard any previously       * If discardSavedBuffers is nonzero, must also discard any previously
4837       * saved buffer in the saveInBufPtr field.       * saved buffer in the saveInBufPtr field.
4838       */       */
4839            
4840      if (discardSavedBuffers) {      if (discardSavedBuffers) {
4841          if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {          if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
4842              ckfree((char *) chanPtr->saveInBufPtr);              ckfree((char *) chanPtr->saveInBufPtr);
4843              chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;              chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
4844          }          }
4845      }      }
4846  }  }
4847    
4848  /*  /*
4849   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4850   *   *
4851   * GetInput --   * GetInput --
4852   *   *
4853   *      Reads input data from a device into a channel buffer.     *      Reads input data from a device into a channel buffer.  
4854   *   *
4855   * Results:   * Results:
4856   *      The return value is the Posix error code if an error occurred while   *      The return value is the Posix error code if an error occurred while
4857   *      reading from the file, or 0 otherwise.     *      reading from the file, or 0 otherwise.  
4858   *   *
4859   * Side effects:   * Side effects:
4860   *      Reads from the underlying device.   *      Reads from the underlying device.
4861   *   *
4862   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
4863   */   */
4864    
4865  static int  static int
4866  GetInput(chanPtr)  GetInput(chanPtr)
4867      Channel *chanPtr;           /* Channel to read input from. */      Channel *chanPtr;           /* Channel to read input from. */
4868  {  {
4869      int toRead;                 /* How much to read? */      int toRead;                 /* How much to read? */
4870      int result;                 /* Of calling driver. */      int result;                 /* Of calling driver. */
4871      int nread;                  /* How much was read from channel? */      int nread;                  /* How much was read from channel? */
4872      ChannelBuffer *bufPtr;      /* New buffer to add to input queue. */      ChannelBuffer *bufPtr;      /* New buffer to add to input queue. */
4873    
4874      /*      /*
4875       * Prevent reading from a dead channel -- a channel that has been closed       * 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       * 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       * channel cleanup has run but the channel is still registered in some
4878       * interpreter.       * interpreter.
4879       */       */
4880            
4881      if (CheckForDeadChannel(NULL, chanPtr)) {      if (CheckForDeadChannel(NULL, chanPtr)) {
4882          return EINVAL;          return EINVAL;
4883      }      }
4884    
4885      /*      /*
4886       * See if we can fill an existing buffer. If we can, read only       * 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,       * 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.       * add it to the input queue and attempt to fill it to the max.
4889       */       */
4890    
4891      bufPtr = chanPtr->inQueueTail;      bufPtr = chanPtr->inQueueTail;
4892      if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {      if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
4893          toRead = bufPtr->bufLength - bufPtr->nextAdded;          toRead = bufPtr->bufLength - bufPtr->nextAdded;
4894      } else {      } else {
4895          bufPtr = chanPtr->saveInBufPtr;          bufPtr = chanPtr->saveInBufPtr;
4896          chanPtr->saveInBufPtr = NULL;          chanPtr->saveInBufPtr = NULL;
4897          if (bufPtr == NULL) {          if (bufPtr == NULL) {
4898              bufPtr = AllocChannelBuffer(chanPtr->bufSize);              bufPtr = AllocChannelBuffer(chanPtr->bufSize);
4899          }          }
4900          bufPtr->nextPtr = (ChannelBuffer *) NULL;          bufPtr->nextPtr = (ChannelBuffer *) NULL;
4901    
4902          toRead = chanPtr->bufSize;          toRead = chanPtr->bufSize;
4903          if (chanPtr->inQueueTail == NULL) {          if (chanPtr->inQueueTail == NULL) {
4904              chanPtr->inQueueHead = bufPtr;              chanPtr->inQueueHead = bufPtr;
4905          } else {          } else {
4906              chanPtr->inQueueTail->nextPtr = bufPtr;              chanPtr->inQueueTail->nextPtr = bufPtr;
4907          }          }
4908          chanPtr->inQueueTail = bufPtr;          chanPtr->inQueueTail = bufPtr;
4909      }      }
4910                
4911      /*      /*
4912       * If EOF is set, we should avoid calling the driver because on some       * 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.       * platforms it is impossible to read from a device after EOF.
4914       */       */
4915    
4916      if (chanPtr->flags & CHANNEL_EOF) {      if (chanPtr->flags & CHANNEL_EOF) {
4917          return 0;          return 0;
4918      }      }
4919    
4920      nread = (*chanPtr->typePtr->inputProc)(chanPtr->instanceData,      nread = (*chanPtr->typePtr->inputProc)(chanPtr->instanceData,
4921              bufPtr->buf + bufPtr->nextAdded, toRead, &result);              bufPtr->buf + bufPtr->nextAdded, toRead, &result);
4922    
4923      if (nread > 0) {      if (nread > 0) {
4924          bufPtr->nextAdded += nread;          bufPtr->nextAdded += nread;
4925    
4926          /*          /*
4927           * If we get a short read, signal up that we may be BLOCKED. We           * 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           * should avoid calling the driver because on some platforms we
4929           * will block in the low level reading code even though the           * will block in the low level reading code even though the
4930           * channel is set into nonblocking mode.           * channel is set into nonblocking mode.
4931           */           */
4932                            
4933          if (nread < toRead) {          if (nread < toRead) {
4934              chanPtr->flags |= CHANNEL_BLOCKED;              chanPtr->flags |= CHANNEL_BLOCKED;
4935          }          }
4936      } else if (nread == 0) {      } else if (nread == 0) {
4937          chanPtr->flags |= CHANNEL_EOF;          chanPtr->flags |= CHANNEL_EOF;
4938          chanPtr->inputEncodingFlags |= TCL_ENCODING_END;          chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
4939      } else if (nread < 0) {      } else if (nread < 0) {
4940          if ((result == EWOULDBLOCK) || (result == EAGAIN)) {          if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
4941              chanPtr->flags |= CHANNEL_BLOCKED;              chanPtr->flags |= CHANNEL_BLOCKED;
4942              result = EAGAIN;              result = EAGAIN;
4943          }          }
4944          Tcl_SetErrno(result);          Tcl_SetErrno(result);
4945          return result;          return result;
4946      }      }
4947      return 0;      return 0;
4948  }  }
4949    
4950  /*  /*
4951   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4952   *   *
4953   * Tcl_Seek --   * Tcl_Seek --
4954   *   *
4955   *      Implements seeking on Tcl Channels. This is a public function   *      Implements seeking on Tcl Channels. This is a public function
4956   *      so that other C facilities may be implemented on top of it.   *      so that other C facilities may be implemented on top of it.
4957   *   *
4958   * Results:   * Results:
4959   *      The new access point or -1 on error. If error, use Tcl_GetErrno()   *      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.   *      to retrieve the POSIX error code for the error that occurred.
4961   *   *
4962   * Side effects:   * Side effects:
4963   *      May flush output on the channel. May discard queued input.   *      May flush output on the channel. May discard queued input.
4964   *   *
4965   *----------------------------------------------------------------------   *----------------------------------------------------------------------
4966   */   */
4967    
4968  int  int
4969  Tcl_Seek(chan, offset, mode)  Tcl_Seek(chan, offset, mode)
4970      Tcl_Channel chan;           /* The channel on which to seek. */      Tcl_Channel chan;           /* The channel on which to seek. */
4971      int offset;                 /* Offset to seek to. */      int offset;                 /* Offset to seek to. */
4972      int mode;                   /* Relative to which location to seek? */      int mode;                   /* Relative to which location to seek? */
4973  {  {
4974      Channel *chanPtr;           /* The real IO channel. */      Channel *chanPtr;           /* The real IO channel. */
4975      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
4976      int inputBuffered, outputBuffered;      int inputBuffered, outputBuffered;
4977      int result;                 /* Of device driver operations. */      int result;                 /* Of device driver operations. */
4978      int curPos;                 /* Position on the device. */      int curPos;                 /* Position on the device. */
4979      int wasAsync;               /* Was the channel nonblocking before the      int wasAsync;               /* Was the channel nonblocking before the
4980                                   * seek operation? If so, must restore to                                   * seek operation? If so, must restore to
4981                                   * nonblocking mode after the seek. */                                   * nonblocking mode after the seek. */
4982    
4983      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
4984      if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
4985          return -1;          return -1;
4986      }      }
4987    
4988      /*      /*
4989       * Disallow seek on dead channels -- channels that have been closed but       * Disallow seek on dead channels -- channels that have been closed but
4990       * not yet been deallocated. Such channels can be found if the exit       * not yet been deallocated. Such channels can be found if the exit
4991       * handler for channel cleanup has run but the channel is still       * handler for channel cleanup has run but the channel is still
4992       * registered in an interpreter.       * registered in an interpreter.
4993       */       */
4994    
4995      if (CheckForDeadChannel(NULL,chanPtr)) return -1;      if (CheckForDeadChannel(NULL,chanPtr)) return -1;
4996    
4997      /*      /*
4998       * Disallow seek on channels whose type does not have a seek procedure       * Disallow seek on channels whose type does not have a seek procedure
4999       * defined. This means that the channel does not support seeking.       * defined. This means that the channel does not support seeking.
5000       */       */
5001    
5002      if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {      if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
5003          Tcl_SetErrno(EINVAL);          Tcl_SetErrno(EINVAL);
5004          return -1;          return -1;
5005      }      }
5006    
5007      /*      /*
5008       * Compute how much input and output is buffered. If both input and       * Compute how much input and output is buffered. If both input and
5009       * output is buffered, cannot compute the current position.       * output is buffered, cannot compute the current position.
5010       */       */
5011    
5012      for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;      for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
5013               bufPtr != (ChannelBuffer *) NULL;               bufPtr != (ChannelBuffer *) NULL;
5014               bufPtr = bufPtr->nextPtr) {               bufPtr = bufPtr->nextPtr) {
5015          inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);          inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5016      }      }
5017      for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;      for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
5018               bufPtr != (ChannelBuffer *) NULL;               bufPtr != (ChannelBuffer *) NULL;
5019               bufPtr = bufPtr->nextPtr) {               bufPtr = bufPtr->nextPtr) {
5020          outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);          outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5021      }      }
5022      if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&      if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
5023             (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {             (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
5024          chanPtr->flags |= BUFFER_READY;          chanPtr->flags |= BUFFER_READY;
5025          outputBuffered +=          outputBuffered +=
5026              (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);              (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
5027      }      }
5028    
5029      if ((inputBuffered != 0) && (outputBuffered != 0)) {      if ((inputBuffered != 0) && (outputBuffered != 0)) {
5030          Tcl_SetErrno(EFAULT);          Tcl_SetErrno(EFAULT);
5031          return -1;          return -1;
5032      }      }
5033    
5034      /*      /*
5035       * If we are seeking relative to the current position, compute the       * If we are seeking relative to the current position, compute the
5036       * corrected offset taking into account the amount of unread input.       * corrected offset taking into account the amount of unread input.
5037       */       */
5038    
5039      if (mode == SEEK_CUR) {      if (mode == SEEK_CUR) {
5040          offset -= inputBuffered;          offset -= inputBuffered;
5041      }      }
5042    
5043      /*      /*
5044       * Discard any queued input - this input should not be read after       * Discard any queued input - this input should not be read after
5045       * the seek.       * the seek.
5046       */       */
5047    
5048      DiscardInputQueued(chanPtr, 0);      DiscardInputQueued(chanPtr, 0);
5049    
5050      /*      /*
5051       * Reset EOF and BLOCKED flags. We invalidate them by moving the       * Reset EOF and BLOCKED flags. We invalidate them by moving the
5052       * access point. Also clear CR related flags.       * access point. Also clear CR related flags.
5053       */       */
5054    
5055      chanPtr->flags &=      chanPtr->flags &=
5056          (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));          (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
5057            
5058      /*      /*
5059       * If the channel is in asynchronous output mode, switch it back       * If the channel is in asynchronous output mode, switch it back
5060       * to synchronous mode and cancel any async flush that may be       * to synchronous mode and cancel any async flush that may be
5061       * scheduled. After the flush, the channel will be put back into       * scheduled. After the flush, the channel will be put back into
5062       * asynchronous output mode.       * asynchronous output mode.
5063       */       */
5064    
5065      wasAsync = 0;      wasAsync = 0;
5066      if (chanPtr->flags & CHANNEL_NONBLOCKING) {      if (chanPtr->flags & CHANNEL_NONBLOCKING) {
5067          wasAsync = 1;          wasAsync = 1;
5068          result = 0;          result = 0;
5069          if (chanPtr->typePtr->blockModeProc != NULL) {          if (chanPtr->typePtr->blockModeProc != NULL) {
5070              result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,              result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
5071                      TCL_MODE_BLOCKING);                      TCL_MODE_BLOCKING);
5072          }          }
5073          if (result != 0) {          if (result != 0) {
5074              Tcl_SetErrno(result);              Tcl_SetErrno(result);
5075              return -1;              return -1;
5076          }          }
5077          chanPtr->flags &= (~(CHANNEL_NONBLOCKING));          chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
5078          if (chanPtr->flags & BG_FLUSH_SCHEDULED) {          if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
5079              chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));              chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
5080          }          }
5081      }      }
5082            
5083      /*      /*
5084       * If the flush fails we cannot recover the original position. In       * 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       * that case the seek is not attempted because we do not know where
5086       * the access position is - instead we return the error. FlushChannel       * the access position is - instead we return the error. FlushChannel
5087       * has already called Tcl_SetErrno() to report the error upwards.       * has already called Tcl_SetErrno() to report the error upwards.
5088       * If the flush succeeds we do the seek also.       * If the flush succeeds we do the seek also.
5089       */       */
5090            
5091      if (FlushChannel(NULL, chanPtr, 0) != 0) {      if (FlushChannel(NULL, chanPtr, 0) != 0) {
5092          curPos = -1;          curPos = -1;
5093      } else {      } else {
5094    
5095          /*          /*
5096           * Now seek to the new position in the channel as requested by the           * Now seek to the new position in the channel as requested by the
5097           * caller.           * caller.
5098           */           */
5099    
5100          curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,          curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
5101                  (long) offset, mode, &result);                  (long) offset, mode, &result);
5102          if (curPos == -1) {          if (curPos == -1) {
5103              Tcl_SetErrno(result);              Tcl_SetErrno(result);
5104          }          }
5105      }      }
5106            
5107      /*      /*
5108       * Restore to nonblocking mode if that was the previous behavior.       * 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       * 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.       * it now because we already flushed all the queued output, above.
5112       */       */
5113            
5114      if (wasAsync) {      if (wasAsync) {
5115          chanPtr->flags |= CHANNEL_NONBLOCKING;          chanPtr->flags |= CHANNEL_NONBLOCKING;
5116          result = 0;          result = 0;
5117          if (chanPtr->typePtr->blockModeProc != NULL) {          if (chanPtr->typePtr->blockModeProc != NULL) {
5118              result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,              result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
5119                      TCL_MODE_NONBLOCKING);                      TCL_MODE_NONBLOCKING);
5120          }          }
5121          if (result != 0) {          if (result != 0) {
5122              Tcl_SetErrno(result);              Tcl_SetErrno(result);
5123              return -1;              return -1;
5124          }          }
5125      }      }
5126    
5127      return curPos;      return curPos;
5128  }  }
5129    
5130  /*  /*
5131   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5132   *   *
5133   * Tcl_Tell --   * Tcl_Tell --
5134   *   *
5135   *      Returns the position of the next character to be read/written on   *      Returns the position of the next character to be read/written on
5136   *      this channel.   *      this channel.
5137   *   *
5138   * Results:   * Results:
5139   *      A nonnegative integer on success, -1 on failure. If failed,   *      A nonnegative integer on success, -1 on failure. If failed,
5140   *      use Tcl_GetErrno() to retrieve the POSIX error code for the   *      use Tcl_GetErrno() to retrieve the POSIX error code for the
5141   *      error that occurred.   *      error that occurred.
5142   *   *
5143   * Side effects:   * Side effects:
5144   *      None.   *      None.
5145   *   *
5146   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5147   */   */
5148    
5149  int  int
5150  Tcl_Tell(chan)  Tcl_Tell(chan)
5151      Tcl_Channel chan;                   /* The channel to return pos for. */      Tcl_Channel chan;                   /* The channel to return pos for. */
5152  {  {
5153      Channel *chanPtr;                   /* The actual channel to tell on. */      Channel *chanPtr;                   /* The actual channel to tell on. */
5154      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
5155      int inputBuffered, outputBuffered;      int inputBuffered, outputBuffered;
5156      int result;                         /* Of calling device driver. */      int result;                         /* Of calling device driver. */
5157      int curPos;                         /* Position on device. */      int curPos;                         /* Position on device. */
5158    
5159      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
5160      if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {      if (CheckChannelErrors(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
5161          return -1;          return -1;
5162      }      }
5163    
5164      /*      /*
5165       * Disallow tell on dead channels -- channels that have been closed but       * Disallow tell on dead channels -- channels that have been closed but
5166       * not yet been deallocated. Such channels can be found if the exit       * not yet been deallocated. Such channels can be found if the exit
5167       * handler for channel cleanup has run but the channel is still       * handler for channel cleanup has run but the channel is still
5168       * registered in an interpreter.       * registered in an interpreter.
5169       */       */
5170    
5171      if (CheckForDeadChannel(NULL,chanPtr)) {      if (CheckForDeadChannel(NULL,chanPtr)) {
5172          return -1;          return -1;
5173      }      }
5174    
5175      /*      /*
5176       * Disallow tell on channels whose type does not have a seek procedure       * Disallow tell on channels whose type does not have a seek procedure
5177       * defined. This means that the channel does not support seeking.       * defined. This means that the channel does not support seeking.
5178       */       */
5179    
5180      if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {      if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
5181          Tcl_SetErrno(EINVAL);          Tcl_SetErrno(EINVAL);
5182          return -1;          return -1;
5183      }      }
5184    
5185      /*      /*
5186       * Compute how much input and output is buffered. If both input and       * Compute how much input and output is buffered. If both input and
5187       * output is buffered, cannot compute the current position.       * output is buffered, cannot compute the current position.
5188       */       */
5189    
5190      for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;      for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
5191               bufPtr != (ChannelBuffer *) NULL;               bufPtr != (ChannelBuffer *) NULL;
5192               bufPtr = bufPtr->nextPtr) {               bufPtr = bufPtr->nextPtr) {
5193          inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);          inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5194      }      }
5195      for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;      for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
5196               bufPtr != (ChannelBuffer *) NULL;               bufPtr != (ChannelBuffer *) NULL;
5197               bufPtr = bufPtr->nextPtr) {               bufPtr = bufPtr->nextPtr) {
5198          outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);          outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5199      }      }
5200      if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&      if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
5201             (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {             (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
5202          chanPtr->flags |= BUFFER_READY;          chanPtr->flags |= BUFFER_READY;
5203          outputBuffered +=          outputBuffered +=
5204              (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);              (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
5205      }      }
5206    
5207      if ((inputBuffered != 0) && (outputBuffered != 0)) {      if ((inputBuffered != 0) && (outputBuffered != 0)) {
5208          Tcl_SetErrno(EFAULT);          Tcl_SetErrno(EFAULT);
5209          return -1;          return -1;
5210      }      }
5211    
5212      /*      /*
5213       * Get the current position in the device and compute the position       * Get the current position in the device and compute the position
5214       * where the next character will be read or written.       * where the next character will be read or written.
5215       */       */
5216    
5217      curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,      curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
5218              (long) 0, SEEK_CUR, &result);              (long) 0, SEEK_CUR, &result);
5219      if (curPos == -1) {      if (curPos == -1) {
5220          Tcl_SetErrno(result);          Tcl_SetErrno(result);
5221          return -1;          return -1;
5222      }      }
5223      if (inputBuffered != 0) {      if (inputBuffered != 0) {
5224          return (curPos - inputBuffered);          return (curPos - inputBuffered);
5225      }      }
5226      return (curPos + outputBuffered);      return (curPos + outputBuffered);
5227  }  }
5228    
5229  /*  /*
5230   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
5231   *   *
5232   * CheckChannelErrors --   * CheckChannelErrors --
5233   *   *
5234   *      See if the channel is in an ready state and can perform the   *      See if the channel is in an ready state and can perform the
5235   *      desired operation.   *      desired operation.
5236   *   *
5237   * Results:   * Results:
5238   *      The return value is 0 if the channel is OK, otherwise the   *      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.   *      return value is -1 and errno is set to indicate the error.
5240   *   *
5241   * Side effects:   * Side effects:
5242   *      May clear the EOF and/or BLOCKED bits if reading from channel.   *      May clear the EOF and/or BLOCKED bits if reading from channel.
5243   *   *
5244   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
5245   */   */
5246    
5247  static int  static int
5248  CheckChannelErrors(chanPtr, direction)  CheckChannelErrors(chanPtr, direction)
5249      Channel *chanPtr;       /* Channel to check. */      Channel *chanPtr;       /* Channel to check. */
5250      int direction;          /* Test if channel supports desired operation:      int direction;          /* Test if channel supports desired operation:
5251                               * TCL_READABLE, TCL_WRITABLE. */                               * TCL_READABLE, TCL_WRITABLE. */
5252  {  {
5253      /*      /*
5254       * Check for unreported error.       * Check for unreported error.
5255       */       */
5256    
5257      if (chanPtr->unreportedError != 0) {      if (chanPtr->unreportedError != 0) {
5258          Tcl_SetErrno(chanPtr->unreportedError);          Tcl_SetErrno(chanPtr->unreportedError);
5259          chanPtr->unreportedError = 0;          chanPtr->unreportedError = 0;
5260          return -1;          return -1;
5261      }      }
5262    
5263      /*      /*
5264       * Fail if the channel is not opened for desired operation.       * Fail if the channel is not opened for desired operation.
5265       */       */
5266    
5267      if ((chanPtr->flags & direction) == 0) {      if ((chanPtr->flags & direction) == 0) {
5268          Tcl_SetErrno(EACCES);          Tcl_SetErrno(EACCES);
5269          return -1;          return -1;
5270      }      }
5271    
5272      /*      /*
5273       * Fail if the channel is in the middle of a background copy.       * Fail if the channel is in the middle of a background copy.
5274       */       */
5275    
5276      if (chanPtr->csPtr != NULL) {      if (chanPtr->csPtr != NULL) {
5277          Tcl_SetErrno(EBUSY);          Tcl_SetErrno(EBUSY);
5278          return -1;          return -1;
5279      }      }
5280    
5281      if (direction == TCL_READABLE) {      if (direction == TCL_READABLE) {
5282          /*          /*
5283           * If we have not encountered a sticky EOF, clear the EOF bit           * 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           * (sticky EOF is set if we have seen the input eofChar, to prevent
5285           * reading beyond the eofChar). Also, always clear the BLOCKED bit.           * reading beyond the eofChar). Also, always clear the BLOCKED bit.
5286           * We want to discover these conditions anew in each operation.           * We want to discover these conditions anew in each operation.
5287           */           */
5288                    
5289          if ((chanPtr->flags & CHANNEL_STICKY_EOF) == 0) {          if ((chanPtr->flags & CHANNEL_STICKY_EOF) == 0) {
5290              chanPtr->flags &= ~CHANNEL_EOF;              chanPtr->flags &= ~CHANNEL_EOF;
5291          }          }
5292          chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);          chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
5293      }      }
5294    
5295      return 0;      return 0;
5296  }  }
5297    
5298  /*  /*
5299   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5300   *   *
5301   * Tcl_Eof --   * Tcl_Eof --
5302   *   *
5303   *      Returns 1 if the channel is at EOF, 0 otherwise.   *      Returns 1 if the channel is at EOF, 0 otherwise.
5304   *   *
5305   * Results:   * Results:
5306   *      1 or 0, always.   *      1 or 0, always.
5307   *   *
5308   * Side effects:   * Side effects:
5309   *      None.   *      None.
5310   *   *
5311   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5312   */   */
5313    
5314  int  int
5315  Tcl_Eof(chan)  Tcl_Eof(chan)
5316      Tcl_Channel chan;                   /* Does this channel have EOF? */      Tcl_Channel chan;                   /* Does this channel have EOF? */
5317  {  {
5318      Channel *chanPtr;           /* The real channel structure. */      Channel *chanPtr;           /* The real channel structure. */
5319    
5320      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
5321      return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||      return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
5322              ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))              ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
5323          ? 1 : 0;          ? 1 : 0;
5324  }  }
5325    
5326  /*  /*
5327   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5328   *   *
5329   * Tcl_InputBlocked --   * Tcl_InputBlocked --
5330   *   *
5331   *      Returns 1 if input is blocked on this channel, 0 otherwise.   *      Returns 1 if input is blocked on this channel, 0 otherwise.
5332   *   *
5333   * Results:   * Results:
5334   *      0 or 1, always.   *      0 or 1, always.
5335   *   *
5336   * Side effects:   * Side effects:
5337   *      None.   *      None.
5338   *   *
5339   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5340   */   */
5341    
5342  int  int
5343  Tcl_InputBlocked(chan)  Tcl_InputBlocked(chan)
5344      Tcl_Channel chan;                   /* Is this channel blocked? */      Tcl_Channel chan;                   /* Is this channel blocked? */
5345  {  {
5346      Channel *chanPtr;           /* The real channel structure. */      Channel *chanPtr;           /* The real channel structure. */
5347    
5348      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
5349      return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;      return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
5350  }  }
5351    
5352  /*  /*
5353   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5354   *   *
5355   * Tcl_InputBuffered --   * Tcl_InputBuffered --
5356   *   *
5357   *      Returns the number of bytes of input currently buffered in the   *      Returns the number of bytes of input currently buffered in the
5358   *      internal buffer of a channel.   *      internal buffer of a channel.
5359   *   *
5360   * Results:   * Results:
5361   *      The number of input bytes buffered, or zero if the channel is not   *      The number of input bytes buffered, or zero if the channel is not
5362   *      open for reading.   *      open for reading.
5363   *   *
5364   * Side effects:   * Side effects:
5365   *      None.   *      None.
5366   *   *
5367   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5368   */   */
5369    
5370  int  int
5371  Tcl_InputBuffered(chan)  Tcl_InputBuffered(chan)
5372      Tcl_Channel chan;                   /* The channel to query. */      Tcl_Channel chan;                   /* The channel to query. */
5373  {  {
5374      Channel *chanPtr;      Channel *chanPtr;
5375      int bytesBuffered;      int bytesBuffered;
5376      ChannelBuffer *bufPtr;      ChannelBuffer *bufPtr;
5377    
5378      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
5379      for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;      for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
5380               bufPtr != (ChannelBuffer *) NULL;               bufPtr != (ChannelBuffer *) NULL;
5381               bufPtr = bufPtr->nextPtr) {               bufPtr = bufPtr->nextPtr) {
5382          bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);          bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
5383      }      }
5384      return bytesBuffered;      return bytesBuffered;
5385  }  }
5386    
5387  /*  /*
5388   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5389   *   *
5390   * Tcl_SetChannelBufferSize --   * Tcl_SetChannelBufferSize --
5391   *   *
5392   *      Sets the size of buffers to allocate to store input or output   *      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.   *      in the channel. The size must be between 10 bytes and 1 MByte.
5394   *   *
5395   * Results:   * Results:
5396   *      None.   *      None.
5397   *   *
5398   * Side effects:   * Side effects:
5399   *      Sets the size of buffers subsequently allocated for this channel.   *      Sets the size of buffers subsequently allocated for this channel.
5400   *   *
5401   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5402   */   */
5403    
5404  void  void
5405  Tcl_SetChannelBufferSize(chan, sz)  Tcl_SetChannelBufferSize(chan, sz)
5406      Tcl_Channel chan;                   /* The channel whose buffer size      Tcl_Channel chan;                   /* The channel whose buffer size
5407                                           * to set. */                                           * to set. */
5408      int sz;                             /* The size to set. */      int sz;                             /* The size to set. */
5409  {  {
5410      Channel *chanPtr;      Channel *chanPtr;
5411            
5412      /*      /*
5413       * If the buffer size is smaller than 10 bytes or larger than one MByte,       * 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.       * do not accept the requested size and leave the current buffer size.
5415       */       */
5416            
5417      if (sz < 10) {      if (sz < 10) {
5418          return;          return;
5419      }      }
5420      if (sz > (1024 * 1024)) {      if (sz > (1024 * 1024)) {
5421          return;          return;
5422      }      }
5423    
5424      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
5425      chanPtr->bufSize = sz;      chanPtr->bufSize = sz;
5426    
5427      if (chanPtr->outputStage != NULL) {      if (chanPtr->outputStage != NULL) {
5428          ckfree((char *) chanPtr->outputStage);          ckfree((char *) chanPtr->outputStage);
5429          chanPtr->outputStage = NULL;          chanPtr->outputStage = NULL;
5430      }      }
5431      if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {      if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
5432          chanPtr->outputStage = (char *)          chanPtr->outputStage = (char *)
5433                  ckalloc((unsigned) (chanPtr->bufSize + 2));                  ckalloc((unsigned) (chanPtr->bufSize + 2));
5434      }      }
5435  }  }
5436    
5437  /*  /*
5438   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5439   *   *
5440   * Tcl_GetChannelBufferSize --   * Tcl_GetChannelBufferSize --
5441   *   *
5442   *      Retrieves the size of buffers to allocate for this channel.   *      Retrieves the size of buffers to allocate for this channel.
5443   *   *
5444   * Results:   * Results:
5445   *      The size.   *      The size.
5446   *   *
5447   * Side effects:   * Side effects:
5448   *      None.   *      None.
5449   *   *
5450   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5451   */   */
5452    
5453  int  int
5454  Tcl_GetChannelBufferSize(chan)  Tcl_GetChannelBufferSize(chan)
5455      Tcl_Channel chan;           /* The channel for which to find the      Tcl_Channel chan;           /* The channel for which to find the
5456                                   * buffer size. */                                   * buffer size. */
5457  {  {
5458      Channel *chanPtr;      Channel *chanPtr;
5459    
5460      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
5461      return chanPtr->bufSize;      return chanPtr->bufSize;
5462  }  }
5463    
5464  /*  /*
5465   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5466   *   *
5467   * Tcl_BadChannelOption --   * Tcl_BadChannelOption --
5468   *   *
5469   *      This procedure generates a "bad option" error message in an   *      This procedure generates a "bad option" error message in an
5470   *      (optional) interpreter.  It is used by channel drivers when   *      (optional) interpreter.  It is used by channel drivers when
5471   *      a invalid Set/Get option is requested. Its purpose is to concatenate   *      a invalid Set/Get option is requested. Its purpose is to concatenate
5472   *      the generic options list to the specific ones and factorize   *      the generic options list to the specific ones and factorize
5473   *      the generic options error message string.   *      the generic options error message string.
5474   *   *
5475   * Results:   * Results:
5476   *      TCL_ERROR.   *      TCL_ERROR.
5477   *   *
5478   * Side effects:   * Side effects:
5479   *      An error message is generated in interp's result object to   *      An error message is generated in interp's result object to
5480   *      indicate that a command was invoked with the a bad option   *      indicate that a command was invoked with the a bad option
5481   *      The message has the form   *      The message has the form
5482   *              bad option "blah": should be one of   *              bad option "blah": should be one of
5483   *              <...generic options...>+<...specific options...>   *              <...generic options...>+<...specific options...>
5484   *      "blah" is the optionName argument and "<specific options>"   *      "blah" is the optionName argument and "<specific options>"
5485   *      is a space separated list of specific option words.   *      is a space separated list of specific option words.
5486   *      The function takes good care of inserting minus signs before   *      The function takes good care of inserting minus signs before
5487   *      each option, commas after, and an "or" before the last option.   *      each option, commas after, and an "or" before the last option.
5488   *   *
5489   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5490   */   */
5491    
5492  int  int
5493  Tcl_BadChannelOption(interp, optionName, optionList)  Tcl_BadChannelOption(interp, optionName, optionList)
5494      Tcl_Interp *interp;                 /* Current interpreter. (can be NULL)*/      Tcl_Interp *interp;                 /* Current interpreter. (can be NULL)*/
5495      char *optionName;                   /* 'bad option' name */      char *optionName;                   /* 'bad option' name */
5496      char *optionList;                   /* Specific options list to append      char *optionList;                   /* Specific options list to append
5497                                           * to the standard generic options.                                           * to the standard generic options.
5498                                           * can be NULL for generic options                                           * can be NULL for generic options
5499                                           * only.                                           * only.
5500                                           */                                           */
5501  {  {
5502      if (interp) {      if (interp) {
5503          CONST char *genericopt =          CONST char *genericopt =
5504                  "blocking buffering buffersize encoding eofchar translation";                  "blocking buffering buffersize encoding eofchar translation";
5505          char **argv;          char **argv;
5506          int  argc, i;          int  argc, i;
5507          Tcl_DString ds;          Tcl_DString ds;
5508    
5509          Tcl_DStringInit(&ds);          Tcl_DStringInit(&ds);
5510          Tcl_DStringAppend(&ds, (char *) genericopt, -1);          Tcl_DStringAppend(&ds, (char *) genericopt, -1);
5511          if (optionList && (*optionList)) {          if (optionList && (*optionList)) {
5512              Tcl_DStringAppend(&ds, " ", 1);              Tcl_DStringAppend(&ds, " ", 1);
5513              Tcl_DStringAppend(&ds, optionList, -1);              Tcl_DStringAppend(&ds, optionList, -1);
5514          }          }
5515          if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),          if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
5516                    &argc, &argv) != TCL_OK) {                    &argc, &argv) != TCL_OK) {
5517              panic("malformed option list in channel driver");              panic("malformed option list in channel driver");
5518          }          }
5519          Tcl_ResetResult(interp);          Tcl_ResetResult(interp);
5520          Tcl_AppendResult(interp, "bad option \"", optionName,          Tcl_AppendResult(interp, "bad option \"", optionName,
5521                   "\": should be one of ", (char *) NULL);                   "\": should be one of ", (char *) NULL);
5522          argc--;          argc--;
5523          for (i = 0; i < argc; i++) {          for (i = 0; i < argc; i++) {
5524              Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);              Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
5525          }          }
5526          Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);          Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
5527          Tcl_DStringFree(&ds);          Tcl_DStringFree(&ds);
5528          ckfree((char *) argv);          ckfree((char *) argv);
5529      }      }
5530      Tcl_SetErrno(EINVAL);      Tcl_SetErrno(EINVAL);
5531      return TCL_ERROR;      return TCL_ERROR;
5532  }  }
5533    
5534  /*  /*
5535   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5536   *   *
5537   * Tcl_GetChannelOption --   * Tcl_GetChannelOption --
5538   *   *
5539   *      Gets a mode associated with an IO channel. If the optionName arg   *      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   *      is non NULL, retrieves the value of that option. If the optionName
5541   *      arg is NULL, retrieves a list of alternating option names and   *      arg is NULL, retrieves a list of alternating option names and
5542   *      values for the given channel.   *      values for the given channel.
5543   *   *
5544   * Results:   * Results:
5545   *      A standard Tcl result. Also sets the supplied DString to the   *      A standard Tcl result. Also sets the supplied DString to the
5546   *      string value of the option(s) returned.   *      string value of the option(s) returned.
5547   *   *
5548   * Side effects:   * Side effects:
5549   *      None.   *      None.
5550   *   *
5551   *----------------------------------------------------------------------   *----------------------------------------------------------------------
5552   */   */
5553    
5554  int  int
5555  Tcl_GetChannelOption(interp, chan, optionName, dsPtr)  Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
5556      Tcl_Interp *interp;         /* For error reporting - can be NULL. */      Tcl_Interp *interp;         /* For error reporting - can be NULL. */
5557      Tcl_Channel chan;           /* Channel on which to get option. */      Tcl_Channel chan;           /* Channel on which to get option. */
5558      char *optionName;           /* Option to get. */      char *optionName;           /* Option to get. */
5559      Tcl_DString *dsPtr;         /* Where to store value(s). */      Tcl_DString *dsPtr;         /* Where to store value(s). */
5560  {  {
5561      size_t len;                 /* Length of optionName string. */      size_t len;                 /* Length of optionName string. */
5562      char optionVal[128];        /* Buffer for sprintf. */      char optionVal[128];        /* Buffer for sprintf. */
5563      Channel *chanPtr = (Channel *) chan;      Channel *chanPtr = (Channel *) chan;
5564      int flags;      int flags;
5565    
5566      /*      /*
5567       * If we are in the middle of a background copy, use the saved flags.       * If we are in the middle of a background copy, use the saved flags.
5568       */       */
5569    
5570      if (chanPtr->csPtr) {      if (chanPtr->csPtr) {
5571          if (chanPtr == chanPtr->csPtr->readPtr) {          if (chanPtr == chanPtr->csPtr->readPtr) {
5572              flags = chanPtr->csPtr->readFlags;              flags = chanPtr->csPtr->readFlags;
5573          } else {          } else {
5574              flags = chanPtr->csPtr->writeFlags;              flags = chanPtr->csPtr->writeFlags;
5575          }          }
5576      } else {      } else {
5577          flags = chanPtr->flags;          flags = chanPtr->flags;
5578      }      }
5579    
5580      /*      /*
5581       * Disallow options on dead channels -- channels that have been closed but       * Disallow options on dead channels -- channels that have been closed but
5582       * not yet been deallocated. Such channels can be found if the exit       * not yet been deallocated. Such channels can be found if the exit
5583       * handler for channel cleanup has run but the channel is still       * handler for channel cleanup has run but the channel is still
5584       * registered in an interpreter.       * registered in an interpreter.
5585       */       */
5586    
5587      if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;      if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;
5588    
5589      /*      /*
5590       * If the optionName is NULL it means that we want a list of all       * If the optionName is NULL it means that we want a list of all
5591       * options and values.       * options and values.
5592       */       */
5593            
5594      if (optionName == (char *) NULL) {      if (optionName == (char *) NULL) {
5595          len = 0;          len = 0;
5596      } else {      } else {
5597          len = strlen(optionName);          len = strlen(optionName);
5598      }      }
5599            
5600      if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&      if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
5601              (strncmp(optionName, "-blocking", len) == 0))) {              (strncmp(optionName, "-blocking", len) == 0))) {
5602          if (len == 0) {          if (len == 0) {
5603              Tcl_DStringAppendElement(dsPtr, "-blocking");              Tcl_DStringAppendElement(dsPtr, "-blocking");
5604          }          }
5605          Tcl_DStringAppendElement(dsPtr,          Tcl_DStringAppendElement(dsPtr,
5606                  (flags & CHANNEL_NONBLOCKING) ? "0" : "1");                  (flags & CHANNEL_NONBLOCKING) ? "0" : "1");
5607          if (len > 0) {          if (len > 0) {
5608              return TCL_OK;              return TCL_OK;
5609          }          }
5610      }      }
5611      if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&      if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
5612              (strncmp(optionName, "-buffering", len) == 0))) {              (strncmp(optionName, "-buffering", len) == 0))) {
5613          if (len == 0) {          if (len == 0) {
5614              Tcl_DStringAppendElement(dsPtr, "-buffering");              Tcl_DStringAppendElement(dsPtr, "-buffering");
5615          }          }
5616          if (flags & CHANNEL_LINEBUFFERED) {          if (flags & CHANNEL_LINEBUFFERED) {
5617              Tcl_DStringAppendElement(dsPtr, "line");              Tcl_DStringAppendElement(dsPtr, "line");
5618          } else if (flags & CHANNEL_UNBUFFERED) {          } else if (flags & CHANNEL_UNBUFFERED) {
5619              Tcl_DStringAppendElement(dsPtr, "none");              Tcl_DStringAppendElement(dsPtr, "none");
5620          } else {          } else {
5621              Tcl_DStringAppendElement(dsPtr, "full");              Tcl_DStringAppendElement(dsPtr, "full");
5622          }          }
5623          if (len > 0) {          if (len > 0) {
5624              return TCL_OK;              return TCL_OK;
5625          }          }
5626      }      }
5627      if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&      if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
5628              (strncmp(optionName, "-buffersize", len) == 0))) {              (strncmp(optionName, "-buffersize", len) == 0))) {
5629          if (len == 0) {          if (len == 0) {
5630              Tcl_DStringAppendElement(dsPtr, "-buffersize");              Tcl_DStringAppendElement(dsPtr, "-buffersize");
5631          }          }
5632          TclFormatInt(optionVal, chanPtr->bufSize);          TclFormatInt(optionVal, chanPtr->bufSize);
5633          Tcl_DStringAppendElement(dsPtr, optionVal);          Tcl_DStringAppendElement(dsPtr, optionVal);
5634          if (len > 0) {          if (len > 0) {
5635              return TCL_OK;              return TCL_OK;
5636          }          }
5637      }      }
5638      if ((len == 0) ||      if ((len == 0) ||
5639              ((len > 2) && (optionName[1] == 'e') &&              ((len > 2) && (optionName[1] == 'e') &&
5640                      (strncmp(optionName, "-encoding", len) == 0))) {                      (strncmp(optionName, "-encoding", len) == 0))) {
5641          if (len == 0) {          if (len == 0) {
5642              Tcl_DStringAppendElement(dsPtr, "-encoding");              Tcl_DStringAppendElement(dsPtr, "-encoding");
5643          }          }
5644          if (chanPtr->encoding == NULL) {          if (chanPtr->encoding == NULL) {
5645              Tcl_DStringAppendElement(dsPtr, "binary");              Tcl_DStringAppendElement(dsPtr, "binary");
5646          } else {          } else {
5647              Tcl_DStringAppendElement(dsPtr,              Tcl_DStringAppendElement(dsPtr,
5648                      Tcl_GetEncodingName(chanPtr->encoding));                      Tcl_GetEncodingName(chanPtr->encoding));
5649          }          }
5650          if (len > 0) {          if (len > 0) {
5651              return TCL_OK;              return TCL_OK;
5652          }          }
5653      }      }
5654      if ((len == 0) ||      if ((len == 0) ||
5655              ((len > 2) && (optionName[1] == 'e') &&              ((len > 2) && (optionName[1] == 'e') &&
5656                      (strncmp(optionName, "-eofchar", len) == 0))) {                      (strncmp(optionName, "-eofchar", len) == 0))) {
5657          if (len == 0) {          if (len == 0) {
5658              Tcl_DStringAppendElement(dsPtr, "-eofchar");              Tcl_DStringAppendElement(dsPtr, "-eofchar");
5659          }          }
5660          if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==          if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5661                  (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {                  (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5662              Tcl_DStringStartSublist(dsPtr);              Tcl_DStringStartSublist(dsPtr);
5663          }          }
5664          if (flags & TCL_READABLE) {          if (flags & TCL_READABLE) {
5665              if (chanPtr->inEofChar == 0) {              if (chanPtr->inEofChar == 0) {
5666                  Tcl_DStringAppendElement(dsPtr, "");                  Tcl_DStringAppendElement(dsPtr, "");
5667              } else {              } else {
5668                  char buf[4];                  char buf[4];
5669    
5670                  sprintf(buf, "%c", chanPtr->inEofChar);                  sprintf(buf, "%c", chanPtr->inEofChar);
5671                  Tcl_DStringAppendElement(dsPtr, buf);                  Tcl_DStringAppendElement(dsPtr, buf);
5672              }              }
5673          }          }
5674          if (flags & TCL_WRITABLE) {          if (flags & TCL_WRITABLE) {
5675              if (chanPtr->outEofChar == 0) {              if (chanPtr->outEofChar == 0) {
5676                  Tcl_DStringAppendElement(dsPtr, "");                  Tcl_DStringAppendElement(dsPtr, "");
5677              } else {              } else {
5678                  char buf[4];                  char buf[4];
5679    
5680                  sprintf(buf, "%c", chanPtr->outEofChar);                  sprintf(buf, "%c", chanPtr->outEofChar);
5681                  Tcl_DStringAppendElement(dsPtr, buf);                  Tcl_DStringAppendElement(dsPtr, buf);
5682              }              }
5683          }          }
5684          if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==          if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5685                  (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {                  (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5686              Tcl_DStringEndSublist(dsPtr);              Tcl_DStringEndSublist(dsPtr);
5687          }          }
5688          if (len > 0) {          if (len > 0) {
5689              return TCL_OK;              return TCL_OK;
5690          }          }
5691      }      }
5692      if ((len == 0) ||      if ((len == 0) ||
5693              ((len > 1) && (optionName[1] == 't') &&              ((len > 1) && (optionName[1] == 't') &&
5694                      (strncmp(optionName, "-translation", len) == 0))) {                      (strncmp(optionName, "-translation", len) == 0))) {
5695          if (len == 0) {          if (len == 0) {
5696              Tcl_DStringAppendElement(dsPtr, "-translation");              Tcl_DStringAppendElement(dsPtr, "-translation");
5697          }          }
5698          if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==          if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5699                  (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {                  (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5700              Tcl_DStringStartSublist(dsPtr);              Tcl_DStringStartSublist(dsPtr);
5701          }          }
5702          if (flags & TCL_READABLE) {          if (flags & TCL_READABLE) {
5703              if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {              if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
5704                  Tcl_DStringAppendElement(dsPtr, "auto");                  Tcl_DStringAppendElement(dsPtr, "auto");
5705              } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {              } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
5706                  Tcl_DStringAppendElement(dsPtr, "cr");                  Tcl_DStringAppendElement(dsPtr, "cr");
5707              } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {              } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
5708                  Tcl_DStringAppendElement(dsPtr, "crlf");                  Tcl_DStringAppendElement(dsPtr, "crlf");
5709              } else {              } else {
5710                  Tcl_DStringAppendElement(dsPtr, "lf");                  Tcl_DStringAppendElement(dsPtr, "lf");
5711              }              }
5712          }          }
5713          if (flags & TCL_WRITABLE) {          if (flags & TCL_WRITABLE) {
5714              if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {              if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
5715                  Tcl_DStringAppendElement(dsPtr, "auto");                  Tcl_DStringAppendElement(dsPtr, "auto");
5716              } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {              } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
5717                  Tcl_DStringAppendElement(dsPtr, "cr");                  Tcl_DStringAppendElement(dsPtr, "cr");
5718              } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {              } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
5719                  Tcl_DStringAppendElement(dsPtr, "crlf");                  Tcl_DStringAppendElement(dsPtr, "crlf");
5720              } else {              } else {
5721                  Tcl_DStringAppendElement(dsPtr, "lf");                  Tcl_DStringAppendElement(dsPtr, "lf");
5722              }              }
5723          }          }
5724          if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==          if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
5725                  (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {                  (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
5726              Tcl_DStringEndSublist(dsPtr);              Tcl_DStringEndSublist(dsPtr);
5727          }          }
5728          if (len > 0) {          if (len > 0) {
5729              return TCL_OK;              return TCL_OK;
5730          }          }
5731      }      }
5732      if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {      if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
5733          /*          /*
5734           * let the driver specific handle additional options           * let the driver specific handle additional options
5735           * and result code and message.           * and result code and message.
5736           */           */
5737    
5738          return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,          return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
5739                    interp, optionName, dsPtr);                    interp, optionName, dsPtr);
5740      } else {      } else {
5741          /*          /*
5742           * no driver specific options case.           * no driver specific options case.
5743           */           */
5744    
5745          if (len == 0) {          if (len == 0) {
5746              return TCL_OK;              return TCL_OK;
5747          }          }
5748          return Tcl_BadChannelOption(interp, optionName, NULL);          return Tcl_BadChannelOption(interp, optionName, NULL);
5749      }      }
5750  }  }
5751    
5752  /*  /*
5753   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
5754   *   *
5755   * Tcl_SetChannelOption --   * Tcl_SetChannelOption --
5756   *   *
5757   *      Sets an option on a channel.   *      Sets an option on a channel.
5758   *   *
5759   * Results:   * Results:
5760   *      A standard Tcl result.  On error, sets interp's result object   *      A standard Tcl result.  On error, sets interp's result object
5761   *      if interp is not NULL.   *      if interp is not NULL.
5762   *   *
5763   * Side effects:   * Side effects:
5764   *      May modify an option on a device.   *      May modify an option on a device.
5765   *   *
5766   *---------------------------------------------------------------------------   *---------------------------------------------------------------------------
5767   */   */
5768    
5769  int  int
5770  Tcl_SetChannelOption(interp, chan, optionName, newValue)  Tcl_SetChannelOption(interp, chan, optionName, newValue)
5771      Tcl_Interp *interp;         /* For error reporting - can be NULL. */      Tcl_Interp *interp;         /* For error reporting - can be NULL. */
5772      Tcl_Channel chan;           /* Channel on which to set mode. */      Tcl_Channel chan;           /* Channel on which to set mode. */
5773      char *optionName;           /* Which option to set? */      char *optionName;           /* Which option to set? */
5774      char *newValue;             /* New value for option. */      char *newValue;             /* New value for option. */
5775  {  {
5776      int newMode;                /* New (numeric) mode to sert. */      int newMode;                /* New (numeric) mode to sert. */
5777      Channel *chanPtr;           /* The real IO channel. */      Channel *chanPtr;           /* The real IO channel. */
5778      size_t len;                 /* Length of optionName string. */      size_t len;                 /* Length of optionName string. */
5779      int argc;      int argc;
5780      char **argv;      char **argv;
5781            
5782      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
5783    
5784      /*      /*
5785       * If the channel is in the middle of a background copy, fail.       * If the channel is in the middle of a background copy, fail.
5786       */       */
5787    
5788      if (chanPtr->csPtr) {      if (chanPtr->csPtr) {
5789          if (interp) {          if (interp) {
5790              Tcl_AppendResult(interp,              Tcl_AppendResult(interp,
5791                   "unable to set channel options: background copy in progress",                   "unable to set channel options: background copy in progress",
5792                   (char *) NULL);                   (char *) NULL);
5793          }          }
5794          return TCL_ERROR;          return TCL_ERROR;
5795      }      }
5796    
5797    
5798      /*      /*
5799       * Disallow options on dead channels -- channels that have been closed but       * Disallow options on dead channels -- channels that have been closed but
5800       * not yet been deallocated. Such channels can be found if the exit       * not yet been deallocated. Such channels can be found if the exit
5801       * handler for channel cleanup has run but the channel is still       * handler for channel cleanup has run but the channel is still
5802       * registered in an interpreter.       * registered in an interpreter.
5803       */       */
5804    
5805      if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;      if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;
5806            
5807      len = strlen(optionName);      len = strlen(optionName);
5808    
5809      if ((len > 2) && (optionName[1] == 'b') &&      if ((len > 2) && (optionName[1] == 'b') &&
5810              (strncmp(optionName, "-blocking", len) == 0)) {              (strncmp(optionName, "-blocking", len) == 0)) {
5811          if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {          if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
5812              return TCL_ERROR;              return TCL_ERROR;
5813          }          }
5814          if (newMode) {          if (newMode) {
5815              newMode = TCL_MODE_BLOCKING;              newMode = TCL_MODE_BLOCKING;
5816          } else {          } else {
5817              newMode = TCL_MODE_NONBLOCKING;              newMode = TCL_MODE_NONBLOCKING;
5818          }          }
5819          return SetBlockMode(interp, chanPtr, newMode);          return SetBlockMode(interp, chanPtr, newMode);
5820      } else if ((len > 7) && (optionName[1] == 'b') &&      } else if ((len > 7) && (optionName[1] == 'b') &&
5821              (strncmp(optionName, "-buffering", len) == 0)) {              (strncmp(optionName, "-buffering", len) == 0)) {
5822          len = strlen(newValue);          len = strlen(newValue);
5823          if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {          if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
5824              chanPtr->flags &=              chanPtr->flags &=
5825                  (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));                  (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
5826          } else if ((newValue[0] == 'l') &&          } else if ((newValue[0] == 'l') &&
5827                  (strncmp(newValue, "line", len) == 0)) {                  (strncmp(newValue, "line", len) == 0)) {
5828              chanPtr->flags &= (~(CHANNEL_UNBUFFERED));              chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
5829              chanPtr->flags |= CHANNEL_LINEBUFFERED;              chanPtr->flags |= CHANNEL_LINEBUFFERED;
5830          } else if ((newValue[0] == 'n') &&          } else if ((newValue[0] == 'n') &&
5831                  (strncmp(newValue, "none", len) == 0)) {                  (strncmp(newValue, "none", len) == 0)) {
5832              chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));              chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
5833              chanPtr->flags |= CHANNEL_UNBUFFERED;              chanPtr->flags |= CHANNEL_UNBUFFERED;
5834          } else {          } else {
5835              if (interp) {              if (interp) {
5836                  Tcl_AppendResult(interp, "bad value for -buffering: ",                  Tcl_AppendResult(interp, "bad value for -buffering: ",
5837                          "must be one of full, line, or none",                          "must be one of full, line, or none",
5838                          (char *) NULL);                          (char *) NULL);
5839                  return TCL_ERROR;                  return TCL_ERROR;
5840              }              }
5841          }          }
5842          return TCL_OK;          return TCL_OK;
5843      } else if ((len > 7) && (optionName[1] == 'b') &&      } else if ((len > 7) && (optionName[1] == 'b') &&
5844              (strncmp(optionName, "-buffersize", len) == 0)) {              (strncmp(optionName, "-buffersize", len) == 0)) {
5845          chanPtr->bufSize = atoi(newValue);      /* INTL: "C", UTF safe. */          chanPtr->bufSize = atoi(newValue);      /* INTL: "C", UTF safe. */
5846          if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {          if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
5847              chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;              chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
5848          }          }
5849      } else if ((len > 2) && (optionName[1] == 'e') &&      } else if ((len > 2) && (optionName[1] == 'e') &&
5850              (strncmp(optionName, "-encoding", len) == 0)) {              (strncmp(optionName, "-encoding", len) == 0)) {
5851          Tcl_Encoding encoding;          Tcl_Encoding encoding;
5852    
5853          if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {          if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
5854              encoding = NULL;              encoding = NULL;
5855          } else {          } else {
5856              encoding = Tcl_GetEncoding(interp, newValue);              encoding = Tcl_GetEncoding(interp, newValue);
5857              if (encoding == NULL) {              if (encoding == NULL) {
5858                  return TCL_ERROR;                  return TCL_ERROR;
5859              }              }
5860          }          }
5861          Tcl_FreeEncoding(chanPtr->encoding);          Tcl_FreeEncoding(chanPtr->encoding);
5862          chanPtr->encoding = encoding;          chanPtr->encoding = encoding;
5863          chanPtr->inputEncodingState = NULL;          chanPtr->inputEncodingState = NULL;
5864          chanPtr->inputEncodingFlags = TCL_ENCODING_START;          chanPtr->inputEncodingFlags = TCL_ENCODING_START;
5865          chanPtr->outputEncodingState = NULL;          chanPtr->outputEncodingState = NULL;
5866          chanPtr->outputEncodingFlags = TCL_ENCODING_START;          chanPtr->outputEncodingFlags = TCL_ENCODING_START;
5867          chanPtr->flags &= ~CHANNEL_NEED_MORE_DATA;          chanPtr->flags &= ~CHANNEL_NEED_MORE_DATA;
5868          UpdateInterest(chanPtr);          UpdateInterest(chanPtr);
5869      } else if ((len > 2) && (optionName[1] == 'e') &&      } else if ((len > 2) && (optionName[1] == 'e') &&
5870              (strncmp(optionName, "-eofchar", len) == 0)) {              (strncmp(optionName, "-eofchar", len) == 0)) {
5871          if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {          if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
5872              return TCL_ERROR;              return TCL_ERROR;
5873          }          }
5874          if (argc == 0) {          if (argc == 0) {
5875              chanPtr->inEofChar = 0;              chanPtr->inEofChar = 0;
5876              chanPtr->outEofChar = 0;              chanPtr->outEofChar = 0;
5877          } else if (argc == 1) {          } else if (argc == 1) {
5878              if (chanPtr->flags & TCL_WRITABLE) {              if (chanPtr->flags & TCL_WRITABLE) {
5879                  chanPtr->outEofChar = (int) argv[0][0];                  chanPtr->outEofChar = (int) argv[0][0];
5880              }              }
5881              if (chanPtr->flags & TCL_READABLE) {              if (chanPtr->flags & TCL_READABLE) {
5882                  chanPtr->inEofChar = (int) argv[0][0];                  chanPtr->inEofChar = (int) argv[0][0];
5883              }              }
5884          } else if (argc != 2) {          } else if (argc != 2) {
5885              if (interp) {              if (interp) {
5886                  Tcl_AppendResult(interp,                  Tcl_AppendResult(interp,
5887                          "bad value for -eofchar: should be a list of one or",                          "bad value for -eofchar: should be a list of one or",
5888                          " two elements", (char *) NULL);                          " two elements", (char *) NULL);
5889              }              }
5890              ckfree((char *) argv);              ckfree((char *) argv);
5891              return TCL_ERROR;              return TCL_ERROR;
5892          } else {          } else {
5893              if (chanPtr->flags & TCL_READABLE) {              if (chanPtr->flags & TCL_READABLE) {
5894                  chanPtr->inEofChar = (int) argv[0][0];                  chanPtr->inEofChar = (int) argv[0][0];
5895              }              }
5896              if (chanPtr->flags & TCL_WRITABLE) {              if (chanPtr->flags & TCL_WRITABLE) {
5897                  chanPtr->outEofChar = (int) argv[1][0];                  chanPtr->outEofChar = (int) argv[1][0];
5898              }              }
5899          }          }
5900          if (argv != (char **) NULL) {          if (argv != (char **) NULL) {
5901              ckfree((char *) argv);              ckfree((char *) argv);
5902          }          }
5903          return TCL_OK;          return TCL_OK;
5904      } else if ((len > 1) && (optionName[1] == 't') &&      } else if ((len > 1) && (optionName[1] == 't') &&
5905              (strncmp(optionName, "-translation", len) == 0)) {              (strncmp(optionName, "-translation", len) == 0)) {
5906          char *readMode, *writeMode;          char *readMode, *writeMode;
5907    
5908          if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {          if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
5909              return TCL_ERROR;              return TCL_ERROR;
5910          }          }
5911    
5912          if (argc == 1) {          if (argc == 1) {
5913              readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;              readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
5914              writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;              writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
5915          } else if (argc == 2) {          } else if (argc == 2) {
5916              readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;              readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
5917              writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;              writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
5918          } else {          } else {
5919              if (interp) {              if (interp) {
5920                  Tcl_AppendResult(interp,                  Tcl_AppendResult(interp,
5921                          "bad value for -translation: must be a one or two",                          "bad value for -translation: must be a one or two",
5922                          " element list", (char *) NULL);                          " element list", (char *) NULL);
5923              }              }
5924              ckfree((char *) argv);              ckfree((char *) argv);
5925              return TCL_ERROR;              return TCL_ERROR;
5926          }          }
5927    
5928          if (readMode) {          if (readMode) {
5929              if (*readMode == '\0') {              if (*readMode == '\0') {
5930                  newMode = chanPtr->inputTranslation;                  newMode = chanPtr->inputTranslation;
5931              } else if (strcmp(readMode, "auto") == 0) {              } else if (strcmp(readMode, "auto") == 0) {
5932                  newMode = TCL_TRANSLATE_AUTO;                  newMode = TCL_TRANSLATE_AUTO;
5933              } else if (strcmp(readMode, "binary") == 0) {              } else if (strcmp(readMode, "binary") == 0) {
5934                  newMode = TCL_TRANSLATE_LF;                  newMode = TCL_TRANSLATE_LF;
5935                  chanPtr->inEofChar = 0;                  chanPtr->inEofChar = 0;
5936                  Tcl_FreeEncoding(chanPtr->encoding);                                  Tcl_FreeEncoding(chanPtr->encoding);                
5937                  chanPtr->encoding = NULL;                  chanPtr->encoding = NULL;
5938              } else if (strcmp(readMode, "lf") == 0) {              } else if (strcmp(readMode, "lf") == 0) {
5939                  newMode = TCL_TRANSLATE_LF;                  newMode = TCL_TRANSLATE_LF;
5940              } else if (strcmp(readMode, "cr") == 0) {              } else if (strcmp(readMode, "cr") == 0) {
5941                  newMode = TCL_TRANSLATE_CR;                  newMode = TCL_TRANSLATE_CR;
5942              } else if (strcmp(readMode, "crlf") == 0) {              } else if (strcmp(readMode, "crlf") == 0) {
5943                  newMode = TCL_TRANSLATE_CRLF;                  newMode = TCL_TRANSLATE_CRLF;
5944              } else if (strcmp(readMode, "platform") == 0) {              } else if (strcmp(readMode, "platform") == 0) {
5945                  newMode = TCL_PLATFORM_TRANSLATION;                  newMode = TCL_PLATFORM_TRANSLATION;
5946              } else {              } else {
5947                  if (interp) {                  if (interp) {
5948                      Tcl_AppendResult(interp,                      Tcl_AppendResult(interp,
5949                              "bad value for -translation: ",                              "bad value for -translation: ",
5950                              "must be one of auto, binary, cr, lf, crlf,",                              "must be one of auto, binary, cr, lf, crlf,",
5951                              " or platform", (char *) NULL);                              " or platform", (char *) NULL);
5952                  }                  }
5953                  ckfree((char *) argv);                  ckfree((char *) argv);
5954                  return TCL_ERROR;                  return TCL_ERROR;
5955              }              }
5956    
5957              /*              /*
5958               * Reset the EOL flags since we need to look at any buffered               * Reset the EOL flags since we need to look at any buffered
5959               * data to see if the new translation mode allows us to               * data to see if the new translation mode allows us to
5960               * complete the line.               * complete the line.
5961               */               */
5962    
5963              if (newMode != chanPtr->inputTranslation) {              if (newMode != chanPtr->inputTranslation) {
5964                  chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;                  chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;
5965                  chanPtr->flags &= ~(INPUT_SAW_CR);                  chanPtr->flags &= ~(INPUT_SAW_CR);
5966                  chanPtr->flags &= ~(CHANNEL_NEED_MORE_DATA);                  chanPtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
5967                  UpdateInterest(chanPtr);                  UpdateInterest(chanPtr);
5968              }              }
5969          }          }
5970          if (writeMode) {          if (writeMode) {
5971              if (*writeMode == '\0') {              if (*writeMode == '\0') {
5972                  /* Do nothing. */                  /* Do nothing. */
5973              } else if (strcmp(writeMode, "auto") == 0) {              } else if (strcmp(writeMode, "auto") == 0) {
5974                  /*                  /*
5975                   * This is a hack to get TCP sockets to produce output                   * This is a hack to get TCP sockets to produce output
5976                   * in CRLF mode if they are being set into AUTO mode.                   * in CRLF mode if they are being set into AUTO mode.
5977                   * A better solution for achieving this effect will be                   * A better solution for achieving this effect will be
5978                   * coded later.                   * coded later.
5979                   */                   */
5980    
5981                  if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {                  if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
5982                      chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;                      chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
5983                  } else {                  } else {
5984                      chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;                      chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
5985                  }                  }
5986              } else if (strcmp(writeMode, "binary") == 0) {              } else if (strcmp(writeMode, "binary") == 0) {
5987                  chanPtr->outEofChar = 0;                  chanPtr->outEofChar = 0;
5988                  chanPtr->outputTranslation = TCL_TRANSLATE_LF;                  chanPtr->outputTranslation = TCL_TRANSLATE_LF;
5989                  Tcl_FreeEncoding(chanPtr->encoding);                                  Tcl_FreeEncoding(chanPtr->encoding);                
5990                  chanPtr->encoding = NULL;                  chanPtr->encoding = NULL;
5991              } else if (strcmp(writeMode, "lf") == 0) {              } else if (strcmp(writeMode, "lf") == 0) {
5992                  chanPtr->outputTranslation = TCL_TRANSLATE_LF;                  chanPtr->outputTranslation = TCL_TRANSLATE_LF;
5993              } else if (strcmp(writeMode, "cr") == 0) {              } else if (strcmp(writeMode, "cr") == 0) {
5994                  chanPtr->outputTranslation = TCL_TRANSLATE_CR;                  chanPtr->outputTranslation = TCL_TRANSLATE_CR;
5995              } else if (strcmp(writeMode, "crlf") == 0) {              } else if (strcmp(writeMode, "crlf") == 0) {
5996                  chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;                  chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
5997              } else if (strcmp(writeMode, "platform") == 0) {              } else if (strcmp(writeMode, "platform") == 0) {
5998                  chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;                  chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
5999              } else {              } else {
6000                  if (interp) {                  if (interp) {
6001                      Tcl_AppendResult(interp,                      Tcl_AppendResult(interp,
6002                              "bad value for -translation: ",                              "bad value for -translation: ",
6003                              "must be one of auto, binary, cr, lf, crlf,",                              "must be one of auto, binary, cr, lf, crlf,",
6004                              " or platform", (char *) NULL);                              " or platform", (char *) NULL);
6005                  }                  }
6006                  ckfree((char *) argv);                  ckfree((char *) argv);
6007                  return TCL_ERROR;                  return TCL_ERROR;
6008              }              }
6009          }          }
6010          ckfree((char *) argv);                      ckfree((char *) argv);            
6011          return TCL_OK;          return TCL_OK;
6012      } else if (chanPtr->typePtr->setOptionProc != NULL) {      } else if (chanPtr->typePtr->setOptionProc != NULL) {
6013          return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,          return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
6014                  interp, optionName, newValue);                  interp, optionName, newValue);
6015      } else {      } else {
6016          return Tcl_BadChannelOption(interp, optionName, (char *) NULL);          return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
6017      }      }
6018    
6019      /*      /*
6020       * If bufsize changes, need to get rid of old utility buffer.       * If bufsize changes, need to get rid of old utility buffer.
6021       */       */
6022    
6023      if (chanPtr->saveInBufPtr != NULL) {      if (chanPtr->saveInBufPtr != NULL) {
6024          RecycleBuffer(chanPtr, chanPtr->saveInBufPtr, 1);          RecycleBuffer(chanPtr, chanPtr->saveInBufPtr, 1);
6025          chanPtr->saveInBufPtr = NULL;          chanPtr->saveInBufPtr = NULL;
6026      }      }
6027      if (chanPtr->inQueueHead != NULL) {      if (chanPtr->inQueueHead != NULL) {
6028          if ((chanPtr->inQueueHead->nextPtr == NULL)          if ((chanPtr->inQueueHead->nextPtr == NULL)
6029                  && (chanPtr->inQueueHead->nextAdded ==                  && (chanPtr->inQueueHead->nextAdded ==
6030                          chanPtr->inQueueHead->nextRemoved)) {                          chanPtr->inQueueHead->nextRemoved)) {
6031              RecycleBuffer(chanPtr, chanPtr->inQueueHead, 1);              RecycleBuffer(chanPtr, chanPtr->inQueueHead, 1);
6032              chanPtr->inQueueHead = NULL;              chanPtr->inQueueHead = NULL;
6033              chanPtr->inQueueTail = NULL;              chanPtr->inQueueTail = NULL;
6034          }          }
6035      }      }
6036    
6037      /*      /*
6038       * If encoding or bufsize changes, need to update output staging buffer.       * If encoding or bufsize changes, need to update output staging buffer.
6039       */       */
6040    
6041      if (chanPtr->outputStage != NULL) {      if (chanPtr->outputStage != NULL) {
6042          ckfree((char *) chanPtr->outputStage);          ckfree((char *) chanPtr->outputStage);
6043          chanPtr->outputStage = NULL;          chanPtr->outputStage = NULL;
6044      }      }
6045      if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {      if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
6046          chanPtr->outputStage = (char *)          chanPtr->outputStage = (char *)
6047                  ckalloc((unsigned) (chanPtr->bufSize + 2));                  ckalloc((unsigned) (chanPtr->bufSize + 2));
6048      }      }
6049      return TCL_OK;      return TCL_OK;
6050  }  }
6051    
6052  /*  /*
6053   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6054   *   *
6055   * CleanupChannelHandlers --   * CleanupChannelHandlers --
6056   *   *
6057   *      Removes channel handlers that refer to the supplied interpreter,   *      Removes channel handlers that refer to the supplied interpreter,
6058   *      so that if the actual channel is not closed now, these handlers   *      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   *      will not run on subsequent events on the channel. This would be
6060   *      erroneous, because the interpreter no longer has a reference to   *      erroneous, because the interpreter no longer has a reference to
6061   *      this channel.   *      this channel.
6062   *   *
6063   * Results:   * Results:
6064   *      None.   *      None.
6065   *   *
6066   * Side effects:   * Side effects:
6067   *      Removes channel handlers.   *      Removes channel handlers.
6068   *   *
6069   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6070   */   */
6071    
6072  static void  static void
6073  CleanupChannelHandlers(interp, chanPtr)  CleanupChannelHandlers(interp, chanPtr)
6074      Tcl_Interp *interp;      Tcl_Interp *interp;
6075      Channel *chanPtr;      Channel *chanPtr;
6076  {  {
6077      EventScriptRecord *sPtr, *prevPtr, *nextPtr;      EventScriptRecord *sPtr, *prevPtr, *nextPtr;
6078    
6079      /*      /*
6080       * Remove fileevent records on this channel that refer to the       * Remove fileevent records on this channel that refer to the
6081       * given interpreter.       * given interpreter.
6082       */       */
6083            
6084      for (sPtr = chanPtr->scriptRecordPtr,      for (sPtr = chanPtr->scriptRecordPtr,
6085               prevPtr = (EventScriptRecord *) NULL;               prevPtr = (EventScriptRecord *) NULL;
6086               sPtr != (EventScriptRecord *) NULL;               sPtr != (EventScriptRecord *) NULL;
6087               sPtr = nextPtr) {               sPtr = nextPtr) {
6088          nextPtr = sPtr->nextPtr;          nextPtr = sPtr->nextPtr;
6089          if (sPtr->interp == interp) {          if (sPtr->interp == interp) {
6090              if (prevPtr == (EventScriptRecord *) NULL) {              if (prevPtr == (EventScriptRecord *) NULL) {
6091                  chanPtr->scriptRecordPtr = nextPtr;                  chanPtr->scriptRecordPtr = nextPtr;
6092              } else {              } else {
6093                  prevPtr->nextPtr = nextPtr;                  prevPtr->nextPtr = nextPtr;
6094              }              }
6095    
6096              Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,              Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
6097                      ChannelEventScriptInvoker, (ClientData) sPtr);                      ChannelEventScriptInvoker, (ClientData) sPtr);
6098    
6099              Tcl_DecrRefCount(sPtr->scriptPtr);              Tcl_DecrRefCount(sPtr->scriptPtr);
6100              ckfree((char *) sPtr);              ckfree((char *) sPtr);
6101          } else {          } else {
6102              prevPtr = sPtr;              prevPtr = sPtr;
6103          }          }
6104      }      }
6105  }  }
6106    
6107  /*  /*
6108   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6109   *   *
6110   * Tcl_NotifyChannel --   * Tcl_NotifyChannel --
6111   *   *
6112   *      This procedure is called by a channel driver when a driver   *      This procedure is called by a channel driver when a driver
6113   *      detects an event on a channel.  This procedure is responsible   *      detects an event on a channel.  This procedure is responsible
6114   *      for actually handling the event by invoking any channel   *      for actually handling the event by invoking any channel
6115   *      handler callbacks.   *      handler callbacks.
6116   *   *
6117   * Results:   * Results:
6118   *      None.   *      None.
6119   *   *
6120   * Side effects:   * Side effects:
6121   *      Whatever the channel handler callback procedure does.   *      Whatever the channel handler callback procedure does.
6122   *   *
6123   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6124   */   */
6125    
6126  void  void
6127  Tcl_NotifyChannel(channel, mask)  Tcl_NotifyChannel(channel, mask)
6128      Tcl_Channel channel;        /* Channel that detected an event. */      Tcl_Channel channel;        /* Channel that detected an event. */
6129      int mask;                   /* OR'ed combination of TCL_READABLE,      int mask;                   /* OR'ed combination of TCL_READABLE,
6130                                   * TCL_WRITABLE, or TCL_EXCEPTION: indicates                                   * TCL_WRITABLE, or TCL_EXCEPTION: indicates
6131                                   * which events were detected. */                                   * which events were detected. */
6132  {  {
6133      Channel *chanPtr = (Channel *) channel;      Channel *chanPtr = (Channel *) channel;
6134      ChannelHandler *chPtr;      ChannelHandler *chPtr;
6135      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
6136      NextChannelHandler nh;      NextChannelHandler nh;
6137    
6138      /* Walk all channels in a stack ! and notify them in order.      /* Walk all channels in a stack ! and notify them in order.
6139       */       */
6140    
6141      while (chanPtr !=  (Channel *) NULL) {      while (chanPtr !=  (Channel *) NULL) {
6142          /*          /*
6143           * Preserve the channel struct in case the script closes it.           * Preserve the channel struct in case the script closes it.
6144           */           */
6145            
6146          Tcl_Preserve((ClientData) channel);          Tcl_Preserve((ClientData) channel);
6147    
6148          /*          /*
6149           * If we are flushing in the background, be sure to call FlushChannel           * If we are flushing in the background, be sure to call FlushChannel
6150           * for writable events.  Note that we have to discard the writable           * 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           * event so we don't call any write handlers before the flush is
6152           * complete.           * complete.
6153           */           */
6154    
6155          if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {          if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
6156              FlushChannel(NULL, chanPtr, 1);              FlushChannel(NULL, chanPtr, 1);
6157              mask &= ~TCL_WRITABLE;              mask &= ~TCL_WRITABLE;
6158          }          }
6159    
6160          /*          /*
6161           * Add this invocation to the list of recursive invocations of           * Add this invocation to the list of recursive invocations of
6162           * ChannelHandlerEventProc.           * ChannelHandlerEventProc.
6163           */           */
6164            
6165          nh.nextHandlerPtr = (ChannelHandler *) NULL;          nh.nextHandlerPtr = (ChannelHandler *) NULL;
6166          nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;          nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
6167          tsdPtr->nestedHandlerPtr = &nh;          tsdPtr->nestedHandlerPtr = &nh;
6168            
6169          for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {          for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
6170    
6171              /*              /*
6172               * If this channel handler is interested in any of the events that               * If this channel handler is interested in any of the events that
6173               * have occurred on the channel, invoke its procedure.               * have occurred on the channel, invoke its procedure.
6174               */               */
6175                    
6176            if ((chPtr->mask & mask) != 0) {            if ((chPtr->mask & mask) != 0) {
6177                nh.nextHandlerPtr = chPtr->nextPtr;                nh.nextHandlerPtr = chPtr->nextPtr;
6178                (*(chPtr->proc))(chPtr->clientData, mask);                (*(chPtr->proc))(chPtr->clientData, mask);
6179                chPtr = nh.nextHandlerPtr;                chPtr = nh.nextHandlerPtr;
6180            } else {            } else {
6181                chPtr = chPtr->nextPtr;                chPtr = chPtr->nextPtr;
6182            }            }
6183          }          }
6184    
6185          /*          /*
6186           * Update the notifier interest, since it may have changed after           * Update the notifier interest, since it may have changed after
6187           * invoking event handlers. Skip that if the channel was deleted           * invoking event handlers. Skip that if the channel was deleted
6188           * in the call to the channel handler.           * in the call to the channel handler.
6189           */           */
6190    
6191          if (chanPtr->typePtr != NULL) {          if (chanPtr->typePtr != NULL) {
6192              UpdateInterest(chanPtr);              UpdateInterest(chanPtr);
6193    
6194              /* Walk down the stack.              /* Walk down the stack.
6195               */               */
6196            chanPtr = chanPtr-> supercedes;            chanPtr = chanPtr-> supercedes;
6197          } else {          } else {
6198              /* Stop walking the chain, the whole stack was destroyed!              /* Stop walking the chain, the whole stack was destroyed!
6199               */               */
6200              chanPtr = (Channel*) NULL;              chanPtr = (Channel*) NULL;
6201          }          }
6202    
6203          Tcl_Release((ClientData) channel);          Tcl_Release((ClientData) channel);
6204    
6205          tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;          tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
6206    
6207          channel = (Tcl_Channel) chanPtr;          channel = (Tcl_Channel) chanPtr;
6208      }      }
6209  }  }
6210    
6211  /*  /*
6212   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6213   *   *
6214   * UpdateInterest --   * UpdateInterest --
6215   *   *
6216   *      Arrange for the notifier to call us back at appropriate times   *      Arrange for the notifier to call us back at appropriate times
6217   *      based on the current state of the channel.   *      based on the current state of the channel.
6218   *   *
6219   * Results:   * Results:
6220   *      None.   *      None.
6221   *   *
6222   * Side effects:   * Side effects:
6223   *      May schedule a timer or driver handler.   *      May schedule a timer or driver handler.
6224   *   *
6225   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6226   */   */
6227    
6228  static void  static void
6229  UpdateInterest(chanPtr)  UpdateInterest(chanPtr)
6230      Channel *chanPtr;           /* Channel to update. */      Channel *chanPtr;           /* Channel to update. */
6231  {  {
6232      int mask = chanPtr->interestMask;      int mask = chanPtr->interestMask;
6233    
6234      /*      /*
6235       * If there are flushed buffers waiting to be written, then       * If there are flushed buffers waiting to be written, then
6236       * we need to watch for the channel to become writable.       * we need to watch for the channel to become writable.
6237       */       */
6238    
6239      if (chanPtr->flags & BG_FLUSH_SCHEDULED) {      if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
6240          mask |= TCL_WRITABLE;          mask |= TCL_WRITABLE;
6241      }      }
6242    
6243      /*      /*
6244       * If there is data in the input queue, and we aren't waiting for more       * 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       * 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       * notifier.  Also, cancel the read interest so we don't get duplicate
6247       * events.       * events.
6248       */       */
6249    
6250      if (mask & TCL_READABLE) {      if (mask & TCL_READABLE) {
6251          if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)          if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
6252                  && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)                  && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
6253                  && (chanPtr->inQueueHead->nextRemoved <                  && (chanPtr->inQueueHead->nextRemoved <
6254                          chanPtr->inQueueHead->nextAdded)) {                          chanPtr->inQueueHead->nextAdded)) {
6255              mask &= ~TCL_READABLE;              mask &= ~TCL_READABLE;
6256              if (!chanPtr->timer) {              if (!chanPtr->timer) {
6257                  chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,                  chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
6258                          (ClientData) chanPtr);                          (ClientData) chanPtr);
6259              }              }
6260          }          }
6261      }      }
6262      (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);      (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
6263  }  }
6264    
6265  /*  /*
6266   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6267   *   *
6268   * ChannelTimerProc --   * ChannelTimerProc --
6269   *   *
6270   *      Timer handler scheduled by UpdateInterest to monitor the   *      Timer handler scheduled by UpdateInterest to monitor the
6271   *      channel buffers until they are empty.   *      channel buffers until they are empty.
6272   *   *
6273   * Results:   * Results:
6274   *      None.   *      None.
6275   *   *
6276   * Side effects:   * Side effects:
6277   *      May invoke channel handlers.   *      May invoke channel handlers.
6278   *   *
6279   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6280   */   */
6281    
6282  static void  static void
6283  ChannelTimerProc(clientData)  ChannelTimerProc(clientData)
6284      ClientData clientData;      ClientData clientData;
6285  {  {
6286      Channel *chanPtr = (Channel *) clientData;      Channel *chanPtr = (Channel *) clientData;
6287    
6288      if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)      if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
6289              && (chanPtr->interestMask & TCL_READABLE)              && (chanPtr->interestMask & TCL_READABLE)
6290              && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)              && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
6291              && (chanPtr->inQueueHead->nextRemoved <              && (chanPtr->inQueueHead->nextRemoved <
6292                      chanPtr->inQueueHead->nextAdded)) {                      chanPtr->inQueueHead->nextAdded)) {
6293          /*          /*
6294           * Restart the timer in case a channel handler reenters the           * Restart the timer in case a channel handler reenters the
6295           * event loop before UpdateInterest gets called by Tcl_NotifyChannel.           * event loop before UpdateInterest gets called by Tcl_NotifyChannel.
6296           */           */
6297    
6298          chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,          chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
6299                          (ClientData) chanPtr);                          (ClientData) chanPtr);
6300          Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);          Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
6301    
6302     } else {     } else {
6303          chanPtr->timer = NULL;          chanPtr->timer = NULL;
6304          UpdateInterest(chanPtr);          UpdateInterest(chanPtr);
6305      }      }
6306  }  }
6307    
6308  /*  /*
6309   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6310   *   *
6311   * Tcl_CreateChannelHandler --   * Tcl_CreateChannelHandler --
6312   *   *
6313   *      Arrange for a given procedure to be invoked whenever the   *      Arrange for a given procedure to be invoked whenever the
6314   *      channel indicated by the chanPtr arg becomes readable or   *      channel indicated by the chanPtr arg becomes readable or
6315   *      writable.   *      writable.
6316   *   *
6317   * Results:   * Results:
6318   *      None.   *      None.
6319   *   *
6320   * Side effects:   * Side effects:
6321   *      From now on, whenever the I/O channel given by chanPtr becomes   *      From now on, whenever the I/O channel given by chanPtr becomes
6322   *      ready in the way indicated by mask, proc will be invoked.   *      ready in the way indicated by mask, proc will be invoked.
6323   *      See the manual entry for details on the calling sequence   *      See the manual entry for details on the calling sequence
6324   *      to proc.  If there is already an event handler for chan, proc   *      to proc.  If there is already an event handler for chan, proc
6325   *      and clientData, then the mask will be updated.   *      and clientData, then the mask will be updated.
6326   *   *
6327   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6328   */   */
6329    
6330  void  void
6331  Tcl_CreateChannelHandler(chan, mask, proc, clientData)  Tcl_CreateChannelHandler(chan, mask, proc, clientData)
6332      Tcl_Channel chan;           /* The channel to create the handler for. */      Tcl_Channel chan;           /* The channel to create the handler for. */
6333      int mask;                   /* OR'ed combination of TCL_READABLE,      int mask;                   /* OR'ed combination of TCL_READABLE,
6334                                   * TCL_WRITABLE, and TCL_EXCEPTION:                                   * TCL_WRITABLE, and TCL_EXCEPTION:
6335                                   * indicates conditions under which                                   * indicates conditions under which
6336                                   * proc should be called. Use 0 to                                   * proc should be called. Use 0 to
6337                                   * disable a registered handler. */                                   * disable a registered handler. */
6338      Tcl_ChannelProc *proc;      /* Procedure to call for each      Tcl_ChannelProc *proc;      /* Procedure to call for each
6339                                   * selected event. */                                   * selected event. */
6340      ClientData clientData;      /* Arbitrary data to pass to proc. */      ClientData clientData;      /* Arbitrary data to pass to proc. */
6341  {  {
6342      ChannelHandler *chPtr;      ChannelHandler *chPtr;
6343      Channel *chanPtr;      Channel *chanPtr;
6344    
6345      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
6346            
6347      /*      /*
6348       * Check whether this channel handler is not already registered. If       * Check whether this channel handler is not already registered. If
6349       * it is not, create a new record, else reuse existing record (smash       * it is not, create a new record, else reuse existing record (smash
6350       * current values).       * current values).
6351       */       */
6352    
6353      for (chPtr = chanPtr->chPtr;      for (chPtr = chanPtr->chPtr;
6354               chPtr != (ChannelHandler *) NULL;               chPtr != (ChannelHandler *) NULL;
6355               chPtr = chPtr->nextPtr) {               chPtr = chPtr->nextPtr) {
6356          if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&          if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
6357                  (chPtr->clientData == clientData)) {                  (chPtr->clientData == clientData)) {
6358              break;              break;
6359          }          }
6360      }      }
6361      if (chPtr == (ChannelHandler *) NULL) {      if (chPtr == (ChannelHandler *) NULL) {
6362          chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));          chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
6363          chPtr->mask = 0;          chPtr->mask = 0;
6364          chPtr->proc = proc;          chPtr->proc = proc;
6365          chPtr->clientData = clientData;          chPtr->clientData = clientData;
6366          chPtr->chanPtr = chanPtr;          chPtr->chanPtr = chanPtr;
6367          chPtr->nextPtr = chanPtr->chPtr;          chPtr->nextPtr = chanPtr->chPtr;
6368          chanPtr->chPtr = chPtr;          chanPtr->chPtr = chPtr;
6369      }      }
6370    
6371      /*      /*
6372       * The remainder of the initialization below is done regardless of       * 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       * whether or not this is a new record or a modification of an old
6374       * one.       * one.
6375       */       */
6376    
6377      chPtr->mask = mask;      chPtr->mask = mask;
6378    
6379      /*      /*
6380       * Recompute the interest mask for the channel - this call may actually       * Recompute the interest mask for the channel - this call may actually
6381       * be disabling an existing handler.       * be disabling an existing handler.
6382       */       */
6383            
6384      chanPtr->interestMask = 0;      chanPtr->interestMask = 0;
6385      for (chPtr = chanPtr->chPtr;      for (chPtr = chanPtr->chPtr;
6386           chPtr != (ChannelHandler *) NULL;           chPtr != (ChannelHandler *) NULL;
6387           chPtr = chPtr->nextPtr) {           chPtr = chPtr->nextPtr) {
6388          chanPtr->interestMask |= chPtr->mask;          chanPtr->interestMask |= chPtr->mask;
6389      }      }
6390    
6391      UpdateInterest(chanPtr);      UpdateInterest(chanPtr);
6392  }  }
6393    
6394  /*  /*
6395   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6396   *   *
6397   * Tcl_DeleteChannelHandler --   * Tcl_DeleteChannelHandler --
6398   *   *
6399   *      Cancel a previously arranged callback arrangement for an IO   *      Cancel a previously arranged callback arrangement for an IO
6400   *      channel.   *      channel.
6401   *   *
6402   * Results:   * Results:
6403   *      None.   *      None.
6404   *   *
6405   * Side effects:   * Side effects:
6406   *      If a callback was previously registered for this chan, proc and   *      If a callback was previously registered for this chan, proc and
6407   *       clientData , it is removed and the callback will no longer be called   *       clientData , it is removed and the callback will no longer be called
6408   *      when the channel becomes ready for IO.   *      when the channel becomes ready for IO.
6409   *   *
6410   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6411   */   */
6412    
6413  void  void
6414  Tcl_DeleteChannelHandler(chan, proc, clientData)  Tcl_DeleteChannelHandler(chan, proc, clientData)
6415      Tcl_Channel chan;           /* The channel for which to remove the      Tcl_Channel chan;           /* The channel for which to remove the
6416                                   * callback. */                                   * callback. */
6417      Tcl_ChannelProc *proc;      /* The procedure in the callback to delete. */      Tcl_ChannelProc *proc;      /* The procedure in the callback to delete. */
6418      ClientData clientData;      /* The client data in the callback      ClientData clientData;      /* The client data in the callback
6419                                   * to delete. */                                   * to delete. */
6420            
6421  {  {
6422      ChannelHandler *chPtr, *prevChPtr;      ChannelHandler *chPtr, *prevChPtr;
6423      Channel *chanPtr;      Channel *chanPtr;
6424      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
6425      NextChannelHandler *nhPtr;      NextChannelHandler *nhPtr;
6426    
6427      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
6428    
6429      /*      /*
6430       * Find the entry and the previous one in the list.       * Find the entry and the previous one in the list.
6431       */       */
6432    
6433      for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;      for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
6434               chPtr != (ChannelHandler *) NULL;               chPtr != (ChannelHandler *) NULL;
6435               chPtr = chPtr->nextPtr) {               chPtr = chPtr->nextPtr) {
6436          if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)          if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
6437                  && (chPtr->proc == proc)) {                  && (chPtr->proc == proc)) {
6438              break;              break;
6439          }          }
6440          prevChPtr = chPtr;          prevChPtr = chPtr;
6441      }      }
6442            
6443      /*      /*
6444       * If not found, return without doing anything.       * If not found, return without doing anything.
6445       */       */
6446    
6447      if (chPtr == (ChannelHandler *) NULL) {      if (chPtr == (ChannelHandler *) NULL) {
6448          return;          return;
6449      }      }
6450    
6451      /*      /*
6452       * If ChannelHandlerEventProc is about to process this handler, tell it to       * If ChannelHandlerEventProc is about to process this handler, tell it to
6453       * process the next one instead - we are going to delete *this* one.       * process the next one instead - we are going to delete *this* one.
6454       */       */
6455    
6456      for (nhPtr = tsdPtr->nestedHandlerPtr;      for (nhPtr = tsdPtr->nestedHandlerPtr;
6457               nhPtr != (NextChannelHandler *) NULL;               nhPtr != (NextChannelHandler *) NULL;
6458               nhPtr = nhPtr->nestedHandlerPtr) {               nhPtr = nhPtr->nestedHandlerPtr) {
6459          if (nhPtr->nextHandlerPtr == chPtr) {          if (nhPtr->nextHandlerPtr == chPtr) {
6460              nhPtr->nextHandlerPtr = chPtr->nextPtr;              nhPtr->nextHandlerPtr = chPtr->nextPtr;
6461          }          }
6462      }      }
6463    
6464      /*      /*
6465       * Splice it out of the list of channel handlers.       * Splice it out of the list of channel handlers.
6466       */       */
6467            
6468      if (prevChPtr == (ChannelHandler *) NULL) {      if (prevChPtr == (ChannelHandler *) NULL) {
6469          chanPtr->chPtr = chPtr->nextPtr;          chanPtr->chPtr = chPtr->nextPtr;
6470      } else {      } else {
6471          prevChPtr->nextPtr = chPtr->nextPtr;          prevChPtr->nextPtr = chPtr->nextPtr;
6472      }      }
6473      ckfree((char *) chPtr);      ckfree((char *) chPtr);
6474    
6475      /*      /*
6476       * Recompute the interest list for the channel, so that infinite loops       * Recompute the interest list for the channel, so that infinite loops
6477       * will not result if Tcl_DeleteChannelHandler is called inside an       * will not result if Tcl_DeleteChannelHandler is called inside an
6478       * event.       * event.
6479       */       */
6480    
6481      chanPtr->interestMask = 0;      chanPtr->interestMask = 0;
6482      for (chPtr = chanPtr->chPtr;      for (chPtr = chanPtr->chPtr;
6483               chPtr != (ChannelHandler *) NULL;               chPtr != (ChannelHandler *) NULL;
6484               chPtr = chPtr->nextPtr) {               chPtr = chPtr->nextPtr) {
6485          chanPtr->interestMask |= chPtr->mask;          chanPtr->interestMask |= chPtr->mask;
6486      }      }
6487    
6488      UpdateInterest(chanPtr);      UpdateInterest(chanPtr);
6489  }  }
6490    
6491  /*  /*
6492   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6493   *   *
6494   * DeleteScriptRecord --   * DeleteScriptRecord --
6495   *   *
6496   *      Delete a script record for this combination of channel, interp   *      Delete a script record for this combination of channel, interp
6497   *      and mask.   *      and mask.
6498   *   *
6499   * Results:   * Results:
6500   *      None.   *      None.
6501   *   *
6502   * Side effects:   * Side effects:
6503   *      Deletes a script record and cancels a channel event handler.   *      Deletes a script record and cancels a channel event handler.
6504   *   *
6505   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6506   */   */
6507    
6508  static void  static void
6509  DeleteScriptRecord(interp, chanPtr, mask)  DeleteScriptRecord(interp, chanPtr, mask)
6510      Tcl_Interp *interp;         /* Interpreter in which script was to be      Tcl_Interp *interp;         /* Interpreter in which script was to be
6511                                   * executed. */                                   * executed. */
6512      Channel *chanPtr;           /* The channel for which to delete the      Channel *chanPtr;           /* The channel for which to delete the
6513                                   * script record (if any). */                                   * script record (if any). */
6514      int mask;                   /* Events in mask must exactly match mask      int mask;                   /* Events in mask must exactly match mask
6515                                   * of script to delete. */                                   * of script to delete. */
6516  {  {
6517      EventScriptRecord *esPtr, *prevEsPtr;      EventScriptRecord *esPtr, *prevEsPtr;
6518    
6519      for (esPtr = chanPtr->scriptRecordPtr,      for (esPtr = chanPtr->scriptRecordPtr,
6520               prevEsPtr = (EventScriptRecord *) NULL;               prevEsPtr = (EventScriptRecord *) NULL;
6521               esPtr != (EventScriptRecord *) NULL;               esPtr != (EventScriptRecord *) NULL;
6522               prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {               prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
6523          if ((esPtr->interp == interp) && (esPtr->mask == mask)) {          if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6524              if (esPtr == chanPtr->scriptRecordPtr) {              if (esPtr == chanPtr->scriptRecordPtr) {
6525                  chanPtr->scriptRecordPtr = esPtr->nextPtr;                  chanPtr->scriptRecordPtr = esPtr->nextPtr;
6526              } else {              } else {
6527                  prevEsPtr->nextPtr = esPtr->nextPtr;                  prevEsPtr->nextPtr = esPtr->nextPtr;
6528              }              }
6529    
6530              Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,              Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
6531                      ChannelEventScriptInvoker, (ClientData) esPtr);                      ChannelEventScriptInvoker, (ClientData) esPtr);
6532                            
6533              Tcl_DecrRefCount(esPtr->scriptPtr);              Tcl_DecrRefCount(esPtr->scriptPtr);
6534              ckfree((char *) esPtr);              ckfree((char *) esPtr);
6535    
6536              break;              break;
6537          }          }
6538      }      }
6539  }  }
6540    
6541  /*  /*
6542   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6543   *   *
6544   * CreateScriptRecord --   * CreateScriptRecord --
6545   *   *
6546   *      Creates a record to store a script to be executed when a specific   *      Creates a record to store a script to be executed when a specific
6547   *      event fires on a specific channel.   *      event fires on a specific channel.
6548   *   *
6549   * Results:   * Results:
6550   *      None.   *      None.
6551   *   *
6552   * Side effects:   * Side effects:
6553   *      Causes the script to be stored for later execution.   *      Causes the script to be stored for later execution.
6554   *   *
6555   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6556   */   */
6557    
6558  static void  static void
6559  CreateScriptRecord(interp, chanPtr, mask, scriptPtr)  CreateScriptRecord(interp, chanPtr, mask, scriptPtr)
6560      Tcl_Interp *interp;                 /* Interpreter in which to execute      Tcl_Interp *interp;                 /* Interpreter in which to execute
6561                                           * the stored script. */                                           * the stored script. */
6562      Channel *chanPtr;                   /* Channel for which script is to      Channel *chanPtr;                   /* Channel for which script is to
6563                                           * be stored. */                                           * be stored. */
6564      int mask;                           /* Set of events for which script      int mask;                           /* Set of events for which script
6565                                           * will be invoked. */                                           * will be invoked. */
6566      Tcl_Obj *scriptPtr;                 /* Pointer to script object. */      Tcl_Obj *scriptPtr;                 /* Pointer to script object. */
6567  {  {
6568      EventScriptRecord *esPtr;      EventScriptRecord *esPtr;
6569    
6570      for (esPtr = chanPtr->scriptRecordPtr;      for (esPtr = chanPtr->scriptRecordPtr;
6571               esPtr != (EventScriptRecord *) NULL;               esPtr != (EventScriptRecord *) NULL;
6572               esPtr = esPtr->nextPtr) {               esPtr = esPtr->nextPtr) {
6573          if ((esPtr->interp == interp) && (esPtr->mask == mask)) {          if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6574              Tcl_DecrRefCount(esPtr->scriptPtr);              Tcl_DecrRefCount(esPtr->scriptPtr);
6575              esPtr->scriptPtr = (Tcl_Obj *) NULL;              esPtr->scriptPtr = (Tcl_Obj *) NULL;
6576              break;              break;
6577          }          }
6578      }      }
6579      if (esPtr == (EventScriptRecord *) NULL) {      if (esPtr == (EventScriptRecord *) NULL) {
6580          esPtr = (EventScriptRecord *) ckalloc((unsigned)          esPtr = (EventScriptRecord *) ckalloc((unsigned)
6581                  sizeof(EventScriptRecord));                  sizeof(EventScriptRecord));
6582          Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,          Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
6583                  ChannelEventScriptInvoker, (ClientData) esPtr);                  ChannelEventScriptInvoker, (ClientData) esPtr);
6584          esPtr->nextPtr = chanPtr->scriptRecordPtr;          esPtr->nextPtr = chanPtr->scriptRecordPtr;
6585          chanPtr->scriptRecordPtr = esPtr;          chanPtr->scriptRecordPtr = esPtr;
6586      }      }
6587      esPtr->chanPtr = chanPtr;      esPtr->chanPtr = chanPtr;
6588      esPtr->interp = interp;      esPtr->interp = interp;
6589      esPtr->mask = mask;      esPtr->mask = mask;
6590      Tcl_IncrRefCount(scriptPtr);      Tcl_IncrRefCount(scriptPtr);
6591      esPtr->scriptPtr = scriptPtr;      esPtr->scriptPtr = scriptPtr;
6592  }  }
6593    
6594  /*  /*
6595   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6596   *   *
6597   * ChannelEventScriptInvoker --   * ChannelEventScriptInvoker --
6598   *   *
6599   *      Invokes a script scheduled by "fileevent" for when the channel   *      Invokes a script scheduled by "fileevent" for when the channel
6600   *      becomes ready for IO. This function is invoked by the channel   *      becomes ready for IO. This function is invoked by the channel
6601   *      handler which was created by the Tcl "fileevent" command.   *      handler which was created by the Tcl "fileevent" command.
6602   *   *
6603   * Results:   * Results:
6604   *      None.   *      None.
6605   *   *
6606   * Side effects:   * Side effects:
6607   *      Whatever the script does.   *      Whatever the script does.
6608   *   *
6609   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6610   */   */
6611    
6612  static void  static void
6613  ChannelEventScriptInvoker(clientData, mask)  ChannelEventScriptInvoker(clientData, mask)
6614      ClientData clientData;      /* The script+interp record. */      ClientData clientData;      /* The script+interp record. */
6615      int mask;                   /* Not used. */      int mask;                   /* Not used. */
6616  {  {
6617      Tcl_Interp *interp;         /* Interpreter in which to eval the script. */      Tcl_Interp *interp;         /* Interpreter in which to eval the script. */
6618      Channel *chanPtr;           /* The channel for which this handler is      Channel *chanPtr;           /* The channel for which this handler is
6619                                   * registered. */                                   * registered. */
6620      EventScriptRecord *esPtr;   /* The event script + interpreter to eval it      EventScriptRecord *esPtr;   /* The event script + interpreter to eval it
6621                                   * in. */                                   * in. */
6622      int result;                 /* Result of call to eval script. */      int result;                 /* Result of call to eval script. */
6623    
6624      esPtr = (EventScriptRecord *) clientData;      esPtr = (EventScriptRecord *) clientData;
6625    
6626      chanPtr = esPtr->chanPtr;      chanPtr = esPtr->chanPtr;
6627      mask = esPtr->mask;      mask = esPtr->mask;
6628      interp = esPtr->interp;      interp = esPtr->interp;
6629            
6630      /*      /*
6631       * We must preserve the interpreter so we can report errors on it       * 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       * later.  Note that we do not need to preserve the channel because
6633       * that is done by Tcl_NotifyChannel before calling channel handlers.       * that is done by Tcl_NotifyChannel before calling channel handlers.
6634       */       */
6635            
6636      Tcl_Preserve((ClientData) interp);      Tcl_Preserve((ClientData) interp);
6637      result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);      result = Tcl_EvalObjEx(interp, esPtr->scriptPtr, TCL_EVAL_GLOBAL);
6638    
6639      /*      /*
6640       * On error, cause a background error and remove the channel handler       * On error, cause a background error and remove the channel handler
6641       * and the script record.       * and the script record.
6642       *       *
6643       * NOTE: Must delete channel handler before causing the background error       * NOTE: Must delete channel handler before causing the background error
6644       * because the background error may want to reinstall the handler.       * because the background error may want to reinstall the handler.
6645       */       */
6646            
6647      if (result != TCL_OK) {      if (result != TCL_OK) {
6648          if (chanPtr->typePtr != NULL) {          if (chanPtr->typePtr != NULL) {
6649              DeleteScriptRecord(interp, chanPtr, mask);              DeleteScriptRecord(interp, chanPtr, mask);
6650          }          }
6651          Tcl_BackgroundError(interp);          Tcl_BackgroundError(interp);
6652      }      }
6653      Tcl_Release((ClientData) interp);      Tcl_Release((ClientData) interp);
6654  }  }
6655    
6656  /*  /*
6657   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6658   *   *
6659   * Tcl_FileEventObjCmd --   * Tcl_FileEventObjCmd --
6660   *   *
6661   *      This procedure implements the "fileevent" Tcl command. See the   *      This procedure implements the "fileevent" Tcl command. See the
6662   *      user documentation for details on what it does. This command is   *      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   *      based on the Tk command "fileevent" which in turn is based on work
6664   *      contributed by Mark Diekhans.   *      contributed by Mark Diekhans.
6665   *   *
6666   * Results:   * Results:
6667   *      A standard Tcl result.   *      A standard Tcl result.
6668   *   *
6669   * Side effects:   * Side effects:
6670   *      May create a channel handler for the specified channel.   *      May create a channel handler for the specified channel.
6671   *   *
6672   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6673   */   */
6674    
6675          /* ARGSUSED */          /* ARGSUSED */
6676  int  int
6677  Tcl_FileEventObjCmd(clientData, interp, objc, objv)  Tcl_FileEventObjCmd(clientData, interp, objc, objv)
6678      ClientData clientData;              /* Not used. */      ClientData clientData;              /* Not used. */
6679      Tcl_Interp *interp;                 /* Interpreter in which the channel      Tcl_Interp *interp;                 /* Interpreter in which the channel
6680                                           * for which to create the handler                                           * for which to create the handler
6681                                           * is found. */                                           * is found. */
6682      int objc;                           /* Number of arguments. */      int objc;                           /* Number of arguments. */
6683      Tcl_Obj *CONST objv[];              /* Argument objects. */      Tcl_Obj *CONST objv[];              /* Argument objects. */
6684  {  {
6685      Channel *chanPtr;                   /* The channel to create      Channel *chanPtr;                   /* The channel to create
6686                                           * the handler for. */                                           * the handler for. */
6687      Tcl_Channel chan;                   /* The opaque type for the channel. */      Tcl_Channel chan;                   /* The opaque type for the channel. */
6688      char *chanName;      char *chanName;
6689      int modeIndex;                      /* Index of mode argument. */      int modeIndex;                      /* Index of mode argument. */
6690      int mask;      int mask;
6691      static char *modeOptions[] = {"readable", "writable", NULL};      static char *modeOptions[] = {"readable", "writable", NULL};
6692      static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};      static int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
6693    
6694      if ((objc != 3) && (objc != 4)) {      if ((objc != 3) && (objc != 4)) {
6695          Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");          Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
6696          return TCL_ERROR;          return TCL_ERROR;
6697      }      }
6698      if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,      if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
6699              &modeIndex) != TCL_OK) {              &modeIndex) != TCL_OK) {
6700          return TCL_ERROR;          return TCL_ERROR;
6701      }      }
6702      mask = maskArray[modeIndex];      mask = maskArray[modeIndex];
6703    
6704      chanName = Tcl_GetString(objv[1]);      chanName = Tcl_GetString(objv[1]);
6705      chan = Tcl_GetChannel(interp, chanName, NULL);      chan = Tcl_GetChannel(interp, chanName, NULL);
6706      if (chan == (Tcl_Channel) NULL) {      if (chan == (Tcl_Channel) NULL) {
6707          return TCL_ERROR;          return TCL_ERROR;
6708      }      }
6709      chanPtr = (Channel *) chan;      chanPtr = (Channel *) chan;
6710      if ((chanPtr->flags & mask) == 0) {      if ((chanPtr->flags & mask) == 0) {
6711          Tcl_AppendResult(interp, "channel is not ",          Tcl_AppendResult(interp, "channel is not ",
6712                  (mask == TCL_READABLE) ? "readable" : "writable",                  (mask == TCL_READABLE) ? "readable" : "writable",
6713                  (char *) NULL);                  (char *) NULL);
6714          return TCL_ERROR;          return TCL_ERROR;
6715      }      }
6716            
6717      /*      /*
6718       * If we are supposed to return the script, do so.       * If we are supposed to return the script, do so.
6719       */       */
6720    
6721      if (objc == 3) {      if (objc == 3) {
6722          EventScriptRecord *esPtr;          EventScriptRecord *esPtr;
6723          for (esPtr = chanPtr->scriptRecordPtr;          for (esPtr = chanPtr->scriptRecordPtr;
6724               esPtr != (EventScriptRecord *) NULL;               esPtr != (EventScriptRecord *) NULL;
6725               esPtr = esPtr->nextPtr) {               esPtr = esPtr->nextPtr) {
6726              if ((esPtr->interp == interp) && (esPtr->mask == mask)) {              if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
6727                  Tcl_SetObjResult(interp, esPtr->scriptPtr);                  Tcl_SetObjResult(interp, esPtr->scriptPtr);
6728                  break;                  break;
6729              }              }
6730          }          }
6731          return TCL_OK;          return TCL_OK;
6732      }      }
6733    
6734      /*      /*
6735       * If we are supposed to delete a stored script, do so.       * If we are supposed to delete a stored script, do so.
6736       */       */
6737    
6738      if (*(Tcl_GetString(objv[3])) == '\0') {      if (*(Tcl_GetString(objv[3])) == '\0') {
6739          DeleteScriptRecord(interp, chanPtr, mask);          DeleteScriptRecord(interp, chanPtr, mask);
6740          return TCL_OK;          return TCL_OK;
6741      }      }
6742    
6743      /*      /*
6744       * Make the script record that will link between the event and the       * Make the script record that will link between the event and the
6745       * script to invoke. This also creates a channel event handler which       * script to invoke. This also creates a channel event handler which
6746       * will evaluate the script in the supplied interpreter.       * will evaluate the script in the supplied interpreter.
6747       */       */
6748    
6749      CreateScriptRecord(interp, chanPtr, mask, objv[3]);      CreateScriptRecord(interp, chanPtr, mask, objv[3]);
6750            
6751      return TCL_OK;      return TCL_OK;
6752  }  }
6753    
6754  /*  /*
6755   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6756   *   *
6757   * TclTestChannelCmd --   * TclTestChannelCmd --
6758   *   *
6759   *      Implements the Tcl "testchannel" debugging command and its   *      Implements the Tcl "testchannel" debugging command and its
6760   *      subcommands. This is part of the testing environment but must be   *      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   *      in this file instead of tclTest.c because it needs access to the
6762   *      fields of struct Channel.   *      fields of struct Channel.
6763   *   *
6764   * Results:   * Results:
6765   *      A standard Tcl result.   *      A standard Tcl result.
6766   *   *
6767   * Side effects:   * Side effects:
6768   *      None.   *      None.
6769   *   *
6770   *----------------------------------------------------------------------   *----------------------------------------------------------------------
6771   */   */
6772    
6773          /* ARGSUSED */          /* ARGSUSED */
6774  int  int
6775  TclTestChannelCmd(clientData, interp, argc, argv)  TclTestChannelCmd(clientData, interp, argc, argv)
6776      ClientData clientData;      /* Not used. */      ClientData clientData;      /* Not used. */
6777      Tcl_Interp *interp;         /* Interpreter for result. */      Tcl_Interp *interp;         /* Interpreter for result. */
6778      int argc;                   /* Count of additional args. */      int argc;                   /* Count of additional args. */
6779      char **argv;                /* Additional arg strings. */      char **argv;                /* Additional arg strings. */
6780  {  {
6781      char *cmdName;              /* Sub command. */      char *cmdName;              /* Sub command. */
6782      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */      Tcl_HashTable *hTblPtr;     /* Hash table of channels. */
6783      Tcl_HashSearch hSearch;     /* Search variable. */      Tcl_HashSearch hSearch;     /* Search variable. */
6784      Tcl_HashEntry *hPtr;        /* Search variable. */      Tcl_HashEntry *hPtr;        /* Search variable. */
6785      Channel *chanPtr;           /* The actual channel. */      Channel *chanPtr;           /* The actual channel. */
6786      Tcl_Channel chan;           /* The opaque type. */      Tcl_Channel chan;           /* The opaque type. */
6787      size_t len;                 /* Length of subcommand string. */      size_t len;                 /* Length of subcommand string. */
6788      int IOQueued;               /* How much IO is queued inside channel? */      int IOQueued;               /* How much IO is queued inside channel? */
6789      ChannelBuffer *bufPtr;      /* For iterating over queued IO. */      ChannelBuffer *bufPtr;      /* For iterating over queued IO. */
6790      char buf[TCL_INTEGER_SPACE];/* For sprintf. */      char buf[TCL_INTEGER_SPACE];/* For sprintf. */
6791            
6792      if (argc < 2) {      if (argc < 2) {
6793          Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],          Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6794                  " subcommand ?additional args..?\"", (char *) NULL);                  " subcommand ?additional args..?\"", (char *) NULL);
6795          return TCL_ERROR;          return TCL_ERROR;
6796      }      }
6797      cmdName = argv[1];      cmdName = argv[1];
6798      len = strlen(cmdName);      len = strlen(cmdName);
6799    
6800      chanPtr = (Channel *) NULL;      chanPtr = (Channel *) NULL;
6801    
6802      if (argc > 2) {      if (argc > 2) {
6803          chan = Tcl_GetChannel(interp, argv[2], NULL);          chan = Tcl_GetChannel(interp, argv[2], NULL);
6804          if (chan == (Tcl_Channel) NULL) {          if (chan == (Tcl_Channel) NULL) {
6805              return TCL_ERROR;              return TCL_ERROR;
6806          }          }
6807          chanPtr = (Channel *) chan;          chanPtr = (Channel *) chan;
6808      }      }
6809    
6810    
6811      if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {      if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
6812          if (argc != 3) {          if (argc != 3) {
6813              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6814                      " info channelName\"", (char *) NULL);                      " info channelName\"", (char *) NULL);
6815              return TCL_ERROR;              return TCL_ERROR;
6816          }          }
6817          Tcl_AppendElement(interp, argv[2]);          Tcl_AppendElement(interp, argv[2]);
6818          Tcl_AppendElement(interp, chanPtr->typePtr->typeName);          Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
6819          if (chanPtr->flags & TCL_READABLE) {          if (chanPtr->flags & TCL_READABLE) {
6820              Tcl_AppendElement(interp, "read");              Tcl_AppendElement(interp, "read");
6821          } else {          } else {
6822              Tcl_AppendElement(interp, "");              Tcl_AppendElement(interp, "");
6823          }          }
6824          if (chanPtr->flags & TCL_WRITABLE) {          if (chanPtr->flags & TCL_WRITABLE) {
6825              Tcl_AppendElement(interp, "write");              Tcl_AppendElement(interp, "write");
6826          } else {          } else {
6827              Tcl_AppendElement(interp, "");              Tcl_AppendElement(interp, "");
6828          }          }
6829          if (chanPtr->flags & CHANNEL_NONBLOCKING) {          if (chanPtr->flags & CHANNEL_NONBLOCKING) {
6830              Tcl_AppendElement(interp, "nonblocking");              Tcl_AppendElement(interp, "nonblocking");
6831          } else {          } else {
6832              Tcl_AppendElement(interp, "blocking");              Tcl_AppendElement(interp, "blocking");
6833          }          }
6834          if (chanPtr->flags & CHANNEL_LINEBUFFERED) {          if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
6835              Tcl_AppendElement(interp, "line");              Tcl_AppendElement(interp, "line");
6836          } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {          } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
6837              Tcl_AppendElement(interp, "none");              Tcl_AppendElement(interp, "none");
6838          } else {          } else {
6839              Tcl_AppendElement(interp, "full");              Tcl_AppendElement(interp, "full");
6840          }          }
6841          if (chanPtr->flags & BG_FLUSH_SCHEDULED) {          if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
6842              Tcl_AppendElement(interp, "async_flush");              Tcl_AppendElement(interp, "async_flush");
6843          } else {          } else {
6844              Tcl_AppendElement(interp, "");              Tcl_AppendElement(interp, "");
6845          }          }
6846          if (chanPtr->flags & CHANNEL_EOF) {          if (chanPtr->flags & CHANNEL_EOF) {
6847              Tcl_AppendElement(interp, "eof");              Tcl_AppendElement(interp, "eof");
6848          } else {          } else {
6849              Tcl_AppendElement(interp, "");              Tcl_AppendElement(interp, "");
6850          }          }
6851          if (chanPtr->flags & CHANNEL_BLOCKED) {          if (chanPtr->flags & CHANNEL_BLOCKED) {
6852              Tcl_AppendElement(interp, "blocked");              Tcl_AppendElement(interp, "blocked");
6853          } else {          } else {
6854              Tcl_AppendElement(interp, "unblocked");              Tcl_AppendElement(interp, "unblocked");
6855          }          }
6856          if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {          if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
6857              Tcl_AppendElement(interp, "auto");              Tcl_AppendElement(interp, "auto");
6858              if (chanPtr->flags & INPUT_SAW_CR) {              if (chanPtr->flags & INPUT_SAW_CR) {
6859                  Tcl_AppendElement(interp, "saw_cr");                  Tcl_AppendElement(interp, "saw_cr");
6860              } else {              } else {
6861                  Tcl_AppendElement(interp, "");                  Tcl_AppendElement(interp, "");
6862              }              }
6863          } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {          } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
6864              Tcl_AppendElement(interp, "lf");              Tcl_AppendElement(interp, "lf");
6865              Tcl_AppendElement(interp, "");              Tcl_AppendElement(interp, "");
6866          } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {          } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
6867              Tcl_AppendElement(interp, "cr");              Tcl_AppendElement(interp, "cr");
6868              Tcl_AppendElement(interp, "");              Tcl_AppendElement(interp, "");
6869          } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {          } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
6870              Tcl_AppendElement(interp, "crlf");              Tcl_AppendElement(interp, "crlf");
6871              if (chanPtr->flags & INPUT_SAW_CR) {              if (chanPtr->flags & INPUT_SAW_CR) {
6872                  Tcl_AppendElement(interp, "queued_cr");                  Tcl_AppendElement(interp, "queued_cr");
6873              } else {              } else {
6874                  Tcl_AppendElement(interp, "");                  Tcl_AppendElement(interp, "");
6875              }              }
6876          }          }
6877          if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {          if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
6878              Tcl_AppendElement(interp, "auto");              Tcl_AppendElement(interp, "auto");
6879          } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {          } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
6880              Tcl_AppendElement(interp, "lf");              Tcl_AppendElement(interp, "lf");
6881          } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {          } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
6882              Tcl_AppendElement(interp, "cr");              Tcl_AppendElement(interp, "cr");
6883          } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {          } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
6884              Tcl_AppendElement(interp, "crlf");              Tcl_AppendElement(interp, "crlf");
6885          }          }
6886          for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;          for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
6887                   bufPtr != (ChannelBuffer *) NULL;                   bufPtr != (ChannelBuffer *) NULL;
6888                   bufPtr = bufPtr->nextPtr) {                   bufPtr = bufPtr->nextPtr) {
6889              IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;              IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
6890          }          }
6891          TclFormatInt(buf, IOQueued);          TclFormatInt(buf, IOQueued);
6892          Tcl_AppendElement(interp, buf);          Tcl_AppendElement(interp, buf);
6893                    
6894          IOQueued = 0;          IOQueued = 0;
6895          if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {          if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
6896              IOQueued = chanPtr->curOutPtr->nextAdded -              IOQueued = chanPtr->curOutPtr->nextAdded -
6897                  chanPtr->curOutPtr->nextRemoved;                  chanPtr->curOutPtr->nextRemoved;
6898          }          }
6899          for (bufPtr = chanPtr->outQueueHead;          for (bufPtr = chanPtr->outQueueHead;
6900                   bufPtr != (ChannelBuffer *) NULL;                   bufPtr != (ChannelBuffer *) NULL;
6901                   bufPtr = bufPtr->nextPtr) {                   bufPtr = bufPtr->nextPtr) {
6902              IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);              IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
6903          }          }
6904          TclFormatInt(buf, IOQueued);          TclFormatInt(buf, IOQueued);
6905          Tcl_AppendElement(interp, buf);          Tcl_AppendElement(interp, buf);
6906                    
6907          TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));          TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
6908          Tcl_AppendElement(interp, buf);          Tcl_AppendElement(interp, buf);
6909    
6910          TclFormatInt(buf, chanPtr->refCount);          TclFormatInt(buf, chanPtr->refCount);
6911          Tcl_AppendElement(interp, buf);          Tcl_AppendElement(interp, buf);
6912    
6913          return TCL_OK;          return TCL_OK;
6914      }      }
6915    
6916      if ((cmdName[0] == 'i') &&      if ((cmdName[0] == 'i') &&
6917              (strncmp(cmdName, "inputbuffered", len) == 0)) {              (strncmp(cmdName, "inputbuffered", len) == 0)) {
6918          if (argc != 3) {          if (argc != 3) {
6919              Tcl_AppendResult(interp, "channel name required",              Tcl_AppendResult(interp, "channel name required",
6920                      (char *) NULL);                      (char *) NULL);
6921              return TCL_ERROR;              return TCL_ERROR;
6922          }          }
6923                    
6924          for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;          for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
6925                   bufPtr != (ChannelBuffer *) NULL;                   bufPtr != (ChannelBuffer *) NULL;
6926                   bufPtr = bufPtr->nextPtr) {                   bufPtr = bufPtr->nextPtr) {
6927              IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;              IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
6928          }          }
6929          TclFormatInt(buf, IOQueued);          TclFormatInt(buf, IOQueued);
6930          Tcl_AppendResult(interp, buf, (char *) NULL);          Tcl_AppendResult(interp, buf, (char *) NULL);
6931          return TCL_OK;          return TCL_OK;
6932      }      }
6933                    
6934      if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {      if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
6935          if (argc != 3) {          if (argc != 3) {
6936              Tcl_AppendResult(interp, "channel name required",              Tcl_AppendResult(interp, "channel name required",
6937                      (char *) NULL);                      (char *) NULL);
6938              return TCL_ERROR;              return TCL_ERROR;
6939          }          }
6940                    
6941          if (chanPtr->flags & TCL_READABLE) {          if (chanPtr->flags & TCL_READABLE) {
6942              Tcl_AppendElement(interp, "read");              Tcl_AppendElement(interp, "read");
6943          } else {          } else {
6944              Tcl_AppendElement(interp, "");              Tcl_AppendElement(interp, "");
6945          }          }
6946          if (chanPtr->flags & TCL_WRITABLE) {          if (chanPtr->flags & TCL_WRITABLE) {
6947              Tcl_AppendElement(interp, "write");              Tcl_AppendElement(interp, "write");
6948          } else {          } else {
6949              Tcl_AppendElement(interp, "");              Tcl_AppendElement(interp, "");
6950          }          }
6951          return TCL_OK;          return TCL_OK;
6952      }      }
6953            
6954      if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {      if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
6955          if (argc != 3) {          if (argc != 3) {
6956              Tcl_AppendResult(interp, "channel name required",              Tcl_AppendResult(interp, "channel name required",
6957                      (char *) NULL);                      (char *) NULL);
6958              return TCL_ERROR;              return TCL_ERROR;
6959          }          }
6960          Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);          Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
6961          return TCL_OK;          return TCL_OK;
6962      }      }
6963            
6964      if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {      if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
6965          hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);          hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
6966          if (hTblPtr == (Tcl_HashTable *) NULL) {          if (hTblPtr == (Tcl_HashTable *) NULL) {
6967              return TCL_OK;              return TCL_OK;
6968          }          }
6969          for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);          for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
6970                   hPtr != (Tcl_HashEntry *) NULL;                   hPtr != (Tcl_HashEntry *) NULL;
6971                   hPtr = Tcl_NextHashEntry(&hSearch)) {                   hPtr = Tcl_NextHashEntry(&hSearch)) {
6972              Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));              Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
6973          }          }
6974          return TCL_OK;          return TCL_OK;
6975      }      }
6976    
6977      if ((cmdName[0] == 'o') &&      if ((cmdName[0] == 'o') &&
6978              (strncmp(cmdName, "outputbuffered", len) == 0)) {              (strncmp(cmdName, "outputbuffered", len) == 0)) {
6979          if (argc != 3) {          if (argc != 3) {
6980              Tcl_AppendResult(interp, "channel name required",              Tcl_AppendResult(interp, "channel name required",
6981                      (char *) NULL);                      (char *) NULL);
6982              return TCL_ERROR;              return TCL_ERROR;
6983          }          }
6984                    
6985          IOQueued = 0;          IOQueued = 0;
6986          if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {          if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
6987              IOQueued = chanPtr->curOutPtr->nextAdded -              IOQueued = chanPtr->curOutPtr->nextAdded -
6988                  chanPtr->curOutPtr->nextRemoved;                  chanPtr->curOutPtr->nextRemoved;
6989          }          }
6990          for (bufPtr = chanPtr->outQueueHead;          for (bufPtr = chanPtr->outQueueHead;
6991                   bufPtr != (ChannelBuffer *) NULL;                   bufPtr != (ChannelBuffer *) NULL;
6992                   bufPtr = bufPtr->nextPtr) {                   bufPtr = bufPtr->nextPtr) {
6993              IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);              IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
6994          }          }
6995          TclFormatInt(buf, IOQueued);          TclFormatInt(buf, IOQueued);
6996          Tcl_AppendResult(interp, buf, (char *) NULL);          Tcl_AppendResult(interp, buf, (char *) NULL);
6997          return TCL_OK;          return TCL_OK;
6998      }      }
6999                    
7000      if ((cmdName[0] == 'q') &&      if ((cmdName[0] == 'q') &&
7001              (strncmp(cmdName, "queuedcr", len) == 0)) {              (strncmp(cmdName, "queuedcr", len) == 0)) {
7002          if (argc != 3) {          if (argc != 3) {
7003              Tcl_AppendResult(interp, "channel name required",              Tcl_AppendResult(interp, "channel name required",
7004                      (char *) NULL);                      (char *) NULL);
7005              return TCL_ERROR;              return TCL_ERROR;
7006          }          }
7007                    
7008          Tcl_AppendResult(interp,          Tcl_AppendResult(interp,
7009                  (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",                  (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
7010                  (char *) NULL);                  (char *) NULL);
7011          return TCL_OK;          return TCL_OK;
7012      }      }
7013            
7014      if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {      if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
7015          hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);          hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
7016          if (hTblPtr == (Tcl_HashTable *) NULL) {          if (hTblPtr == (Tcl_HashTable *) NULL) {
7017              return TCL_OK;              return TCL_OK;
7018          }          }
7019          for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);          for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
7020                   hPtr != (Tcl_HashEntry *) NULL;                   hPtr != (Tcl_HashEntry *) NULL;
7021                   hPtr = Tcl_NextHashEntry(&hSearch)) {                   hPtr = Tcl_NextHashEntry(&hSearch)) {
7022              chanPtr = (Channel *) Tcl_GetHashValue(hPtr);              chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
7023              if (chanPtr->flags & TCL_READABLE) {              if (chanPtr->flags & TCL_READABLE) {
7024                  Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));                  Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
7025              }              }
7026          }          }
7027          return TCL_OK;          return TCL_OK;
7028      }      }
7029    
7030      if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {      if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
7031          if (argc != 3) {          if (argc != 3) {
7032              Tcl_AppendResult(interp, "channel name required",              Tcl_AppendResult(interp, "channel name required",
7033                      (char *) NULL);                      (char *) NULL);
7034              return TCL_ERROR;              return TCL_ERROR;
7035          }          }
7036                    
7037          TclFormatInt(buf, chanPtr->refCount);          TclFormatInt(buf, chanPtr->refCount);
7038          Tcl_AppendResult(interp, buf, (char *) NULL);          Tcl_AppendResult(interp, buf, (char *) NULL);
7039          return TCL_OK;          return TCL_OK;
7040      }      }
7041            
7042      if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {      if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
7043          if (argc != 3) {          if (argc != 3) {
7044              Tcl_AppendResult(interp, "channel name required",              Tcl_AppendResult(interp, "channel name required",
7045                      (char *) NULL);                      (char *) NULL);
7046              return TCL_ERROR;              return TCL_ERROR;
7047          }          }
7048          Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);          Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
7049          return TCL_OK;          return TCL_OK;
7050      }      }
7051            
7052      if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {      if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
7053          hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);          hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
7054          if (hTblPtr == (Tcl_HashTable *) NULL) {          if (hTblPtr == (Tcl_HashTable *) NULL) {
7055              return TCL_OK;              return TCL_OK;
7056          }          }
7057          for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);          for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
7058                   hPtr != (Tcl_HashEntry *) NULL;                   hPtr != (Tcl_HashEntry *) NULL;
7059                   hPtr = Tcl_NextHashEntry(&hSearch)) {                   hPtr = Tcl_NextHashEntry(&hSearch)) {
7060              chanPtr = (Channel *) Tcl_GetHashValue(hPtr);              chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
7061              if (chanPtr->flags & TCL_WRITABLE) {              if (chanPtr->flags & TCL_WRITABLE) {
7062                  Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));                  Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
7063              }              }
7064          }          }
7065          return TCL_OK;          return TCL_OK;
7066      }      }
7067    
7068      Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",      Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
7069              "info, open, readable, or writable",              "info, open, readable, or writable",
7070              (char *) NULL);              (char *) NULL);
7071      return TCL_ERROR;      return TCL_ERROR;
7072  }  }
7073    
7074  /*  /*
7075   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7076   *   *
7077   * TclTestChannelEventCmd --   * TclTestChannelEventCmd --
7078   *   *
7079   *      This procedure implements the "testchannelevent" command. It is   *      This procedure implements the "testchannelevent" command. It is
7080   *      used to test the Tcl channel event mechanism. It is present in   *      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   *      this file instead of tclTest.c because it needs access to the
7082   *      internal structure of the channel.   *      internal structure of the channel.
7083   *   *
7084   * Results:   * Results:
7085   *      A standard Tcl result.   *      A standard Tcl result.
7086   *   *
7087   * Side effects:   * Side effects:
7088   *      Creates, deletes and returns channel event handlers.   *      Creates, deletes and returns channel event handlers.
7089   *   *
7090   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7091   */   */
7092    
7093          /* ARGSUSED */          /* ARGSUSED */
7094  int  int
7095  TclTestChannelEventCmd(dummy, interp, argc, argv)  TclTestChannelEventCmd(dummy, interp, argc, argv)
7096      ClientData dummy;                   /* Not used. */      ClientData dummy;                   /* Not used. */
7097      Tcl_Interp *interp;                 /* Current interpreter. */      Tcl_Interp *interp;                 /* Current interpreter. */
7098      int argc;                           /* Number of arguments. */      int argc;                           /* Number of arguments. */
7099      char **argv;                        /* Argument strings. */      char **argv;                        /* Argument strings. */
7100  {  {
7101      Tcl_Obj *resultListPtr;      Tcl_Obj *resultListPtr;
7102      Channel *chanPtr;      Channel *chanPtr;
7103      EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;      EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
7104      char *cmd;      char *cmd;
7105      int index, i, mask, len;      int index, i, mask, len;
7106    
7107      if ((argc < 3) || (argc > 5)) {      if ((argc < 3) || (argc > 5)) {
7108          Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],          Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7109                  " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);                  " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
7110          return TCL_ERROR;          return TCL_ERROR;
7111      }      }
7112      chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);      chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
7113      if (chanPtr == (Channel *) NULL) {      if (chanPtr == (Channel *) NULL) {
7114          return TCL_ERROR;          return TCL_ERROR;
7115      }      }
7116      cmd = argv[2];      cmd = argv[2];
7117      len = strlen(cmd);      len = strlen(cmd);
7118      if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {      if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
7119          if (argc != 5) {          if (argc != 5) {
7120              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7121                      " channelName add eventSpec script\"", (char *) NULL);                      " channelName add eventSpec script\"", (char *) NULL);
7122              return TCL_ERROR;              return TCL_ERROR;
7123          }          }
7124          if (strcmp(argv[3], "readable") == 0) {          if (strcmp(argv[3], "readable") == 0) {
7125              mask = TCL_READABLE;              mask = TCL_READABLE;
7126          } else if (strcmp(argv[3], "writable") == 0) {          } else if (strcmp(argv[3], "writable") == 0) {
7127              mask = TCL_WRITABLE;              mask = TCL_WRITABLE;
7128          } else if (strcmp(argv[3], "none") == 0) {          } else if (strcmp(argv[3], "none") == 0) {
7129              mask = 0;              mask = 0;
7130          } else {          } else {
7131              Tcl_AppendResult(interp, "bad event name \"", argv[3],              Tcl_AppendResult(interp, "bad event name \"", argv[3],
7132                      "\": must be readable, writable, or none", (char *) NULL);                      "\": must be readable, writable, or none", (char *) NULL);
7133              return TCL_ERROR;              return TCL_ERROR;
7134          }          }
7135    
7136          esPtr = (EventScriptRecord *) ckalloc((unsigned)          esPtr = (EventScriptRecord *) ckalloc((unsigned)
7137                  sizeof(EventScriptRecord));                  sizeof(EventScriptRecord));
7138          esPtr->nextPtr = chanPtr->scriptRecordPtr;          esPtr->nextPtr = chanPtr->scriptRecordPtr;
7139          chanPtr->scriptRecordPtr = esPtr;          chanPtr->scriptRecordPtr = esPtr;
7140                    
7141          esPtr->chanPtr = chanPtr;          esPtr->chanPtr = chanPtr;
7142          esPtr->interp = interp;          esPtr->interp = interp;
7143          esPtr->mask = mask;          esPtr->mask = mask;
7144          esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);          esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
7145          Tcl_IncrRefCount(esPtr->scriptPtr);          Tcl_IncrRefCount(esPtr->scriptPtr);
7146    
7147          Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,          Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
7148                  ChannelEventScriptInvoker, (ClientData) esPtr);                  ChannelEventScriptInvoker, (ClientData) esPtr);
7149                    
7150          return TCL_OK;          return TCL_OK;
7151      }      }
7152    
7153      if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {      if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
7154          if (argc != 4) {          if (argc != 4) {
7155              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7156                      " channelName delete index\"", (char *) NULL);                      " channelName delete index\"", (char *) NULL);
7157              return TCL_ERROR;              return TCL_ERROR;
7158          }          }
7159          if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {          if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
7160              return TCL_ERROR;              return TCL_ERROR;
7161          }          }
7162          if (index < 0) {          if (index < 0) {
7163              Tcl_AppendResult(interp, "bad event index: ", argv[3],              Tcl_AppendResult(interp, "bad event index: ", argv[3],
7164                      ": must be nonnegative", (char *) NULL);                      ": must be nonnegative", (char *) NULL);
7165              return TCL_ERROR;              return TCL_ERROR;
7166          }          }
7167          for (i = 0, esPtr = chanPtr->scriptRecordPtr;          for (i = 0, esPtr = chanPtr->scriptRecordPtr;
7168                   (i < index) && (esPtr != (EventScriptRecord *) NULL);                   (i < index) && (esPtr != (EventScriptRecord *) NULL);
7169                   i++, esPtr = esPtr->nextPtr) {                   i++, esPtr = esPtr->nextPtr) {
7170              /* Empty loop body. */              /* Empty loop body. */
7171          }          }
7172          if (esPtr == (EventScriptRecord *) NULL) {          if (esPtr == (EventScriptRecord *) NULL) {
7173              Tcl_AppendResult(interp, "bad event index ", argv[3],              Tcl_AppendResult(interp, "bad event index ", argv[3],
7174                      ": out of range", (char *) NULL);                      ": out of range", (char *) NULL);
7175              return TCL_ERROR;              return TCL_ERROR;
7176          }          }
7177          if (esPtr == chanPtr->scriptRecordPtr) {          if (esPtr == chanPtr->scriptRecordPtr) {
7178              chanPtr->scriptRecordPtr = esPtr->nextPtr;              chanPtr->scriptRecordPtr = esPtr->nextPtr;
7179          } else {          } else {
7180              for (prevEsPtr = chanPtr->scriptRecordPtr;              for (prevEsPtr = chanPtr->scriptRecordPtr;
7181                       (prevEsPtr != (EventScriptRecord *) NULL) &&                       (prevEsPtr != (EventScriptRecord *) NULL) &&
7182                           (prevEsPtr->nextPtr != esPtr);                           (prevEsPtr->nextPtr != esPtr);
7183                       prevEsPtr = prevEsPtr->nextPtr) {                       prevEsPtr = prevEsPtr->nextPtr) {
7184                  /* Empty loop body. */                  /* Empty loop body. */
7185              }              }
7186              if (prevEsPtr == (EventScriptRecord *) NULL) {              if (prevEsPtr == (EventScriptRecord *) NULL) {
7187                  panic("TclTestChannelEventCmd: damaged event script list");                  panic("TclTestChannelEventCmd: damaged event script list");
7188              }              }
7189              prevEsPtr->nextPtr = esPtr->nextPtr;              prevEsPtr->nextPtr = esPtr->nextPtr;
7190          }          }
7191          Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,          Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
7192                  ChannelEventScriptInvoker, (ClientData) esPtr);                  ChannelEventScriptInvoker, (ClientData) esPtr);
7193          Tcl_DecrRefCount(esPtr->scriptPtr);          Tcl_DecrRefCount(esPtr->scriptPtr);
7194          ckfree((char *) esPtr);          ckfree((char *) esPtr);
7195    
7196          return TCL_OK;          return TCL_OK;
7197      }      }
7198    
7199      if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {      if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
7200          if (argc != 3) {          if (argc != 3) {
7201              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7202                      " channelName list\"", (char *) NULL);                      " channelName list\"", (char *) NULL);
7203              return TCL_ERROR;              return TCL_ERROR;
7204          }          }
7205          resultListPtr = Tcl_GetObjResult(interp);          resultListPtr = Tcl_GetObjResult(interp);
7206          for (esPtr = chanPtr->scriptRecordPtr;          for (esPtr = chanPtr->scriptRecordPtr;
7207                   esPtr != (EventScriptRecord *) NULL;                   esPtr != (EventScriptRecord *) NULL;
7208                   esPtr = esPtr->nextPtr) {                   esPtr = esPtr->nextPtr) {
7209              if (esPtr->mask) {              if (esPtr->mask) {
7210                  Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(                  Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
7211                      (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));                      (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
7212              } else {              } else {
7213                  Tcl_ListObjAppendElement(interp, resultListPtr,                  Tcl_ListObjAppendElement(interp, resultListPtr,
7214                      Tcl_NewStringObj("none", -1));                      Tcl_NewStringObj("none", -1));
7215              }              }
7216              Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);              Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
7217          }          }
7218          Tcl_SetObjResult(interp, resultListPtr);          Tcl_SetObjResult(interp, resultListPtr);
7219          return TCL_OK;          return TCL_OK;
7220      }      }
7221    
7222      if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {      if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
7223          if (argc != 3) {          if (argc != 3) {
7224              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7225                      " channelName removeall\"", (char *) NULL);                      " channelName removeall\"", (char *) NULL);
7226              return TCL_ERROR;              return TCL_ERROR;
7227          }          }
7228          for (esPtr = chanPtr->scriptRecordPtr;          for (esPtr = chanPtr->scriptRecordPtr;
7229                   esPtr != (EventScriptRecord *) NULL;                   esPtr != (EventScriptRecord *) NULL;
7230                   esPtr = nextEsPtr) {                   esPtr = nextEsPtr) {
7231              nextEsPtr = esPtr->nextPtr;              nextEsPtr = esPtr->nextPtr;
7232              Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,              Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
7233                      ChannelEventScriptInvoker, (ClientData) esPtr);                      ChannelEventScriptInvoker, (ClientData) esPtr);
7234              Tcl_DecrRefCount(esPtr->scriptPtr);              Tcl_DecrRefCount(esPtr->scriptPtr);
7235              ckfree((char *) esPtr);              ckfree((char *) esPtr);
7236          }          }
7237          chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;          chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
7238          return TCL_OK;          return TCL_OK;
7239      }      }
7240    
7241      if  ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {      if  ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
7242          if (argc != 5) {          if (argc != 5) {
7243              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
7244                      " channelName delete index event\"", (char *) NULL);                      " channelName delete index event\"", (char *) NULL);
7245              return TCL_ERROR;              return TCL_ERROR;
7246          }          }
7247          if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {          if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
7248              return TCL_ERROR;              return TCL_ERROR;
7249          }          }
7250          if (index < 0) {          if (index < 0) {
7251              Tcl_AppendResult(interp, "bad event index: ", argv[3],              Tcl_AppendResult(interp, "bad event index: ", argv[3],
7252                      ": must be nonnegative", (char *) NULL);                      ": must be nonnegative", (char *) NULL);
7253              return TCL_ERROR;              return TCL_ERROR;
7254          }          }
7255          for (i = 0, esPtr = chanPtr->scriptRecordPtr;          for (i = 0, esPtr = chanPtr->scriptRecordPtr;
7256                   (i < index) && (esPtr != (EventScriptRecord *) NULL);                   (i < index) && (esPtr != (EventScriptRecord *) NULL);
7257                   i++, esPtr = esPtr->nextPtr) {                   i++, esPtr = esPtr->nextPtr) {
7258              /* Empty loop body. */              /* Empty loop body. */
7259          }          }
7260          if (esPtr == (EventScriptRecord *) NULL) {          if (esPtr == (EventScriptRecord *) NULL) {
7261              Tcl_AppendResult(interp, "bad event index ", argv[3],              Tcl_AppendResult(interp, "bad event index ", argv[3],
7262                      ": out of range", (char *) NULL);                      ": out of range", (char *) NULL);
7263              return TCL_ERROR;              return TCL_ERROR;
7264          }          }
7265    
7266          if (strcmp(argv[4], "readable") == 0) {          if (strcmp(argv[4], "readable") == 0) {
7267              mask = TCL_READABLE;              mask = TCL_READABLE;
7268          } else if (strcmp(argv[4], "writable") == 0) {          } else if (strcmp(argv[4], "writable") == 0) {
7269              mask = TCL_WRITABLE;              mask = TCL_WRITABLE;
7270          } else if (strcmp(argv[4], "none") == 0) {          } else if (strcmp(argv[4], "none") == 0) {
7271              mask = 0;              mask = 0;
7272          } else {          } else {
7273              Tcl_AppendResult(interp, "bad event name \"", argv[4],              Tcl_AppendResult(interp, "bad event name \"", argv[4],
7274                      "\": must be readable, writable, or none", (char *) NULL);                      "\": must be readable, writable, or none", (char *) NULL);
7275              return TCL_ERROR;              return TCL_ERROR;
7276          }          }
7277          esPtr->mask = mask;          esPtr->mask = mask;
7278          Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,          Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
7279                  ChannelEventScriptInvoker, (ClientData) esPtr);                  ChannelEventScriptInvoker, (ClientData) esPtr);
7280          return TCL_OK;          return TCL_OK;
7281      }          }    
7282      Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",      Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
7283              "add, delete, list, set, or removeall", (char *) NULL);              "add, delete, list, set, or removeall", (char *) NULL);
7284      return TCL_ERROR;      return TCL_ERROR;
7285  }  }
7286    
7287  /*  /*
7288   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7289   *   *
7290   * TclCopyChannel --   * TclCopyChannel --
7291   *   *
7292   *      This routine copies data from one channel to another, either   *      This routine copies data from one channel to another, either
7293   *      synchronously or asynchronously.  If a command script is   *      synchronously or asynchronously.  If a command script is
7294   *      supplied, the operation runs in the background.  The script   *      supplied, the operation runs in the background.  The script
7295   *      is invoked when the copy completes.  Otherwise the function   *      is invoked when the copy completes.  Otherwise the function
7296   *      waits until the copy is completed before returning.   *      waits until the copy is completed before returning.
7297   *   *
7298   * Results:   * Results:
7299   *      A standard Tcl result.   *      A standard Tcl result.
7300   *   *
7301   * Side effects:   * Side effects:
7302   *      May schedule a background copy operation that causes both   *      May schedule a background copy operation that causes both
7303   *      channels to be marked busy.   *      channels to be marked busy.
7304   *   *
7305   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7306   */   */
7307    
7308  int  int
7309  TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)  TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
7310      Tcl_Interp *interp;         /* Current interpreter. */      Tcl_Interp *interp;         /* Current interpreter. */
7311      Tcl_Channel inChan;         /* Channel to read from. */      Tcl_Channel inChan;         /* Channel to read from. */
7312      Tcl_Channel outChan;        /* Channel to write to. */      Tcl_Channel outChan;        /* Channel to write to. */
7313      int toRead;                 /* Amount of data to copy, or -1 for all. */      int toRead;                 /* Amount of data to copy, or -1 for all. */
7314      Tcl_Obj *cmdPtr;            /* Pointer to script to execute or NULL. */      Tcl_Obj *cmdPtr;            /* Pointer to script to execute or NULL. */
7315  {  {
7316      Channel *inPtr = (Channel *) inChan;      Channel *inPtr = (Channel *) inChan;
7317      Channel *outPtr = (Channel *) outChan;      Channel *outPtr = (Channel *) outChan;
7318      int readFlags, writeFlags;      int readFlags, writeFlags;
7319      CopyState *csPtr;      CopyState *csPtr;
7320      int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;      int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
7321    
7322      if (inPtr->csPtr) {      if (inPtr->csPtr) {
7323          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7324                  Tcl_GetChannelName(inChan), "\" is busy", NULL);                  Tcl_GetChannelName(inChan), "\" is busy", NULL);
7325          return TCL_ERROR;          return TCL_ERROR;
7326      }      }
7327      if (outPtr->csPtr) {      if (outPtr->csPtr) {
7328          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
7329                  Tcl_GetChannelName(outChan), "\" is busy", NULL);                  Tcl_GetChannelName(outChan), "\" is busy", NULL);
7330          return TCL_ERROR;          return TCL_ERROR;
7331      }      }
7332    
7333      readFlags = inPtr->flags;      readFlags = inPtr->flags;
7334      writeFlags = outPtr->flags;      writeFlags = outPtr->flags;
7335    
7336      /*      /*
7337       * Set up the blocking mode appropriately.  Background copies need       * Set up the blocking mode appropriately.  Background copies need
7338       * non-blocking channels.  Foreground copies need blocking channels.       * non-blocking channels.  Foreground copies need blocking channels.
7339       * If there is an error, restore the old blocking mode.       * If there is an error, restore the old blocking mode.
7340       */       */
7341    
7342      if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {      if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7343          if (SetBlockMode(interp, inPtr,          if (SetBlockMode(interp, inPtr,
7344                  nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)                  nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
7345                  != TCL_OK) {                  != TCL_OK) {
7346              return TCL_ERROR;              return TCL_ERROR;
7347          }          }
7348      }            }      
7349      if (inPtr != outPtr) {      if (inPtr != outPtr) {
7350          if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {          if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
7351              if (SetBlockMode(NULL, outPtr,              if (SetBlockMode(NULL, outPtr,
7352                      nonBlocking ? TCL_MODE_BLOCKING : TCL_MODE_NONBLOCKING)                      nonBlocking ? TCL_MODE_BLOCKING : TCL_MODE_NONBLOCKING)
7353                      != TCL_OK) {                      != TCL_OK) {
7354                  if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {                  if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
7355                      SetBlockMode(NULL, inPtr,                      SetBlockMode(NULL, inPtr,
7356                              (readFlags & CHANNEL_NONBLOCKING)                              (readFlags & CHANNEL_NONBLOCKING)
7357                              ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);                              ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
7358                      return TCL_ERROR;                      return TCL_ERROR;
7359                  }                  }
7360              }              }
7361          }          }
7362      }      }
7363    
7364      /*      /*
7365       * Make sure the output side is unbuffered.       * Make sure the output side is unbuffered.
7366       */       */
7367    
7368      outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))      outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))
7369          | CHANNEL_UNBUFFERED;          | CHANNEL_UNBUFFERED;
7370    
7371      /*      /*
7372       * Allocate a new CopyState to maintain info about the current copy in       * Allocate a new CopyState to maintain info about the current copy in
7373       * progress.  This structure will be deallocated when the copy is       * progress.  This structure will be deallocated when the copy is
7374       * completed.       * completed.
7375       */       */
7376    
7377      csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);      csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);
7378      csPtr->bufSize = inPtr->bufSize;      csPtr->bufSize = inPtr->bufSize;
7379      csPtr->readPtr = inPtr;      csPtr->readPtr = inPtr;
7380      csPtr->writePtr = outPtr;      csPtr->writePtr = outPtr;
7381      csPtr->readFlags = readFlags;      csPtr->readFlags = readFlags;
7382      csPtr->writeFlags = writeFlags;      csPtr->writeFlags = writeFlags;
7383      csPtr->toRead = toRead;      csPtr->toRead = toRead;
7384      csPtr->total = 0;      csPtr->total = 0;
7385      csPtr->interp = interp;      csPtr->interp = interp;
7386      if (cmdPtr) {      if (cmdPtr) {
7387          Tcl_IncrRefCount(cmdPtr);          Tcl_IncrRefCount(cmdPtr);
7388      }      }
7389      csPtr->cmdPtr = cmdPtr;      csPtr->cmdPtr = cmdPtr;
7390      inPtr->csPtr = csPtr;      inPtr->csPtr = csPtr;
7391      outPtr->csPtr = csPtr;      outPtr->csPtr = csPtr;
7392    
7393      /*      /*
7394       * Start copying data between the channels.       * Start copying data between the channels.
7395       */       */
7396    
7397      return CopyData(csPtr, 0);      return CopyData(csPtr, 0);
7398  }  }
7399    
7400  /*  /*
7401   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7402   *   *
7403   * CopyData --   * CopyData --
7404   *   *
7405   *      This function implements the lowest level of the copying   *      This function implements the lowest level of the copying
7406   *      mechanism for TclCopyChannel.   *      mechanism for TclCopyChannel.
7407   *   *
7408   * Results:   * Results:
7409   *      Returns TCL_OK on success, else TCL_ERROR.   *      Returns TCL_OK on success, else TCL_ERROR.
7410   *   *
7411   * Side effects:   * Side effects:
7412   *      Moves data between channels, may create channel handlers.   *      Moves data between channels, may create channel handlers.
7413   *   *
7414   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7415   */   */
7416    
7417  static int  static int
7418  CopyData(csPtr, mask)  CopyData(csPtr, mask)
7419      CopyState *csPtr;           /* State of copy operation. */      CopyState *csPtr;           /* State of copy operation. */
7420      int mask;                   /* Current channel event flags. */      int mask;                   /* Current channel event flags. */
7421  {  {
7422      Tcl_Interp *interp;      Tcl_Interp *interp;
7423      Tcl_Obj *cmdPtr, *errObj = NULL;      Tcl_Obj *cmdPtr, *errObj = NULL;
7424      Tcl_Channel inChan, outChan;      Tcl_Channel inChan, outChan;
7425      int result = TCL_OK;      int result = TCL_OK;
7426      int size;      int size;
7427      int total;      int total;
7428    
7429      inChan = (Tcl_Channel)csPtr->readPtr;      inChan = (Tcl_Channel)csPtr->readPtr;
7430      outChan = (Tcl_Channel)csPtr->writePtr;      outChan = (Tcl_Channel)csPtr->writePtr;
7431      interp = csPtr->interp;      interp = csPtr->interp;
7432      cmdPtr = csPtr->cmdPtr;      cmdPtr = csPtr->cmdPtr;
7433    
7434      /*      /*
7435       * Copy the data the slow way, using the translation mechanism.       * Copy the data the slow way, using the translation mechanism.
7436       */       */
7437    
7438      while (csPtr->toRead != 0) {      while (csPtr->toRead != 0) {
7439    
7440          /*          /*
7441           * Check for unreported background errors.           * Check for unreported background errors.
7442           */           */
7443    
7444          if (csPtr->readPtr->unreportedError != 0) {          if (csPtr->readPtr->unreportedError != 0) {
7445              Tcl_SetErrno(csPtr->readPtr->unreportedError);              Tcl_SetErrno(csPtr->readPtr->unreportedError);
7446              csPtr->readPtr->unreportedError = 0;              csPtr->readPtr->unreportedError = 0;
7447              goto readError;              goto readError;
7448          }          }
7449          if (csPtr->writePtr->unreportedError != 0) {          if (csPtr->writePtr->unreportedError != 0) {
7450              Tcl_SetErrno(csPtr->writePtr->unreportedError);              Tcl_SetErrno(csPtr->writePtr->unreportedError);
7451              csPtr->writePtr->unreportedError = 0;              csPtr->writePtr->unreportedError = 0;
7452              goto writeError;              goto writeError;
7453          }          }
7454                    
7455          /*          /*
7456           * Read up to bufSize bytes.           * Read up to bufSize bytes.
7457           */           */
7458    
7459          if ((csPtr->toRead == -1)          if ((csPtr->toRead == -1)
7460                  || (csPtr->toRead > csPtr->bufSize)) {                  || (csPtr->toRead > csPtr->bufSize)) {
7461              size = csPtr->bufSize;              size = csPtr->bufSize;
7462          } else {          } else {
7463              size = csPtr->toRead;              size = csPtr->toRead;
7464          }          }
7465          size = DoRead(csPtr->readPtr, csPtr->buffer, size);          size = DoRead(csPtr->readPtr, csPtr->buffer, size);
7466    
7467          if (size < 0) {          if (size < 0) {
7468              readError:              readError:
7469              errObj = Tcl_NewObj();              errObj = Tcl_NewObj();
7470              Tcl_AppendStringsToObj(errObj, "error reading \"",              Tcl_AppendStringsToObj(errObj, "error reading \"",
7471                      Tcl_GetChannelName(inChan), "\": ",                      Tcl_GetChannelName(inChan), "\": ",
7472                      Tcl_PosixError(interp), (char *) NULL);                      Tcl_PosixError(interp), (char *) NULL);
7473              break;              break;
7474          } else if (size == 0) {          } else if (size == 0) {
7475              /*              /*
7476               * We had an underflow on the read side.  If we are at EOF,               * We had an underflow on the read side.  If we are at EOF,
7477               * then the copying is done, otherwise set up a channel               * then the copying is done, otherwise set up a channel
7478               * handler to detect when the channel becomes readable again.               * handler to detect when the channel becomes readable again.
7479               */               */
7480                            
7481              if (Tcl_Eof(inChan)) {              if (Tcl_Eof(inChan)) {
7482                  break;                  break;
7483              } else if (!(mask & TCL_READABLE)) {              } else if (!(mask & TCL_READABLE)) {
7484                  if (mask & TCL_WRITABLE) {                  if (mask & TCL_WRITABLE) {
7485                      Tcl_DeleteChannelHandler(outChan, CopyEventProc,                      Tcl_DeleteChannelHandler(outChan, CopyEventProc,
7486                              (ClientData) csPtr);                              (ClientData) csPtr);
7487                  }                  }
7488                  Tcl_CreateChannelHandler(inChan, TCL_READABLE,                  Tcl_CreateChannelHandler(inChan, TCL_READABLE,
7489                          CopyEventProc, (ClientData) csPtr);                          CopyEventProc, (ClientData) csPtr);
7490              }              }
7491              return TCL_OK;              return TCL_OK;
7492          }          }
7493    
7494          /*          /*
7495           * Now write the buffer out.           * Now write the buffer out.
7496           */           */
7497    
7498          size = DoWrite(csPtr->writePtr, csPtr->buffer, size);          size = DoWrite(csPtr->writePtr, csPtr->buffer, size);
7499          if (size < 0) {          if (size < 0) {
7500              writeError:              writeError:
7501              errObj = Tcl_NewObj();              errObj = Tcl_NewObj();
7502              Tcl_AppendStringsToObj(errObj, "error writing \"",              Tcl_AppendStringsToObj(errObj, "error writing \"",
7503                      Tcl_GetChannelName(outChan), "\": ",                      Tcl_GetChannelName(outChan), "\": ",
7504                      Tcl_PosixError(interp), (char *) NULL);                      Tcl_PosixError(interp), (char *) NULL);
7505              break;              break;
7506          }          }
7507    
7508          /*          /*
7509           * Check to see if the write is happening in the background.  If so,           * 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.           * stop copying and wait for the channel to become writable again.
7511           */           */
7512    
7513          if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {          if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {
7514              if (!(mask & TCL_WRITABLE)) {              if (!(mask & TCL_WRITABLE)) {
7515                  if (mask & TCL_READABLE) {                  if (mask & TCL_READABLE) {
7516                      Tcl_DeleteChannelHandler(outChan, CopyEventProc,                      Tcl_DeleteChannelHandler(outChan, CopyEventProc,
7517                              (ClientData) csPtr);                              (ClientData) csPtr);
7518                  }                  }
7519                  Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,                  Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7520                          CopyEventProc, (ClientData) csPtr);                          CopyEventProc, (ClientData) csPtr);
7521              }              }
7522              return TCL_OK;              return TCL_OK;
7523          }          }
7524    
7525          /*          /*
7526           * Update the current byte count if we care.           * Update the current byte count if we care.
7527           */           */
7528    
7529          if (csPtr->toRead != -1) {          if (csPtr->toRead != -1) {
7530              csPtr->toRead -= size;              csPtr->toRead -= size;
7531          }          }
7532          csPtr->total += size;          csPtr->total += size;
7533    
7534          /*          /*
7535           * For background copies, we only do one buffer per invocation so           * For background copies, we only do one buffer per invocation so
7536           * we don't starve the rest of the system.           * we don't starve the rest of the system.
7537           */           */
7538    
7539          if (cmdPtr) {          if (cmdPtr) {
7540              /*              /*
7541               * The first time we enter this code, there won't be a               * The first time we enter this code, there won't be a
7542               * channel handler established yet, so do it here.               * channel handler established yet, so do it here.
7543               */               */
7544    
7545              if (mask == 0) {              if (mask == 0) {
7546                  Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,                  Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
7547                          CopyEventProc, (ClientData) csPtr);                          CopyEventProc, (ClientData) csPtr);
7548              }              }
7549              return TCL_OK;              return TCL_OK;
7550          }          }
7551      }      }
7552    
7553      /*      /*
7554       * Make the callback or return the number of bytes transferred.       * Make the callback or return the number of bytes transferred.
7555       * The local total is used because StopCopy frees csPtr.       * The local total is used because StopCopy frees csPtr.
7556       */       */
7557    
7558      total = csPtr->total;      total = csPtr->total;
7559      if (cmdPtr) {      if (cmdPtr) {
7560          /*          /*
7561           * Get a private copy of the command so we can mutate it           * Get a private copy of the command so we can mutate it
7562           * by adding arguments.  Note that StopCopy frees our saved           * by adding arguments.  Note that StopCopy frees our saved
7563           * reference to the original command obj.           * reference to the original command obj.
7564           */           */
7565    
7566          cmdPtr = Tcl_DuplicateObj(cmdPtr);          cmdPtr = Tcl_DuplicateObj(cmdPtr);
7567          Tcl_IncrRefCount(cmdPtr);          Tcl_IncrRefCount(cmdPtr);
7568          StopCopy(csPtr);          StopCopy(csPtr);
7569          Tcl_Preserve((ClientData) interp);          Tcl_Preserve((ClientData) interp);
7570    
7571          Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));          Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
7572          if (errObj) {          if (errObj) {
7573              Tcl_ListObjAppendElement(interp, cmdPtr, errObj);              Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
7574          }          }
7575          if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {          if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
7576              Tcl_BackgroundError(interp);              Tcl_BackgroundError(interp);
7577              result = TCL_ERROR;              result = TCL_ERROR;
7578          }          }
7579          Tcl_DecrRefCount(cmdPtr);          Tcl_DecrRefCount(cmdPtr);
7580          Tcl_Release((ClientData) interp);          Tcl_Release((ClientData) interp);
7581      } else {      } else {
7582          StopCopy(csPtr);          StopCopy(csPtr);
7583          if (errObj) {          if (errObj) {
7584              Tcl_SetObjResult(interp, errObj);              Tcl_SetObjResult(interp, errObj);
7585              result = TCL_ERROR;              result = TCL_ERROR;
7586          } else {          } else {
7587              Tcl_ResetResult(interp);              Tcl_ResetResult(interp);
7588              Tcl_SetIntObj(Tcl_GetObjResult(interp), total);              Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
7589          }          }
7590      }      }
7591      return result;      return result;
7592  }  }
7593    
7594  /*  /*
7595   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7596   *   *
7597   * DoRead --   * DoRead --
7598   *   *
7599   *      Reads a given number of bytes from a channel.   *      Reads a given number of bytes from a channel.
7600   *   *
7601   * Results:   * Results:
7602   *      The number of characters read, or -1 on error. Use Tcl_GetErrno()   *      The number of characters read, or -1 on error. Use Tcl_GetErrno()
7603   *      to retrieve the error code for the error that occurred.   *      to retrieve the error code for the error that occurred.
7604   *   *
7605   * Side effects:   * Side effects:
7606   *      May cause input to be buffered.   *      May cause input to be buffered.
7607   *   *
7608   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7609   */   */
7610    
7611  static int  static int
7612  DoRead(chanPtr, bufPtr, toRead)  DoRead(chanPtr, bufPtr, toRead)
7613      Channel *chanPtr;           /* The channel from which to read. */      Channel *chanPtr;           /* The channel from which to read. */
7614      char *bufPtr;               /* Where to store input read. */      char *bufPtr;               /* Where to store input read. */
7615      int toRead;                 /* Maximum number of bytes to read. */      int toRead;                 /* Maximum number of bytes to read. */
7616  {  {
7617      int copied;                 /* How many characters were copied into      int copied;                 /* How many characters were copied into
7618                                   * the result string? */                                   * the result string? */
7619      int copiedNow;              /* How many characters were copied from      int copiedNow;              /* How many characters were copied from
7620                                   * the current input buffer? */                                   * the current input buffer? */
7621      int result;                 /* Of calling GetInput. */      int result;                 /* Of calling GetInput. */
7622            
7623      /*      /*
7624       * If we have not encountered a sticky EOF, clear the EOF bit. Either       * 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       * way clear the BLOCKED bit. We want to discover these anew during
7626       * each operation.       * each operation.
7627       */       */
7628    
7629      if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {      if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
7630          chanPtr->flags &= ~CHANNEL_EOF;          chanPtr->flags &= ~CHANNEL_EOF;
7631      }      }
7632      chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);      chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
7633            
7634      for (copied = 0; copied < toRead; copied += copiedNow) {      for (copied = 0; copied < toRead; copied += copiedNow) {
7635          copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,          copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
7636                  toRead - copied);                  toRead - copied);
7637          if (copiedNow == 0) {          if (copiedNow == 0) {
7638              if (chanPtr->flags & CHANNEL_EOF) {              if (chanPtr->flags & CHANNEL_EOF) {
7639                  goto done;                  goto done;
7640              }              }
7641              if (chanPtr->flags & CHANNEL_BLOCKED) {              if (chanPtr->flags & CHANNEL_BLOCKED) {
7642                  if (chanPtr->flags & CHANNEL_NONBLOCKING) {                  if (chanPtr->flags & CHANNEL_NONBLOCKING) {
7643                      goto done;                      goto done;
7644                  }                  }
7645                  chanPtr->flags &= (~(CHANNEL_BLOCKED));                  chanPtr->flags &= (~(CHANNEL_BLOCKED));
7646              }              }
7647              result = GetInput(chanPtr);              result = GetInput(chanPtr);
7648              if (result != 0) {              if (result != 0) {
7649                  if (result != EAGAIN) {                  if (result != EAGAIN) {
7650                      copied = -1;                      copied = -1;
7651                  }                  }
7652                  goto done;                  goto done;
7653              }              }
7654          }          }
7655      }      }
7656    
7657      chanPtr->flags &= (~(CHANNEL_BLOCKED));      chanPtr->flags &= (~(CHANNEL_BLOCKED));
7658    
7659      done:      done:
7660      /*      /*
7661       * Update the notifier state so we don't block while there is still       * Update the notifier state so we don't block while there is still
7662       * data in the buffers.       * data in the buffers.
7663       */       */
7664    
7665      UpdateInterest(chanPtr);      UpdateInterest(chanPtr);
7666      return copied;      return copied;
7667  }  }
7668    
7669  /*  /*
7670   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7671   *   *
7672   * CopyAndTranslateBuffer --   * CopyAndTranslateBuffer --
7673   *   *
7674   *      Copy at most one buffer of input to the result space, doing   *      Copy at most one buffer of input to the result space, doing
7675   *      eol translations according to mode in effect currently.   *      eol translations according to mode in effect currently.
7676   *   *
7677   * Results:   * Results:
7678   *      Number of bytes stored in the result buffer (as opposed to the   *      Number of bytes stored in the result buffer (as opposed to the
7679   *      number of bytes read from the channel).  May return   *      number of bytes read from the channel).  May return
7680   *      zero if no input is available to be translated.   *      zero if no input is available to be translated.
7681   *   *
7682   * Side effects:   * Side effects:
7683   *      Consumes buffered input. May deallocate one buffer.   *      Consumes buffered input. May deallocate one buffer.
7684   *   *
7685   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7686   */   */
7687    
7688  static int  static int
7689  CopyAndTranslateBuffer(chanPtr, result, space)  CopyAndTranslateBuffer(chanPtr, result, space)
7690      Channel *chanPtr;           /* The channel from which to read input. */      Channel *chanPtr;           /* The channel from which to read input. */
7691      char *result;               /* Where to store the copied input. */      char *result;               /* Where to store the copied input. */
7692      int space;                  /* How many bytes are available in result      int space;                  /* How many bytes are available in result
7693                                   * to store the copied input? */                                   * to store the copied input? */
7694  {  {
7695      int bytesInBuffer;          /* How many bytes are available to be      int bytesInBuffer;          /* How many bytes are available to be
7696                                   * copied in the current input buffer? */                                   * copied in the current input buffer? */
7697      int copied;                 /* How many characters were already copied      int copied;                 /* How many characters were already copied
7698                                   * into the destination space? */                                   * into the destination space? */
7699      ChannelBuffer *bufPtr;      /* The buffer from which to copy bytes. */      ChannelBuffer *bufPtr;      /* The buffer from which to copy bytes. */
7700      int i;                      /* Iterates over the copied input looking      int i;                      /* Iterates over the copied input looking
7701                                   * for the input eofChar. */                                   * for the input eofChar. */
7702            
7703      /*      /*
7704       * If there is no input at all, return zero. The invariant is that either       * 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       * 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).       * 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.       * Note also that if the buffer is empty, we leave it in the queue.
7708       */       */
7709            
7710      if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {      if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
7711          return 0;          return 0;
7712      }      }
7713      bufPtr = chanPtr->inQueueHead;      bufPtr = chanPtr->inQueueHead;
7714      bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;      bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
7715    
7716      copied = 0;      copied = 0;
7717      switch (chanPtr->inputTranslation) {      switch (chanPtr->inputTranslation) {
7718          case TCL_TRANSLATE_LF: {          case TCL_TRANSLATE_LF: {
7719              if (bytesInBuffer == 0) {              if (bytesInBuffer == 0) {
7720                  return 0;                  return 0;
7721              }              }
7722    
7723              /*              /*
7724               * Copy the current chunk into the result buffer.               * Copy the current chunk into the result buffer.
7725               */               */
7726    
7727              if (bytesInBuffer < space) {              if (bytesInBuffer < space) {
7728                  space = bytesInBuffer;                  space = bytesInBuffer;
7729              }              }
7730              memcpy((VOID *) result,              memcpy((VOID *) result,
7731                      (VOID *) (bufPtr->buf + bufPtr->nextRemoved),                      (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7732                      (size_t) space);                      (size_t) space);
7733              bufPtr->nextRemoved += space;              bufPtr->nextRemoved += space;
7734              copied = space;              copied = space;
7735              break;              break;
7736          }          }
7737          case TCL_TRANSLATE_CR: {          case TCL_TRANSLATE_CR: {
7738              char *end;              char *end;
7739                            
7740              if (bytesInBuffer == 0) {              if (bytesInBuffer == 0) {
7741                  return 0;                  return 0;
7742              }              }
7743    
7744              /*              /*
7745               * Copy the current chunk into the result buffer, then               * Copy the current chunk into the result buffer, then
7746               * replace all \r with \n.               * replace all \r with \n.
7747               */               */
7748    
7749              if (bytesInBuffer < space) {              if (bytesInBuffer < space) {
7750                  space = bytesInBuffer;                  space = bytesInBuffer;
7751              }              }
7752              memcpy((VOID *) result,              memcpy((VOID *) result,
7753                      (VOID *) (bufPtr->buf + bufPtr->nextRemoved),                      (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7754                      (size_t) space);                      (size_t) space);
7755              bufPtr->nextRemoved += space;              bufPtr->nextRemoved += space;
7756              copied = space;              copied = space;
7757    
7758              for (end = result + copied; result < end; result++) {              for (end = result + copied; result < end; result++) {
7759                  if (*result == '\r') {                  if (*result == '\r') {
7760                      *result = '\n';                      *result = '\n';
7761                  }                  }
7762              }              }
7763              break;              break;
7764          }          }
7765          case TCL_TRANSLATE_CRLF: {          case TCL_TRANSLATE_CRLF: {
7766              char *src, *end, *dst;              char *src, *end, *dst;
7767              int curByte;              int curByte;
7768                            
7769              /*              /*
7770               * If there is a held-back "\r" at EOF, produce it now.               * If there is a held-back "\r" at EOF, produce it now.
7771               */               */
7772                            
7773              if (bytesInBuffer == 0) {              if (bytesInBuffer == 0) {
7774                  if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==                  if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
7775                          (INPUT_SAW_CR | CHANNEL_EOF)) {                          (INPUT_SAW_CR | CHANNEL_EOF)) {
7776                      result[0] = '\r';                      result[0] = '\r';
7777                      chanPtr->flags &= ~INPUT_SAW_CR;                      chanPtr->flags &= ~INPUT_SAW_CR;
7778                      return 1;                      return 1;
7779                  }                  }
7780                  return 0;                  return 0;
7781              }              }
7782    
7783              /*              /*
7784               * Copy the current chunk and replace "\r\n" with "\n"               * Copy the current chunk and replace "\r\n" with "\n"
7785               * (but not standalone "\r"!).               * (but not standalone "\r"!).
7786               */               */
7787    
7788              if (bytesInBuffer < space) {              if (bytesInBuffer < space) {
7789                  space = bytesInBuffer;                  space = bytesInBuffer;
7790              }              }
7791              memcpy((VOID *) result,              memcpy((VOID *) result,
7792                      (VOID *) (bufPtr->buf + bufPtr->nextRemoved),                      (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7793                      (size_t) space);                      (size_t) space);
7794              bufPtr->nextRemoved += space;              bufPtr->nextRemoved += space;
7795              copied = space;              copied = space;
7796    
7797              end = result + copied;              end = result + copied;
7798              dst = result;              dst = result;
7799              for (src = result; src < end; src++) {              for (src = result; src < end; src++) {
7800                  curByte = *src;                  curByte = *src;
7801                  if (curByte == '\n') {                  if (curByte == '\n') {
7802                      chanPtr->flags &= ~INPUT_SAW_CR;                      chanPtr->flags &= ~INPUT_SAW_CR;
7803                  } else if (chanPtr->flags & INPUT_SAW_CR) {                  } else if (chanPtr->flags & INPUT_SAW_CR) {
7804                      chanPtr->flags &= ~INPUT_SAW_CR;                      chanPtr->flags &= ~INPUT_SAW_CR;
7805                      *dst = '\r';                      *dst = '\r';
7806                      dst++;                      dst++;
7807                  }                  }
7808                  if (curByte == '\r') {                  if (curByte == '\r') {
7809                      chanPtr->flags |= INPUT_SAW_CR;                      chanPtr->flags |= INPUT_SAW_CR;
7810                  } else {                  } else {
7811                      *dst = (char) curByte;                      *dst = (char) curByte;
7812                      dst++;                      dst++;
7813                  }                  }
7814              }              }
7815              copied = dst - result;              copied = dst - result;
7816              break;              break;
7817          }          }
7818          case TCL_TRANSLATE_AUTO: {          case TCL_TRANSLATE_AUTO: {
7819              char *src, *end, *dst;              char *src, *end, *dst;
7820              int curByte;              int curByte;
7821                    
7822              if (bytesInBuffer == 0) {              if (bytesInBuffer == 0) {
7823                  return 0;                  return 0;
7824              }              }
7825    
7826              /*              /*
7827               * Loop over the current buffer, converting "\r" and "\r\n"               * Loop over the current buffer, converting "\r" and "\r\n"
7828               * to "\n".               * to "\n".
7829               */               */
7830    
7831              if (bytesInBuffer < space) {              if (bytesInBuffer < space) {
7832                  space = bytesInBuffer;                  space = bytesInBuffer;
7833              }              }
7834              memcpy((VOID *) result,              memcpy((VOID *) result,
7835                      (VOID *) (bufPtr->buf + bufPtr->nextRemoved),                      (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
7836                      (size_t) space);                      (size_t) space);
7837              bufPtr->nextRemoved += space;              bufPtr->nextRemoved += space;
7838              copied = space;              copied = space;
7839    
7840              end = result + copied;              end = result + copied;
7841              dst = result;              dst = result;
7842              for (src = result; src < end; src++) {              for (src = result; src < end; src++) {
7843                  curByte = *src;                  curByte = *src;
7844                  if (curByte == '\r') {                  if (curByte == '\r') {
7845                      chanPtr->flags |= INPUT_SAW_CR;                      chanPtr->flags |= INPUT_SAW_CR;
7846                      *dst = '\n';                      *dst = '\n';
7847                      dst++;                      dst++;
7848                  } else {                  } else {
7849                      if ((curByte != '\n') ||                      if ((curByte != '\n') ||
7850                              !(chanPtr->flags & INPUT_SAW_CR)) {                              !(chanPtr->flags & INPUT_SAW_CR)) {
7851                          *dst = (char) curByte;                          *dst = (char) curByte;
7852                          dst++;                          dst++;
7853                      }                      }
7854                      chanPtr->flags &= ~INPUT_SAW_CR;                      chanPtr->flags &= ~INPUT_SAW_CR;
7855                  }                  }
7856              }              }
7857              copied = dst - result;              copied = dst - result;
7858              break;              break;
7859          }          }
7860          default: {          default: {
7861              panic("unknown eol translation mode");              panic("unknown eol translation mode");
7862          }          }
7863      }      }
7864    
7865      /*      /*
7866       * If an in-stream EOF character is set for this channel, check that       * 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,       * the input we copied so far does not contain the EOF char.  If it does,
7868       * copy only up to and excluding that character.       * copy only up to and excluding that character.
7869       */       */
7870            
7871      if (chanPtr->inEofChar != 0) {      if (chanPtr->inEofChar != 0) {
7872          for (i = 0; i < copied; i++) {          for (i = 0; i < copied; i++) {
7873              if (result[i] == (char) chanPtr->inEofChar) {              if (result[i] == (char) chanPtr->inEofChar) {
7874                  /*                  /*
7875                   * Set sticky EOF so that no further input is presented                   * Set sticky EOF so that no further input is presented
7876                   * to the caller.                   * to the caller.
7877                   */                   */
7878                                    
7879                  chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);                  chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
7880                  chanPtr->inputEncodingFlags |= TCL_ENCODING_END;                  chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
7881                  copied = i;                  copied = i;
7882                  break;                  break;
7883              }              }
7884          }          }
7885      }      }
7886    
7887      /*      /*
7888       * If the current buffer is empty recycle it.       * If the current buffer is empty recycle it.
7889       */       */
7890    
7891      if (bufPtr->nextRemoved == bufPtr->nextAdded) {      if (bufPtr->nextRemoved == bufPtr->nextAdded) {
7892          chanPtr->inQueueHead = bufPtr->nextPtr;          chanPtr->inQueueHead = bufPtr->nextPtr;
7893          if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {          if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
7894              chanPtr->inQueueTail = (ChannelBuffer *) NULL;              chanPtr->inQueueTail = (ChannelBuffer *) NULL;
7895          }          }
7896          RecycleBuffer(chanPtr, bufPtr, 0);          RecycleBuffer(chanPtr, bufPtr, 0);
7897      }      }
7898    
7899      /*      /*
7900       * Return the number of characters copied into the result buffer.       * Return the number of characters copied into the result buffer.
7901       * This may be different from the number of bytes consumed, because       * This may be different from the number of bytes consumed, because
7902       * of EOL translations.       * of EOL translations.
7903       */       */
7904    
7905      return copied;      return copied;
7906  }  }
7907    
7908  /*  /*
7909   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7910   *   *
7911   * DoWrite --   * DoWrite --
7912   *   *
7913   *      Puts a sequence of characters into an output buffer, may queue the   *      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   *      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   *      current buffer is ready e.g. if it contains a newline and we are in
7916   *      line buffering mode.   *      line buffering mode.
7917   *   *
7918   * Results:   * Results:
7919   *      The number of bytes written or -1 in case of error. If -1,   *      The number of bytes written or -1 in case of error. If -1,
7920   *      Tcl_GetErrno will return the error code.   *      Tcl_GetErrno will return the error code.
7921   *   *
7922   * Side effects:   * Side effects:
7923   *      May buffer up output and may cause output to be produced on the   *      May buffer up output and may cause output to be produced on the
7924   *      channel.   *      channel.
7925   *   *
7926   *----------------------------------------------------------------------   *----------------------------------------------------------------------
7927   */   */
7928    
7929  static int  static int
7930  DoWrite(chanPtr, src, srcLen)  DoWrite(chanPtr, src, srcLen)
7931      Channel *chanPtr;                   /* The channel to buffer output for. */      Channel *chanPtr;                   /* The channel to buffer output for. */
7932      char *src;                          /* Data to write. */      char *src;                          /* Data to write. */
7933      int srcLen;                         /* Number of bytes to write. */      int srcLen;                         /* Number of bytes to write. */
7934  {  {
7935      ChannelBuffer *outBufPtr;           /* Current output buffer. */      ChannelBuffer *outBufPtr;           /* Current output buffer. */
7936      int foundNewline;                   /* Did we find a newline in output? */      int foundNewline;                   /* Did we find a newline in output? */
7937      char *dPtr;      char *dPtr;
7938      char *sPtr;                         /* Search variables for newline. */      char *sPtr;                         /* Search variables for newline. */
7939      int crsent;                         /* In CRLF eol translation mode,      int crsent;                         /* In CRLF eol translation mode,
7940                                           * remember the fact that a CR was                                           * remember the fact that a CR was
7941                                           * output to the channel without                                           * output to the channel without
7942                                           * its following NL. */                                           * its following NL. */
7943      int i;                              /* Loop index for newline search. */      int i;                              /* Loop index for newline search. */
7944      int destCopied;                     /* How many bytes were used in this      int destCopied;                     /* How many bytes were used in this
7945                                           * destination buffer to hold the                                           * destination buffer to hold the
7946                                           * output? */                                           * output? */
7947      int totalDestCopied;                /* How many bytes total were      int totalDestCopied;                /* How many bytes total were
7948                                           * copied to the channel buffer? */                                           * copied to the channel buffer? */
7949      int srcCopied;                      /* How many bytes were copied from      int srcCopied;                      /* How many bytes were copied from
7950                                           * the source string? */                                           * the source string? */
7951      char *destPtr;                      /* Where in line to copy to? */      char *destPtr;                      /* Where in line to copy to? */
7952    
7953      /*      /*
7954       * If we are in network (or windows) translation mode, record the fact       * If we are in network (or windows) translation mode, record the fact
7955       * that we have not yet sent a CR to the channel.       * that we have not yet sent a CR to the channel.
7956       */       */
7957    
7958      crsent = 0;      crsent = 0;
7959            
7960      /*      /*
7961       * Loop filling buffers and flushing them until all output has been       * Loop filling buffers and flushing them until all output has been
7962       * consumed.       * consumed.
7963       */       */
7964    
7965      srcCopied = 0;      srcCopied = 0;
7966      totalDestCopied = 0;      totalDestCopied = 0;
7967    
7968      while (srcLen > 0) {      while (srcLen > 0) {
7969                    
7970          /*          /*
7971           * Make sure there is a current output buffer to accept output.           * Make sure there is a current output buffer to accept output.
7972           */           */
7973    
7974          if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {          if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
7975              chanPtr->curOutPtr = AllocChannelBuffer(chanPtr->bufSize);              chanPtr->curOutPtr = AllocChannelBuffer(chanPtr->bufSize);
7976          }          }
7977    
7978          outBufPtr = chanPtr->curOutPtr;          outBufPtr = chanPtr->curOutPtr;
7979    
7980          destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;          destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
7981          if (destCopied > srcLen) {          if (destCopied > srcLen) {
7982              destCopied = srcLen;              destCopied = srcLen;
7983          }          }
7984                    
7985          destPtr = outBufPtr->buf + outBufPtr->nextAdded;          destPtr = outBufPtr->buf + outBufPtr->nextAdded;
7986          switch (chanPtr->outputTranslation) {          switch (chanPtr->outputTranslation) {
7987              case TCL_TRANSLATE_LF:              case TCL_TRANSLATE_LF:
7988                  srcCopied = destCopied;                  srcCopied = destCopied;
7989                  memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);                  memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
7990                  break;                  break;
7991              case TCL_TRANSLATE_CR:              case TCL_TRANSLATE_CR:
7992                  srcCopied = destCopied;                  srcCopied = destCopied;
7993                  memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);                  memcpy((VOID *) destPtr, (VOID *) src, (size_t) destCopied);
7994                  for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {                  for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
7995                      if (*dPtr == '\n') {                      if (*dPtr == '\n') {
7996                          *dPtr = '\r';                          *dPtr = '\r';
7997                      }                      }
7998                  }                  }
7999                  break;                  break;
8000              case TCL_TRANSLATE_CRLF:              case TCL_TRANSLATE_CRLF:
8001                  for (srcCopied = 0, dPtr = destPtr, sPtr = src;                  for (srcCopied = 0, dPtr = destPtr, sPtr = src;
8002                       dPtr < destPtr + destCopied;                       dPtr < destPtr + destCopied;
8003                       dPtr++, sPtr++, srcCopied++) {                       dPtr++, sPtr++, srcCopied++) {
8004                      if (*sPtr == '\n') {                      if (*sPtr == '\n') {
8005                          if (crsent) {                          if (crsent) {
8006                              *dPtr = '\n';                              *dPtr = '\n';
8007                              crsent = 0;                              crsent = 0;
8008                          } else {                          } else {
8009                              *dPtr = '\r';                              *dPtr = '\r';
8010                              crsent = 1;                              crsent = 1;
8011                              sPtr--, srcCopied--;                              sPtr--, srcCopied--;
8012                          }                          }
8013                      } else {                      } else {
8014                          *dPtr = *sPtr;                          *dPtr = *sPtr;
8015                      }                      }
8016                  }                  }
8017                  break;                  break;
8018              case TCL_TRANSLATE_AUTO:              case TCL_TRANSLATE_AUTO:
8019                  panic("Tcl_Write: AUTO output translation mode not supported");                  panic("Tcl_Write: AUTO output translation mode not supported");
8020              default:              default:
8021                  panic("Tcl_Write: unknown output translation mode");                  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           * 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           * contains a newline and this channel is line-buffered, or if it
8027           * contains any output and this channel is unbuffered.           * contains any output and this channel is unbuffered.
8028           */           */
8029    
8030          outBufPtr->nextAdded += destCopied;          outBufPtr->nextAdded += destCopied;
8031          if (!(chanPtr->flags & BUFFER_READY)) {          if (!(chanPtr->flags & BUFFER_READY)) {
8032              if (outBufPtr->nextAdded == outBufPtr->bufLength) {              if (outBufPtr->nextAdded == outBufPtr->bufLength) {
8033                  chanPtr->flags |= BUFFER_READY;                  chanPtr->flags |= BUFFER_READY;
8034              } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {              } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
8035                  for (sPtr = src, i = 0, foundNewline = 0;                  for (sPtr = src, i = 0, foundNewline = 0;
8036                           (i < srcCopied) && (!foundNewline);                           (i < srcCopied) && (!foundNewline);
8037                           i++, sPtr++) {                           i++, sPtr++) {
8038                      if (*sPtr == '\n') {                      if (*sPtr == '\n') {
8039                          foundNewline = 1;                          foundNewline = 1;
8040                          break;                          break;
8041                      }                      }
8042                  }                  }
8043                  if (foundNewline) {                  if (foundNewline) {
8044                      chanPtr->flags |= BUFFER_READY;                      chanPtr->flags |= BUFFER_READY;
8045                  }                  }
8046              } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {              } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
8047                  chanPtr->flags |= BUFFER_READY;                  chanPtr->flags |= BUFFER_READY;
8048              }              }
8049          }          }
8050                    
8051          totalDestCopied += srcCopied;          totalDestCopied += srcCopied;
8052          src += srcCopied;          src += srcCopied;
8053          srcLen -= srcCopied;          srcLen -= srcCopied;
8054    
8055          if (chanPtr->flags & BUFFER_READY) {          if (chanPtr->flags & BUFFER_READY) {
8056              if (FlushChannel(NULL, chanPtr, 0) != 0) {              if (FlushChannel(NULL, chanPtr, 0) != 0) {
8057                  return -1;                  return -1;
8058              }              }
8059          }          }
8060      } /* Closes "while" */      } /* Closes "while" */
8061    
8062      return totalDestCopied;      return totalDestCopied;
8063  }  }
8064    
8065  /*  /*
8066   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8067   *   *
8068   * CopyEventProc --   * CopyEventProc --
8069   *   *
8070   *      This routine is invoked as a channel event handler for   *      This routine is invoked as a channel event handler for
8071   *      the background copy operation.  It is just a trivial wrapper   *      the background copy operation.  It is just a trivial wrapper
8072   *      around the CopyData routine.   *      around the CopyData routine.
8073   *   *
8074   * Results:   * Results:
8075   *      None.   *      None.
8076   *   *
8077   * Side effects:   * Side effects:
8078   *      None.   *      None.
8079   *   *
8080   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8081   */   */
8082    
8083  static void  static void
8084  CopyEventProc(clientData, mask)  CopyEventProc(clientData, mask)
8085      ClientData clientData;      ClientData clientData;
8086      int mask;      int mask;
8087  {  {
8088      (void) CopyData((CopyState *)clientData, mask);      (void) CopyData((CopyState *)clientData, mask);
8089  }  }
8090    
8091  /*  /*
8092   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8093   *   *
8094   * StopCopy --   * StopCopy --
8095   *   *
8096   *      This routine halts a copy that is in progress.   *      This routine halts a copy that is in progress.
8097   *   *
8098   * Results:   * Results:
8099   *      None.   *      None.
8100   *   *
8101   * Side effects:   * Side effects:
8102   *      Removes any pending channel handlers and restores the blocking   *      Removes any pending channel handlers and restores the blocking
8103   *      and buffering modes of the channels.  The CopyState is freed.   *      and buffering modes of the channels.  The CopyState is freed.
8104   *   *
8105   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8106   */   */
8107    
8108  static void  static void
8109  StopCopy(csPtr)  StopCopy(csPtr)
8110      CopyState *csPtr;           /* State for bg copy to stop . */      CopyState *csPtr;           /* State for bg copy to stop . */
8111  {  {
8112      int nonBlocking;      int nonBlocking;
8113    
8114      if (!csPtr) {      if (!csPtr) {
8115          return;          return;
8116      }      }
8117    
8118      /*      /*
8119       * Restore the old blocking mode and output buffering mode.       * Restore the old blocking mode and output buffering mode.
8120       */       */
8121    
8122      nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);      nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
8123      if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {      if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {
8124          SetBlockMode(NULL, csPtr->readPtr,          SetBlockMode(NULL, csPtr->readPtr,
8125                  nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);                  nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
8126      }      }
8127      if (csPtr->writePtr != csPtr->writePtr) {      if (csPtr->writePtr != csPtr->writePtr) {
8128          if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {          if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {
8129              SetBlockMode(NULL, csPtr->writePtr,              SetBlockMode(NULL, csPtr->writePtr,
8130                      nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);                      nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
8131          }          }
8132      }      }
8133      csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);      csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
8134      csPtr->writePtr->flags |=      csPtr->writePtr->flags |=
8135          csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);          csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
8136                            
8137    
8138      if (csPtr->cmdPtr) {      if (csPtr->cmdPtr) {
8139          Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,          Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
8140              (ClientData)csPtr);              (ClientData)csPtr);
8141          if (csPtr->readPtr != csPtr->writePtr) {          if (csPtr->readPtr != csPtr->writePtr) {
8142              Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,              Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
8143                      CopyEventProc, (ClientData)csPtr);                      CopyEventProc, (ClientData)csPtr);
8144          }          }
8145          Tcl_DecrRefCount(csPtr->cmdPtr);          Tcl_DecrRefCount(csPtr->cmdPtr);
8146      }      }
8147      csPtr->readPtr->csPtr = NULL;      csPtr->readPtr->csPtr = NULL;
8148      csPtr->writePtr->csPtr = NULL;      csPtr->writePtr->csPtr = NULL;
8149      ckfree((char*) csPtr);      ckfree((char*) csPtr);
8150  }  }
8151    
8152  /*  /*
8153   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8154   *   *
8155   * SetBlockMode --   * SetBlockMode --
8156   *   *
8157   *      This function sets the blocking mode for a channel and updates   *      This function sets the blocking mode for a channel and updates
8158   *      the state flags.   *      the state flags.
8159   *   *
8160   * Results:   * Results:
8161   *      A standard Tcl result.   *      A standard Tcl result.
8162   *   *
8163   * Side effects:   * Side effects:
8164   *      Modifies the blocking mode of the channel and possibly generates   *      Modifies the blocking mode of the channel and possibly generates
8165   *      an error.   *      an error.
8166   *   *
8167   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8168   */   */
8169    
8170  static int  static int
8171  SetBlockMode(interp, chanPtr, mode)  SetBlockMode(interp, chanPtr, mode)
8172      Tcl_Interp *interp;         /* Interp for error reporting. */      Tcl_Interp *interp;         /* Interp for error reporting. */
8173      Channel *chanPtr;           /* Channel to modify. */      Channel *chanPtr;           /* Channel to modify. */
8174      int mode;                   /* One of TCL_MODE_BLOCKING or      int mode;                   /* One of TCL_MODE_BLOCKING or
8175                                   * TCL_MODE_NONBLOCKING. */                                   * TCL_MODE_NONBLOCKING. */
8176  {  {
8177      int result = 0;      int result = 0;
8178      if (chanPtr->typePtr->blockModeProc != NULL) {      if (chanPtr->typePtr->blockModeProc != NULL) {
8179          result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,          result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
8180                  mode);                  mode);
8181      }      }
8182      if (result != 0) {      if (result != 0) {
8183          Tcl_SetErrno(result);          Tcl_SetErrno(result);
8184          if (interp != (Tcl_Interp *) NULL) {          if (interp != (Tcl_Interp *) NULL) {
8185              Tcl_AppendResult(interp, "error setting blocking mode: ",              Tcl_AppendResult(interp, "error setting blocking mode: ",
8186                      Tcl_PosixError(interp), (char *) NULL);                      Tcl_PosixError(interp), (char *) NULL);
8187          }          }
8188          return TCL_ERROR;          return TCL_ERROR;
8189      }      }
8190      if (mode == TCL_MODE_BLOCKING) {      if (mode == TCL_MODE_BLOCKING) {
8191          chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));          chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
8192      } else {      } else {
8193          chanPtr->flags |= CHANNEL_NONBLOCKING;          chanPtr->flags |= CHANNEL_NONBLOCKING;
8194      }      }
8195      return TCL_OK;      return TCL_OK;
8196  }  }
8197    
8198  /*  /*
8199   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8200   *   *
8201   * Tcl_GetChannelNames --   * Tcl_GetChannelNames --
8202   *   *
8203   *      Return the names of all open channels in the interp.   *      Return the names of all open channels in the interp.
8204   *   *
8205   * Results:   * Results:
8206   *      TCL_OK or TCL_ERROR.   *      TCL_OK or TCL_ERROR.
8207   *   *
8208   * Side effects:   * Side effects:
8209   *      Interp result modified with list of channel names.   *      Interp result modified with list of channel names.
8210   *   *
8211   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8212   */   */
8213    
8214  int  int
8215  Tcl_GetChannelNames(interp)  Tcl_GetChannelNames(interp)
8216      Tcl_Interp *interp;         /* Interp for error reporting. */      Tcl_Interp *interp;         /* Interp for error reporting. */
8217  {  {
8218      return Tcl_GetChannelNamesEx(interp, (char *) NULL);      return Tcl_GetChannelNamesEx(interp, (char *) NULL);
8219  }  }
8220    
8221  /*  /*
8222   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8223   *   *
8224   * Tcl_GetChannelNamesEx --   * Tcl_GetChannelNamesEx --
8225   *   *
8226   *      Return the names of open channels in the interp filtered   *      Return the names of open channels in the interp filtered
8227   *      filtered through a pattern.  If pattern is NULL, it returns   *      filtered through a pattern.  If pattern is NULL, it returns
8228   *      all the open channels.   *      all the open channels.
8229   *   *
8230   * Results:   * Results:
8231   *      TCL_OK or TCL_ERROR.   *      TCL_OK or TCL_ERROR.
8232   *   *
8233   * Side effects:   * Side effects:
8234   *      Interp result modified with list of channel names.   *      Interp result modified with list of channel names.
8235   *   *
8236   *----------------------------------------------------------------------   *----------------------------------------------------------------------
8237   */   */
8238    
8239  int  int
8240  Tcl_GetChannelNamesEx(interp, pattern)  Tcl_GetChannelNamesEx(interp, pattern)
8241      Tcl_Interp *interp;         /* Interp for error reporting. */      Tcl_Interp *interp;         /* Interp for error reporting. */
8242      char *pattern;              /* pattern to filter on. */      char *pattern;              /* pattern to filter on. */
8243  {  {
8244      Channel *chanPtr;      Channel *chanPtr;
8245      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);      ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
8246      char *name;      char *name;
8247      Tcl_Obj *resultPtr;      Tcl_Obj *resultPtr;
8248    
8249      resultPtr = Tcl_GetObjResult(interp);      resultPtr = Tcl_GetObjResult(interp);
8250      for (chanPtr = tsdPtr->firstChanPtr;      for (chanPtr = tsdPtr->firstChanPtr;
8251           chanPtr != NULL;           chanPtr != NULL;
8252           chanPtr = chanPtr->nextChanPtr) {           chanPtr = chanPtr->nextChanPtr) {
8253          if (chanPtr == (Channel *) tsdPtr->stdinChannel) {          if (chanPtr == (Channel *) tsdPtr->stdinChannel) {
8254              name = "stdin";              name = "stdin";
8255          } else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {          } else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) {
8256              name = "stdout";              name = "stdout";
8257          } else if (chanPtr == (Channel *) tsdPtr->stderrChannel) {          } else if (chanPtr == (Channel *) tsdPtr->stderrChannel) {
8258              name = "stderr";              name = "stderr";
8259          } else {          } else {
8260              name = chanPtr->channelName;              name = chanPtr->channelName;
8261          }          }
8262          if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&          if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
8263                  (Tcl_ListObjAppendElement(interp, resultPtr,                  (Tcl_ListObjAppendElement(interp, resultPtr,
8264                          Tcl_NewStringObj(name, -1)) != TCL_OK)) {                          Tcl_NewStringObj(name, -1)) != TCL_OK)) {
8265              return TCL_ERROR;              return TCL_ERROR;
8266          }          }
8267      }      }
8268      return TCL_OK;      return TCL_OK;
8269  }  }
8270    
8271  /* End of tclio.c */  /* End of tclio.c */

Legend:
Removed from v.64  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25