/[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 66 by dashley, Sun Oct 30 21:57:38 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       *       &n