tclIO.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:273k
- /*
- * tclIO.c --
- *
- * This file provides the generic portions (those that are the same on
- * all platforms and for all channel types) of Tcl's IO facilities.
- *
- * Copyright (c) 1998-2000 Ajuba Solutions
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIO.c,v 1.61.2.23 2007/05/24 19:31:55 dgp Exp $
- */
- #include "tclInt.h"
- #include "tclPort.h"
- #include "tclIO.h"
- #include <assert.h>
- #ifndef TCL_INHERIT_STD_CHANNELS
- #define TCL_INHERIT_STD_CHANNELS 1
- #endif
- /*
- * All static variables used in this file are collected into a single
- * instance of the following structure. For multi-threaded implementations,
- * there is one instance of this structure for each thread.
- *
- * Notice that different structures with the same name appear in other
- * files. The structure defined below is used in this file only.
- */
- typedef struct ThreadSpecificData {
- /*
- * This variable holds the list of nested ChannelHandlerEventProc
- * invocations.
- */
- NextChannelHandler *nestedHandlerPtr;
- /*
- * List of all channels currently open, indexed by ChannelState,
- * as only one ChannelState exists per set of stacked channels.
- */
- ChannelState *firstCSPtr;
- #ifdef oldcode
- /*
- * Has a channel exit handler been created yet?
- */
- int channelExitHandlerCreated;
- /*
- * Has the channel event source been created and registered with the
- * notifier?
- */
- int channelEventSourceCreated;
- #endif
- /*
- * Static variables to hold channels for stdin, stdout and stderr.
- */
- Tcl_Channel stdinChannel;
- int stdinInitialized;
- Tcl_Channel stdoutChannel;
- int stdoutInitialized;
- Tcl_Channel stderrChannel;
- int stderrInitialized;
- } ThreadSpecificData;
- static Tcl_ThreadDataKey dataKey;
- /*
- * Static functions in this file:
- */
- static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
- static void ChannelTimerProc _ANSI_ARGS_((
- ClientData clientData));
- static int CheckChannelErrors _ANSI_ARGS_((ChannelState *statePtr,
- int direction));
- static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
- ChannelBuffer *bufPtr, int newlineFlag));
- static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
- ChannelState *statePtr));
- static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
- Tcl_Channel chan));
- static void CleanupChannelHandlers _ANSI_ARGS_((
- Tcl_Interp *interp, Channel *chanPtr));
- static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int errorCode));
- static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
- Tcl_Encoding encoding));
- static int CopyAndTranslateBuffer _ANSI_ARGS_((
- ChannelState *statePtr, char *result,
- int space));
- static int CopyBuffer _ANSI_ARGS_((
- Channel *chanPtr, char *result, int space));
- static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
- static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
- int mask));
- static void CreateScriptRecord _ANSI_ARGS_((
- Tcl_Interp *interp, Channel *chanPtr,
- int mask, Tcl_Obj *scriptPtr));
- static void DeleteChannelTable _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp));
- static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int mask));
- static int DetachChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel chan));
- static void DiscardInputQueued _ANSI_ARGS_((ChannelState *statePtr,
- int discardSavedBuffers));
- static void DiscardOutputQueued _ANSI_ARGS_((
- ChannelState *chanPtr));
- static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
- int slen));
- static int DoWrite _ANSI_ARGS_((Channel *chanPtr, CONST char *src,
- int srcLen));
- static int DoReadChars _ANSI_ARGS_ ((Channel* chan,
- Tcl_Obj* objPtr, int toRead, int appendFlag));
- static int DoWriteChars _ANSI_ARGS_ ((Channel* chan,
- CONST char* src, int len));
- static int FilterInputBytes _ANSI_ARGS_((Channel *chanPtr,
- GetsState *statePtr));
- static int FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int calledFromAsyncFlush));
- static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
- static int GetInput _ANSI_ARGS_((Channel *chanPtr));
- static int HaveVersion _ANSI_ARGS_((Tcl_ChannelType *typePtr,
- Tcl_ChannelTypeVersion minimumVersion));
- static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
- char **dstEndPtr, GetsState *gsPtr));
- static int ReadBytes _ANSI_ARGS_((ChannelState *statePtr,
- Tcl_Obj *objPtr, int charsLeft,
- int *offsetPtr));
- static int ReadChars _ANSI_ARGS_((ChannelState *statePtr,
- Tcl_Obj *objPtr, int charsLeft,
- int *offsetPtr, int *factorPtr));
- static void RecycleBuffer _ANSI_ARGS_((ChannelState *statePtr,
- ChannelBuffer *bufPtr, int mustDiscard));
- static int StackSetBlockMode _ANSI_ARGS_((Channel *chanPtr,
- int mode));
- static int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
- Channel *chanPtr, int mode));
- static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
- static int TranslateInputEOL _ANSI_ARGS_((ChannelState *statePtr,
- char *dst, CONST char *src,
- int *dstLenPtr, int *srcLenPtr));
- static int TranslateOutputEOL _ANSI_ARGS_((ChannelState *statePtr,
- char *dst, CONST char *src,
- int *dstLenPtr, int *srcLenPtr));
- static void UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
- static int WriteBytes _ANSI_ARGS_((Channel *chanPtr,
- CONST char *src, int srcLen));
- static int WriteChars _ANSI_ARGS_((Channel *chanPtr,
- CONST char *src, int srcLen));
- /*
- *---------------------------------------------------------------------------
- *
- * TclInitIOSubsystem --
- *
- * Initialize all resources used by this subsystem on a per-process
- * basis.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Depends on the memory subsystems.
- *
- *---------------------------------------------------------------------------
- */
- void
- TclInitIOSubsystem()
- {
- /*
- * By fetching thread local storage we take care of
- * allocating it for each thread.
- */
- (void) TCL_TSD_INIT(&dataKey);
- }
- /*
- *-------------------------------------------------------------------------
- *
- * TclFinalizeIOSubsystem --
- *
- * Releases all resources used by this subsystem on a per-thread
- * basis. Closes all extant channels that have not already been
- * closed because they were not owned by any interp.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Depends on encoding and memory subsystems.
- *
- *-------------------------------------------------------------------------
- */
- /* ARGSUSED */
- void
- TclFinalizeIOSubsystem(void)
- {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr = NULL; /* Iterates over open channels. */
- ChannelState *statePtr; /* State of channel stack */
- int active = 1; /* Flag == 1 while there's still work to do */
- /*
- * Walk all channel state structures known to this thread and
- * close corresponding channels.
- */
- while (active) {
- /*
- * Iterate through the open channel list, and find the first
- * channel that isn't dead. We start from the head of the list
- * each time, because the close action on one channel can close
- * others.
- */
- active = 0;
- for (statePtr = tsdPtr->firstCSPtr;
- statePtr != NULL;
- statePtr = statePtr->nextCSPtr) {
- chanPtr = statePtr->topChanPtr;
- if (!(statePtr->flags & CHANNEL_DEAD)) {
- active = 1;
- break;
- }
- }
- /*
- * We've found a live channel. Close it.
- */
- if (active) {
- /*
- * Set the channel back into blocking mode to ensure that we
- * wait for all data to flush out.
- */
-
- (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
- "-blocking", "on");
-
- if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
- (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
- (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
- /*
- * Decrement the refcount which was earlier artificially
- * bumped up to keep the channel from being closed.
- */
-
- statePtr->refCount--;
- }
-
- if (statePtr->refCount <= 0) {
- /*
- * Close it only if the refcount indicates that the channel
- * is not referenced from any interpreter. If it is, that
- * interpreter will close the channel when it gets destroyed.
- */
-
- (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr);
- } else {
- /*
- * The refcount is greater than zero, so flush the channel.
- */
-
- Tcl_Flush((Tcl_Channel) chanPtr);
-
- /*
- * Call the device driver to actually close the underlying
- * device for this channel.
- */
-
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);
- } else {
- (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
- NULL, 0);
- }
-
- /*
- * Finally, we clean up the fields in the channel data
- * structure since all of them have been deleted already.
- * We mark the channel with CHANNEL_DEAD to prevent any
- * further IO operations
- * on it.
- */
-
- chanPtr->instanceData = NULL;
- statePtr->flags |= CHANNEL_DEAD;
- }
- }
- }
- TclpFinalizeSockets();
- TclpFinalizePipes();
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_SetStdChannel --
- *
- * This function is used to change the channels that are used
- * for stdin/stdout/stderr in new interpreters.
- *
- * Results:
- * None
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- void
- Tcl_SetStdChannel(channel, type)
- Tcl_Channel channel;
- int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
- {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- switch (type) {
- case TCL_STDIN:
- tsdPtr->stdinInitialized = 1;
- tsdPtr->stdinChannel = channel;
- break;
- case TCL_STDOUT:
- tsdPtr->stdoutInitialized = 1;
- tsdPtr->stdoutChannel = channel;
- break;
- case TCL_STDERR:
- tsdPtr->stderrInitialized = 1;
- tsdPtr->stderrChannel = channel;
- break;
- }
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetStdChannel --
- *
- * Returns the specified standard channel.
- *
- * Results:
- * Returns the specified standard channel, or NULL.
- *
- * Side effects:
- * May cause the creation of a standard channel and the underlying
- * file.
- *
- *----------------------------------------------------------------------
- */
- Tcl_Channel
- Tcl_GetStdChannel(type)
- int type; /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
- {
- Tcl_Channel channel = NULL;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- /*
- * If the channels were not created yet, create them now and
- * store them in the static variables.
- */
- switch (type) {
- case TCL_STDIN:
- if (!tsdPtr->stdinInitialized) {
- tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
- tsdPtr->stdinInitialized = 1;
- /*
- * Artificially bump the refcount to ensure that the channel
- * is only closed on exit.
- *
- * NOTE: Must only do this if stdinChannel is not NULL. It
- * can be NULL in situations where Tcl is unable to connect
- * to the standard input.
- */
- if (tsdPtr->stdinChannel != (Tcl_Channel) NULL) {
- (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
- tsdPtr->stdinChannel);
- }
- }
- channel = tsdPtr->stdinChannel;
- break;
- case TCL_STDOUT:
- if (!tsdPtr->stdoutInitialized) {
- tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
- tsdPtr->stdoutInitialized = 1;
- if (tsdPtr->stdoutChannel != (Tcl_Channel) NULL) {
- (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
- tsdPtr->stdoutChannel);
- }
- }
- channel = tsdPtr->stdoutChannel;
- break;
- case TCL_STDERR:
- if (!tsdPtr->stderrInitialized) {
- tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
- tsdPtr->stderrInitialized = 1;
- if (tsdPtr->stderrChannel != (Tcl_Channel) NULL) {
- (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
- tsdPtr->stderrChannel);
- }
- }
- channel = tsdPtr->stderrChannel;
- break;
- }
- return channel;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateCloseHandler
- *
- * Creates a close callback which will be called when the channel is
- * closed.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Causes the callback to be called in the future when the channel
- * will be closed.
- *
- *----------------------------------------------------------------------
- */
- void
- Tcl_CreateCloseHandler(chan, proc, clientData)
- Tcl_Channel chan; /* The channel for which to create the
- * close callback. */
- Tcl_CloseProc *proc; /* The callback routine to call when the
- * channel will be closed. */
- ClientData clientData; /* Arbitrary data to pass to the
- * close callback. */
- {
- ChannelState *statePtr;
- CloseCallback *cbPtr;
- statePtr = ((Channel *) chan)->state;
- cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
- cbPtr->proc = proc;
- cbPtr->clientData = clientData;
- cbPtr->nextPtr = statePtr->closeCbPtr;
- statePtr->closeCbPtr = cbPtr;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_DeleteCloseHandler --
- *
- * Removes a callback that would have been called on closing
- * the channel. If there is no matching callback then this
- * function has no effect.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The callback will not be called in the future when the channel
- * is eventually closed.
- *
- *----------------------------------------------------------------------
- */
- void
- Tcl_DeleteCloseHandler(chan, proc, clientData)
- Tcl_Channel chan; /* The channel for which to cancel the
- * close callback. */
- Tcl_CloseProc *proc; /* The procedure for the callback to
- * remove. */
- ClientData clientData; /* The callback data for the callback
- * to remove. */
- {
- ChannelState *statePtr;
- CloseCallback *cbPtr, *cbPrevPtr;
- statePtr = ((Channel *) chan)->state;
- for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
- cbPtr != (CloseCallback *) NULL;
- cbPtr = cbPtr->nextPtr) {
- if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
- if (cbPrevPtr == (CloseCallback *) NULL) {
- statePtr->closeCbPtr = cbPtr->nextPtr;
- }
- ckfree((char *) cbPtr);
- break;
- } else {
- cbPrevPtr = cbPtr;
- }
- }
- }
- /*
- *----------------------------------------------------------------------
- *
- * GetChannelTable --
- *
- * Gets and potentially initializes the channel table for an
- * interpreter. If it is initializing the table it also inserts
- * channels for stdin, stdout and stderr if the interpreter is
- * trusted.
- *
- * Results:
- * A pointer to the hash table created, for use by the caller.
- *
- * Side effects:
- * Initializes the channel table for an interpreter. May create
- * channels for stdin, stdout and stderr.
- *
- *----------------------------------------------------------------------
- */
- static Tcl_HashTable *
- GetChannelTable(interp)
- Tcl_Interp *interp;
- {
- Tcl_HashTable *hTblPtr; /* Hash table of channels. */
- Tcl_Channel stdinChan, stdoutChan, stderrChan;
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
- Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
- (void) Tcl_SetAssocData(interp, "tclIO",
- (Tcl_InterpDeleteProc *) DeleteChannelTable,
- (ClientData) hTblPtr);
- /*
- * If the interpreter is trusted (not "safe"), insert channels
- * for stdin, stdout and stderr (possibly creating them in the
- * process).
- */
- if (Tcl_IsSafe(interp) == 0) {
- stdinChan = Tcl_GetStdChannel(TCL_STDIN);
- if (stdinChan != NULL) {
- Tcl_RegisterChannel(interp, stdinChan);
- }
- stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
- if (stdoutChan != NULL) {
- Tcl_RegisterChannel(interp, stdoutChan);
- }
- stderrChan = Tcl_GetStdChannel(TCL_STDERR);
- if (stderrChan != NULL) {
- Tcl_RegisterChannel(interp, stderrChan);
- }
- }
- }
- return hTblPtr;
- }
- /*
- *----------------------------------------------------------------------
- *
- * DeleteChannelTable --
- *
- * Deletes the channel table for an interpreter, closing any open
- * channels whose refcount reaches zero. This procedure is invoked
- * when an interpreter is deleted, via the AssocData cleanup
- * mechanism.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Deletes the hash table of channels. May close channels. May flush
- * output on closed channels. Removes any channeEvent handlers that were
- * registered in this interpreter.
- *
- *----------------------------------------------------------------------
- */
- static void
- DeleteChannelTable(clientData, interp)
- ClientData clientData; /* The per-interpreter data structure. */
- Tcl_Interp *interp; /* The interpreter being deleted. */
- {
- Tcl_HashTable *hTblPtr; /* The hash table. */
- Tcl_HashSearch hSearch; /* Search variable. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- Channel *chanPtr; /* Channel being deleted. */
- ChannelState *statePtr; /* State of Channel being deleted. */
- EventScriptRecord *sPtr, *prevPtr, *nextPtr;
- /* Variables to loop over all channel events
- * registered, to delete the ones that refer
- * to the interpreter being deleted. */
- /*
- * Delete all the registered channels - this will close channels whose
- * refcount reaches zero.
- */
-
- hTblPtr = (Tcl_HashTable *) clientData;
- for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
- hPtr != (Tcl_HashEntry *) NULL;
- hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
- statePtr = chanPtr->state;
- /*
- * Remove any fileevents registered in this interpreter.
- */
-
- for (sPtr = statePtr->scriptRecordPtr,
- prevPtr = (EventScriptRecord *) NULL;
- sPtr != (EventScriptRecord *) NULL;
- sPtr = nextPtr) {
- nextPtr = sPtr->nextPtr;
- if (sPtr->interp == interp) {
- if (prevPtr == (EventScriptRecord *) NULL) {
- statePtr->scriptRecordPtr = nextPtr;
- } else {
- prevPtr->nextPtr = nextPtr;
- }
- Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- TclChannelEventScriptInvoker, (ClientData) sPtr);
- Tcl_DecrRefCount(sPtr->scriptPtr);
- ckfree((char *) sPtr);
- } else {
- prevPtr = sPtr;
- }
- }
- /*
- * Cannot call Tcl_UnregisterChannel because that procedure calls
- * Tcl_GetAssocData to get the channel table, which might already
- * be inaccessible from the interpreter structure. Instead, we
- * emulate the behavior of Tcl_UnregisterChannel directly here.
- */
- Tcl_DeleteHashEntry(hPtr);
- statePtr->refCount--;
- if (statePtr->refCount <= 0) {
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
- (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
- }
- }
- }
- Tcl_DeleteHashTable(hTblPtr);
- ckfree((char *) hTblPtr);
- }
- /*
- *----------------------------------------------------------------------
- *
- * CheckForStdChannelsBeingClosed --
- *
- * Perform special handling for standard channels being closed. When
- * given a standard channel, if the refcount is now 1, it means that
- * the last reference to the standard channel is being explicitly
- * closed. Now bump the refcount artificially down to 0, to ensure the
- * normal handling of channels being closed will occur. Also reset the
- * static pointer to the channel to NULL, to avoid dangling references.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Manipulates the refcount on standard channels. May smash the global
- * static pointer to a standard channel.
- *
- *----------------------------------------------------------------------
- */
- static void
- CheckForStdChannelsBeingClosed(chan)
- Tcl_Channel chan;
- {
- ChannelState *statePtr = ((Channel *) chan)->state;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
- if (statePtr->refCount < 2) {
- statePtr->refCount = 0;
- tsdPtr->stdinChannel = NULL;
- return;
- }
- } else if ((chan == tsdPtr->stdoutChannel)
- && (tsdPtr->stdoutInitialized)) {
- if (statePtr->refCount < 2) {
- statePtr->refCount = 0;
- tsdPtr->stdoutChannel = NULL;
- return;
- }
- } else if ((chan == tsdPtr->stderrChannel)
- && (tsdPtr->stderrInitialized)) {
- if (statePtr->refCount < 2) {
- statePtr->refCount = 0;
- tsdPtr->stderrChannel = NULL;
- return;
- }
- }
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_IsStandardChannel --
- *
- * Test if the given channel is a standard channel. No attempt
- * is made to check if the channel or the standard channels
- * are initialized or otherwise valid.
- *
- * Results:
- * Returns 1 if true, 0 if false.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_IsStandardChannel(chan)
- Tcl_Channel chan; /* Channel to check. */
- {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if ((chan == tsdPtr->stdinChannel)
- || (chan == tsdPtr->stdoutChannel)
- || (chan == tsdPtr->stderrChannel)) {
- return 1;
- } else {
- return 0;
- }
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_RegisterChannel --
- *
- * Adds an already-open channel to the channel table of an interpreter.
- * If the interpreter passed as argument is NULL, it only increments
- * the channel refCount.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May increment the reference count of a channel.
- *
- *----------------------------------------------------------------------
- */
- void
- Tcl_RegisterChannel(interp, chan)
- Tcl_Interp *interp; /* Interpreter in which to add the channel. */
- Tcl_Channel chan; /* The channel to add to this interpreter
- * channel table. */
- {
- Tcl_HashTable *hTblPtr; /* Hash table of channels. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- int new; /* Is the hash entry new or does it exist? */
- Channel *chanPtr; /* The actual channel. */
- ChannelState *statePtr; /* State of the actual channel. */
- /*
- * Always (un)register bottom-most channel in the stack. This makes
- * management of the channel list easier because no manipulation is
- * necessary during (un)stack operation.
- */
- chanPtr = ((Channel *) chan)->state->bottomChanPtr;
- statePtr = chanPtr->state;
- if (statePtr->channelName == (CONST char *) NULL) {
- panic("Tcl_RegisterChannel: channel without name");
- }
- if (interp != (Tcl_Interp *) NULL) {
- hTblPtr = GetChannelTable(interp);
- hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);
- if (new == 0) {
- if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
- return;
- }
- panic("Tcl_RegisterChannel: duplicate channel names");
- }
- Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
- }
- statePtr->refCount++;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_UnregisterChannel --
- *
- * Deletes the hash entry for a channel associated with an interpreter.
- * If the interpreter given as argument is NULL, it only decrements the
- * reference count. (This all happens in the Tcl_DetachChannel helper
- * function).
- *
- * Finally, if the reference count of the channel drops to zero,
- * it is deleted.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Calls Tcl_DetachChannel which deletes the hash entry for a channel
- * associated with an interpreter.
- *
- * May delete the channel, which can have a variety of consequences,
- * especially if we are forced to close the channel.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_UnregisterChannel(interp, chan)
- Tcl_Interp *interp; /* Interpreter in which channel is defined. */
- Tcl_Channel chan; /* Channel to delete. */
- {
- ChannelState *statePtr; /* State of the real channel. */
- statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
-
- if (statePtr->flags & CHANNEL_INCLOSE) {
- if (interp != (Tcl_Interp*) NULL) {
- Tcl_AppendResult(interp,
- "Illegal recursive call to close through close-handler of channel",
- (char *) NULL);
- }
- return TCL_ERROR;
- }
-
- if (DetachChannel(interp, chan) != TCL_OK) {
- return TCL_OK;
- }
-
- statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
- /*
- * Perform special handling for standard channels being closed. If the
- * refCount is now 1 it means that the last reference to the standard
- * channel is being explicitly closed, so bump the refCount down
- * artificially to 0. This will ensure that the channel is actually
- * closed, below. Also set the static pointer to NULL for the channel.
- */
- CheckForStdChannelsBeingClosed(chan);
- /*
- * If the refCount reached zero, close the actual channel.
- */
- if (statePtr->refCount <= 0) {
- /*
- * Ensure that if there is another buffer, it gets flushed
- * whether or not we are doing a background flush.
- */
- if ((statePtr->curOutPtr != NULL) &&
- (statePtr->curOutPtr->nextAdded >
- statePtr->curOutPtr->nextRemoved)) {
- statePtr->flags |= BUFFER_READY;
- }
- Tcl_Preserve((ClientData)statePtr);
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
- /* We don't want to re-enter Tcl_Close */
- if (!(statePtr->flags & CHANNEL_CLOSED)) {
- if (Tcl_Close(interp, chan) != TCL_OK) {
- statePtr->flags |= CHANNEL_CLOSED;
- Tcl_Release((ClientData)statePtr);
- return TCL_ERROR;
- }
- }
- }
- statePtr->flags |= CHANNEL_CLOSED;
- Tcl_Release((ClientData)statePtr);
- }
- return TCL_OK;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_DetachChannel --
- *
- * Deletes the hash entry for a channel associated with an interpreter.
- * If the interpreter given as argument is NULL, it only decrements the
- * reference count. Even if the ref count drops to zero, the
- * channel is NOT closed or cleaned up. This allows a channel to
- * be detached from an interpreter and left in the same state it
- * was in when it was originally returned by 'Tcl_OpenFileChannel',
- * for example.
- *
- * This function cannot be used on the standard channels, and
- * will return TCL_ERROR if that is attempted.
- *
- * This function should only be necessary for special purposes
- * in which you need to generate a pristine channel from one
- * that has already been used. All ordinary purposes will almost
- * always want to use Tcl_UnregisterChannel instead.
- *
- * Provided the channel is not attached to any other interpreter,
- * it can then be closed with Tcl_Close, rather than with
- * Tcl_UnregisterChannel.
- *
- * Results:
- * A standard Tcl result. If the channel is not currently registered
- * with the given interpreter, TCL_ERROR is returned, otherwise
- * TCL_OK. However no error messages are left in the interp's result.
- *
- * Side effects:
- * Deletes the hash entry for a channel associated with an
- * interpreter.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_DetachChannel(interp, chan)
- Tcl_Interp *interp; /* Interpreter in which channel is defined. */
- Tcl_Channel chan; /* Channel to delete. */
- {
- if (Tcl_IsStandardChannel(chan)) {
- return TCL_ERROR;
- }
-
- return DetachChannel(interp, chan);
- }
- /*
- *----------------------------------------------------------------------
- *
- * DetachChannel --
- *
- * Deletes the hash entry for a channel associated with an interpreter.
- * If the interpreter given as argument is NULL, it only decrements the
- * reference count. Even if the ref count drops to zero, the
- * channel is NOT closed or cleaned up. This allows a channel to
- * be detached from an interpreter and left in the same state it
- * was in when it was originally returned by 'Tcl_OpenFileChannel',
- * for example.
- *
- * Results:
- * A standard Tcl result. If the channel is not currently registered
- * with the given interpreter, TCL_ERROR is returned, otherwise
- * TCL_OK. However no error messages are left in the interp's result.
- *
- * Side effects:
- * Deletes the hash entry for a channel associated with an
- * interpreter.
- *
- *----------------------------------------------------------------------
- */
- static int
- DetachChannel(interp, chan)
- Tcl_Interp *interp; /* Interpreter in which channel is defined. */
- Tcl_Channel chan; /* Channel to delete. */
- {
- Tcl_HashTable *hTblPtr; /* Hash table of channels. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- Channel *chanPtr; /* The real IO channel. */
- ChannelState *statePtr; /* State of the real channel. */
- /*
- * Always (un)register bottom-most channel in the stack. This makes
- * management of the channel list easier because no manipulation is
- * necessary during (un)stack operation.
- */
- chanPtr = ((Channel *) chan)->state->bottomChanPtr;
- statePtr = chanPtr->state;
- if (interp != (Tcl_Interp *) NULL) {
- hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
- if (hTblPtr == (Tcl_HashTable *) NULL) {
- return TCL_ERROR;
- }
- hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- return TCL_ERROR;
- }
- if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
- return TCL_ERROR;
- }
- Tcl_DeleteHashEntry(hPtr);
- /*
- * Remove channel handlers that refer to this interpreter, so that they
- * will not be present if the actual close is delayed and more events
- * happen on the channel. This may occur if the channel is shared
- * between several interpreters, or if the channel has async
- * flushing active.
- */
-
- CleanupChannelHandlers(interp, chanPtr);
- }
- statePtr->refCount--;
-
- return TCL_OK;
- }
- /*
- *---------------------------------------------------------------------------
- *
- * Tcl_GetChannel --
- *
- * Finds an existing Tcl_Channel structure by name in a given
- * interpreter. This function is public because it is used by
- * channel-type-specific functions.
- *
- * Results:
- * A Tcl_Channel or NULL on failure. If failed, interp's result
- * object contains an error message. *modePtr is filled with the
- * modes in which the channel was opened.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
- Tcl_Channel
- Tcl_GetChannel(interp, chanName, modePtr)
- Tcl_Interp *interp; /* Interpreter in which to find or create
- * the channel. */
- CONST char *chanName; /* The name of the channel. */
- int *modePtr; /* Where to store the mode in which the
- * channel was opened? Will contain an ORed
- * combination of TCL_READABLE and
- * TCL_WRITABLE, if non-NULL. */
- {
- Channel *chanPtr; /* The actual channel. */
- Tcl_HashTable *hTblPtr; /* Hash table of channels. */
- Tcl_HashEntry *hPtr; /* Search variable. */
- CONST char *name; /* Translated name. */
- /*
- * Substitute "stdin", etc. Note that even though we immediately
- * find the channel using Tcl_GetStdChannel, we still need to look
- * it up in the specified interpreter to ensure that it is present
- * in the channel table. Otherwise, safe interpreters would always
- * have access to the standard channels.
- */
- name = chanName;
- if ((chanName[0] == 's') && (chanName[1] == 't')) {
- chanPtr = NULL;
- if (strcmp(chanName, "stdin") == 0) {
- chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDIN);
- } else if (strcmp(chanName, "stdout") == 0) {
- chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDOUT);
- } else if (strcmp(chanName, "stderr") == 0) {
- chanPtr = (Channel *) Tcl_GetStdChannel(TCL_STDERR);
- }
- if (chanPtr != NULL) {
- name = chanPtr->state->channelName;
- }
- }
- hTblPtr = GetChannelTable(interp);
- hPtr = Tcl_FindHashEntry(hTblPtr, name);
- if (hPtr == (Tcl_HashEntry *) NULL) {
- Tcl_AppendResult(interp, "can not find channel named "",
- chanName, """, (char *) NULL);
- return NULL;
- }
- /*
- * Always return bottom-most channel in the stack. This one lives
- * the longest - other channels may go away unnoticed.
- * The other APIs compensate where necessary to retrieve the
- * topmost channel again.
- */
- chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
- chanPtr = chanPtr->state->bottomChanPtr;
- if (modePtr != NULL) {
- *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
- }
-
- return (Tcl_Channel) chanPtr;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateChannel --
- *
- * Creates a new entry in the hash table for a Tcl_Channel
- * record.
- *
- * Results:
- * Returns the new Tcl_Channel.
- *
- * Side effects:
- * Creates a new Tcl_Channel instance and inserts it into the
- * hash table.
- *
- *----------------------------------------------------------------------
- */
- Tcl_Channel
- Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
- Tcl_ChannelType *typePtr; /* The channel type record. */
- CONST char *chanName; /* Name of channel to record. */
- ClientData instanceData; /* Instance specific data. */
- int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
- * if the channel is readable, writable. */
- {
- Channel *chanPtr; /* The channel structure newly created. */
- ChannelState *statePtr; /* The stack-level independent state info
- * for the channel. */
- CONST char *name;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- /*
- * With the change of the Tcl_ChannelType structure to use a version in
- * 8.3.2+, we have to make sure that our assumption that the structure
- * remains a binary compatible size is true.
- *
- * If this assertion fails on some system, then it can be removed
- * only if the user recompiles code with older channel drivers in
- * the new system as well.
- */
- assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
- /*
- * JH: We could subsequently memset these to 0 to avoid the
- * numerous assignments to 0/NULL below.
- */
- chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
- statePtr = (ChannelState *) ckalloc((unsigned) sizeof(ChannelState));
- chanPtr->state = statePtr;
- chanPtr->instanceData = instanceData;
- chanPtr->typePtr = typePtr;
- /*
- * Set all the bits that are part of the stack-independent state
- * information for the channel.
- */
- if (chanName != (char *) NULL) {
- char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
- statePtr->channelName = tmp;
- strcpy(tmp, chanName);
- } else {
- panic("Tcl_CreateChannel: NULL channel name");
- }
- statePtr->flags = mask;
- /*
- * Set the channel to system default encoding.
- */
- statePtr->encoding = NULL;
- name = Tcl_GetEncodingName(NULL);
- if (strcmp(name, "binary") != 0) {
- statePtr->encoding = Tcl_GetEncoding(NULL, name);
- }
- statePtr->inputEncodingState = NULL;
- statePtr->inputEncodingFlags = TCL_ENCODING_START;
- statePtr->outputEncodingState = NULL;
- statePtr->outputEncodingFlags = TCL_ENCODING_START;
- /*
- * Set the channel up initially in AUTO input translation mode to
- * accept "n", "r" and "rn". Output translation mode is set to
- * a platform specific default value. The eofChar is set to 0 for both
- * input and output, so that Tcl does not look for an in-file EOF
- * indicator (e.g. ^Z) and does not append an EOF indicator to files.
- */
- statePtr->inputTranslation = TCL_TRANSLATE_AUTO;
- statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
- statePtr->inEofChar = 0;
- statePtr->outEofChar = 0;
- statePtr->unreportedError = 0;
- statePtr->refCount = 0;
- statePtr->closeCbPtr = (CloseCallback *) NULL;
- statePtr->curOutPtr = (ChannelBuffer *) NULL;
- statePtr->outQueueHead = (ChannelBuffer *) NULL;
- statePtr->outQueueTail = (ChannelBuffer *) NULL;
- statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
- statePtr->inQueueHead = (ChannelBuffer *) NULL;
- statePtr->inQueueTail = (ChannelBuffer *) NULL;
- statePtr->chPtr = (ChannelHandler *) NULL;
- statePtr->interestMask = 0;
- statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
- statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
- statePtr->timer = NULL;
- statePtr->csPtr = NULL;
- statePtr->outputStage = NULL;
- if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
- statePtr->outputStage = (char *)
- ckalloc((unsigned) (statePtr->bufSize + 2));
- }
- /*
- * As we are creating the channel, it is obviously the top for now
- */
- statePtr->topChanPtr = chanPtr;
- statePtr->bottomChanPtr = chanPtr;
- chanPtr->downChanPtr = (Channel *) NULL;
- chanPtr->upChanPtr = (Channel *) NULL;
- chanPtr->inQueueHead = (ChannelBuffer*) NULL;
- chanPtr->inQueueTail = (ChannelBuffer*) NULL;
- /*
- * Link the channel into the list of all channels; create an on-exit
- * handler if there is not one already, to close off all the channels
- * in the list on exit.
- *
- * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
- *
- * TIP #218.
- * AK: Just initialize the field to NULL before invoking Tcl_SpliceChannel
- * We need Tcl_SpliceChannel, for the threadAction calls.
- * There is no real reason to duplicate all of this.
- * NOTE: All drivers using thread actions now have to perform their TSD
- * manipulation only in their thread action proc. Doing it when
- * creating their instance structures will collide with the thread
- * action activity and lead to damaged lists.
- */
- statePtr->nextCSPtr = (ChannelState *) NULL;
- Tcl_SpliceChannel ((Tcl_Channel) chanPtr);
- /*
- * Install this channel in the first empty standard channel slot, if
- * the channel was previously closed explicitly.
- */
- #if TCL_INHERIT_STD_CHANNELS
- if ((tsdPtr->stdinChannel == NULL) &&
- (tsdPtr->stdinInitialized == 1)) {
- Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
- Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
- } else if ((tsdPtr->stdoutChannel == NULL) &&
- (tsdPtr->stdoutInitialized == 1)) {
- Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
- Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
- } else if ((tsdPtr->stderrChannel == NULL) &&
- (tsdPtr->stderrInitialized == 1)) {
- Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
- Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
- }
- #endif
- return (Tcl_Channel) chanPtr;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_StackChannel --
- *
- * Replaces an entry in the hash table for a Tcl_Channel
- * record. The replacement is a new channel with same name,
- * it supercedes the replaced channel. Input and output of
- * the superceded channel is now going through the newly
- * created channel and allows the arbitrary filtering/manipulation
- * of the dataflow.
- *
- * Andreas Kupries <a.kupries@westend.com>, 12/13/1998
- * "Trf-Patch for filtering channels"
- *
- * Results:
- * Returns the new Tcl_Channel, which actually contains the
- * saved information about prevChan.
- *
- * Side effects:
- * A new channel structure is allocated and linked below
- * the existing channel. The channel operations and client
- * data of the existing channel are copied down to the newly
- * created channel, and the current channel has its operations
- * replaced by the new typePtr.
- *
- *----------------------------------------------------------------------
- */
- Tcl_Channel
- Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
- Tcl_Interp *interp; /* The interpreter we are working in */
- Tcl_ChannelType *typePtr; /* The channel type record for the new
- * channel. */
- ClientData instanceData; /* Instance specific data for the new
- * channel. */
- int mask; /* TCL_READABLE & TCL_WRITABLE to indicate
- * if the channel is readable, writable. */
- Tcl_Channel prevChan; /* The channel structure to replace */
- {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Channel *chanPtr, *prevChanPtr;
- ChannelState *statePtr;
- /*
- * Find the given channel in the list of all channels.
- * If we don't find it, then it was never registered correctly.
- *
- * This operation should occur at the top of a channel stack.
- */
- statePtr = (ChannelState *) tsdPtr->firstCSPtr;
- prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;
- while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
- statePtr = statePtr->nextCSPtr;
- }
- if (statePtr == NULL) {
- if (interp) {
- Tcl_AppendResult(interp, "couldn't find state for channel "",
- Tcl_GetChannelName(prevChan), """, (char *) NULL);
- }
- return (Tcl_Channel) NULL;
- }
- /*
- * Here we check if the given "mask" matches the "flags"
- * of the already existing channel.
- *
- * | - | R | W | RW |
- * --+---+---+---+----+ <=> 0 != (chan->mask & prevChan->mask)
- * - | | | | |
- * R | | + | | + | The superceding channel is allowed to
- * W | | | + | + | restrict the capabilities of the
- * RW| | + | + | + | superceded one !
- * --+---+---+---+----+
- */
- if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
- if (interp) {
- Tcl_AppendResult(interp,
- "reading and writing both disallowed for channel "",
- Tcl_GetChannelName(prevChan), """, (char *) NULL);
- }
- return (Tcl_Channel) NULL;
- }
- /*
- * Flush the buffers. This ensures that any data still in them
- * at this time is not handled by the new transformation. Restrict
- * this to writable channels. Take care to hide a possible bg-copy
- * in progress from Tcl_Flush and the CheckForChannelErrors inside.
- */
- if ((mask & TCL_WRITABLE) != 0) {
- CopyState *csPtr;
- csPtr = statePtr->csPtr;
- statePtr->csPtr = (CopyState*) NULL;
- if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
- statePtr->csPtr = csPtr;
- if (interp) {
- Tcl_AppendResult(interp, "could not flush channel "",
- Tcl_GetChannelName(prevChan), """, (char *) NULL);
- }
- return (Tcl_Channel) NULL;
- }
- statePtr->csPtr = csPtr;
- }
- /*
- * Discard any input in the buffers. They are not yet read by the
- * user of the channel, so they have to go through the new
- * transformation before reading. As the buffers contain the
- * untransformed form their contents are not only useless but actually
- * distorts our view of the system.
- *
- * To preserve the information without having to read them again and
- * to avoid problems with the location in the channel (seeking might
- * be impossible) we move the buffers from the common state structure
- * into the channel itself. We use the buffers in the channel below
- * the new transformation to hold the data. In the future this allows
- * us to write transformations which pre-read data and push the unused
- * part back when they are going away.
- */
- if (((mask & TCL_READABLE) != 0) &&
- (statePtr->inQueueHead != (ChannelBuffer*) NULL)) {
- /*
- * Remark: It is possible that the channel buffers contain data from
- * some earlier push-backs.
- */
- statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
- prevChanPtr->inQueueHead = statePtr->inQueueHead;
- if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) {
- prevChanPtr->inQueueTail = statePtr->inQueueTail;
- }
- statePtr->inQueueHead = (ChannelBuffer*) NULL;
- statePtr->inQueueTail = (ChannelBuffer*) NULL;
- }
- chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
- /*
- * Save some of the current state into the new structure,
- * reinitialize the parts which will stay with the transformation.
- *
- * Remarks:
- */
- chanPtr->state = statePtr;
- chanPtr->instanceData = instanceData;
- chanPtr->typePtr = typePtr;
- chanPtr->downChanPtr = prevChanPtr;
- chanPtr->upChanPtr = (Channel *) NULL;
- chanPtr->inQueueHead = (ChannelBuffer*) NULL;
- chanPtr->inQueueTail = (ChannelBuffer*) NULL;
- /*
- * Place new block at the head of a possibly existing list of previously
- * stacked channels.
- */
- prevChanPtr->upChanPtr = chanPtr;
- statePtr->topChanPtr = chanPtr;
- return (Tcl_Channel) chanPtr;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_UnstackChannel --
- *
- * Unstacks an entry in the hash table for a Tcl_Channel
- * record. This is the reverse to 'Tcl_StackChannel'.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * If TCL_ERROR is returned, the posix error code will be set
- * with Tcl_SetErrno.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_UnstackChannel (interp, chan)
- Tcl_Interp *interp; /* The interpreter we are working in */
- Tcl_Channel chan; /* The channel to unstack */
- {
- Channel *chanPtr = (Channel *) chan;
- ChannelState *statePtr = chanPtr->state;
- int result = 0;
- /*
- * This operation should occur at the top of a channel stack.
- */
- chanPtr = statePtr->topChanPtr;
- if (chanPtr->downChanPtr != (Channel *) NULL) {
- /*
- * Instead of manipulating the per-thread / per-interp list/hashtable
- * of registered channels we wind down the state of the transformation,
- * and then restore the state of underlying channel into the old
- * structure.
- */
- Channel *downChanPtr = chanPtr->downChanPtr;
- /*
- * Flush the buffers. This ensures that any data still in them
- * at this time _is_ handled by the transformation we are unstacking
- * right now. Restrict this to writable channels. Take care to hide
- * a possible bg-copy in progress from Tcl_Flush and the
- * CheckForChannelErrors inside.
- */
- if (statePtr->flags & TCL_WRITABLE) {
- CopyState* csPtr;
- csPtr = statePtr->csPtr;
- statePtr->csPtr = (CopyState*) NULL;
- if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
- statePtr->csPtr = csPtr;
- if (interp) {
- Tcl_AppendResult(interp, "could not flush channel "",
- Tcl_GetChannelName((Tcl_Channel) chanPtr), """,
- (char *) NULL);
- }
- return TCL_ERROR;
- }
- statePtr->csPtr = csPtr;
- }
- /*
- * Anything in the input queue and the push-back buffers of
- * the transformation going away is transformed data, but not
- * yet read. As unstacking means that the caller does not want
- * to see transformed data any more we have to discard these
- * bytes. To avoid writing an analogue to 'DiscardInputQueued'
- * we move the information in the push back buffers to the
- * input queue and then call 'DiscardInputQueued' on that.
- */
- if (((statePtr->flags & TCL_READABLE) != 0) &&
- ((statePtr->inQueueHead != (ChannelBuffer*) NULL) ||
- (chanPtr->inQueueHead != (ChannelBuffer*) NULL))) {
- if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) &&
- (chanPtr->inQueueHead != (ChannelBuffer*) NULL)) {
- statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
- statePtr->inQueueTail = chanPtr->inQueueTail;
- statePtr->inQueueHead = statePtr->inQueueTail;
- } else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
- statePtr->inQueueHead = chanPtr->inQueueHead;
- statePtr->inQueueTail = chanPtr->inQueueTail;
- }
- chanPtr->inQueueHead = (ChannelBuffer*) NULL;
- chanPtr->inQueueTail = (ChannelBuffer*) NULL;
- DiscardInputQueued (statePtr, 0);
- }
- statePtr->topChanPtr = downChanPtr;
- downChanPtr->upChanPtr = (Channel *) NULL;
- /*
- * Leave this link intact for closeproc
- * chanPtr->downChanPtr = (Channel *) NULL;
- */
- /*
- * Close and free the channel driver state.
- */
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
- interp);
- } else {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
- interp, 0);
- }
- chanPtr->typePtr = NULL;
- /*
- * AK: Tcl_NotifyChannel may hold a reference to this block of memory
- */
- Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
- UpdateInterest(downChanPtr);
- if (result != 0) {
- Tcl_SetErrno(result);
- return TCL_ERROR;
- }
- } else {
- /*
- * This channel does not cover another one.
- * Simply do a close, if necessary.
- */
- if (statePtr->refCount <= 0) {
- if (Tcl_Close(interp, chan) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- }
- return TCL_OK;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetStackedChannel --
- *
- * Determines whether the specified channel is stacked upon another.
- *
- * Results:
- * NULL if the channel is not stacked upon another one, or a reference
- * to the channel it is stacked upon. This reference can be used in
- * queries, but modification is not allowed.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- Tcl_Channel
- Tcl_GetStackedChannel(chan)
- Tcl_Channel chan;
- {
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- return (Tcl_Channel) chanPtr->downChanPtr;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetTopChannel --
- *
- * Returns the top channel of a channel stack.
- *
- * Results:
- * NULL if the channel is not stacked upon another one, or a reference
- * to the channel it is stacked upon. This reference can be used in
- * queries, but modification is not allowed.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- Tcl_Channel
- Tcl_GetTopChannel(chan)
- Tcl_Channel chan;
- {
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- return (Tcl_Channel) chanPtr->state->topChanPtr;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetChannelInstanceData --
- *
- * Returns the client data associated with a channel.
- *
- * Results:
- * The client data.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- ClientData
- Tcl_GetChannelInstanceData(chan)
- Tcl_Channel chan; /* Channel for which to return client data. */
- {
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- return chanPtr->instanceData;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetChannelThread --
- *
- * Given a channel structure, returns the thread managing it.
- * TIP #10
- *
- * Results:
- * Returns the id of the thread managing the channel.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- Tcl_ThreadId
- Tcl_GetChannelThread(chan)
- Tcl_Channel chan; /* The channel to return managing thread for. */
- {
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- return chanPtr->state->managingThread;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetChannelType --
- *
- * Given a channel structure, returns the channel type structure.
- *
- * Results:
- * Returns a pointer to the channel type structure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- Tcl_ChannelType *
- Tcl_GetChannelType(chan)
- Tcl_Channel chan; /* The channel to return type for. */
- {
- Channel *chanPtr = (Channel *) chan; /* The actual channel. */
- return chanPtr->typePtr;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetChannelMode --
- *
- * Computes a mask indicating whether the channel is open for
- * reading and writing.
- *
- * Results:
- * An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_GetChannelMode(chan)
- Tcl_Channel chan; /* The channel for which the mode is
- * being computed. */
- {
- ChannelState *statePtr = ((Channel *) chan)->state;
- /* State of actual channel. */
- return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetChannelName --
- *
- * Returns the string identifying the channel name.
- *
- * Results:
- * The string containing the channel name. This memory is
- * owned by the generic layer and should not be modified by
- * the caller.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- CONST char *
- Tcl_GetChannelName(chan)
- Tcl_Channel chan; /* The channel for which to return the name. */
- {
- ChannelState *statePtr; /* State of actual channel. */
- statePtr = ((Channel *) chan)->state;
- return statePtr->channelName;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_GetChannelHandle --
- *
- * Returns an OS handle associated with a channel.
- *
- * Results:
- * Returns TCL_OK and places the handle in handlePtr, or returns
- * TCL_ERROR on failure.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_GetChannelHandle(chan, direction, handlePtr)
- Tcl_Channel chan; /* The channel to get file from. */
- int direction; /* TCL_WRITABLE or TCL_READABLE. */
- ClientData *handlePtr; /* Where to store handle */
- {
- Channel *chanPtr; /* The actual channel. */
- ClientData handle;
- int result;
- chanPtr = ((Channel *) chan)->state->bottomChanPtr;
- result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
- direction, &handle);
- if (handlePtr) {
- *handlePtr = handle;
- }
- return result;
- }
- /*
- *---------------------------------------------------------------------------
- *
- * AllocChannelBuffer --
- *
- * A channel buffer has BUFFER_PADDING bytes extra at beginning to
- * hold any bytes of a native-encoding character that got split by
- * the end of the previous buffer and need to be moved to the
- * beginning of the next buffer to make a contiguous string so it
- * can be converted to UTF-8.
- *
- * A channel buffer has BUFFER_PADDING bytes extra at the end to
- * hold any bytes of a native-encoding character (generated from a
- * UTF-8 character) that overflow past the end of the buffer and
- * need to be moved to the next buffer.
- *
- * Results:
- * A newly allocated channel buffer.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
- static ChannelBuffer *
- AllocChannelBuffer(length)
- int length; /* Desired length of channel buffer. */
- {
- ChannelBuffer *bufPtr;
- int n;
- n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
- bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
- bufPtr->nextAdded = BUFFER_PADDING;
- bufPtr->nextRemoved = BUFFER_PADDING;
- bufPtr->bufLength = length + BUFFER_PADDING;
- bufPtr->nextPtr = (ChannelBuffer *) NULL;
- return bufPtr;
- }
- /*
- *----------------------------------------------------------------------
- *
- * RecycleBuffer --
- *
- * Helper function to recycle input and output buffers. Ensures
- * that two input buffers are saved (one in the input queue and
- * another in the saveInBufPtr field) and that curOutPtr is set
- * to a buffer. Only if these conditions are met is the buffer
- * freed to the OS.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May free a buffer to the OS.
- *
- *----------------------------------------------------------------------
- */
- static void
- RecycleBuffer(statePtr, bufPtr, mustDiscard)
- ChannelState *statePtr; /* ChannelState in which to recycle buffers. */
- ChannelBuffer *bufPtr; /* The buffer to recycle. */
- int mustDiscard; /* If nonzero, free the buffer to the
- * OS, always. */
- {
- /*
- * Do we have to free the buffer to the OS?
- */
- if (mustDiscard) {
- ckfree((char *) bufPtr);
- return;
- }
- /*
- * Only save buffers which are at least as big as the requested
- * buffersize for the channel. This is to honor dynamic changes
- * of the buffersize made by the user.
- */
- if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
- ckfree((char *) bufPtr);
- return;
- }
- /*
- * Only save buffers for the input queue if the channel is readable.
- */
-
- if (statePtr->flags & TCL_READABLE) {
- if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
- statePtr->inQueueHead = bufPtr;
- statePtr->inQueueTail = bufPtr;
- goto keepit;
- }
- if (statePtr->saveInBufPtr == (ChannelBuffer *) NULL) {
- statePtr->saveInBufPtr = bufPtr;
- goto keepit;
- }
- }
- /*
- * Only save buffers for the output queue if the channel is writable.
- */
- if (statePtr->flags & TCL_WRITABLE) {
- if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
- statePtr->curOutPtr = bufPtr;
- goto keepit;
- }
- }
- /*
- * If we reached this code we return the buffer to the OS.
- */
- ckfree((char *) bufPtr);
- return;
- keepit:
- bufPtr->nextRemoved = BUFFER_PADDING;
- bufPtr->nextAdded = BUFFER_PADDING;
- bufPtr->nextPtr = (ChannelBuffer *) NULL;
- }
- /*
- *----------------------------------------------------------------------
- *
- * DiscardOutputQueued --
- *
- * Discards all output queued in the output queue of a channel.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Recycles buffers.
- *
- *----------------------------------------------------------------------
- */
- static void
- DiscardOutputQueued(statePtr)
- ChannelState *statePtr; /* ChannelState for which to discard output. */
- {
- ChannelBuffer *bufPtr;
-
- while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
- bufPtr = statePtr->outQueueHead;
- statePtr->outQueueHead = bufPtr->nextPtr;
- RecycleBuffer(statePtr, bufPtr, 0);
- }
- statePtr->outQueueHead = (ChannelBuffer *) NULL;
- statePtr->outQueueTail = (ChannelBuffer *) NULL;
- }
- /*
- *----------------------------------------------------------------------
- *
- * CheckForDeadChannel --
- *
- * This function checks is a given channel is Dead.
- * (A channel that has been closed but not yet deallocated.)
- *
- * Results:
- * True (1) if channel is Dead, False (0) if channel is Ok
- *
- * Side effects:
- * None
- *
- *----------------------------------------------------------------------
- */
- static int
- CheckForDeadChannel(interp, statePtr)
- Tcl_Interp *interp; /* For error reporting (can be NULL) */
- ChannelState *statePtr; /* The channel state to check. */
- {
- if (statePtr->flags & CHANNEL_DEAD) {
- Tcl_SetErrno(EINVAL);
- if (interp) {
- Tcl_AppendResult(interp,
- "unable to access channel: invalid channel",
- (char *) NULL);
- }
- return 1;
- }
- return 0;
- }
- /*
- *----------------------------------------------------------------------
- *
- * FlushChannel --
- *
- * This function flushes as much of the queued output as is possible
- * now. If calledFromAsyncFlush is nonzero, it is being called in an
- * event handler to flush channel output asynchronously.
- *
- * Results:
- * 0 if successful, else the error code that was returned by the
- * channel type operation.
- *
- * Side effects:
- * May produce output on a channel. May block indefinitely if the
- * channel is synchronous. May schedule an async flush on the channel.
- * May recycle memory for buffers in the output queue.
- *
- *----------------------------------------------------------------------
- */
- static int
- FlushChannel(interp, chanPtr, calledFromAsyncFlush)
- Tcl_Interp *interp; /* For error reporting during close. */
- Channel *chanPtr; /* The channel to flush on. */
- int calledFromAsyncFlush; /* If nonzero then we are being
- * called from an asynchronous
- * flush callback. */
- {
- ChannelState *statePtr = chanPtr->state;
- /* State of the channel stack. */
- ChannelBuffer *bufPtr; /* Iterates over buffered output
- * queue. */
- int toWrite; /* Amount of output data in current
- * buffer available to be written. */
- int written; /* Amount of output data actually
- * written in current round. */
- int errorCode = 0; /* Stores POSIX error codes from
- * channel driver operations. */
- int wroteSome = 0; /* Set to one if any data was
- * written to the driver. */
- /*
- * Prevent writing on a dead channel -- a channel that has been closed
- * but not yet deallocated. This can occur if the exit handler for the
- * channel deallocation runs before all channels are deregistered in
- * all interpreters.
- */
-
- if (CheckForDeadChannel(interp, statePtr)) return -1;
-
- /*
- * Loop over the queued buffers and attempt to flush as
- * much as possible of the queued output to the channel.
- */
- while (1) {
- /*
- * If the queue is empty and there is a ready current buffer, OR if
- * the current buffer is full, then move the current buffer to the
- * queue.
- */
- if (((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (statePtr->curOutPtr->nextAdded == statePtr->curOutPtr->bufLength))
- || ((statePtr->flags & BUFFER_READY) &&
- (statePtr->outQueueHead == (ChannelBuffer *) NULL))) {
- statePtr->flags &= (~(BUFFER_READY));
- statePtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
- if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
- statePtr->outQueueHead = statePtr->curOutPtr;
- } else {
- statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
- }
- statePtr->outQueueTail = statePtr->curOutPtr;
- statePtr->curOutPtr = (ChannelBuffer *) NULL;
- }
- bufPtr = statePtr->outQueueHead;
- /*
- * If we are not being called from an async flush and an async
- * flush is active, we just return without producing any output.
- */
- if ((!calledFromAsyncFlush) &&
- (statePtr->flags & BG_FLUSH_SCHEDULED)) {
- return 0;
- }
- /*
- * If the output queue is still empty, break out of the while loop.
- */
- if (bufPtr == (ChannelBuffer *) NULL) {
- break; /* Out of the "while (1)". */
- }
- /*
- * Produce the output on the channel.
- */
- toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
- written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
- bufPtr->buf + bufPtr->nextRemoved, toWrite,
- &errorCode);
- /*
- * If the write failed completely attempt to start the asynchronous
- * flush mechanism and break out of this loop - do not attempt to
- * write any more output at this time.
- */
- if (written < 0) {
-
- /*
- * If the last attempt to write was interrupted, simply retry.
- */
-
- if (errorCode == EINTR) {
- errorCode = 0;
- continue;
- }
- /*
- * If the channel is non-blocking and we would have blocked,
- * start a background flushing handler and break out of the loop.
- */
- if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
- /*
- * This used to check for CHANNEL_NONBLOCKING, and panic
- * if the channel was blocking. However, it appears
- * that setting stdin to -blocking 0 has some effect on
- * the stdout when it's a tty channel (dup'ed underneath)
- */
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
- statePtr->flags |= BG_FLUSH_SCHEDULED;
- UpdateInterest(chanPtr);
- }
- errorCode = 0;
- break;
- }
- /*
- * Decide whether to report the error upwards or defer it.
- */
- if (calledFromAsyncFlush) {
- if (statePtr->unreportedError == 0) {
- statePtr->unreportedError = errorCode;
- }
- } else {
- Tcl_SetErrno(errorCode);
- if (interp != NULL) {
- /*
- * Casting away CONST here is safe because the
- * TCL_VOLATILE flag guarantees CONST treatment
- * of the Posix error string.
- */
- Tcl_SetResult(interp,
- (char *) Tcl_PosixError(interp), TCL_VOLATILE);
- }
- }
- /*
- * When we get an error we throw away all the output
- * currently queued.
- */
- DiscardOutputQueued(statePtr);
- continue;
- } else {
- wroteSome = 1;
- }
- bufPtr->nextRemoved += written;
- /*
- * If this buffer is now empty, recycle it.
- */
- if (bufPtr->nextRemoved == bufPtr->nextAdded) {
- statePtr->outQueueHead = bufPtr->nextPtr;
- if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
- statePtr->outQueueTail = (ChannelBuffer *) NULL;
- }
- RecycleBuffer(statePtr, bufPtr, 0);
- }
- } /* Closes "while (1)". */
- /*
- * If we wrote some data while flushing in the background, we are done.
- * We can't finish the background flush until we run out of data and
- * the channel becomes writable again. This ensures that all of the
- * pending data has been flushed at the system level.
- */
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
- if (wroteSome) {
- return errorCode;
- } else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
- statePtr->flags &= (~(BG_FLUSH_SCHEDULED));
- (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
- statePtr->interestMask);
- }
- }
- /*
- * If the channel is flagged as closed, delete it when the refCount
- * drops to zero, the output queue is empty and there is no output
- * in the current output buffer.
- */
- if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
- (statePtr->outQueueHead == (ChannelBuffer *) NULL) &&
- ((statePtr->curOutPtr == (ChannelBuffer *) NULL) ||
- (statePtr->curOutPtr->nextAdded ==
- statePtr->curOutPtr->nextRemoved))) {
- return CloseChannel(interp, chanPtr, errorCode);
- }
- return errorCode;
- }
- /*
- *----------------------------------------------------------------------
- *
- * CloseChannel --
- *
- * Utility procedure to close a channel and free associated resources.
- *
- * If the channel was stacked, then the it will copy the necessary
- * elements of the NEXT channel into the TOP channel, in essence
- * unstacking the channel. The NEXT channel will then be freed.
- *
- * If the channel was not stacked, then we will free all the bits
- * for the TOP channel, including the data structure itself.
- *
- * Results:
- * 1 if the channel was stacked, 0 otherwise.
- *
- * Side effects:
- * May close the actual channel; may free memory.
- * May change the value of errno.
- *
- *----------------------------------------------------------------------
- */
- static int
- CloseChannel(interp, chanPtr, errorCode)
- Tcl_Interp *interp; /* For error reporting. */
- Channel *chanPtr; /* The channel to close. */
- int errorCode; /* Status of operation so far. */
- {
- int result = 0; /* Of calling driver close
- * operation. */
- ChannelState *statePtr; /* state of the channel stack. */
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (chanPtr == NULL) {
- return result;
- }
- statePtr = chanPtr->state;
- /*
- * No more input can be consumed so discard any leftover input.
- */
- DiscardInputQueued(statePtr, 1);
- /*
- * Discard a leftover buffer in the current output buffer field.
- */
- if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
- ckfree((char *) statePtr->curOutPtr);
- statePtr->curOutPtr = (ChannelBuffer *) NULL;
- }
-
- /*
- * The caller guarantees that there are no more buffers
- * queued for output.
- */
- if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
- panic("TclFlush, closed channel: queued output left");
- }
- /*
- * If the EOF character is set in the channel, append that to the
- * output device.
- */
- if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
- int dummy;
- char c;
- c = (char) statePtr->outEofChar;
- (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
- }
- /*
- * Remove this channel from of the list of all channels.
- */
- Tcl_CutChannel((Tcl_Channel) chanPtr);
- /*
- * Close and free the channel driver state.
- */
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
- } else {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
- 0);
- }
- /*
- * Some resources can be cleared only if the bottom channel
- * in a stack is closed. All the other channels in the stack
- * are not allowed to remove.
- */
- if (chanPtr == statePtr->bottomChanPtr) {
- if (statePtr->channelName != (char *) NULL) {
- ckfree((char *) statePtr->channelName);
- statePtr->channelName = NULL;
- }
- Tcl_FreeEncoding(statePtr->encoding);
- if (statePtr->outputStage != NULL) {
- ckfree((char *) statePtr->outputStage);
- statePtr->outputStage = (char *) NULL;
- }
- }
- /*
- * If we are being called synchronously, report either
- * any latent error on the channel or the current error.
- */
- if (statePtr->unreportedError != 0) {
- errorCode = statePtr->unreportedError;
- }
- if (errorCode == 0) {
- errorCode = result;
- if (errorCode != 0) {
- Tcl_SetErrno(errorCode);
- }
- }
- /*
- * Cancel any outstanding timer.
- */
- Tcl_DeleteTimerHandler(statePtr->timer);
- /*
- * Mark the channel as deleted by clearing the type structure.
- */
- if (chanPtr->downChanPtr != (Channel *) NULL) {
- Channel *downChanPtr = chanPtr->downChanPtr;
- statePtr->nextCSPtr = tsdPtr->firstCSPtr;
- tsdPtr->firstCSPtr = statePtr;
- statePtr->topChanPtr = downChanPtr;
- downChanPtr->upChanPtr = (Channel *) NULL;
- chanPtr->typePtr = NULL;
- Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
- return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
- }
- /*
- * There is only the TOP Channel, so we free the remaining
- * pointers we have and then ourselves. Since this is the
- * last of the channels in the stack, make sure to free the
- * ChannelState structure associated with it. We use
- * Tcl_EventuallyFree to allow for any last
- */
- chanPtr->typePtr = NULL;
- Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);
- Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
- return errorCode;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_CutChannel --
- *
- * Removes a channel from the (thread-)global list of all channels
- * (in that thread). This is actually the statePtr for the stack
- * of channel.
- *
- * Results:
- * Nothing.
- *
- * Side effects:
- * Resets the field 'nextCSPtr' of the specified channel state to NULL.
- *
- * NOTE:
- * The channel to cut out of the list must not be referenced
- * in any interpreter. This is something this procedure cannot
- * check (despite the refcount) because the caller usually wants
- * fiddle with the channel (like transfering it to a different
- * thread) and thus keeps the refcount artifically high to prevent
- * its destruction.
- *
- *----------------------------------------------------------------------
- */
- void
- Tcl_CutChannel(chan)
- Tcl_Channel chan; /* The channel being removed. Must
- * not be referenced in any
- * interpreter. */
- {
- ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
- ChannelState *prevCSPtr; /* Preceding channel state in list of
- * all states - used to splice a
- * channel out of the list on close. */
- ChannelState *statePtr = ((Channel *) chan)->state;
- /* state of the channel stack. */
- Tcl_DriverThreadActionProc *threadActionProc;
- /*
- * Remove this channel from of the list of all channels
- * (in the current thread).
- */
- if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
- tsdPtr->firstCSPtr = statePtr->nextCSPtr;
- } else {
- for (prevCSPtr = tsdPtr->firstCSPtr;
- prevCSPtr && (prevCSPtr->nextCSPtr != statePtr);
- prevCSPtr = prevCSPtr->nextCSPtr) {
- /* Empty loop body. */
- }
- if (prevCSPtr == (ChannelState *) NULL) {
- panic("FlushChannel: damaged channel list");
- }
- prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
- }
- statePtr->nextCSPtr = (ChannelState *) NULL;
- /* TIP #218, Channel Thread Actions */
- threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
- if (threadActionProc != NULL) {
- (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
- TCL_CHANNEL_THREAD_REMOVE);
- }
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_SpliceChannel --
- *
- * Adds a channel to the (thread-)global list of all channels
- * (in that thread). Expects that the field 'nextChanPtr' in
- * the channel is set to NULL.
- *
- * Results:
- * Nothing.
- *
- * Side effects:
- * Nothing.
- *
- * NOTE:
- * The channel to splice into the list must not be referenced in any
- * interpreter. This is something this procedure cannot check
- * (despite the refcount) because the caller usually wants figgle
- * with the channel (like transfering it to a different thread)
- * and thus keeps the refcount artifically high to prevent its
- * destruction.
- *
- *----------------------------------------------------------------------
- */
- void
- Tcl_SpliceChannel(chan)
- Tcl_Channel chan; /* The channel being added. Must
- * not be referenced in any
- * interpreter. */
- {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- ChannelState *statePtr = ((Channel *) chan)->state;
- Tcl_DriverThreadActionProc *threadActionProc;
- if (statePtr->nextCSPtr != (ChannelState *) NULL) {
- panic("Tcl_SpliceChannel: trying to add channel used in different list");
- }
- statePtr->nextCSPtr = tsdPtr->firstCSPtr;
- tsdPtr->firstCSPtr = statePtr;
- /*
- * TIP #10. Mark the current thread as the new one managing this
- * channel. Note: 'Tcl_GetCurrentThread' returns sensible
- * values even for a non-threaded core.
- */
- statePtr->managingThread = Tcl_GetCurrentThread ();
- /* TIP #218, Channel Thread Actions */
- threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
- if (threadActionProc != NULL) {
- (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
- TCL_CHANNEL_THREAD_INSERT);
- }
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_Close --
- *
- * Closes a channel.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Closes the channel if this is the last reference.
- *
- * NOTE:
- * Tcl_Close removes the channel as far as the user is concerned.
- * However, it may continue to exist for a while longer if it has
- * a background flush scheduled. The device itself is eventually
- * closed and the channel record removed, in CloseChannel, above.
- *
- *----------------------------------------------------------------------
- */
- /* ARGSUSED */
- int
- Tcl_Close(interp, chan)
- Tcl_Interp *interp; /* Interpreter for errors. */
- Tcl_Channel chan; /* The channel being closed. Must
- * not be referenced in any
- * interpreter. */
- {
- CloseCallback *cbPtr; /* Iterate over close callbacks
- * for this channel. */
- Channel *chanPtr; /* The real IO channel. */
- ChannelState *statePtr; /* State of real IO channel. */
- int result; /* Of calling FlushChannel. */
- if (chan == (Tcl_Channel) NULL) {
- return TCL_OK;
- }
- /*
- * Perform special handling for standard channels being closed. If the
- * refCount is now 1 it means that the last reference to the standard
- * channel is being explicitly closed, so bump the refCount down
- * artificially to 0. This will ensure that the channel is actually
- * closed, below. Also set the static pointer to NULL for the channel.
- */
- CheckForStdChannelsBeingClosed(chan);
- /*
- * This operation should occur at the top of a channel stack.
- */
- chanPtr = (Channel *) chan;
- statePtr = chanPtr->state;
- chanPtr = statePtr->topChanPtr;
- if (statePtr->refCount > 0) {
- panic("called Tcl_Close on channel with refCount > 0");
- }
-
- if (statePtr->flags & CHANNEL_INCLOSE) {
- if (interp) {
- Tcl_AppendResult(interp,
- "Illegal recursive call to close through close-handler of channel",
- (char *) NULL);
- }
- return TCL_ERROR;
- }
- statePtr->flags |= CHANNEL_INCLOSE;
- /*
- * When the channel has an escape sequence driven encoding such as
- * iso2022, the terminated escape sequence must write to the buffer.
- */
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
- && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
- statePtr->outputEncodingFlags |= TCL_ENCODING_END;
- WriteChars(chanPtr, "", 0);
- }
- Tcl_ClearChannelHandlers(chan);
- /*
- * Invoke the registered close callbacks and delete their records.
- */
- while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
- cbPtr = statePtr->closeCbPtr;
- statePtr->closeCbPtr = cbPtr->nextPtr;
- (cbPtr->proc) (cbPtr->clientData);
- ckfree((char *) cbPtr);
- }
- statePtr->flags &= ~CHANNEL_INCLOSE;
- /*
- * Ensure that the last output buffer will be flushed.
- */
-
- if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
- statePtr->flags |= BUFFER_READY;
- }
- /*
- * If this channel supports it, close the read side, since we don't need it
- * anymore and this will help avoid deadlocks on some channel types.
- */
- if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
- result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
- TCL_CLOSE_READ);
- } else {
- result = 0;
- }
- /*
- * The call to FlushChannel will flush any queued output and invoke
- * the close function of the channel driver, or it will set up the
- * channel to be flushed and closed asynchronously.
- */
- statePtr->flags |= CHANNEL_CLOSED;
- if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
- return TCL_ERROR;
- }
- return TCL_OK;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_ClearChannelHandlers --
- *
- * Removes all channel handlers and event scripts from the channel,
- * cancels all background copies involving the channel and any interest
- * in events.
- *
- * Results:
- * None.
- *
- * Side effects:
- * See above. Deallocates memory.
- *
- *----------------------------------------------------------------------
- */
- void
- Tcl_ClearChannelHandlers (channel)
- Tcl_Channel channel;
- {
- ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */
- EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
- Channel *chanPtr; /* The real IO channel. */
- ChannelState *statePtr; /* State of real IO channel. */
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- NextChannelHandler *nhPtr;
- /*
- * This operation should occur at the top of a channel stack.
- */
- chanPtr = (Channel *) channel;
- statePtr = chanPtr->state;
- chanPtr = statePtr->topChanPtr;
- /*
- * Cancel any outstanding timer.
- */
- Tcl_DeleteTimerHandler(statePtr->timer);
- /*
- * Remove any references to channel handlers for this channel that
- * may be about to be invoked.
- */
- for (nhPtr = tsdPtr->nestedHandlerPtr;
- nhPtr != (NextChannelHandler *) NULL;
- nhPtr = nhPtr->nestedHandlerPtr) {
- if (nhPtr->nextHandlerPtr &&
- (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
- nhPtr->nextHandlerPtr = NULL;
- }
- }
- /*
- * Remove all the channel handler records attached to the channel
- * itself.
- */
- for (chPtr = statePtr->chPtr;
- chPtr != (ChannelHandler *) NULL;
- chPtr = chNext) {
- chNext = chPtr->nextPtr;
- ckfree((char *) chPtr);
- }
- statePtr->chPtr = (ChannelHandler *) NULL;
- /*
- * Cancel any pending copy operation.
- */
- StopCopy(statePtr->csPtr);
- /*
- * Must set the interest mask now to 0, otherwise infinite loops
- * will occur if Tcl_DoOneEvent is called before the channel is
- * finally deleted in FlushChannel. This can happen if the channel
- * has a background flush active.
- */
- statePtr->interestMask = 0;
- /*
- * Remove any EventScript records for this channel.
- */
- for (ePtr = statePtr->scriptRecordPtr;
- ePtr != (EventScriptRecord *) NULL;
- ePtr = eNextPtr) {
- eNextPtr = ePtr->nextPtr;
- Tcl_DecrRefCount(ePtr->scriptPtr);
- ckfree((char *) ePtr);
- }
- statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_Write --
- *
- * Puts a sequence of bytes into an output buffer, may queue the
- * buffer for output if it gets full, and also remembers whether the
- * current buffer is ready e.g. if it contains a newline and we are in
- * line buffering mode. Compensates stacking, i.e. will redirect the
- * data from the specified channel to the topmost channel in a stack.
- *
- * No encoding conversions are applied to the bytes being read.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_Write(chan, src, srcLen)
- Tcl_Channel chan; /* The channel to buffer output for. */
- CONST char *src; /* Data to queue in output buffer. */
- int srcLen; /* Length of data in bytes, or < 0 for
- * strlen(). */
- {
- /*
- * Always use the topmost channel of the stack
- */
- Channel *chanPtr;
- ChannelState *statePtr; /* state info for channel */
- statePtr = ((Channel *) chan)->state;
- chanPtr = statePtr->topChanPtr;
- if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
- return -1;
- }
- if (srcLen < 0) {
- srcLen = strlen(src);
- }
- return DoWrite(chanPtr, src, srcLen);
- }
- /*
- *----------------------------------------------------------------------
- *
- * Tcl_WriteRaw --
- *
- * Puts a sequence of bytes into an output buffer, may queue the
- * buffer for output if it gets full, and also remembers whether the
- * current buffer is ready e.g. if it contains a newline and we are in
- * line buffering mode. Writes directly to the driver of the channel,
- * does not compensate for stacking.
- *
- * No encoding conversions are applied to the bytes being read.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_WriteRaw(chan, src, srcLen)
- Tcl_Channel chan; /* The channel to buffer output for. */
- CONST char *src; /* Data to queue in output buffer. */
- int srcLen; /* Length of data in bytes, or < 0 for
- * strlen(). */
- {
- Channel *chanPtr = ((Channel *) chan);
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- int errorCode, written;
- if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
- return -1;
- }
- if (srcLen < 0) {
- srcLen = strlen(src);
- }
- /*
- * Go immediately to the driver, do all the error handling by ourselves.
- * The code was stolen from 'FlushChannel'.
- */
- written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
- src, srcLen, &errorCode);
- if (written < 0) {
- Tcl_SetErrno(errorCode);
- }
- return written;
- }
- /*
- *---------------------------------------------------------------------------
- *
- * Tcl_WriteChars --
- *
- * Takes a sequence of UTF-8 characters and converts them for output
- * using the channel's current encoding, may queue the buffer for
- * output if it gets full, and also remembers whether the current
- * buffer is ready e.g. if it contains a newline and we are in
- * line buffering mode. Compensates stacking, i.e. will redirect the
- * data from the specified channel to the topmost channel in a stack.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_WriteChars(chan, src, len)
- Tcl_Channel chan; /* The channel to buffer output for. */
- CONST char *src; /* UTF-8 characters to queue in output buffer. */
- int len; /* Length of string in bytes, or < 0 for
- * strlen(). */
- {
- ChannelState *statePtr; /* state info for channel */
- statePtr = ((Channel *) chan)->state;
- if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
- return -1;
- }
- return DoWriteChars ((Channel*) chan, src, len);
- }
- /*
- *---------------------------------------------------------------------------
- *
- * DoWriteChars --
- *
- * Takes a sequence of UTF-8 characters and converts them for output
- * using the channel's current encoding, may queue the buffer for
- * output if it gets full, and also remembers whether the current
- * buffer is ready e.g. if it contains a newline and we are in
- * line buffering mode. Compensates stacking, i.e. will redirect the
- * data from the specified channel to the topmost channel in a stack.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
- static int
- DoWriteChars(chanPtr, src, len)
- Channel* chanPtr; /* The channel to buffer output for. */
- CONST char *src; /* UTF-8 characters to queue in output buffer. */
- int len; /* Length of string in bytes, or < 0 for
- * strlen(). */
- {
- /*
- * Always use the topmost channel of the stack
- */
- ChannelState *statePtr; /* state info for channel */
- statePtr = chanPtr->state;
- chanPtr = statePtr->topChanPtr;
- if (len < 0) {
- len = strlen(src);
- }
- if (statePtr->encoding == NULL) {
- /*
- * Inefficient way to convert UTF-8 to byte-array, but the
- * code parallels the way it is done for objects.
- */
- Tcl_Obj *objPtr;
- int result;
- objPtr = Tcl_NewStringObj(src, len);
- src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
- result = WriteBytes(chanPtr, src, len);
- Tcl_DecrRefCount(objPtr);
- return result;
- }
- return WriteChars(chanPtr, src, len);
- }
- /*
- *---------------------------------------------------------------------------
- *
- * Tcl_WriteObj --
- *
- * Takes the Tcl object and queues its contents for output. If the
- * encoding of the channel is NULL, takes the byte-array representation
- * of the object and queues those bytes for output. Otherwise, takes
- * the characters in the UTF-8 (string) representation of the object
- * and converts them for output using the channel's current encoding.
- * May flush internal buffers to output if one becomes full or is ready
- * for some other reason, e.g. if it contains a newline and the channel
- * is in line buffering mode.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno() will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
- int
- Tcl_WriteObj(chan, objPtr)
- Tcl_Channel chan; /* The channel to buffer output for. */
- Tcl_Obj *objPtr; /* The object to write. */
- {
- /*
- * Always use the topmost channel of the stack
- */
- Channel *chanPtr;
- ChannelState *statePtr; /* state info for channel */
- char *src;
- int srcLen;
- statePtr = ((Channel *) chan)->state;
- chanPtr = statePtr->topChanPtr;
- if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
- return -1;
- }
- if (statePtr->encoding == NULL) {
- src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
- return WriteBytes(chanPtr, src, srcLen);
- } else {
- src = Tcl_GetStringFromObj(objPtr, &srcLen);
- return WriteChars(chanPtr, src, srcLen);
- }
- }
- /*
- *----------------------------------------------------------------------
- *
- * WriteBytes --
- *
- * Write a sequence of bytes into an output buffer, may queue the
- * buffer for output if it gets full, and also remembers whether the
- * current buffer is ready e.g. if it contains a newline and we are in
- * line buffering mode.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
- static int
- WriteBytes(chanPtr, src, srcLen)
- Channel *chanPtr; /* The channel to buffer output for. */
- CONST char *src; /* Bytes to write. */
- int srcLen; /* Number of bytes to write. */
- {
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- ChannelBuffer *bufPtr;
- char *dst;
- int dstMax, sawLF, savedLF, total, dstLen, toWrite;
-
- total = 0;
- sawLF = 0;
- savedLF = 0;
- /*
- * Loop over all bytes in src, storing them in output buffer with
- * proper EOL translation.
- */
- while (srcLen + savedLF > 0) {
- bufPtr = statePtr->curOutPtr;
- if (bufPtr == NULL) {
- bufPtr = AllocChannelBuffer(statePtr->bufSize);
- statePtr->curOutPtr = bufPtr;
- }
- dst = bufPtr->buf + bufPtr->nextAdded;
- dstMax = bufPtr->bufLength - bufPtr->nextAdded;
- dstLen = dstMax;
- toWrite = dstLen;
- if (toWrite > srcLen) {
- toWrite = srcLen;
- }
- if (savedLF) {
- /*
- * A 'n' was left over from last call to TranslateOutputEOL()
- * and we need to store it in this buffer. If the channel is
- * line-based, we will need to flush it.
- */
- *dst++ = 'n';
- dstLen--;
- sawLF++;
- }
- sawLF += TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite);
- dstLen += savedLF;
- savedLF = 0;
- if (dstLen > dstMax) {
- savedLF = 1;
- dstLen = dstMax;
- }
- bufPtr->nextAdded += dstLen;
- if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
- return -1;
- }
- total += dstLen;
- src += toWrite;
- srcLen -= toWrite;
- sawLF = 0;
- }
- return total;
- }
- /*
- *----------------------------------------------------------------------
- *
- * WriteChars --
- *
- * Convert UTF-8 bytes to the channel's external encoding and
- * write the produced bytes into an output buffer, may queue the
- * buffer for output if it gets full, and also remembers whether the
- * current buffer is ready e.g. if it contains a newline and we are in
- * line buffering mode.
- *
- * Results:
- * The number of bytes written or -1 in case of error. If -1,
- * Tcl_GetErrno will return the error code.
- *
- * Side effects:
- * May buffer up output and may cause output to be produced on the
- * channel.
- *
- *----------------------------------------------------------------------
- */
- static int
- WriteChars(chanPtr, src, srcLen)
- Channel *chanPtr; /* The channel to buffer output for. */
- CONST char *src; /* UTF-8 string to write. */
- int srcLen; /* Length of UTF-8 string in bytes. */
- {
- ChannelState *statePtr = chanPtr->state; /* state info for channel */
- ChannelBuffer *bufPtr;
- char *dst, *stage;
- int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote;
- int stageLen, toWrite, stageRead, endEncoding, result;
- int consumedSomething;
- Tcl_Encoding encoding;
- char safe[BUFFER_PADDING];
-
- total = 0;
- sawLF = 0;
- savedLF = 0;
- saved = 0;
- encoding = statePtr->encoding;
- /*
- * Write the terminated escape sequence even if srcLen is 0.
- */