diff options
Diffstat (limited to 'generic/tclIO.c')
-rw-r--r-- | generic/tclIO.c | 447 |
1 files changed, 365 insertions, 82 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index f3f91c0..0fe8f05 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.20 2000/04/05 19:00:41 kupries Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.21 2000/05/02 22:02:34 kupries Exp $ */ #include "tclInt.h" @@ -1155,6 +1155,134 @@ Tcl_UnregisterChannel(interp, chan) } /* + *---------------------------------------------------------------------- + * + * Tcl_IsChannelRegistered -- + * + * Checks whether the channel is associated with the interp. + * + * Results: + * 0 if the channel is not registered in the interpreter, 1 else. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_IsChannelRegistered (interp, chan) + Tcl_Interp* interp; /* The interp to query of the channel */ + Tcl_Channel chan; /* The channel to check */ +{ + Tcl_HashTable *hTblPtr; /* Hash table of channels. */ + Tcl_HashEntry *hPtr; /* Search variable. */ + Channel *chanPtr; /* The real IO channel. */ + + chanPtr = (Channel *) chan; + hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); + + if (hTblPtr == (Tcl_HashTable *) NULL) { + return 0; + } + + hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName); + + if (hPtr == (Tcl_HashEntry *) NULL) { + return 0; + } + if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) { + return 0; + } + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_IsChannelShared -- + * + * Checks whether the channel is shared by multiple interpreters. + * + * Results: + * A boolean value (0 = Not shared, 1 = Shared). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_IsChannelShared (chan) + Tcl_Channel chan; /* The channel to query */ +{ + Channel *chanPtr; /* The real IO channel. */ + + chanPtr = (Channel *) chan; + + return (chanPtr->refCount > 1) ? 1 : 0; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_IsChannelExisting -- + * + * Checks whether a channel of the given name exists in the + * (thread)-global list of all channels. + * + * Results: + * A boolean value (0 = Does not exist, 1 = Does exist). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_IsChannelExisting (chanName) + CONST char* chanName; /* The name of the channel to look for. */ +{ + Channel *chanPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + char *name; + int cLen, nLen, match; + + cLen = strlen (chanName); + + for (chanPtr = tsdPtr->firstChanPtr; + chanPtr != NULL; + chanPtr = chanPtr->nextChanPtr) { + if (chanPtr == (Channel *) tsdPtr->stdinChannel) { + name = "stdin"; + } else if (chanPtr == (Channel *) tsdPtr->stdoutChannel) { + name = "stdout"; + } else if (chanPtr == (Channel *) tsdPtr->stderrChannel) { + name = "stderr"; + } else { + name = chanPtr->channelName; + } + + nLen = strlen (name); + + if (nLen != cLen) { + continue; + } + + match = memcmp(name, chanName, (unsigned) cLen); + + if (match == 0) { + return 1; + } + } + + return 0; +} + +/* *--------------------------------------------------------------------------- * * Tcl_GetChannel -- @@ -1313,7 +1441,8 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask) chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; chanPtr->timer = NULL; chanPtr->csPtr = NULL; - chanPtr->supercedes = (Channel*) NULL; + chanPtr->supercedes = (Channel*) NULL; + chanPtr->nextChanPtr = (Channel*) NULL; chanPtr->outputStage = NULL; if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { @@ -1327,8 +1456,7 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask) * in the list on exit. */ - chanPtr->nextChanPtr = tsdPtr->firstChanPtr; - tsdPtr->firstChanPtr = chanPtr; + Tcl_SpliceChannel ((Tcl_Channel) chanPtr); /* * Install this channel in the first empty standard channel slot, if @@ -1653,7 +1781,6 @@ Tcl_UnstackChannel (interp, chan) Tcl_Interp* interp; /* The interpreter we are working in */ Tcl_Channel chan; /* The channel to unstack */ { - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Channel* chanPtr = (Channel*) chan; if (chanPtr->supercedes != (Channel*) NULL) { @@ -1778,10 +1905,8 @@ Tcl_UnstackChannel (interp, chan) * We know that its refCount dropped to 0. */ - chanDownPtr->nextChanPtr = tsdPtr->firstChanPtr; - tsdPtr->firstChanPtr = chanDownPtr; - - Tcl_Close (interp, (Tcl_Channel)chanDownPtr); + Tcl_SpliceChannel ((Tcl_Channel) chanDownPtr); + Tcl_Close (interp, (Tcl_Channel) chanDownPtr); /* * Now it is possible to wind down the transformation (in 'top'), @@ -2436,10 +2561,6 @@ CloseChannel(interp, chanPtr, errorCode) { int result = 0; /* Of calling driver close * operation. */ - Channel *prevChanPtr; /* Preceding channel in list of - * all channels - used to splice a - * channel out of the list on close. */ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (chanPtr == NULL) { return result; @@ -2491,25 +2612,8 @@ CloseChannel(interp, chanPtr, errorCode) */ chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE)); - - /* - * Splice this channel out of the list of all channels. - */ - if (chanPtr == tsdPtr->firstChanPtr) { - tsdPtr->firstChanPtr = chanPtr->nextChanPtr; - } else { - for (prevChanPtr = tsdPtr->firstChanPtr; - (prevChanPtr != (Channel *) NULL) && - (prevChanPtr->nextChanPtr != chanPtr); - prevChanPtr = prevChanPtr->nextChanPtr) { - /* Empty loop body. */ - } - if (prevChanPtr == (Channel *) NULL) { - panic("FlushChannel: damaged channel list"); - } - prevChanPtr->nextChanPtr = chanPtr->nextChanPtr; - } + Tcl_CutChannel ((Tcl_Channel) chanPtr); /* * Close and free the channel driver state. @@ -2575,8 +2679,7 @@ CloseChannel(interp, chanPtr, errorCode) * the list of open channels, then do a regular close. */ - chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr; - tsdPtr->firstChanPtr = chanPtr->supercedes; + Tcl_SpliceChannel ((Tcl_Channel) chanPtr->supercedes); chanPtr->supercedes->refCount --; /* is deregistered */ Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes); } @@ -2601,6 +2704,109 @@ CloseChannel(interp, chanPtr, errorCode) /* *---------------------------------------------------------------------- * + * Tcl_CutChannel -- + * + * Removes a channel from the (thread-)global list of all channels + * (in that thread). + * + * Results: + * Nothing. + * + * Side effects: + * Resets the field 'nextChanPtr' of the specified channel to NULL. + * + * NOTE: + * The channel to splice 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 + * figgle 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); + Channel* chanPtr = (Channel *) chan; + Channel* prevChanPtr; /* Preceding channel in list of + * all channels - used to splice a + * channel out of the list on close. */ + + /* + * Splice this channel out of the list of all channels (in the current + * thread). + */ + + if (chanPtr == tsdPtr->firstChanPtr) { + tsdPtr->firstChanPtr = chanPtr->nextChanPtr; + } else { + for (prevChanPtr = tsdPtr->firstChanPtr; + (prevChanPtr != (Channel *) NULL) && + (prevChanPtr->nextChanPtr != chanPtr); + prevChanPtr = prevChanPtr->nextChanPtr) { + /* Empty loop body. */ + } + if (prevChanPtr == (Channel *) NULL) { + panic("FlushChannel: damaged channel list"); + } + prevChanPtr->nextChanPtr = chanPtr->nextChanPtr; + } + + chanPtr->nextChanPtr = (Channel *) NULL; +} + +/* + *---------------------------------------------------------------------- + * + * 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 add to 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); + Channel* chanPtr = (Channel *) chan; + + if (chanPtr->nextChanPtr != (Channel *) NULL) { + panic("Tcl_SpliceChannel: trying to add channel used in different list"); + } + + chanPtr->nextChanPtr = tsdPtr->firstChanPtr; + tsdPtr->firstChanPtr = chanPtr; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_Close -- * * Closes a channel. @@ -2628,14 +2834,10 @@ Tcl_Close(interp, chan) * not be referenced in any * interpreter. */ { - ChannelHandler *chPtr, *chNext; /* Iterate over channel handlers. */ CloseCallback *cbPtr; /* Iterate over close callbacks * for this channel. */ - EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */ Channel *chanPtr; /* The real IO channel. */ int result; /* Of calling FlushChannel. */ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - NextChannelHandler *nhPtr; if (chan == (Tcl_Channel) NULL) { return TCL_OK; @@ -2656,6 +2858,83 @@ Tcl_Close(interp, chan) panic("called Tcl_Close on channel with refCount > 0"); } + Tcl_ClearChannelHandlers (chan); + + /* + * Invoke the registered close callbacks and delete their records. + */ + + while (chanPtr->closeCbPtr != (CloseCallback *) NULL) { + cbPtr = chanPtr->closeCbPtr; + chanPtr->closeCbPtr = cbPtr->nextPtr; + (cbPtr->proc) (cbPtr->clientData); + ckfree((char *) cbPtr); + } + + /* + * Ensure that the last output buffer will be flushed. + */ + + if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) && + (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) { + chanPtr->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. + */ + + chanPtr->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. */ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + NextChannelHandler *nhPtr; + + chanPtr = (Channel *) channel; + /* * Remove any references to channel handlers for this channel that * may be about to be invoked. @@ -2711,50 +2990,6 @@ Tcl_Close(interp, chan) ckfree((char *) ePtr); } chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; - - /* - * Invoke the registered close callbacks and delete their records. - */ - - while (chanPtr->closeCbPtr != (CloseCallback *) NULL) { - cbPtr = chanPtr->closeCbPtr; - chanPtr->closeCbPtr = cbPtr->nextPtr; - (cbPtr->proc) (cbPtr->clientData); - ckfree((char *) cbPtr); - } - - /* - * Ensure that the last output buffer will be flushed. - */ - - if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) && - (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) { - chanPtr->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. - */ - - chanPtr->flags |= CHANNEL_CLOSED; - if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) { - return TCL_ERROR; - } - return TCL_OK; } /* @@ -6806,6 +7041,29 @@ TclTestChannelCmd(clientData, interp, argc, argv) chanPtr = (Channel *) chan; } + if ((cmdName[0] == 'c') && + (strncmp(cmdName, "cut", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + Tcl_CutChannel (chan); + return TCL_OK; + } + + if ((cmdName[0] == 'c') && + (strncmp(cmdName, "forgetch", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + Tcl_ClearChannelHandlers (chan); + return TCL_OK; + } if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) { if (argc != 3) { @@ -6930,6 +7188,19 @@ TclTestChannelCmd(clientData, interp, argc, argv) return TCL_OK; } + if ((cmdName[0] == 'i') && + (strncmp(cmdName, "isshared", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + TclFormatInt(buf, Tcl_IsChannelShared (chan)); + Tcl_AppendResult(interp, buf, (char *) NULL); + return TCL_OK; + } + if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", @@ -7037,7 +7308,19 @@ TclTestChannelCmd(clientData, interp, argc, argv) Tcl_AppendResult(interp, buf, (char *) NULL); return TCL_OK; } - + + if ((cmdName[0] == 'c') && + (strncmp(cmdName, "splice", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + Tcl_SpliceChannel (chan); + return TCL_OK; + } + if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", |