tclIO.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:273k
源码类别:

通讯编程

开发平台:

Visual C++

  1. /* 
  2.  * tclIO.c --
  3.  *
  4.  * This file provides the generic portions (those that are the same on
  5.  * all platforms and for all channel types) of Tcl's IO facilities.
  6.  *
  7.  * Copyright (c) 1998-2000 Ajuba Solutions
  8.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * RCS: @(#) $Id: tclIO.c,v 1.61.2.23 2007/05/24 19:31:55 dgp Exp $
  14.  */
  15. #include "tclInt.h"
  16. #include "tclPort.h"
  17. #include "tclIO.h"
  18. #include <assert.h>
  19. #ifndef TCL_INHERIT_STD_CHANNELS
  20. #define TCL_INHERIT_STD_CHANNELS 1
  21. #endif
  22. /*
  23.  * All static variables used in this file are collected into a single
  24.  * instance of the following structure.  For multi-threaded implementations,
  25.  * there is one instance of this structure for each thread.
  26.  *
  27.  * Notice that different structures with the same name appear in other
  28.  * files.  The structure defined below is used in this file only.
  29.  */
  30. typedef struct ThreadSpecificData {
  31.     /*
  32.      * This variable holds the list of nested ChannelHandlerEventProc 
  33.      * invocations.
  34.      */
  35.     NextChannelHandler *nestedHandlerPtr;
  36.     /*
  37.      * List of all channels currently open, indexed by ChannelState,
  38.      * as only one ChannelState exists per set of stacked channels.
  39.      */
  40.     ChannelState *firstCSPtr;
  41. #ifdef oldcode
  42.     /*
  43.      * Has a channel exit handler been created yet?
  44.      */
  45.     int channelExitHandlerCreated;
  46.     /*
  47.      * Has the channel event source been created and registered with the
  48.      * notifier?
  49.      */
  50.     int channelEventSourceCreated;
  51. #endif
  52.     /*
  53.      * Static variables to hold channels for stdin, stdout and stderr.
  54.      */
  55.     Tcl_Channel stdinChannel;
  56.     int stdinInitialized;
  57.     Tcl_Channel stdoutChannel;
  58.     int stdoutInitialized;
  59.     Tcl_Channel stderrChannel;
  60.     int stderrInitialized;
  61. } ThreadSpecificData;
  62. static Tcl_ThreadDataKey dataKey;
  63. /*
  64.  * Static functions in this file:
  65.  */
  66. static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
  67. static void ChannelTimerProc _ANSI_ARGS_((
  68. ClientData clientData));
  69. static int CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr,
  70. int direction));
  71. static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
  72. ChannelBuffer *bufPtr, int newlineFlag));
  73. static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
  74. ChannelState *statePtr));
  75. static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
  76. Tcl_Channel chan));
  77. static void CleanupChannelHandlers _ANSI_ARGS_((
  78. Tcl_Interp *interp, Channel *chanPtr));
  79. static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
  80. Channel *chanPtr, int errorCode));
  81. static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
  82. Tcl_Encoding encoding));
  83. static int CopyAndTranslateBuffer _ANSI_ARGS_((
  84. ChannelState *statePtr, char *result,
  85. int space));
  86. static int CopyBuffer _ANSI_ARGS_((
  87. Channel *chanPtr, char *result, int space));
  88. static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
  89. static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
  90. int mask));
  91. static void CreateScriptRecord _ANSI_ARGS_((
  92. Tcl_Interp *interp, Channel *chanPtr,
  93. int mask, Tcl_Obj *scriptPtr));
  94. static void DeleteChannelTable _ANSI_ARGS_((
  95. ClientData clientData, Tcl_Interp *interp));
  96. static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
  97. Channel *chanPtr, int mask));
  98. static int              DetachChannel _ANSI_ARGS_((Tcl_Interp *interp,
  99. Tcl_Channel chan));
  100. static void DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,
  101. int discardSavedBuffers));
  102. static void DiscardOutputQueued _ANSI_ARGS_((
  103. ChannelState *chanPtr));
  104. static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
  105. int slen));
  106. static int DoWrite _ANSI_ARGS_((Channel *chanPtr, CONST char *src,
  107. int srcLen));
  108. static int DoReadChars _ANSI_ARGS_ ((Channel* chan,
  109. Tcl_Obj* objPtr, int toRead, int appendFlag));
  110. static int DoWriteChars _ANSI_ARGS_ ((Channel* chan,
  111. CONST char* src, int len));
  112. static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
  113. GetsState *statePtr));
  114. static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
  115. Channel *chanPtr, int calledFromAsyncFlush));
  116. static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
  117. static int GetInput _ANSI_ARGS_((Channel *chanPtr));
  118. static int HaveVersion _ANSI_ARGS_((Tcl_ChannelType *typePtr,
  119. Tcl_ChannelTypeVersion minimumVersion));
  120. static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
  121. char **dstEndPtr, GetsState *gsPtr));
  122. static int ReadBytes _ANSI_ARGS_((ChannelState *statePtr,
  123. Tcl_Obj *objPtr, int charsLeft,
  124. int *offsetPtr));
  125. static int ReadChars _ANSI_ARGS_((ChannelState *statePtr,
  126. Tcl_Obj *objPtr, int charsLeft,
  127. int *offsetPtr, int *factorPtr));
  128. static void RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr,
  129. ChannelBuffer *bufPtr, int mustDiscard));
  130. static int StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr,
  131. int mode));
  132. static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
  133. Channel *chanPtr, int mode));
  134. static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
  135. static int TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr,
  136. char *dst, CONST char *src,
  137. int *dstLenPtr, int *srcLenPtr));
  138. static int TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr,
  139. char *dst, CONST char *src,
  140. int *dstLenPtr, int *srcLenPtr));
  141. static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
  142. static int WriteBytes _ANSI_ARGS_((Channel *chanPtr,
  143. CONST char *src, int srcLen));
  144. static int WriteChars _ANSI_ARGS_((Channel *chanPtr,
  145. CONST char *src, int srcLen));
  146. /*
  147.  *---------------------------------------------------------------------------
  148.  *
  149.  * TclInitIOSubsystem --
  150.  *
  151.  * Initialize all resources used by this subsystem on a per-process
  152.  * basis.  
  153.  *
  154.  * Results:
  155.  * None.
  156.  *
  157.  * Side effects:
  158.  * Depends on the memory subsystems.
  159.  *
  160.  *---------------------------------------------------------------------------
  161.  */
  162. void
  163. TclInitIOSubsystem()
  164. {
  165.     /*
  166.      * By fetching thread local storage we take care of
  167.      * allocating it for each thread.
  168.      */
  169.     (void) TCL_TSD_INIT(&dataKey);
  170. }   
  171. /*
  172.  *-------------------------------------------------------------------------
  173.  *
  174.  * TclFinalizeIOSubsystem --
  175.  *
  176.  * Releases all resources used by this subsystem on a per-thread
  177.  * basis.  Closes all extant channels that have not already been 
  178.  * closed because they were not owned by any interp.  
  179.  *
  180.  * Results:
  181.  * None.
  182.  *
  183.  * Side effects:
  184.  * Depends on encoding and memory subsystems.
  185.  *
  186.  *-------------------------------------------------------------------------
  187.  */
  188. /* ARGSUSED */
  189. void
  190. TclFinalizeIOSubsystem(void)
  191. {
  192.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  193.     Channel *chanPtr = NULL; /* Iterates over open channels. */
  194.     ChannelState *statePtr; /* State of channel stack */
  195.     int active = 1; /* Flag == 1 while there's still work to do */
  196.     /*
  197.      * Walk all channel state structures known to this thread and
  198.      * close corresponding channels.
  199.      */
  200.     while (active) {
  201. /*
  202.  * Iterate through the open channel list, and find the first
  203.  * channel that isn't dead. We start from the head of the list
  204.  * each time, because the close action on one channel can close
  205.  * others.
  206.  */
  207. active = 0;
  208. for (statePtr = tsdPtr->firstCSPtr;
  209.      statePtr != NULL;
  210.      statePtr = statePtr->nextCSPtr) {
  211.     chanPtr = statePtr->topChanPtr;
  212.     if (!(statePtr->flags & CHANNEL_DEAD)) {
  213. active = 1;
  214. break;
  215.     }
  216. }
  217. /*
  218.  * We've found a live channel.  Close it.
  219.  */
  220. if (active) {
  221.     /*
  222.      * Set the channel back into blocking mode to ensure that we 
  223.      * wait for all data to flush out.
  224.      */
  225.     
  226.     (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
  227. "-blocking", "on");
  228.     
  229.     if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
  230. (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
  231. (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
  232. /*
  233.  * Decrement the refcount which was earlier artificially 
  234.  * bumped up to keep the channel from being closed.
  235.  */
  236. statePtr->refCount--;
  237.     }
  238.     
  239.     if (statePtr->refCount <= 0) {
  240. /*
  241.  * Close it only if the refcount indicates that the channel 
  242.  * is not referenced from any interpreter. If it is, that
  243.  * interpreter will close the channel when it gets destroyed.
  244.  */
  245. (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr);
  246.     } else {
  247. /*
  248.  * The refcount is greater than zero, so flush the channel.
  249.  */
  250. Tcl_Flush((Tcl_Channel) chanPtr);
  251. /*
  252.  * Call the device driver to actually close the underlying 
  253.  * device for this channel.
  254.  */
  255. if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
  256.     (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);
  257. } else {
  258.     (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
  259.    NULL, 0);
  260. }
  261. /*
  262.  * Finally, we clean up the fields in the channel data 
  263.  * structure since all of them have been deleted already. 
  264.  * We mark the channel with CHANNEL_DEAD to prevent any 
  265.  * further IO operations
  266.  * on it.
  267.  */
  268. chanPtr->instanceData = NULL;
  269. statePtr->flags |= CHANNEL_DEAD;
  270.     }
  271. }
  272.     }
  273.     TclpFinalizeSockets();
  274.     TclpFinalizePipes();
  275. }
  276. /*
  277.  *----------------------------------------------------------------------
  278.  *
  279.  * Tcl_SetStdChannel --
  280.  *
  281.  * This function is used to change the channels that are used
  282.  * for stdin/stdout/stderr in new interpreters.
  283.  *
  284.  * Results:
  285.  * None
  286.  *
  287.  * Side effects:
  288.  * None.
  289.  *
  290.  *----------------------------------------------------------------------
  291.  */
  292. void
  293. Tcl_SetStdChannel(channel, type)
  294.     Tcl_Channel channel;
  295.     int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
  296. {
  297.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  298.     switch (type) {
  299. case TCL_STDIN:
  300.     tsdPtr->stdinInitialized = 1;
  301.     tsdPtr->stdinChannel = channel;
  302.     break;
  303. case TCL_STDOUT:
  304.     tsdPtr->stdoutInitialized = 1;
  305.     tsdPtr->stdoutChannel = channel;
  306.     break;
  307. case TCL_STDERR:
  308.     tsdPtr->stderrInitialized = 1;
  309.     tsdPtr->stderrChannel = channel;
  310.     break;
  311.     }
  312. }
  313. /*
  314.  *----------------------------------------------------------------------
  315.  *
  316.  * Tcl_GetStdChannel --
  317.  *
  318.  * Returns the specified standard channel.
  319.  *
  320.  * Results:
  321.  * Returns the specified standard channel, or NULL.
  322.  *
  323.  * Side effects:
  324.  * May cause the creation of a standard channel and the underlying
  325.  * file.
  326.  *
  327.  *----------------------------------------------------------------------
  328.  */
  329. Tcl_Channel
  330. Tcl_GetStdChannel(type)
  331.     int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
  332. {
  333.     Tcl_Channel channel = NULL;
  334.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  335.     /*
  336.      * If the channels were not created yet, create them now and
  337.      * store them in the static variables. 
  338.      */
  339.     switch (type) {
  340. case TCL_STDIN:
  341.     if (!tsdPtr->stdinInitialized) {
  342. tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
  343. tsdPtr->stdinInitialized = 1;
  344. /*
  345.                  * Artificially bump the refcount to ensure that the channel
  346.                  * is only closed on exit.
  347.                  *
  348.                  * NOTE: Must only do this if stdinChannel is not NULL. It
  349.                  * can be NULL in situations where Tcl is unable to connect
  350.                  * to the standard input.
  351.                  */
  352.                 if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
  353.                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
  354.                             tsdPtr->stdinChannel);
  355.                 }
  356.     }
  357.     channel = tsdPtr->stdinChannel;
  358.     break;
  359. case TCL_STDOUT:
  360.     if (!tsdPtr->stdoutInitialized) {
  361. tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
  362. tsdPtr->stdoutInitialized = 1;
  363.                 if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
  364.                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
  365.                             tsdPtr->stdoutChannel);
  366.                 }
  367.     }
  368.     channel = tsdPtr->stdoutChannel;
  369.     break;
  370. case TCL_STDERR:
  371.     if (!tsdPtr->stderrInitialized) {
  372. tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
  373. tsdPtr->stderrInitialized = 1;
  374.                 if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
  375.                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
  376.                             tsdPtr->stderrChannel);
  377.                 }
  378.     }
  379.     channel = tsdPtr->stderrChannel;
  380.     break;
  381.     }
  382.     return channel;
  383. }
  384. /*
  385.  *----------------------------------------------------------------------
  386.  *
  387.  * Tcl_CreateCloseHandler
  388.  *
  389.  * Creates a close callback which will be called when the channel is
  390.  * closed.
  391.  *
  392.  * Results:
  393.  * None.
  394.  *
  395.  * Side effects:
  396.  * Causes the callback to be called in the future when the channel
  397.  * will be closed.
  398.  *
  399.  *----------------------------------------------------------------------
  400.  */
  401. void
  402. Tcl_CreateCloseHandler(chan, proc, clientData)
  403.     Tcl_Channel chan; /* The channel for which to create the
  404.                                  * close callback. */
  405.     Tcl_CloseProc *proc; /* The callback routine to call when the
  406.                                  * channel will be closed. */
  407.     ClientData clientData; /* Arbitrary data to pass to the
  408.                                  * close callback. */
  409. {
  410.     ChannelState *statePtr;
  411.     CloseCallback *cbPtr;
  412.     statePtr = ((Channel *) chan)->state;
  413.     cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
  414.     cbPtr->proc = proc;
  415.     cbPtr->clientData = clientData;
  416.     cbPtr->nextPtr = statePtr->closeCbPtr;
  417.     statePtr->closeCbPtr = cbPtr;
  418. }
  419. /*
  420.  *----------------------------------------------------------------------
  421.  *
  422.  * Tcl_DeleteCloseHandler --
  423.  *
  424.  * Removes a callback that would have been called on closing
  425.  * the channel. If there is no matching callback then this
  426.  * function has no effect.
  427.  *
  428.  * Results:
  429.  * None.
  430.  *
  431.  * Side effects:
  432.  * The callback will not be called in the future when the channel
  433.  * is eventually closed.
  434.  *
  435.  *----------------------------------------------------------------------
  436.  */
  437. void
  438. Tcl_DeleteCloseHandler(chan, proc, clientData)
  439.     Tcl_Channel chan; /* The channel for which to cancel the
  440.                                  * close callback. */
  441.     Tcl_CloseProc *proc; /* The procedure for the callback to
  442.                                  * remove. */
  443.     ClientData clientData; /* The callback data for the callback
  444.                                  * to remove. */
  445. {
  446.     ChannelState *statePtr;
  447.     CloseCallback *cbPtr, *cbPrevPtr;
  448.     statePtr = ((Channel *) chan)->state;
  449.     for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
  450.  cbPtr != (CloseCallback *) NULL;
  451.  cbPtr = cbPtr->nextPtr) {
  452.         if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
  453.             if (cbPrevPtr == (CloseCallback *) NULL) {
  454.                 statePtr->closeCbPtr = cbPtr->nextPtr;
  455.             }
  456.             ckfree((char *) cbPtr);
  457.             break;
  458.         } else {
  459.             cbPrevPtr = cbPtr;
  460.         }
  461.     }
  462. }
  463. /*
  464.  *----------------------------------------------------------------------
  465.  *
  466.  * GetChannelTable --
  467.  *
  468.  * Gets and potentially initializes the channel table for an
  469.  * interpreter. If it is initializing the table it also inserts
  470.  * channels for stdin, stdout and stderr if the interpreter is
  471.  * trusted.
  472.  *
  473.  * Results:
  474.  * A pointer to the hash table created, for use by the caller.
  475.  *
  476.  * Side effects:
  477.  * Initializes the channel table for an interpreter. May create
  478.  * channels for stdin, stdout and stderr.
  479.  *
  480.  *----------------------------------------------------------------------
  481.  */
  482. static Tcl_HashTable *
  483. GetChannelTable(interp)
  484.     Tcl_Interp *interp;
  485. {
  486.     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
  487.     Tcl_Channel stdinChan, stdoutChan, stderrChan;
  488.     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  489.     if (hTblPtr == (Tcl_HashTable *) NULL) {
  490.         hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
  491.         Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
  492.         (void) Tcl_SetAssocData(interp, "tclIO",
  493.                 (Tcl_InterpDeleteProc *) DeleteChannelTable,
  494.                 (ClientData) hTblPtr);
  495.         /*
  496.          * If the interpreter is trusted (not "safe"), insert channels
  497.          * for stdin, stdout and stderr (possibly creating them in the
  498.          * process).
  499.          */
  500.         if (Tcl_IsSafe(interp) == 0) {
  501.             stdinChan = Tcl_GetStdChannel(TCL_STDIN);
  502.             if (stdinChan != NULL) {
  503.                 Tcl_RegisterChannel(interp, stdinChan);
  504.             }
  505.             stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
  506.             if (stdoutChan != NULL) {
  507.                 Tcl_RegisterChannel(interp, stdoutChan);
  508.             }
  509.             stderrChan = Tcl_GetStdChannel(TCL_STDERR);
  510.             if (stderrChan != NULL) {
  511.                 Tcl_RegisterChannel(interp, stderrChan);
  512.             }
  513.         }
  514.     }
  515.     return hTblPtr;
  516. }
  517. /*
  518.  *----------------------------------------------------------------------
  519.  *
  520.  * DeleteChannelTable --
  521.  *
  522.  * Deletes the channel table for an interpreter, closing any open
  523.  * channels whose refcount reaches zero. This procedure is invoked
  524.  * when an interpreter is deleted, via the AssocData cleanup
  525.  * mechanism.
  526.  *
  527.  * Results:
  528.  * None.
  529.  *
  530.  * Side effects:
  531.  * Deletes the hash table of channels. May close channels. May flush
  532.  * output on closed channels. Removes any channeEvent handlers that were
  533.  * registered in this interpreter.
  534.  *
  535.  *----------------------------------------------------------------------
  536.  */
  537. static void
  538. DeleteChannelTable(clientData, interp)
  539.     ClientData clientData; /* The per-interpreter data structure. */
  540.     Tcl_Interp *interp; /* The interpreter being deleted. */
  541. {
  542.     Tcl_HashTable *hTblPtr; /* The hash table. */
  543.     Tcl_HashSearch hSearch; /* Search variable. */
  544.     Tcl_HashEntry *hPtr; /* Search variable. */
  545.     Channel *chanPtr; /* Channel being deleted. */
  546.     ChannelState *statePtr; /* State of Channel being deleted. */
  547.     EventScriptRecord *sPtr, *prevPtr, *nextPtr;
  548.      /* Variables to loop over all channel events
  549.                                  * registered, to delete the ones that refer
  550.                                  * to the interpreter being deleted. */
  551.     /*
  552.      * Delete all the registered channels - this will close channels whose
  553.      * refcount reaches zero.
  554.      */
  555.     
  556.     hTblPtr = (Tcl_HashTable *) clientData;
  557.     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  558.  hPtr != (Tcl_HashEntry *) NULL;
  559.  hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
  560.         chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  561. statePtr = chanPtr->state;
  562.         /*
  563.          * Remove any fileevents registered in this interpreter.
  564.          */
  565.         
  566.         for (sPtr = statePtr->scriptRecordPtr,
  567.                  prevPtr = (EventScriptRecord *) NULL;
  568.      sPtr != (EventScriptRecord *) NULL;
  569.      sPtr = nextPtr) {
  570.             nextPtr = sPtr->nextPtr;
  571.             if (sPtr->interp == interp) {
  572.                 if (prevPtr == (EventScriptRecord *) NULL) {
  573.                     statePtr->scriptRecordPtr = nextPtr;
  574.                 } else {
  575.                     prevPtr->nextPtr = nextPtr;
  576.                 }
  577.                 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  578.                         TclChannelEventScriptInvoker, (ClientData) sPtr);
  579. Tcl_DecrRefCount(sPtr->scriptPtr);
  580.                 ckfree((char *) sPtr);
  581.             } else {
  582.                 prevPtr = sPtr;
  583.             }
  584.         }
  585.         /*
  586.          * Cannot call Tcl_UnregisterChannel because that procedure calls
  587.          * Tcl_GetAssocData to get the channel table, which might already
  588.          * be inaccessible from the interpreter structure. Instead, we
  589.          * emulate the behavior of Tcl_UnregisterChannel directly here.
  590.          */
  591.         Tcl_DeleteHashEntry(hPtr);
  592.         statePtr->refCount--;
  593.         if (statePtr->refCount <= 0) {
  594.             if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
  595.                 (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
  596.             }
  597.         }
  598.     }
  599.     Tcl_DeleteHashTable(hTblPtr);
  600.     ckfree((char *) hTblPtr);
  601. }
  602. /*
  603.  *----------------------------------------------------------------------
  604.  *
  605.  * CheckForStdChannelsBeingClosed --
  606.  *
  607.  * Perform special handling for standard channels being closed. When
  608.  * given a standard channel, if the refcount is now 1, it means that
  609.  * the last reference to the standard channel is being explicitly
  610.  * closed. Now bump the refcount artificially down to 0, to ensure the
  611.  * normal handling of channels being closed will occur. Also reset the
  612.  * static pointer to the channel to NULL, to avoid dangling references.
  613.  *
  614.  * Results:
  615.  * None.
  616.  *
  617.  * Side effects:
  618.  * Manipulates the refcount on standard channels. May smash the global
  619.  * static pointer to a standard channel.
  620.  *
  621.  *----------------------------------------------------------------------
  622.  */
  623. static void
  624. CheckForStdChannelsBeingClosed(chan)
  625.     Tcl_Channel chan;
  626. {
  627.     ChannelState *statePtr = ((Channel *) chan)->state;
  628.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  629.     if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
  630.         if (statePtr->refCount < 2) {
  631.             statePtr->refCount = 0;
  632.             tsdPtr->stdinChannel = NULL;
  633.             return;
  634.         }
  635.     } else if ((chan == tsdPtr->stdoutChannel)
  636.     && (tsdPtr->stdoutInitialized)) {
  637.         if (statePtr->refCount < 2) {
  638.             statePtr->refCount = 0;
  639.             tsdPtr->stdoutChannel = NULL;
  640.             return;
  641.         }
  642.     } else if ((chan == tsdPtr->stderrChannel)
  643.     && (tsdPtr->stderrInitialized)) {
  644.         if (statePtr->refCount < 2) {
  645.             statePtr->refCount = 0;
  646.             tsdPtr->stderrChannel = NULL;
  647.             return;
  648.         }
  649.     }
  650. }
  651. /*
  652.  *----------------------------------------------------------------------
  653.  *
  654.  * Tcl_IsStandardChannel --
  655.  *
  656.  * Test if the given channel is a standard channel.  No attempt
  657.  * is made to check if the channel or the standard channels
  658.  * are initialized or otherwise valid.
  659.  *
  660.  * Results:
  661.  * Returns 1 if true, 0 if false.
  662.  *
  663.  * Side effects:
  664.  *      None.
  665.  *
  666.  *----------------------------------------------------------------------
  667.  */
  668. int 
  669. Tcl_IsStandardChannel(chan)
  670.     Tcl_Channel chan; /* Channel to check. */
  671. {
  672.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  673.     if ((chan == tsdPtr->stdinChannel) 
  674. || (chan == tsdPtr->stdoutChannel)
  675. || (chan == tsdPtr->stderrChannel)) {
  676. return 1;
  677.     } else {
  678. return 0;
  679.     }
  680. }
  681. /*
  682.  *----------------------------------------------------------------------
  683.  *
  684.  * Tcl_RegisterChannel --
  685.  *
  686.  * Adds an already-open channel to the channel table of an interpreter.
  687.  * If the interpreter passed as argument is NULL, it only increments
  688.  * the channel refCount.
  689.  *
  690.  * Results:
  691.  * None.
  692.  *
  693.  * Side effects:
  694.  * May increment the reference count of a channel.
  695.  *
  696.  *----------------------------------------------------------------------
  697.  */
  698. void
  699. Tcl_RegisterChannel(interp, chan)
  700.     Tcl_Interp *interp; /* Interpreter in which to add the channel. */
  701.     Tcl_Channel chan; /* The channel to add to this interpreter
  702.                                  * channel table. */
  703. {
  704.     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
  705.     Tcl_HashEntry *hPtr; /* Search variable. */
  706.     int new; /* Is the hash entry new or does it exist? */
  707.     Channel *chanPtr; /* The actual channel. */
  708.     ChannelState *statePtr; /* State of the actual channel. */
  709.     /*
  710.      * Always (un)register bottom-most channel in the stack.  This makes
  711.      * management of the channel list easier because no manipulation is
  712.      * necessary during (un)stack operation.
  713.      */
  714.     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
  715.     statePtr = chanPtr->state;
  716.     if (statePtr->channelName == (CONST char *) NULL) {
  717.         panic("Tcl_RegisterChannel: channel without name");
  718.     }
  719.     if (interp != (Tcl_Interp *) NULL) {
  720.         hTblPtr = GetChannelTable(interp);
  721.         hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);
  722.         if (new == 0) {
  723.             if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
  724.                 return;
  725.             }
  726.     panic("Tcl_RegisterChannel: duplicate channel names");
  727.         }
  728.         Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
  729.     }
  730.     statePtr->refCount++;
  731. }
  732. /*
  733.  *----------------------------------------------------------------------
  734.  *
  735.  * Tcl_UnregisterChannel --
  736.  *
  737.  * Deletes the hash entry for a channel associated with an interpreter.
  738.  * If the interpreter given as argument is NULL, it only decrements the
  739.  * reference count.  (This all happens in the Tcl_DetachChannel helper
  740.  * function).
  741.  *
  742.  * Finally, if the reference count of the channel drops to zero,
  743.  * it is deleted.
  744.  *
  745.  * Results:
  746.  * A standard Tcl result.
  747.  *
  748.  * Side effects:
  749.  * Calls Tcl_DetachChannel which deletes the hash entry for a channel 
  750.  * associated with an interpreter.
  751.  *
  752.  * May delete the channel, which can have a variety of consequences,
  753.  * especially if we are forced to close the channel.
  754.  *
  755.  *----------------------------------------------------------------------
  756.  */
  757. int
  758. Tcl_UnregisterChannel(interp, chan)
  759.     Tcl_Interp *interp; /* Interpreter in which channel is defined. */
  760.     Tcl_Channel chan; /* Channel to delete. */
  761. {
  762.     ChannelState *statePtr; /* State of the real channel. */
  763.     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
  764.  
  765.     if (statePtr->flags & CHANNEL_INCLOSE) {
  766.         if (interp != (Tcl_Interp*) NULL) {
  767.     Tcl_AppendResult(interp, 
  768.      "Illegal recursive call to close through close-handler of channel",
  769.      (char *) NULL);
  770. }
  771.         return TCL_ERROR;
  772.     }
  773.  
  774.     if (DetachChannel(interp, chan) != TCL_OK) {
  775.         return TCL_OK;
  776.     }
  777.     
  778.     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
  779.     /*
  780.      * Perform special handling for standard channels being closed. If the
  781.      * refCount is now 1 it means that the last reference to the standard
  782.      * channel is being explicitly closed, so bump the refCount down
  783.      * artificially to 0. This will ensure that the channel is actually
  784.      * closed, below. Also set the static pointer to NULL for the channel.
  785.      */
  786.     CheckForStdChannelsBeingClosed(chan);
  787.     /*
  788.      * If the refCount reached zero, close the actual channel.
  789.      */
  790.     if (statePtr->refCount <= 0) {
  791.         /*
  792.          * Ensure that if there is another buffer, it gets flushed
  793.          * whether or not we are doing a background flush.
  794.          */
  795.         if ((statePtr->curOutPtr != NULL) &&
  796.                 (statePtr->curOutPtr->nextAdded >
  797.                         statePtr->curOutPtr->nextRemoved)) {
  798.             statePtr->flags |= BUFFER_READY;
  799.         }
  800. Tcl_Preserve((ClientData)statePtr);
  801.         if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
  802.     /* We don't want to re-enter Tcl_Close */
  803.     if (!(statePtr->flags & CHANNEL_CLOSED)) {
  804. if (Tcl_Close(interp, chan) != TCL_OK) {
  805.     statePtr->flags |= CHANNEL_CLOSED;
  806.     Tcl_Release((ClientData)statePtr);
  807.     return TCL_ERROR;
  808. }
  809.     }
  810.         }
  811.         statePtr->flags |= CHANNEL_CLOSED;
  812. Tcl_Release((ClientData)statePtr);
  813.     }
  814.     return TCL_OK;
  815. }
  816. /*
  817.  *----------------------------------------------------------------------
  818.  *
  819.  * Tcl_DetachChannel --
  820.  *
  821.  * Deletes the hash entry for a channel associated with an interpreter.
  822.  * If the interpreter given as argument is NULL, it only decrements the
  823.  * reference count.  Even if the ref count drops to zero, the 
  824.  * channel is NOT closed or cleaned up.  This allows a channel to
  825.  * be detached from an interpreter and left in the same state it
  826.  * was in when it was originally returned by 'Tcl_OpenFileChannel',
  827.  * for example.
  828.  *
  829.  * This function cannot be used on the standard channels, and
  830.  * will return TCL_ERROR if that is attempted.
  831.  *
  832.  * This function should only be necessary for special purposes
  833.  * in which you need to generate a pristine channel from one
  834.  * that has already been used.  All ordinary purposes will almost
  835.  * always want to use Tcl_UnregisterChannel instead.
  836.  *
  837.  * Provided the channel is not attached to any other interpreter,
  838.  * it can then be closed with Tcl_Close, rather than with 
  839.  * Tcl_UnregisterChannel.
  840.  *
  841.  * Results:
  842.  * A standard Tcl result.  If the channel is not currently registered
  843.  * with the given interpreter, TCL_ERROR is returned, otherwise
  844.  * TCL_OK.  However no error messages are left in the interp's result.
  845.  *
  846.  * Side effects:
  847.  * Deletes the hash entry for a channel associated with an 
  848.  * interpreter.
  849.  *
  850.  *----------------------------------------------------------------------
  851.  */
  852. int
  853. Tcl_DetachChannel(interp, chan)
  854.     Tcl_Interp *interp; /* Interpreter in which channel is defined. */
  855.     Tcl_Channel chan; /* Channel to delete. */
  856. {
  857.     if (Tcl_IsStandardChannel(chan)) {
  858.         return TCL_ERROR;
  859.     }
  860.     
  861.     return DetachChannel(interp, chan);
  862. }
  863. /*
  864.  *----------------------------------------------------------------------
  865.  *
  866.  * DetachChannel --
  867.  *
  868.  * Deletes the hash entry for a channel associated with an interpreter.
  869.  * If the interpreter given as argument is NULL, it only decrements the
  870.  * reference count.  Even if the ref count drops to zero, the 
  871.  * channel is NOT closed or cleaned up.  This allows a channel to
  872.  * be detached from an interpreter and left in the same state it
  873.  * was in when it was originally returned by 'Tcl_OpenFileChannel',
  874.  * for example.
  875.  *
  876.  * Results:
  877.  * A standard Tcl result.  If the channel is not currently registered
  878.  * with the given interpreter, TCL_ERROR is returned, otherwise
  879.  * TCL_OK.  However no error messages are left in the interp's result.
  880.  *
  881.  * Side effects:
  882.  * Deletes the hash entry for a channel associated with an 
  883.  * interpreter.
  884.  *
  885.  *----------------------------------------------------------------------
  886.  */
  887. static int
  888. DetachChannel(interp, chan)
  889.     Tcl_Interp *interp; /* Interpreter in which channel is defined. */
  890.     Tcl_Channel chan; /* Channel to delete. */
  891. {
  892.     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
  893.     Tcl_HashEntry *hPtr; /* Search variable. */
  894.     Channel *chanPtr; /* The real IO channel. */
  895.     ChannelState *statePtr; /* State of the real channel. */
  896.     /*
  897.      * Always (un)register bottom-most channel in the stack.  This makes
  898.      * management of the channel list easier because no manipulation is
  899.      * necessary during (un)stack operation.
  900.      */
  901.     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
  902.     statePtr = chanPtr->state;
  903.     if (interp != (Tcl_Interp *) NULL) {
  904. hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  905. if (hTblPtr == (Tcl_HashTable *) NULL) {
  906.     return TCL_ERROR;
  907. }
  908. hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
  909. if (hPtr == (Tcl_HashEntry *) NULL) {
  910.     return TCL_ERROR;
  911. }
  912. if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
  913.     return TCL_ERROR;
  914. }
  915. Tcl_DeleteHashEntry(hPtr);
  916. /*
  917.  * Remove channel handlers that refer to this interpreter, so that they
  918.  * will not be present if the actual close is delayed and more events
  919.  * happen on the channel. This may occur if the channel is shared
  920.  * between several interpreters, or if the channel has async
  921.  * flushing active.
  922.  */
  923.     
  924. CleanupChannelHandlers(interp, chanPtr);
  925.     }
  926.     statePtr->refCount--;
  927.     
  928.     return TCL_OK;
  929. }
  930. /*
  931.  *---------------------------------------------------------------------------
  932.  *
  933.  * Tcl_GetChannel --
  934.  *
  935.  * Finds an existing Tcl_Channel structure by name in a given
  936.  * interpreter. This function is public because it is used by
  937.  * channel-type-specific functions.
  938.  *
  939.  * Results:
  940.  * A Tcl_Channel or NULL on failure. If failed, interp's result
  941.  * object contains an error message.  *modePtr is filled with the
  942.  * modes in which the channel was opened.
  943.  *
  944.  * Side effects:
  945.  * None.
  946.  *
  947.  *---------------------------------------------------------------------------
  948.  */
  949. Tcl_Channel
  950. Tcl_GetChannel(interp, chanName, modePtr)
  951.     Tcl_Interp *interp; /* Interpreter in which to find or create
  952.                                  * the channel. */
  953.     CONST char *chanName; /* The name of the channel. */
  954.     int *modePtr; /* Where to store the mode in which the
  955.                                  * channel was opened? Will contain an ORed
  956.                                  * combination of TCL_READABLE and
  957.                                  * TCL_WRITABLE, if non-NULL. */
  958. {
  959.     Channel *chanPtr; /* The actual channel. */
  960.     Tcl_HashTable *hTblPtr; /* Hash table of channels. */
  961.     Tcl_HashEntry *hPtr; /* Search variable. */
  962.     CONST char *name; /* Translated name. */
  963.     /*
  964.      * Substitute "stdin", etc.  Note that even though we immediately
  965.      * find the channel using Tcl_GetStdChannel, we still need to look
  966.      * it up in the specified interpreter to ensure that it is present
  967.      * in the channel table.  Otherwise, safe interpreters would always
  968.      * have access to the standard channels.
  969.      */
  970.     name = chanName;
  971.     if ((chanName[0] == 's') && (chanName[1] == 't')) {
  972. chanPtr = NULL;
  973. if (strcmp(chanName, "stdin") == 0) {
  974.     chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN);
  975. } else if (strcmp(chanName, "stdout") == 0) {
  976.     chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT);
  977. } else if (strcmp(chanName, "stderr") == 0) {
  978.     chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR);
  979. }
  980. if (chanPtr != NULL) {
  981.     name = chanPtr->state->channelName;
  982. }
  983.     }
  984.     hTblPtr = GetChannelTable(interp);
  985.     hPtr = Tcl_FindHashEntry(hTblPtr, name);
  986.     if (hPtr == (Tcl_HashEntry *) NULL) {
  987.         Tcl_AppendResult(interp, "can not find channel named "",
  988.                 chanName, """, (char *) NULL);
  989.         return NULL;
  990.     }
  991.     /*
  992.      * Always return bottom-most channel in the stack.  This one lives
  993.      * the longest - other channels may go away unnoticed.
  994.      * The other APIs compensate where necessary to retrieve the
  995.      * topmost channel again.
  996.      */
  997.     chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  998.     chanPtr = chanPtr->state->bottomChanPtr;
  999.     if (modePtr != NULL) {
  1000.         *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
  1001.     }
  1002.     
  1003.     return (Tcl_Channel) chanPtr;
  1004. }
  1005. /*
  1006.  *----------------------------------------------------------------------
  1007.  *
  1008.  * Tcl_CreateChannel --
  1009.  *
  1010.  * Creates a new entry in the hash table for a Tcl_Channel
  1011.  * record.
  1012.  *
  1013.  * Results:
  1014.  * Returns the new Tcl_Channel.
  1015.  *
  1016.  * Side effects:
  1017.  * Creates a new Tcl_Channel instance and inserts it into the
  1018.  * hash table.
  1019.  *
  1020.  *----------------------------------------------------------------------
  1021.  */
  1022. Tcl_Channel
  1023. Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
  1024.     Tcl_ChannelType *typePtr; /* The channel type record. */
  1025.     CONST char *chanName; /* Name of channel to record. */
  1026.     ClientData instanceData; /* Instance specific data. */
  1027.     int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
  1028.                                  * if the channel is readable, writable. */
  1029. {
  1030.     Channel *chanPtr; /* The channel structure newly created. */
  1031.     ChannelState *statePtr; /* The stack-level independent state info
  1032.  * for the channel. */
  1033.     CONST char *name;
  1034.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  1035.     /*
  1036.      * With the change of the Tcl_ChannelType structure to use a version in
  1037.      * 8.3.2+, we have to make sure that our assumption that the structure
  1038.      * remains a binary compatible size is true.
  1039.      *
  1040.      * If this assertion fails on some system, then it can be removed
  1041.      * only if the user recompiles code with older channel drivers in
  1042.      * the new system as well.
  1043.      */
  1044.     assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
  1045.     /*
  1046.      * JH: We could subsequently memset these to 0 to avoid the
  1047.      * numerous assignments to 0/NULL below.
  1048.      */
  1049.     chanPtr  = (Channel *) ckalloc((unsigned) sizeof(Channel));
  1050.     statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState));
  1051.     chanPtr->state = statePtr;
  1052.     chanPtr->instanceData = instanceData;
  1053.     chanPtr->typePtr = typePtr;
  1054.     /*
  1055.      * Set all the bits that are part of the stack-independent state
  1056.      * information for the channel.
  1057.      */
  1058.     if (chanName != (char *) NULL) {
  1059. char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
  1060.         statePtr->channelName = tmp;
  1061.         strcpy(tmp, chanName);
  1062.     } else {
  1063.         panic("Tcl_CreateChannel: NULL channel name");
  1064.     }
  1065.     statePtr->flags = mask;
  1066.     /*
  1067.      * Set the channel to system default encoding.
  1068.      */
  1069.     statePtr->encoding = NULL;
  1070.     name = Tcl_GetEncodingName(NULL);
  1071.     if (strcmp(name, "binary") != 0) {
  1072.      statePtr->encoding = Tcl_GetEncoding(NULL, name);
  1073.     }
  1074.     statePtr->inputEncodingState = NULL;
  1075.     statePtr->inputEncodingFlags = TCL_ENCODING_START;
  1076.     statePtr->outputEncodingState = NULL;
  1077.     statePtr->outputEncodingFlags = TCL_ENCODING_START;
  1078.     /*
  1079.      * Set the channel up initially in AUTO input translation mode to
  1080.      * accept "n", "r" and "rn". Output translation mode is set to
  1081.      * a platform specific default value. The eofChar is set to 0 for both
  1082.      * input and output, so that Tcl does not look for an in-file EOF
  1083.      * indicator (e.g. ^Z) and does not append an EOF indicator to files.
  1084.      */
  1085.     statePtr->inputTranslation = TCL_TRANSLATE_AUTO;
  1086.     statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
  1087.     statePtr->inEofChar = 0;
  1088.     statePtr->outEofChar = 0;
  1089.     statePtr->unreportedError = 0;
  1090.     statePtr->refCount = 0;
  1091.     statePtr->closeCbPtr = (CloseCallback *) NULL;
  1092.     statePtr->curOutPtr = (ChannelBuffer *) NULL;
  1093.     statePtr->outQueueHead = (ChannelBuffer *) NULL;
  1094.     statePtr->outQueueTail = (ChannelBuffer *) NULL;
  1095.     statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
  1096.     statePtr->inQueueHead = (ChannelBuffer *) NULL;
  1097.     statePtr->inQueueTail = (ChannelBuffer *) NULL;
  1098.     statePtr->chPtr = (ChannelHandler *) NULL;
  1099.     statePtr->interestMask = 0;
  1100.     statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
  1101.     statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
  1102.     statePtr->timer = NULL;
  1103.     statePtr->csPtr = NULL;
  1104.     statePtr->outputStage = NULL;
  1105.     if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
  1106. statePtr->outputStage = (char *)
  1107.     ckalloc((unsigned) (statePtr->bufSize + 2));
  1108.     }
  1109.     /*
  1110.      * As we are creating the channel, it is obviously the top for now
  1111.      */
  1112.     statePtr->topChanPtr = chanPtr;
  1113.     statePtr->bottomChanPtr = chanPtr;
  1114.     chanPtr->downChanPtr = (Channel *) NULL;
  1115.     chanPtr->upChanPtr = (Channel *) NULL;
  1116.     chanPtr->inQueueHead        = (ChannelBuffer*) NULL;
  1117.     chanPtr->inQueueTail        = (ChannelBuffer*) NULL;
  1118.     /*
  1119.      * Link the channel into the list of all channels; create an on-exit
  1120.      * handler if there is not one already, to close off all the channels
  1121.      * in the list on exit.
  1122.      *
  1123.      * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
  1124.      *
  1125.      * TIP #218.
  1126.      * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
  1127.      *     We need Tcl_SpliceChannel, for the threadAction calls.
  1128.      *     There is no real reason to duplicate all of this.
  1129.      * NOTE: All drivers using thread actions now have to perform their TSD
  1130.      *       manipulation only in their thread action proc. Doing it when
  1131.      *       creating their instance structures will collide with the thread
  1132.      *       action activity and lead to damaged lists.
  1133.      */
  1134.     statePtr->nextCSPtr = (ChannelState *) NULL;
  1135.     Tcl_SpliceChannel ((Tcl_Channel) chanPtr);
  1136.     /*
  1137.      * Install this channel in the first empty standard channel slot, if
  1138.      * the channel was previously closed explicitly.
  1139.      */
  1140. #if TCL_INHERIT_STD_CHANNELS
  1141.     if ((tsdPtr->stdinChannel == NULL) &&
  1142.     (tsdPtr->stdinInitialized == 1)) {
  1143. Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
  1144.         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
  1145.     } else if ((tsdPtr->stdoutChannel == NULL) &&
  1146.     (tsdPtr->stdoutInitialized == 1)) {
  1147. Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
  1148.         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
  1149.     } else if ((tsdPtr->stderrChannel == NULL) &&
  1150.     (tsdPtr->stderrInitialized == 1)) {
  1151. Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
  1152.         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
  1153.     }
  1154. #endif
  1155.     return (Tcl_Channel) chanPtr;
  1156. }
  1157. /*
  1158.  *----------------------------------------------------------------------
  1159.  *
  1160.  * Tcl_StackChannel --
  1161.  *
  1162.  * Replaces an entry in the hash table for a Tcl_Channel
  1163.  * record. The replacement is a new channel with same name,
  1164.  * it supercedes the replaced channel. Input and output of
  1165.  * the superceded channel is now going through the newly
  1166.  * created channel and allows the arbitrary filtering/manipulation
  1167.  * of the dataflow.
  1168.  *
  1169.  * Andreas Kupries <a.kupries@westend.com>, 12/13/1998
  1170.  * "Trf-Patch for filtering channels"
  1171.  *
  1172.  * Results:
  1173.  * Returns the new Tcl_Channel, which actually contains the
  1174.  *      saved information about prevChan.
  1175.  *
  1176.  * Side effects:
  1177.  *    A new channel structure is allocated and linked below
  1178.  *    the existing channel.  The channel operations and client
  1179.  *    data of the existing channel are copied down to the newly
  1180.  *    created channel, and the current channel has its operations
  1181.  *    replaced by the new typePtr.
  1182.  *
  1183.  *----------------------------------------------------------------------
  1184.  */
  1185. Tcl_Channel
  1186. Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
  1187.     Tcl_Interp     *interp;    /* The interpreter we are working in */
  1188.     Tcl_ChannelType *typePtr;    /* The channel type record for the new
  1189.     * channel. */
  1190.     ClientData      instanceData; /* Instance specific data for the new
  1191.     * channel. */
  1192.     int      mask;    /* TCL_READABLE & TCL_WRITABLE to indicate
  1193.     * if the channel is readable, writable. */
  1194.     Tcl_Channel      prevChan;    /* The channel structure to replace */
  1195. {
  1196.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  1197.     Channel *chanPtr, *prevChanPtr;
  1198.     ChannelState *statePtr;
  1199.     /*
  1200.      * Find the given channel in the list of all channels.
  1201.      * If we don't find it, then it was never registered correctly.
  1202.      *
  1203.      * This operation should occur at the top of a channel stack.
  1204.      */
  1205.     statePtr    = (ChannelState *) tsdPtr->firstCSPtr;
  1206.     prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;
  1207.     while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
  1208. statePtr = statePtr->nextCSPtr;
  1209.     }
  1210.     if (statePtr == NULL) {
  1211. if (interp) {
  1212.     Tcl_AppendResult(interp, "couldn't find state for channel "",
  1213.     Tcl_GetChannelName(prevChan), """, (char *) NULL);
  1214. }
  1215.         return (Tcl_Channel) NULL;
  1216.     }
  1217.     /*
  1218.      * Here we check if the given "mask" matches the "flags"
  1219.      * of the already existing channel.
  1220.      *
  1221.      *   | - | R | W | RW |
  1222.      * --+---+---+---+----+ <=>  0 != (chan->mask & prevChan->mask)
  1223.      * - |   |   |   |    |
  1224.      * R |   | + |   | +  | The superceding channel is allowed to
  1225.      * W |   |   | + | +  | restrict the capabilities of the
  1226.      * RW|   | + | + | +  | superceded one !
  1227.      * --+---+---+---+----+
  1228.      */
  1229.     if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
  1230. if (interp) {
  1231.     Tcl_AppendResult(interp,
  1232.     "reading and writing both disallowed for channel "",
  1233.     Tcl_GetChannelName(prevChan), """, (char *) NULL);
  1234. }
  1235.         return (Tcl_Channel) NULL;
  1236.     }
  1237.     /*
  1238.      * Flush the buffers. This ensures that any data still in them
  1239.      * at this time is not handled by the new transformation. Restrict
  1240.      * this to writable channels. Take care to hide a possible bg-copy
  1241.      * in progress from Tcl_Flush and the CheckForChannelErrors inside.
  1242.      */
  1243.     if ((mask & TCL_WRITABLE) != 0) {
  1244.         CopyState *csPtr;
  1245.         csPtr           = statePtr->csPtr;
  1246. statePtr->csPtr = (CopyState*) NULL;
  1247. if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
  1248.     statePtr->csPtr = csPtr;
  1249.     if (interp) {
  1250. Tcl_AppendResult(interp, "could not flush channel "",
  1251. Tcl_GetChannelName(prevChan), """, (char *) NULL);
  1252.     }
  1253.     return (Tcl_Channel) NULL;
  1254. }
  1255. statePtr->csPtr = csPtr;
  1256.     }
  1257.     /*
  1258.      * Discard any input in the buffers. They are not yet read by the
  1259.      * user of the channel, so they have to go through the new
  1260.      * transformation before reading. As the buffers contain the
  1261.      * untransformed form their contents are not only useless but actually
  1262.      * distorts our view of the system.
  1263.      *
  1264.      * To preserve the information without having to read them again and
  1265.      * to avoid problems with the location in the channel (seeking might
  1266.      * be impossible) we move the buffers from the common state structure
  1267.      * into the channel itself. We use the buffers in the channel below
  1268.      * the new transformation to hold the data. In the future this allows
  1269.      * us to write transformations which pre-read data and push the unused
  1270.      * part back when they are going away.
  1271.      */
  1272.     if (((mask & TCL_READABLE) != 0) &&
  1273. (statePtr->inQueueHead != (ChannelBuffer*) NULL)) {
  1274.       /*
  1275.        * Remark: It is possible that the channel buffers contain data from
  1276.        * some earlier push-backs.
  1277.        */
  1278.       statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
  1279.       prevChanPtr->inQueueHead       = statePtr->inQueueHead;
  1280.       if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) {
  1281. prevChanPtr->inQueueTail = statePtr->inQueueTail;
  1282.       }
  1283.       statePtr->inQueueHead          = (ChannelBuffer*) NULL;
  1284.       statePtr->inQueueTail          = (ChannelBuffer*) NULL;
  1285.     }
  1286.     chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
  1287.     /*
  1288.      * Save some of the current state into the new structure,
  1289.      * reinitialize the parts which will stay with the transformation.
  1290.      *
  1291.      * Remarks:
  1292.      */
  1293.     chanPtr->state = statePtr;
  1294.     chanPtr->instanceData = instanceData;
  1295.     chanPtr->typePtr = typePtr;
  1296.     chanPtr->downChanPtr = prevChanPtr;
  1297.     chanPtr->upChanPtr = (Channel *) NULL;
  1298.     chanPtr->inQueueHead        = (ChannelBuffer*) NULL;
  1299.     chanPtr->inQueueTail        = (ChannelBuffer*) NULL;
  1300.     /*
  1301.      * Place new block at the head of a possibly existing list of previously
  1302.      * stacked channels.
  1303.      */
  1304.     prevChanPtr->upChanPtr = chanPtr;
  1305.     statePtr->topChanPtr = chanPtr;
  1306.     return (Tcl_Channel) chanPtr;
  1307. }
  1308. /*
  1309.  *----------------------------------------------------------------------
  1310.  *
  1311.  * Tcl_UnstackChannel --
  1312.  *
  1313.  * Unstacks an entry in the hash table for a Tcl_Channel
  1314.  * record. This is the reverse to 'Tcl_StackChannel'.
  1315.  *
  1316.  * Results:
  1317.  * A standard Tcl result.
  1318.  *
  1319.  * Side effects:
  1320.  * If TCL_ERROR is returned, the posix error code will be set
  1321.  * with Tcl_SetErrno.
  1322.  *
  1323.  *----------------------------------------------------------------------
  1324.  */
  1325. int
  1326. Tcl_UnstackChannel (interp, chan)
  1327.     Tcl_Interp *interp; /* The interpreter we are working in */
  1328.     Tcl_Channel chan;   /* The channel to unstack */
  1329. {
  1330.     Channel      *chanPtr  = (Channel *) chan;
  1331.     ChannelState *statePtr = chanPtr->state;
  1332.     int result = 0;
  1333.     /*
  1334.      * This operation should occur at the top of a channel stack.
  1335.      */
  1336.     chanPtr = statePtr->topChanPtr;
  1337.     if (chanPtr->downChanPtr != (Channel *) NULL) {
  1338.         /*
  1339.  * Instead of manipulating the per-thread / per-interp list/hashtable
  1340.  * of registered channels we wind down the state of the transformation,
  1341.  * and then restore the state of underlying channel into the old
  1342.  * structure.
  1343.  */
  1344. Channel *downChanPtr = chanPtr->downChanPtr;
  1345. /*
  1346.  * Flush the buffers. This ensures that any data still in them
  1347.  * at this time _is_ handled by the transformation we are unstacking
  1348.  * right now. Restrict this to writable channels. Take care to hide
  1349.  * a possible bg-copy in progress from Tcl_Flush and the
  1350.  * CheckForChannelErrors inside.
  1351.  */
  1352. if (statePtr->flags & TCL_WRITABLE) {
  1353.     CopyState*    csPtr;
  1354.     csPtr           = statePtr->csPtr;
  1355.     statePtr->csPtr = (CopyState*) NULL;
  1356.     if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
  1357.         statePtr->csPtr = csPtr;
  1358. if (interp) {
  1359.     Tcl_AppendResult(interp, "could not flush channel "",
  1360.     Tcl_GetChannelName((Tcl_Channel) chanPtr), """,
  1361.     (char *) NULL);
  1362. }
  1363. return TCL_ERROR;
  1364.     }
  1365.     statePtr->csPtr = csPtr;
  1366. }
  1367. /*
  1368.  * Anything in the input queue and the push-back buffers of
  1369.  * the transformation going away is transformed data, but not
  1370.  * yet read. As unstacking means that the caller does not want
  1371.  * to see transformed data any more we have to discard these
  1372.  * bytes. To avoid writing an analogue to 'DiscardInputQueued'
  1373.  * we move the information in the push back buffers to the
  1374.  * input queue and then call 'DiscardInputQueued' on that.
  1375.  */
  1376. if (((statePtr->flags & TCL_READABLE)  != 0) &&
  1377.     ((statePtr->inQueueHead != (ChannelBuffer*) NULL) ||
  1378.      (chanPtr->inQueueHead  != (ChannelBuffer*) NULL))) {
  1379.     if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) &&
  1380. (chanPtr->inQueueHead  != (ChannelBuffer*) NULL)) {
  1381.         statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
  1382. statePtr->inQueueTail = chanPtr->inQueueTail;
  1383.         statePtr->inQueueHead = statePtr->inQueueTail;
  1384.     } else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
  1385.         statePtr->inQueueHead = chanPtr->inQueueHead;
  1386. statePtr->inQueueTail = chanPtr->inQueueTail;
  1387.     }
  1388.     chanPtr->inQueueHead          = (ChannelBuffer*) NULL;
  1389.     chanPtr->inQueueTail          = (ChannelBuffer*) NULL;
  1390.     DiscardInputQueued (statePtr, 0);
  1391. }
  1392. statePtr->topChanPtr = downChanPtr;
  1393. downChanPtr->upChanPtr = (Channel *) NULL;
  1394. /*
  1395.  * Leave this link intact for closeproc
  1396.  *  chanPtr->downChanPtr = (Channel *) NULL;
  1397.  */
  1398. /*
  1399.  * Close and free the channel driver state.
  1400.  */
  1401. if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
  1402.     result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
  1403.     interp);
  1404. } else {
  1405.     result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
  1406.     interp, 0);
  1407. }
  1408. chanPtr->typePtr = NULL;
  1409. /*
  1410.  * AK: Tcl_NotifyChannel may hold a reference to this block of memory
  1411.  */
  1412. Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
  1413. UpdateInterest(downChanPtr);
  1414. if (result != 0) {
  1415.     Tcl_SetErrno(result);
  1416.     return TCL_ERROR;
  1417. }
  1418.     } else {
  1419.         /*
  1420.  * This channel does not cover another one.
  1421.  * Simply do a close, if necessary.
  1422.  */
  1423.         if (statePtr->refCount <= 0) {
  1424.             if (Tcl_Close(interp, chan) != TCL_OK) {
  1425.                 return TCL_ERROR;
  1426.             }
  1427. }
  1428.     }
  1429.     return TCL_OK;
  1430. }
  1431. /*
  1432.  *----------------------------------------------------------------------
  1433.  *
  1434.  * Tcl_GetStackedChannel --
  1435.  *
  1436.  * Determines whether the specified channel is stacked upon another.
  1437.  *
  1438.  * Results:
  1439.  * NULL if the channel is not stacked upon another one, or a reference
  1440.  * to the channel it is stacked upon. This reference can be used in
  1441.  * queries, but modification is not allowed.
  1442.  *
  1443.  * Side effects:
  1444.  * None.
  1445.  *
  1446.  *----------------------------------------------------------------------
  1447.  */
  1448. Tcl_Channel
  1449. Tcl_GetStackedChannel(chan)
  1450.     Tcl_Channel chan;
  1451. {
  1452.     Channel *chanPtr = (Channel *) chan; /* The actual channel. */
  1453.     return (Tcl_Channel) chanPtr->downChanPtr;
  1454. }
  1455. /*
  1456.  *----------------------------------------------------------------------
  1457.  *
  1458.  * Tcl_GetTopChannel --
  1459.  *
  1460.  * Returns the top channel of a channel stack.
  1461.  *
  1462.  * Results:
  1463.  * NULL if the channel is not stacked upon another one, or a reference
  1464.  * to the channel it is stacked upon. This reference can be used in
  1465.  * queries, but modification is not allowed.
  1466.  *
  1467.  * Side effects:
  1468.  * None.
  1469.  *
  1470.  *----------------------------------------------------------------------
  1471.  */
  1472. Tcl_Channel
  1473. Tcl_GetTopChannel(chan)
  1474.     Tcl_Channel chan;
  1475. {
  1476.     Channel *chanPtr = (Channel *) chan; /* The actual channel. */
  1477.     return (Tcl_Channel) chanPtr->state->topChanPtr;
  1478. }
  1479. /*
  1480.  *----------------------------------------------------------------------
  1481.  *
  1482.  * Tcl_GetChannelInstanceData --
  1483.  *
  1484.  * Returns the client data associated with a channel.
  1485.  *
  1486.  * Results:
  1487.  * The client data.
  1488.  *
  1489.  * Side effects:
  1490.  * None.
  1491.  *
  1492.  *----------------------------------------------------------------------
  1493.  */
  1494. ClientData
  1495. Tcl_GetChannelInstanceData(chan)
  1496.     Tcl_Channel chan; /* Channel for which to return client data. */
  1497. {
  1498.     Channel *chanPtr = (Channel *) chan; /* The actual channel. */
  1499.     return chanPtr->instanceData;
  1500. }
  1501. /*
  1502.  *----------------------------------------------------------------------
  1503.  *
  1504.  * Tcl_GetChannelThread --
  1505.  *
  1506.  * Given a channel structure, returns the thread managing it.
  1507.  * TIP #10
  1508.  *
  1509.  * Results:
  1510.  * Returns the id of the thread managing the channel.
  1511.  *
  1512.  * Side effects:
  1513.  * None.
  1514.  *
  1515.  *----------------------------------------------------------------------
  1516.  */
  1517. Tcl_ThreadId
  1518. Tcl_GetChannelThread(chan)
  1519.     Tcl_Channel chan; /* The channel to return managing thread for. */
  1520. {
  1521.     Channel *chanPtr = (Channel *) chan; /* The actual channel. */
  1522.     return chanPtr->state->managingThread;
  1523. }
  1524. /*
  1525.  *----------------------------------------------------------------------
  1526.  *
  1527.  * Tcl_GetChannelType --
  1528.  *
  1529.  * Given a channel structure, returns the channel type structure.
  1530.  *
  1531.  * Results:
  1532.  * Returns a pointer to the channel type structure.
  1533.  *
  1534.  * Side effects:
  1535.  * None.
  1536.  *
  1537.  *----------------------------------------------------------------------
  1538.  */
  1539. Tcl_ChannelType *
  1540. Tcl_GetChannelType(chan)
  1541.     Tcl_Channel chan; /* The channel to return type for. */
  1542. {
  1543.     Channel *chanPtr = (Channel *) chan; /* The actual channel. */
  1544.     return chanPtr->typePtr;
  1545. }
  1546. /*
  1547.  *----------------------------------------------------------------------
  1548.  *
  1549.  * Tcl_GetChannelMode --
  1550.  *
  1551.  * Computes a mask indicating whether the channel is open for
  1552.  * reading and writing.
  1553.  *
  1554.  * Results:
  1555.  * An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
  1556.  *
  1557.  * Side effects:
  1558.  * None.
  1559.  *
  1560.  *----------------------------------------------------------------------
  1561.  */
  1562. int
  1563. Tcl_GetChannelMode(chan)
  1564.     Tcl_Channel chan; /* The channel for which the mode is
  1565.                                  * being computed. */
  1566. {
  1567.     ChannelState *statePtr = ((Channel *) chan)->state;
  1568. /* State of actual channel. */
  1569.     return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
  1570. }
  1571. /*
  1572.  *----------------------------------------------------------------------
  1573.  *
  1574.  * Tcl_GetChannelName --
  1575.  *
  1576.  * Returns the string identifying the channel name.
  1577.  *
  1578.  * Results:
  1579.  * The string containing the channel name. This memory is
  1580.  * owned by the generic layer and should not be modified by
  1581.  * the caller.
  1582.  *
  1583.  * Side effects:
  1584.  * None.
  1585.  *
  1586.  *----------------------------------------------------------------------
  1587.  */
  1588. CONST char *
  1589. Tcl_GetChannelName(chan)
  1590.     Tcl_Channel chan; /* The channel for which to return the name. */
  1591. {
  1592.     ChannelState *statePtr; /* State of actual channel. */
  1593.     statePtr = ((Channel *) chan)->state;
  1594.     return statePtr->channelName;
  1595. }
  1596. /*
  1597.  *----------------------------------------------------------------------
  1598.  *
  1599.  * Tcl_GetChannelHandle --
  1600.  *
  1601.  * Returns an OS handle associated with a channel.
  1602.  *
  1603.  * Results:
  1604.  * Returns TCL_OK and places the handle in handlePtr, or returns
  1605.  * TCL_ERROR on failure.
  1606.  *
  1607.  * Side effects:
  1608.  * None.
  1609.  *
  1610.  *----------------------------------------------------------------------
  1611.  */
  1612. int
  1613. Tcl_GetChannelHandle(chan, direction, handlePtr)
  1614.     Tcl_Channel chan; /* The channel to get file from. */
  1615.     int direction; /* TCL_WRITABLE or TCL_READABLE. */
  1616.     ClientData *handlePtr; /* Where to store handle */
  1617. {
  1618.     Channel *chanPtr; /* The actual channel. */
  1619.     ClientData handle;
  1620.     int result;
  1621.     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
  1622.     result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
  1623.     direction, &handle);
  1624.     if (handlePtr) {
  1625. *handlePtr = handle;
  1626.     }
  1627.     return result;
  1628. }
  1629. /*
  1630.  *---------------------------------------------------------------------------
  1631.  *
  1632.  * AllocChannelBuffer --
  1633.  *
  1634.  * A channel buffer has BUFFER_PADDING bytes extra at beginning to
  1635.  * hold any bytes of a native-encoding character that got split by
  1636.  * the end of the previous buffer and need to be moved to the
  1637.  * beginning of the next buffer to make a contiguous string so it
  1638.  * can be converted to UTF-8.
  1639.  *
  1640.  * A channel buffer has BUFFER_PADDING bytes extra at the end to
  1641.  * hold any bytes of a native-encoding character (generated from a
  1642.  * UTF-8 character) that overflow past the end of the buffer and
  1643.  * need to be moved to the next buffer.
  1644.  *
  1645.  * Results:
  1646.  * A newly allocated channel buffer.
  1647.  *
  1648.  * Side effects:
  1649.  * None.
  1650.  *
  1651.  *---------------------------------------------------------------------------
  1652.  */
  1653. static ChannelBuffer *
  1654. AllocChannelBuffer(length)
  1655.     int length; /* Desired length of channel buffer. */
  1656. {
  1657.     ChannelBuffer *bufPtr;
  1658.     int n;
  1659.     n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
  1660.     bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
  1661.     bufPtr->nextAdded = BUFFER_PADDING;
  1662.     bufPtr->nextRemoved = BUFFER_PADDING;
  1663.     bufPtr->bufLength = length + BUFFER_PADDING;
  1664.     bufPtr->nextPtr = (ChannelBuffer *) NULL;
  1665.     return bufPtr;
  1666. }
  1667. /*
  1668.  *----------------------------------------------------------------------
  1669.  *
  1670.  * RecycleBuffer --
  1671.  *
  1672.  * Helper function to recycle input and output buffers. Ensures
  1673.  * that two input buffers are saved (one in the input queue and
  1674.  * another in the saveInBufPtr field) and that curOutPtr is set
  1675.  * to a buffer. Only if these conditions are met is the buffer
  1676.  * freed to the OS.
  1677.  *
  1678.  * Results:
  1679.  * None.
  1680.  *
  1681.  * Side effects:
  1682.  * May free a buffer to the OS.
  1683.  *
  1684.  *----------------------------------------------------------------------
  1685.  */
  1686. static void
  1687. RecycleBuffer(statePtr, bufPtr, mustDiscard)
  1688.     ChannelState *statePtr; /* ChannelState in which to recycle buffers. */
  1689.     ChannelBuffer *bufPtr; /* The buffer to recycle. */
  1690.     int mustDiscard; /* If nonzero, free the buffer to the
  1691.                                  * OS, always. */
  1692. {
  1693.     /*
  1694.      * Do we have to free the buffer to the OS?
  1695.      */
  1696.     if (mustDiscard) {
  1697.         ckfree((char *) bufPtr);
  1698.         return;
  1699.     }
  1700.     /*
  1701.      * Only save buffers which are at least as big as the requested
  1702.      * buffersize for the channel. This is to honor dynamic changes
  1703.      * of the buffersize made by the user.
  1704.      */
  1705.     if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
  1706.         ckfree((char *) bufPtr);
  1707.         return;
  1708.     }
  1709.     /*
  1710.      * Only save buffers for the input queue if the channel is readable.
  1711.      */
  1712.     
  1713.     if (statePtr->flags & TCL_READABLE) {
  1714.         if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
  1715.             statePtr->inQueueHead = bufPtr;
  1716.             statePtr->inQueueTail = bufPtr;
  1717.             goto keepit;
  1718.         }
  1719.         if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) {
  1720.             statePtr->saveInBufPtr = bufPtr;
  1721.             goto keepit;
  1722.         }
  1723.     }
  1724.     /*
  1725.      * Only save buffers for the output queue if the channel is writable.
  1726.      */
  1727.     if (statePtr->flags & TCL_WRITABLE) {
  1728.         if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
  1729.             statePtr->curOutPtr = bufPtr;
  1730.             goto keepit;
  1731.         }
  1732.     }
  1733.     /*
  1734.      * If we reached this code we return the buffer to the OS.
  1735.      */
  1736.     ckfree((char *) bufPtr);
  1737.     return;
  1738.     keepit:
  1739.     bufPtr->nextRemoved = BUFFER_PADDING;
  1740.     bufPtr->nextAdded = BUFFER_PADDING;
  1741.     bufPtr->nextPtr = (ChannelBuffer *) NULL;
  1742. }
  1743. /*
  1744.  *----------------------------------------------------------------------
  1745.  *
  1746.  * DiscardOutputQueued --
  1747.  *
  1748.  * Discards all output queued in the output queue of a channel.
  1749.  *
  1750.  * Results:
  1751.  * None.
  1752.  *
  1753.  * Side effects:
  1754.  * Recycles buffers.
  1755.  *
  1756.  *----------------------------------------------------------------------
  1757.  */
  1758. static void
  1759. DiscardOutputQueued(statePtr)
  1760.     ChannelState *statePtr; /* ChannelState for which to discard output. */
  1761. {
  1762.     ChannelBuffer *bufPtr;
  1763.     
  1764.     while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
  1765.         bufPtr = statePtr->outQueueHead;
  1766.         statePtr->outQueueHead = bufPtr->nextPtr;
  1767.         RecycleBuffer(statePtr, bufPtr, 0);
  1768.     }
  1769.     statePtr->outQueueHead = (ChannelBuffer *) NULL;
  1770.     statePtr->outQueueTail = (ChannelBuffer *) NULL;
  1771. }
  1772. /*
  1773.  *----------------------------------------------------------------------
  1774.  *
  1775.  * CheckForDeadChannel --
  1776.  *
  1777.  * This function checks is a given channel is Dead.
  1778.  *      (A channel that has been closed but not yet deallocated.)
  1779.  *
  1780.  * Results:
  1781.  * True (1) if channel is Dead, False (0) if channel is Ok
  1782.  *
  1783.  * Side effects:
  1784.  *      None
  1785.  *
  1786.  *----------------------------------------------------------------------
  1787.  */
  1788. static int
  1789. CheckForDeadChannel(interp, statePtr)
  1790.     Tcl_Interp *interp; /* For error reporting (can be NULL) */
  1791.     ChannelState *statePtr; /* The channel state to check. */
  1792. {
  1793.     if (statePtr->flags & CHANNEL_DEAD) {
  1794.         Tcl_SetErrno(EINVAL);
  1795. if (interp) {
  1796.     Tcl_AppendResult(interp,
  1797.     "unable to access channel: invalid channel",
  1798.     (char *) NULL);   
  1799. }
  1800. return 1;
  1801.     }
  1802.     return 0;
  1803. }
  1804. /*
  1805.  *----------------------------------------------------------------------
  1806.  *
  1807.  * FlushChannel --
  1808.  *
  1809.  * This function flushes as much of the queued output as is possible
  1810.  * now. If calledFromAsyncFlush is nonzero, it is being called in an
  1811.  * event handler to flush channel output asynchronously.
  1812.  *
  1813.  * Results:
  1814.  * 0 if successful, else the error code that was returned by the
  1815.  * channel type operation.
  1816.  *
  1817.  * Side effects:
  1818.  * May produce output on a channel. May block indefinitely if the
  1819.  * channel is synchronous. May schedule an async flush on the channel.
  1820.  * May recycle memory for buffers in the output queue.
  1821.  *
  1822.  *----------------------------------------------------------------------
  1823.  */
  1824. static int
  1825. FlushChannel(interp, chanPtr, calledFromAsyncFlush)
  1826.     Tcl_Interp *interp; /* For error reporting during close. */
  1827.     Channel *chanPtr; /* The channel to flush on. */
  1828.     int calledFromAsyncFlush; /* If nonzero then we are being
  1829.                                          * called from an asynchronous
  1830.                                          * flush callback. */
  1831. {
  1832.     ChannelState *statePtr = chanPtr->state;
  1833. /* State of the channel stack. */
  1834.     ChannelBuffer *bufPtr; /* Iterates over buffered output
  1835.                                          * queue. */
  1836.     int toWrite; /* Amount of output data in current
  1837.                                          * buffer available to be written. */
  1838.     int written; /* Amount of output data actually
  1839.                                          * written in current round. */
  1840.     int errorCode = 0; /* Stores POSIX error codes from
  1841.                                          * channel driver operations. */
  1842.     int wroteSome = 0; /* Set to one if any data was
  1843.  * written to the driver. */
  1844.     /*
  1845.      * Prevent writing on a dead channel -- a channel that has been closed
  1846.      * but not yet deallocated. This can occur if the exit handler for the
  1847.      * channel deallocation runs before all channels are deregistered in
  1848.      * all interpreters.
  1849.      */
  1850.     
  1851.     if (CheckForDeadChannel(interp, statePtr)) return -1;
  1852.     
  1853.     /*
  1854.      * Loop over the queued buffers and attempt to flush as
  1855.      * much as possible of the queued output to the channel.
  1856.      */
  1857.     while (1) {
  1858.         /*
  1859.          * If the queue is empty and there is a ready current buffer, OR if
  1860.          * the current buffer is full, then move the current buffer to the
  1861.          * queue.
  1862.          */
  1863.         if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
  1864.                 (statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength))
  1865.                 || ((statePtr->flags & BUFFER_READY) &&
  1866.                         (statePtr->outQueueHead == (ChannelBuffer *) NULL))) {
  1867.             statePtr->flags &= (~(BUFFER_READY));
  1868.             statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
  1869.             if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
  1870.                 statePtr->outQueueHead = statePtr->curOutPtr;
  1871.             } else {
  1872.                 statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
  1873.             }
  1874.             statePtr->outQueueTail = statePtr->curOutPtr;
  1875.             statePtr->curOutPtr = (ChannelBuffer *) NULL;
  1876.         }
  1877.         bufPtr = statePtr->outQueueHead;
  1878.         /*
  1879.          * If we are not being called from an async flush and an async
  1880.          * flush is active, we just return without producing any output.
  1881.          */
  1882.         if ((!calledFromAsyncFlush) &&
  1883.                 (statePtr->flags & BG_FLUSH_SCHEDULED)) {
  1884.             return 0;
  1885.         }
  1886.         /*
  1887.          * If the output queue is still empty, break out of the while loop.
  1888.          */
  1889.         if (bufPtr == (ChannelBuffer *) NULL) {
  1890.             break; /* Out of the "while (1)". */
  1891.         }
  1892.         /*
  1893.          * Produce the output on the channel.
  1894.          */
  1895.         toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
  1896.         written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
  1897.                 bufPtr->buf + bufPtr->nextRemoved, toWrite,
  1898. &errorCode);
  1899. /*
  1900.          * If the write failed completely attempt to start the asynchronous
  1901.          * flush mechanism and break out of this loop - do not attempt to
  1902.          * write any more output at this time.
  1903.          */
  1904.         if (written < 0) {
  1905.             
  1906.             /*
  1907.              * If the last attempt to write was interrupted, simply retry.
  1908.              */
  1909.             
  1910.             if (errorCode == EINTR) {
  1911.                 errorCode = 0;
  1912.                 continue;
  1913.             }
  1914.             /*
  1915.              * If the channel is non-blocking and we would have blocked,
  1916.              * start a background flushing handler and break out of the loop.
  1917.              */
  1918.             if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
  1919. /*
  1920.  * This used to check for CHANNEL_NONBLOCKING, and panic
  1921.  * if the channel was blocking.  However, it appears
  1922.  * that setting stdin to -blocking 0 has some effect on
  1923.  * the stdout when it's a tty channel (dup'ed underneath)
  1924.  */
  1925. if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
  1926.     statePtr->flags |= BG_FLUSH_SCHEDULED;
  1927.     UpdateInterest(chanPtr);
  1928. }
  1929. errorCode = 0;
  1930. break;
  1931.             }
  1932.             /*
  1933.              * Decide whether to report the error upwards or defer it.
  1934.              */
  1935.             if (calledFromAsyncFlush) {
  1936.                 if (statePtr->unreportedError == 0) {
  1937.                     statePtr->unreportedError = errorCode;
  1938.                 }
  1939.             } else {
  1940.                 Tcl_SetErrno(errorCode);
  1941. if (interp != NULL) {
  1942.     /*
  1943.      * Casting away CONST here is safe because the
  1944.      * TCL_VOLATILE flag guarantees CONST treatment
  1945.      * of the Posix error string.
  1946.      */
  1947.     Tcl_SetResult(interp,
  1948.     (char *) Tcl_PosixError(interp), TCL_VOLATILE);
  1949. }
  1950.             }
  1951.             /*
  1952.              * When we get an error we throw away all the output
  1953.              * currently queued.
  1954.              */
  1955.             DiscardOutputQueued(statePtr);
  1956.             continue;
  1957.         } else {
  1958.     wroteSome = 1;
  1959. }
  1960.         bufPtr->nextRemoved += written;
  1961.         /*
  1962.          * If this buffer is now empty, recycle it.
  1963.          */
  1964.         if (bufPtr->nextRemoved == bufPtr->nextAdded) {
  1965.             statePtr->outQueueHead = bufPtr->nextPtr;
  1966.             if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
  1967.                 statePtr->outQueueTail = (ChannelBuffer *) NULL;
  1968.             }
  1969.             RecycleBuffer(statePtr, bufPtr, 0);
  1970.         }
  1971.     } /* Closes "while (1)". */
  1972.     /*
  1973.      * If we wrote some data while flushing in the background, we are done.
  1974.      * We can't finish the background flush until we run out of data and
  1975.      * the channel becomes writable again.  This ensures that all of the
  1976.      * pending data has been flushed at the system level.
  1977.      */
  1978.     if (statePtr->flags & BG_FLUSH_SCHEDULED) {
  1979. if (wroteSome) {
  1980.     return errorCode;
  1981. } else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
  1982.     statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
  1983.     (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
  1984.     statePtr->interestMask);
  1985. }
  1986.     }
  1987.     /*
  1988.      * If the channel is flagged as closed, delete it when the refCount
  1989.      * drops to zero, the output queue is empty and there is no output
  1990.      * in the current output buffer.
  1991.      */
  1992.     if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
  1993.             (statePtr->outQueueHead == (ChannelBuffer *) NULL) &&
  1994.             ((statePtr->curOutPtr == (ChannelBuffer *) NULL) ||
  1995.                     (statePtr->curOutPtr->nextAdded ==
  1996.                             statePtr->curOutPtr->nextRemoved))) {
  1997. return CloseChannel(interp, chanPtr, errorCode);
  1998.     }
  1999.     return errorCode;
  2000. }
  2001. /*
  2002.  *----------------------------------------------------------------------
  2003.  *
  2004.  * CloseChannel --
  2005.  *
  2006.  * Utility procedure to close a channel and free associated resources.
  2007.  *
  2008.  * If the channel was stacked, then the it will copy the necessary
  2009.  * elements of the NEXT channel into the TOP channel, in essence
  2010.  * unstacking the channel.  The NEXT channel will then be freed.
  2011.  *
  2012.  * If the channel was not stacked, then we will free all the bits
  2013.  * for the TOP channel, including the data structure itself.
  2014.  *
  2015.  * Results:
  2016.  * 1 if the channel was stacked, 0 otherwise.
  2017.  *
  2018.  * Side effects:
  2019.  * May close the actual channel; may free memory.
  2020.  * May change the value of errno.
  2021.  *
  2022.  *----------------------------------------------------------------------
  2023.  */
  2024. static int
  2025. CloseChannel(interp, chanPtr, errorCode)
  2026.     Tcl_Interp *interp; /* For error reporting. */
  2027.     Channel *chanPtr; /* The channel to close. */
  2028.     int errorCode; /* Status of operation so far. */
  2029. {
  2030.     int result = 0; /* Of calling driver close
  2031.                                          * operation. */
  2032.     ChannelState *statePtr; /* state of the channel stack. */
  2033.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  2034.     if (chanPtr == NULL) {
  2035.         return result;
  2036.     }
  2037.     statePtr = chanPtr->state;
  2038.     /*
  2039.      * No more input can be consumed so discard any leftover input.
  2040.      */
  2041.     DiscardInputQueued(statePtr, 1);
  2042.     /*
  2043.      * Discard a leftover buffer in the current output buffer field.
  2044.      */
  2045.     if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
  2046.         ckfree((char *) statePtr->curOutPtr);
  2047.         statePtr->curOutPtr = (ChannelBuffer *) NULL;
  2048.     }
  2049.     
  2050.     /*
  2051.      * The caller guarantees that there are no more buffers
  2052.      * queued for output.
  2053.      */
  2054.     if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
  2055.         panic("TclFlush, closed channel: queued output left");
  2056.     }
  2057.     /*
  2058.      * If the EOF character is set in the channel, append that to the
  2059.      * output device.
  2060.      */
  2061.     if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
  2062.         int dummy;
  2063.         char c;
  2064.         c = (char) statePtr->outEofChar;
  2065.         (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
  2066.     }
  2067.     /*
  2068.      * Remove this channel from of the list of all channels.
  2069.      */
  2070.     Tcl_CutChannel((Tcl_Channel) chanPtr);
  2071.     /*
  2072.      * Close and free the channel driver state.
  2073.      */
  2074.     if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
  2075. result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
  2076.     } else {
  2077. result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
  2078. 0);
  2079.     }
  2080.     /*
  2081.      * Some resources can be cleared only if the bottom channel
  2082.      * in a stack is closed. All the other channels in the stack
  2083.      * are not allowed to remove.
  2084.      */
  2085.     if (chanPtr == statePtr->bottomChanPtr) {
  2086. if (statePtr->channelName != (char *) NULL) {
  2087.     ckfree((char *) statePtr->channelName);
  2088.     statePtr->channelName = NULL;
  2089. }
  2090. Tcl_FreeEncoding(statePtr->encoding);
  2091. if (statePtr->outputStage != NULL) {
  2092.     ckfree((char *) statePtr->outputStage);
  2093.     statePtr->outputStage = (char *) NULL;
  2094. }
  2095.     }
  2096.     /*
  2097.      * If we are being called synchronously, report either
  2098.      * any latent error on the channel or the current error.
  2099.      */
  2100.     if (statePtr->unreportedError != 0) {
  2101.         errorCode = statePtr->unreportedError;
  2102.     }
  2103.     if (errorCode == 0) {
  2104.         errorCode = result;
  2105.         if (errorCode != 0) {
  2106.             Tcl_SetErrno(errorCode);
  2107.         }
  2108.     }
  2109.     /*
  2110.      * Cancel any outstanding timer.
  2111.      */
  2112.     Tcl_DeleteTimerHandler(statePtr->timer);
  2113.     /*
  2114.      * Mark the channel as deleted by clearing the type structure.
  2115.      */
  2116.     if (chanPtr->downChanPtr != (Channel *) NULL) {
  2117. Channel *downChanPtr = chanPtr->downChanPtr;
  2118. statePtr->nextCSPtr = tsdPtr->firstCSPtr;
  2119. tsdPtr->firstCSPtr = statePtr;
  2120. statePtr->topChanPtr = downChanPtr;
  2121. downChanPtr->upChanPtr = (Channel *) NULL;
  2122. chanPtr->typePtr = NULL;
  2123. Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
  2124. return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
  2125.     }
  2126.     /*
  2127.      * There is only the TOP Channel, so we free the remaining
  2128.      * pointers we have and then ourselves.  Since this is the
  2129.      * last of the channels in the stack, make sure to free the
  2130.      * ChannelState structure associated with it.  We use
  2131.      * Tcl_EventuallyFree to allow for any last
  2132.      */
  2133.     chanPtr->typePtr = NULL;
  2134.     Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);
  2135.     Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
  2136.     return errorCode;
  2137. }
  2138. /*
  2139.  *----------------------------------------------------------------------
  2140.  *
  2141.  * Tcl_CutChannel --
  2142.  *
  2143.  * Removes a channel from the (thread-)global list of all channels
  2144.  * (in that thread).  This is actually the statePtr for the stack
  2145.  * of channel.
  2146.  *
  2147.  * Results:
  2148.  * Nothing.
  2149.  *
  2150.  * Side effects:
  2151.  * Resets the field 'nextCSPtr' of the specified channel state to NULL.
  2152.  *
  2153.  * NOTE:
  2154.  * The channel to cut out of the list must not be referenced
  2155.  * in any interpreter. This is something this procedure cannot
  2156.  * check (despite the refcount) because the caller usually wants
  2157.  * fiddle with the channel (like transfering it to a different
  2158.  * thread) and thus keeps the refcount artifically high to prevent
  2159.  * its destruction.
  2160.  *
  2161.  *----------------------------------------------------------------------
  2162.  */
  2163. void
  2164. Tcl_CutChannel(chan)
  2165.     Tcl_Channel chan; /* The channel being removed. Must
  2166.                                          * not be referenced in any
  2167.                                          * interpreter. */
  2168. {
  2169.     ThreadSpecificData* tsdPtr  = TCL_TSD_INIT(&dataKey);
  2170.     ChannelState *prevCSPtr; /* Preceding channel state in list of
  2171.                                          * all states - used to splice a
  2172.                                          * channel out of the list on close. */
  2173.     ChannelState *statePtr = ((Channel *) chan)->state;
  2174. /* state of the channel stack. */
  2175.     Tcl_DriverThreadActionProc *threadActionProc;
  2176.     /*
  2177.      * Remove this channel from of the list of all channels
  2178.      * (in the current thread).
  2179.      */
  2180.     if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
  2181.         tsdPtr->firstCSPtr = statePtr->nextCSPtr;
  2182.     } else {
  2183.         for (prevCSPtr = tsdPtr->firstCSPtr;
  2184.      prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
  2185.      prevCSPtr = prevCSPtr->nextCSPtr) {
  2186.             /* Empty loop body. */
  2187.         }
  2188.         if (prevCSPtr == (ChannelState *) NULL) {
  2189.             panic("FlushChannel: damaged channel list");
  2190.         }
  2191.         prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
  2192.     }
  2193.     statePtr->nextCSPtr = (ChannelState *) NULL;
  2194.     /* TIP #218, Channel Thread Actions */
  2195.     threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
  2196.     if (threadActionProc != NULL) {
  2197.         (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
  2198.      TCL_CHANNEL_THREAD_REMOVE);
  2199.     }
  2200. }
  2201. /*
  2202.  *----------------------------------------------------------------------
  2203.  *
  2204.  * Tcl_SpliceChannel --
  2205.  *
  2206.  * Adds a channel to the (thread-)global list of all channels
  2207.  * (in that thread). Expects that the field 'nextChanPtr' in
  2208.  * the channel is set to NULL.
  2209.  *
  2210.  * Results:
  2211.  * Nothing.
  2212.  *
  2213.  * Side effects:
  2214.  * Nothing.
  2215.  *
  2216.  * NOTE:
  2217.  * The channel to splice into the list must not be referenced in any
  2218.  * interpreter. This is something this procedure cannot check
  2219.  * (despite the refcount) because the caller usually wants figgle
  2220.  * with the channel (like transfering it to a different thread)
  2221.  * and thus keeps the refcount artifically high to prevent its
  2222.  * destruction.
  2223.  *
  2224.  *----------------------------------------------------------------------
  2225.  */
  2226. void
  2227. Tcl_SpliceChannel(chan)
  2228.     Tcl_Channel chan; /* The channel being added. Must
  2229.                                          * not be referenced in any
  2230.                                          * interpreter. */
  2231. {
  2232.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  2233.     ChannelState *statePtr = ((Channel *) chan)->state;
  2234.     Tcl_DriverThreadActionProc *threadActionProc;
  2235.     if (statePtr->nextCSPtr != (ChannelState *) NULL) {
  2236.         panic("Tcl_SpliceChannel: trying to add channel used in different list");
  2237.     }
  2238.     statePtr->nextCSPtr = tsdPtr->firstCSPtr;
  2239.     tsdPtr->firstCSPtr = statePtr;
  2240.     /*
  2241.      * TIP #10. Mark the current thread as the new one managing this
  2242.      *          channel. Note: 'Tcl_GetCurrentThread' returns sensible
  2243.      *          values even for a non-threaded core.
  2244.      */
  2245.     statePtr->managingThread = Tcl_GetCurrentThread ();
  2246.     /* TIP #218, Channel Thread Actions */
  2247.     threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
  2248.     if (threadActionProc != NULL) {
  2249.         (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
  2250.      TCL_CHANNEL_THREAD_INSERT);
  2251.     }
  2252. }
  2253. /*
  2254.  *----------------------------------------------------------------------
  2255.  *
  2256.  * Tcl_Close --
  2257.  *
  2258.  * Closes a channel.
  2259.  *
  2260.  * Results:
  2261.  * A standard Tcl result.
  2262.  *
  2263.  * Side effects:
  2264.  * Closes the channel if this is the last reference.
  2265.  *
  2266.  * NOTE:
  2267.  * Tcl_Close removes the channel as far as the user is concerned.
  2268.  * However, it may continue to exist for a while longer if it has
  2269.  * a background flush scheduled. The device itself is eventually
  2270.  * closed and the channel record removed, in CloseChannel, above.
  2271.  *
  2272.  *----------------------------------------------------------------------
  2273.  */
  2274. /* ARGSUSED */
  2275. int
  2276. Tcl_Close(interp, chan)
  2277.     Tcl_Interp *interp; /* Interpreter for errors. */
  2278.     Tcl_Channel chan; /* The channel being closed. Must
  2279.                                          * not be referenced in any
  2280.                                          * interpreter. */
  2281. {
  2282.     CloseCallback *cbPtr; /* Iterate over close callbacks
  2283.                                          * for this channel. */
  2284.     Channel *chanPtr; /* The real IO channel. */
  2285.     ChannelState *statePtr; /* State of real IO channel. */
  2286.     int result; /* Of calling FlushChannel. */
  2287.     if (chan == (Tcl_Channel) NULL) {
  2288.         return TCL_OK;
  2289.     }
  2290.     /*
  2291.      * Perform special handling for standard channels being closed. If the
  2292.      * refCount is now 1 it means that the last reference to the standard
  2293.      * channel is being explicitly closed, so bump the refCount down
  2294.      * artificially to 0. This will ensure that the channel is actually
  2295.      * closed, below. Also set the static pointer to NULL for the channel.
  2296.      */
  2297.     CheckForStdChannelsBeingClosed(chan);
  2298.     /*
  2299.      * This operation should occur at the top of a channel stack.
  2300.      */
  2301.     chanPtr = (Channel *) chan;
  2302.     statePtr = chanPtr->state;
  2303.     chanPtr = statePtr->topChanPtr;
  2304.     if (statePtr->refCount > 0) {
  2305.         panic("called Tcl_Close on channel with refCount > 0");
  2306.     }
  2307.  
  2308.     if (statePtr->flags & CHANNEL_INCLOSE) {
  2309. if (interp) {
  2310.             Tcl_AppendResult(interp,
  2311.     "Illegal recursive call to close through close-handler of channel",
  2312.     (char *) NULL);
  2313. }
  2314.         return TCL_ERROR;
  2315.     }
  2316.     statePtr->flags |= CHANNEL_INCLOSE;
  2317.     /*
  2318.      * When the channel has an escape sequence driven encoding such as
  2319.      * iso2022, the terminated escape sequence must write to the buffer.
  2320.      */
  2321.     if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
  2322.     && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
  2323.         statePtr->outputEncodingFlags |= TCL_ENCODING_END;
  2324.         WriteChars(chanPtr, "", 0);
  2325.     }
  2326.     Tcl_ClearChannelHandlers(chan);
  2327.     /*
  2328.      * Invoke the registered close callbacks and delete their records.
  2329.      */
  2330.     while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
  2331.         cbPtr = statePtr->closeCbPtr;
  2332.         statePtr->closeCbPtr = cbPtr->nextPtr;
  2333.         (cbPtr->proc) (cbPtr->clientData);
  2334.         ckfree((char *) cbPtr);
  2335.     }
  2336.     statePtr->flags &= ~CHANNEL_INCLOSE;
  2337.     /*
  2338.      * Ensure that the last output buffer will be flushed.
  2339.      */
  2340.     
  2341.     if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
  2342.     (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
  2343.         statePtr->flags |= BUFFER_READY;
  2344.     }
  2345.     /*
  2346.      * If this channel supports it, close the read side, since we don't need it
  2347.      * anymore and this will help avoid deadlocks on some channel types.
  2348.      */
  2349.     if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
  2350. result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
  2351. TCL_CLOSE_READ);
  2352.     } else {
  2353. result = 0;
  2354.     }
  2355.     /*
  2356.      * The call to FlushChannel will flush any queued output and invoke
  2357.      * the close function of the channel driver, or it will set up the
  2358.      * channel to be flushed and closed asynchronously.
  2359.      */
  2360.     statePtr->flags |= CHANNEL_CLOSED;
  2361.     if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
  2362.         return TCL_ERROR;
  2363.     }
  2364.     return TCL_OK;
  2365. }
  2366. /*
  2367.  *----------------------------------------------------------------------
  2368.  *
  2369.  * Tcl_ClearChannelHandlers --
  2370.  *
  2371.  * Removes all channel handlers and event scripts from the channel,
  2372.  * cancels all background copies involving the channel and any interest
  2373.  * in events.
  2374.  *
  2375.  * Results:
  2376.  * None.
  2377.  *
  2378.  * Side effects:
  2379.  * See above. Deallocates memory.
  2380.  *
  2381.  *----------------------------------------------------------------------
  2382.  */
  2383. void
  2384. Tcl_ClearChannelHandlers (channel)
  2385.     Tcl_Channel channel;
  2386. {
  2387.     ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
  2388.     EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
  2389.     Channel *chanPtr; /* The real IO channel. */
  2390.     ChannelState *statePtr; /* State of real IO channel. */
  2391.     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
  2392.     NextChannelHandler *nhPtr;
  2393.     /*
  2394.      * This operation should occur at the top of a channel stack.
  2395.      */
  2396.     chanPtr = (Channel *) channel;
  2397.     statePtr = chanPtr->state;
  2398.     chanPtr = statePtr->topChanPtr;
  2399.     /*
  2400.      * Cancel any outstanding timer.
  2401.      */
  2402.     Tcl_DeleteTimerHandler(statePtr->timer);
  2403.     /*
  2404.      * Remove any references to channel handlers for this channel that
  2405.      * may be about to be invoked.
  2406.      */
  2407.     for (nhPtr = tsdPtr->nestedHandlerPtr;
  2408.  nhPtr != (NextChannelHandler *) NULL;
  2409.  nhPtr = nhPtr->nestedHandlerPtr) {
  2410.         if (nhPtr->nextHandlerPtr &&
  2411. (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
  2412.     nhPtr->nextHandlerPtr = NULL;
  2413.         }
  2414.     }
  2415.     /*
  2416.      * Remove all the channel handler records attached to the channel
  2417.      * itself.
  2418.      */
  2419.     for (chPtr = statePtr->chPtr;
  2420.  chPtr != (ChannelHandler *) NULL;
  2421.  chPtr = chNext) {
  2422.         chNext = chPtr->nextPtr;
  2423.         ckfree((char *) chPtr);
  2424.     }
  2425.     statePtr->chPtr = (ChannelHandler *) NULL;
  2426.     /*
  2427.      * Cancel any pending copy operation.
  2428.      */
  2429.     StopCopy(statePtr->csPtr);
  2430.     /*
  2431.      * Must set the interest mask now to 0, otherwise infinite loops
  2432.      * will occur if Tcl_DoOneEvent is called before the channel is
  2433.      * finally deleted in FlushChannel. This can happen if the channel
  2434.      * has a background flush active.
  2435.      */
  2436.     statePtr->interestMask = 0;
  2437.     /*
  2438.      * Remove any EventScript records for this channel.
  2439.      */
  2440.     for (ePtr = statePtr->scriptRecordPtr;
  2441.  ePtr != (EventScriptRecord *) NULL;
  2442.  ePtr = eNextPtr) {
  2443.         eNextPtr = ePtr->nextPtr;
  2444. Tcl_DecrRefCount(ePtr->scriptPtr);
  2445.         ckfree((char *) ePtr);
  2446.     }
  2447.     statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
  2448. }
  2449. /*
  2450.  *----------------------------------------------------------------------
  2451.  *
  2452.  * Tcl_Write --
  2453.  *
  2454.  * Puts a sequence of bytes into an output buffer, may queue the
  2455.  * buffer for output if it gets full, and also remembers whether the
  2456.  * current buffer is ready e.g. if it contains a newline and we are in
  2457.  * line buffering mode. Compensates stacking, i.e. will redirect the
  2458.  * data from the specified channel to the topmost channel in a stack.
  2459.  *
  2460.  * No encoding conversions are applied to the bytes being read.
  2461.  *
  2462.  * Results:
  2463.  * The number of bytes written or -1 in case of error. If -1,
  2464.  * Tcl_GetErrno will return the error code.
  2465.  *
  2466.  * Side effects:
  2467.  * May buffer up output and may cause output to be produced on the
  2468.  * channel.
  2469.  *
  2470.  *----------------------------------------------------------------------
  2471.  */
  2472. int
  2473. Tcl_Write(chan, src, srcLen)
  2474.     Tcl_Channel chan; /* The channel to buffer output for. */
  2475.     CONST char *src; /* Data to queue in output buffer. */
  2476.     int srcLen; /* Length of data in bytes, or < 0 for
  2477.  * strlen(). */
  2478. {
  2479.     /*
  2480.      * Always use the topmost channel of the stack
  2481.      */
  2482.     Channel *chanPtr;
  2483.     ChannelState *statePtr; /* state info for channel */
  2484.     statePtr = ((Channel *) chan)->state;
  2485.     chanPtr  = statePtr->topChanPtr;
  2486.     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
  2487. return -1;
  2488.     }
  2489.     if (srcLen < 0) {
  2490.         srcLen = strlen(src);
  2491.     }
  2492.     return DoWrite(chanPtr, src, srcLen);
  2493. }
  2494. /*
  2495.  *----------------------------------------------------------------------
  2496.  *
  2497.  * Tcl_WriteRaw --
  2498.  *
  2499.  * Puts a sequence of bytes into an output buffer, may queue the
  2500.  * buffer for output if it gets full, and also remembers whether the
  2501.  * current buffer is ready e.g. if it contains a newline and we are in
  2502.  * line buffering mode. Writes directly to the driver of the channel,
  2503.  * does not compensate for stacking.
  2504.  *
  2505.  * No encoding conversions are applied to the bytes being read.
  2506.  *
  2507.  * Results:
  2508.  * The number of bytes written or -1 in case of error. If -1,
  2509.  * Tcl_GetErrno will return the error code.
  2510.  *
  2511.  * Side effects:
  2512.  * May buffer up output and may cause output to be produced on the
  2513.  * channel.
  2514.  *
  2515.  *----------------------------------------------------------------------
  2516.  */
  2517. int
  2518. Tcl_WriteRaw(chan, src, srcLen)
  2519.     Tcl_Channel chan; /* The channel to buffer output for. */
  2520.     CONST char *src; /* Data to queue in output buffer. */
  2521.     int srcLen; /* Length of data in bytes, or < 0 for
  2522.  * strlen(). */
  2523. {
  2524.     Channel *chanPtr = ((Channel *) chan);
  2525.     ChannelState *statePtr = chanPtr->state; /* state info for channel */
  2526.     int errorCode, written;
  2527.     if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
  2528. return -1;
  2529.     }
  2530.     if (srcLen < 0) {
  2531.         srcLen = strlen(src);
  2532.     }
  2533.     /*
  2534.      * Go immediately to the driver, do all the error handling by ourselves.
  2535.      * The code was stolen from 'FlushChannel'.
  2536.      */
  2537.     written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
  2538.     src, srcLen, &errorCode);
  2539.     if (written < 0) {
  2540. Tcl_SetErrno(errorCode);
  2541.     }
  2542.     return written;
  2543. }
  2544. /*
  2545.  *---------------------------------------------------------------------------
  2546.  *
  2547.  * Tcl_WriteChars --
  2548.  *
  2549.  * Takes a sequence of UTF-8 characters and converts them for output
  2550.  * using the channel's current encoding, may queue the buffer for
  2551.  * output if it gets full, and also remembers whether the current
  2552.  * buffer is ready e.g. if it contains a newline and we are in
  2553.  * line buffering mode. Compensates stacking, i.e. will redirect the
  2554.  * data from the specified channel to the topmost channel in a stack.
  2555.  *
  2556.  * Results:
  2557.  * The number of bytes written or -1 in case of error. If -1,
  2558.  * Tcl_GetErrno will return the error code.
  2559.  *
  2560.  * Side effects:
  2561.  * May buffer up output and may cause output to be produced on the
  2562.  * channel.
  2563.  *
  2564.  *----------------------------------------------------------------------
  2565.  */
  2566. int
  2567. Tcl_WriteChars(chan, src, len)
  2568.     Tcl_Channel chan; /* The channel to buffer output for. */
  2569.     CONST char *src; /* UTF-8 characters to queue in output buffer. */
  2570.     int len; /* Length of string in bytes, or < 0 for 
  2571.  * strlen(). */
  2572. {
  2573.     ChannelState *statePtr; /* state info for channel */
  2574.     statePtr = ((Channel *) chan)->state;
  2575.     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
  2576. return -1;
  2577.     }
  2578.     return DoWriteChars ((Channel*) chan, src, len);
  2579. }
  2580. /*
  2581.  *---------------------------------------------------------------------------
  2582.  *
  2583.  * DoWriteChars --
  2584.  *
  2585.  * Takes a sequence of UTF-8 characters and converts them for output
  2586.  * using the channel's current encoding, may queue the buffer for
  2587.  * output if it gets full, and also remembers whether the current
  2588.  * buffer is ready e.g. if it contains a newline and we are in
  2589.  * line buffering mode. Compensates stacking, i.e. will redirect the
  2590.  * data from the specified channel to the topmost channel in a stack.
  2591.  *
  2592.  * Results:
  2593.  * The number of bytes written or -1 in case of error. If -1,
  2594.  * Tcl_GetErrno will return the error code.
  2595.  *
  2596.  * Side effects:
  2597.  * May buffer up output and may cause output to be produced on the
  2598.  * channel.
  2599.  *
  2600.  *----------------------------------------------------------------------
  2601.  */
  2602. static int
  2603. DoWriteChars(chanPtr, src, len)
  2604.     Channel* chanPtr; /* The channel to buffer output for. */
  2605.     CONST char *src; /* UTF-8 characters to queue in output buffer. */
  2606.     int len; /* Length of string in bytes, or < 0 for 
  2607.  * strlen(). */
  2608. {
  2609.     /*
  2610.      * Always use the topmost channel of the stack
  2611.      */
  2612.     ChannelState *statePtr; /* state info for channel */
  2613.     statePtr = chanPtr->state;
  2614.     chanPtr  = statePtr->topChanPtr;
  2615.     if (len < 0) {
  2616.         len = strlen(src);
  2617.     }
  2618.     if (statePtr->encoding == NULL) {
  2619. /*
  2620.  * Inefficient way to convert UTF-8 to byte-array, but the  
  2621.  * code parallels the way it is done for objects.
  2622.  */
  2623. Tcl_Obj *objPtr;
  2624. int result;
  2625. objPtr = Tcl_NewStringObj(src, len);
  2626. src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
  2627. result = WriteBytes(chanPtr, src, len);
  2628. Tcl_DecrRefCount(objPtr);
  2629. return result;
  2630.     }
  2631.     return WriteChars(chanPtr, src, len);
  2632. }
  2633. /*
  2634.  *---------------------------------------------------------------------------
  2635.  *
  2636.  * Tcl_WriteObj --
  2637.  *
  2638.  * Takes the Tcl object and queues its contents for output.  If the 
  2639.  * encoding of the channel is NULL, takes the byte-array representation 
  2640.  * of the object and queues those bytes for output.  Otherwise, takes 
  2641.  * the characters in the UTF-8 (string) representation of the object 
  2642.  * and converts them for output using the channel's current encoding.  
  2643.  * May flush internal buffers to output if one becomes full or is ready 
  2644.  * for some other reason, e.g. if it contains a newline and the channel 
  2645.  * is in line buffering mode.
  2646.  *
  2647.  * Results:
  2648.  * The number of bytes written or -1 in case of error. If -1, 
  2649.  * Tcl_GetErrno() will return the error code.
  2650.  *
  2651.  * Side effects:
  2652.  * May buffer up output and may cause output to be produced on the
  2653.  * channel.
  2654.  *
  2655.  *----------------------------------------------------------------------
  2656.  */
  2657. int
  2658. Tcl_WriteObj(chan, objPtr)
  2659.     Tcl_Channel chan; /* The channel to buffer output for. */
  2660.     Tcl_Obj *objPtr; /* The object to write. */
  2661. {
  2662.     /*
  2663.      * Always use the topmost channel of the stack
  2664.      */
  2665.     Channel *chanPtr;
  2666.     ChannelState *statePtr; /* state info for channel */
  2667.     char *src;
  2668.     int srcLen;
  2669.     statePtr = ((Channel *) chan)->state;
  2670.     chanPtr  = statePtr->topChanPtr;
  2671.     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
  2672. return -1;
  2673.     }
  2674.     if (statePtr->encoding == NULL) {
  2675. src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
  2676. return WriteBytes(chanPtr, src, srcLen);
  2677.     } else {
  2678. src = Tcl_GetStringFromObj(objPtr, &srcLen);
  2679. return WriteChars(chanPtr, src, srcLen);
  2680.     }
  2681. }
  2682. /*
  2683.  *----------------------------------------------------------------------
  2684.  *
  2685.  * WriteBytes --
  2686.  *
  2687.  * Write a sequence of bytes into an output buffer, may queue the
  2688.  * buffer for output if it gets full, and also remembers whether the
  2689.  * current buffer is ready e.g. if it contains a newline and we are in
  2690.  * line buffering mode.
  2691.  *
  2692.  * Results:
  2693.  * The number of bytes written or -1 in case of error. If -1,
  2694.  * Tcl_GetErrno will return the error code.
  2695.  *
  2696.  * Side effects:
  2697.  * May buffer up output and may cause output to be produced on the
  2698.  * channel.
  2699.  *
  2700.  *----------------------------------------------------------------------
  2701.  */
  2702. static int
  2703. WriteBytes(chanPtr, src, srcLen)
  2704.     Channel *chanPtr; /* The channel to buffer output for. */
  2705.     CONST char *src; /* Bytes to write. */
  2706.     int srcLen; /* Number of bytes to write. */
  2707. {
  2708.     ChannelState *statePtr = chanPtr->state; /* state info for channel */
  2709.     ChannelBuffer *bufPtr;
  2710.     char *dst;
  2711.     int dstMax, sawLF, savedLF, total, dstLen, toWrite;
  2712.     
  2713.     total = 0;
  2714.     sawLF = 0;
  2715.     savedLF = 0;
  2716.     /*
  2717.      * Loop over all bytes in src, storing them in output buffer with
  2718.      * proper EOL translation.
  2719.      */
  2720.     while (srcLen + savedLF > 0) {
  2721. bufPtr = statePtr->curOutPtr;
  2722. if (bufPtr == NULL) {
  2723.     bufPtr = AllocChannelBuffer(statePtr->bufSize);
  2724.     statePtr->curOutPtr = bufPtr;
  2725. }
  2726. dst = bufPtr->buf + bufPtr->nextAdded;
  2727. dstMax = bufPtr->bufLength - bufPtr->nextAdded;
  2728. dstLen = dstMax;
  2729. toWrite = dstLen;
  2730. if (toWrite > srcLen) {
  2731.     toWrite = srcLen;
  2732. }
  2733. if (savedLF) {
  2734.     /*
  2735.      * A 'n' was left over from last call to TranslateOutputEOL()
  2736.      * and we need to store it in this buffer.  If the channel is
  2737.      * line-based, we will need to flush it.
  2738.      */
  2739.     *dst++ = 'n';
  2740.     dstLen--;
  2741.     sawLF++;
  2742. }
  2743. sawLF += TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite);
  2744. dstLen += savedLF;
  2745. savedLF = 0;
  2746. if (dstLen > dstMax) {
  2747.     savedLF = 1;
  2748.     dstLen = dstMax;
  2749. }
  2750. bufPtr->nextAdded += dstLen;
  2751. if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
  2752.     return -1;
  2753. }
  2754. total += dstLen;
  2755. src += toWrite;
  2756. srcLen -= toWrite;
  2757. sawLF = 0;
  2758.     }
  2759.     return total;
  2760. }
  2761. /*
  2762.  *----------------------------------------------------------------------
  2763.  *
  2764.  * WriteChars --
  2765.  *
  2766.  * Convert UTF-8 bytes to the channel's external encoding and
  2767.  * write the produced bytes into an output buffer, may queue the 
  2768.  * buffer for output if it gets full, and also remembers whether the
  2769.  * current buffer is ready e.g. if it contains a newline and we are in
  2770.  * line buffering mode.
  2771.  *
  2772.  * Results:
  2773.  * The number of bytes written or -1 in case of error. If -1,
  2774.  * Tcl_GetErrno will return the error code.
  2775.  *
  2776.  * Side effects:
  2777.  * May buffer up output and may cause output to be produced on the
  2778.  * channel.
  2779.  *
  2780.  *----------------------------------------------------------------------
  2781.  */
  2782. static int
  2783. WriteChars(chanPtr, src, srcLen)
  2784.     Channel *chanPtr; /* The channel to buffer output for. */
  2785.     CONST char *src; /* UTF-8 string to write. */
  2786.     int srcLen; /* Length of UTF-8 string in bytes. */
  2787. {
  2788.     ChannelState *statePtr = chanPtr->state; /* state info for channel */
  2789.     ChannelBuffer *bufPtr;
  2790.     char *dst, *stage;
  2791.     int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
  2792.     int stageLen, toWrite, stageRead, endEncoding, result;
  2793.     int consumedSomething;
  2794.     Tcl_Encoding encoding;
  2795.     char safe[BUFFER_PADDING];
  2796.     
  2797.     total = 0;
  2798.     sawLF = 0;
  2799.     savedLF = 0;
  2800.     saved = 0;
  2801.     encoding = statePtr->encoding;
  2802.     /*
  2803.      * Write the terminated escape sequence even if srcLen is 0.
  2804.      */