diff options
Diffstat (limited to 'generic/tclIO.c')
| -rw-r--r-- | generic/tclIO.c | 222 |
1 files changed, 179 insertions, 43 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index 7bd0938..8ef6e12 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * 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.32 2001/07/18 17:13:25 andreas_kupries Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.33 2001/07/31 19:12:06 vincentdarley Exp $ */ #include "tclInt.h" @@ -104,6 +104,8 @@ 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_(( @@ -687,6 +689,38 @@ CheckForStdChannelsBeingClosed(chan) /* *---------------------------------------------------------------------- * + * 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. @@ -747,13 +781,21 @@ Tcl_RegisterChannel(interp, chan) * * 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. + * 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: - * Deletes the hash entry for a channel associated with an interpreter. + * 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. * *---------------------------------------------------------------------- */ @@ -763,46 +805,14 @@ Tcl_UnregisterChannel(interp, chan) Tcl_Interp *interp; /* Interpreter in which channel is defined. */ Tcl_Channel chan; /* Channel to delete. */ { - Tcl_HashTable *hTblPtr; /* Hash table of channels. */ - Tcl_HashEntry *hPtr; /* Search variable. */ - Channel *chanPtr; /* The real IO channel. */ 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_OK; - } - hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName); - if (hPtr == (Tcl_HashEntry *) NULL) { - return TCL_OK; - } - if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) { - return TCL_OK; - } - Tcl_DeleteHashEntry(hPtr); - - /* - * Remove channel handlers that refer to this interpreter, so that they - * will not be present if the actual close is delayed and more events - * happen on the channel. This may occur if the channel is shared - * between several interpreters, or if the channel has async - * flushing active. - */ - - CleanupChannelHandlers(interp, chanPtr); + if (DetachChannel(interp, chan) != TCL_OK) { + return TCL_OK; } - - statePtr->refCount--; + 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 @@ -829,17 +839,143 @@ Tcl_UnregisterChannel(interp, chan) statePtr->curOutPtr->nextRemoved)) { statePtr->flags |= BUFFER_READY; } - statePtr->flags |= CHANNEL_CLOSED; + Tcl_Preserve((ClientData)statePtr); if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { - if (Tcl_Close(interp, chan) != TCL_OK) { - return TCL_ERROR; - } + /* 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. + * + * 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. + * + *---------------------------------------------------------------------- + */ + +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 -- |