diff options
| -rw-r--r-- | generic/tcl.decls | 29 | ||||
| -rw-r--r-- | generic/tclDecls.h | 26 | ||||
| -rw-r--r-- | generic/tclIO.c | 305 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 6 | ||||
| -rw-r--r-- | generic/tclStubs.c | 23 |
5 files changed, 371 insertions, 18 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index ebe7f34..da93b29 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.17 1999/06/17 19:32:14 stanton Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.18 1999/06/30 17:47:27 welch Exp $ library tcl @@ -967,11 +967,30 @@ declare 280 generic { void Tcl_InitMemory(Tcl_Interp *interp) } +# Andreas Kupries <a.kupries@westend.com>, 03/21/1999 +# "Trf-Patch for filtering channels" +# +# C-Level API for (un)stacking of channels. This allows the introduction +# of filtering channels with relatively little changes to the core. +# This patch was created in cooperation with Jan Nijtmans <nijtmans@wxs.nl> +# and is therefore part of his plus-patches too. +# +# It would have been possible to place the following definitions according +# to the alphabetical order used elsewhere in this file, but I decided +# against that to ease the maintenance of the patch across new tcl versions +# (patch usually has no problems to integrate the patch file for the last +# version into the new one). + +declare 281 generic { + Tcl_Channel Tcl_ReplaceChannel(Tcl_Interp *interp, \ + Tcl_ChannelType *typePtr, ClientData instanceData, \ + int mask, Tcl_Channel prevChan) +} +declare 282 generic { + void Tcl_UndoReplaceChannel(Tcl_Interp *interp, Tcl_Channel chan) +} + # Reserved for future use (8.0.x vs. 8.1) -# declare 281 generic { -# } -# declare 282 generic { -# } # declare 283 generic { # } # declare 284 generic { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 0b755fe..835f858 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.17 1999/06/17 19:32:15 stanton Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.18 1999/06/30 17:47:28 welch Exp $ */ #ifndef _TCLDECLS @@ -903,8 +903,14 @@ EXTERN void Tcl_GetVersion _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 280 */ EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp * interp)); -/* Slot 281 is reserved */ -/* Slot 282 is reserved */ +/* 281 */ +EXTERN Tcl_Channel Tcl_ReplaceChannel _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_ChannelType * typePtr, + ClientData instanceData, int mask, + Tcl_Channel prevChan)); +/* 282 */ +EXTERN void Tcl_UndoReplaceChannel _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Channel chan)); /* Slot 283 is reserved */ /* Slot 284 is reserved */ /* Slot 285 is reserved */ @@ -1546,8 +1552,8 @@ typedef struct TclStubs { #endif /* MAC_TCL */ void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */ void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */ - void *reserved281; - void *reserved282; + Tcl_Channel (*tcl_ReplaceChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */ + void (*tcl_UndoReplaceChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 282 */ void *reserved283; void *reserved284; void *reserved285; @@ -2826,8 +2832,14 @@ extern TclStubs *tclStubsPtr; #define Tcl_InitMemory \ (tclStubsPtr->tcl_InitMemory) /* 280 */ #endif -/* Slot 281 is reserved */ -/* Slot 282 is reserved */ +#ifndef Tcl_ReplaceChannel +#define Tcl_ReplaceChannel \ + (tclStubsPtr->tcl_ReplaceChannel) /* 281 */ +#endif +#ifndef Tcl_UndoReplaceChannel +#define Tcl_UndoReplaceChannel \ + (tclStubsPtr->tcl_UndoReplaceChannel) /* 282 */ +#endif /* Slot 283 is reserved */ /* Slot 284 is reserved */ /* Slot 285 is reserved */ diff --git a/generic/tclIO.c b/generic/tclIO.c index bc8db94..f9e7db6 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.8 1999/05/18 20:17:59 hershey Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.9 1999/06/30 17:47:28 welch Exp $ */ #include "tclInt.h" @@ -202,6 +202,10 @@ typedef struct Channel { int bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ CopyState *csPtr; /* State of background copy, or NULL. */ + struct Channel* supercedes; /* Refers to channel this one was stacked upon. + This reference is NULL for normal channels. + See Tcl_ReplaceChannel. */ + } Channel; /* @@ -1038,7 +1042,21 @@ Tcl_RegisterChannel(interp, chan) if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) { return; } - panic("Tcl_RegisterChannel: duplicate channel names"); + + /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998 + * "Trf-Patch for filtering channels" + * + * This is the change to 'Tcl_RegisterChannel'. + * + * Explanation: + * The moment a channel is stacked upon another he + * takes the identity of the channel he supercedes, + * i.e. he gets the *same* name. Because of this we + * cannot check for duplicate names anymore, they + * have to be allowed now. + */ + + /* panic("Tcl_RegisterChannel: duplicate channel names"); */ } Tcl_SetHashValue(hPtr, (ClientData) chanPtr); } @@ -1296,6 +1314,7 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask) chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; chanPtr->timer = NULL; chanPtr->csPtr = NULL; + chanPtr->supercedes = (Channel*) NULL; chanPtr->outputStage = NULL; if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { @@ -1333,6 +1352,252 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask) /* *---------------------------------------------------------------------- * + * Tcl_ReplaceChannel -- + * + * 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. + * + * Side effects: + * See above. + * + *---------------------------------------------------------------------- + */ + +Tcl_Channel +Tcl_ReplaceChannel(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, *pt, *prevPt; + + /* + * Find the given channel in the list of all channels, compute enough + * information to allow easy removal after the conditions are met. + */ + + prevPt = (Channel*) NULL; + pt = (Channel*) tsdPtr->firstChanPtr; + + while (pt != (Channel *) prevChan) { + prevPt = pt; + pt = pt->nextChanPtr; + } + + /* + * 'pt == prevChan' now + */ + + if (!pt) { + 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 & Tcl_GetChannelMode (prevChan)) == 0) { + return (Tcl_Channel) NULL; + } + + chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel)); + chanPtr->flags = mask; + + /* + * Set the channel up initially in no Input translation mode and + * no Output translation mode. + */ + + chanPtr->inputTranslation = TCL_TRANSLATE_LF; + chanPtr->outputTranslation = TCL_TRANSLATE_LF; + chanPtr->inEofChar = 0; + chanPtr->outEofChar = 0; + + chanPtr->unreportedError = 0; + chanPtr->instanceData = instanceData; + chanPtr->typePtr = typePtr; + chanPtr->refCount = 0; + chanPtr->closeCbPtr = (CloseCallback *) NULL; + chanPtr->curOutPtr = (ChannelBuffer *) NULL; + chanPtr->outQueueHead = (ChannelBuffer *) NULL; + chanPtr->outQueueTail = (ChannelBuffer *) NULL; + chanPtr->saveInBufPtr = (ChannelBuffer *) NULL; + chanPtr->inQueueHead = (ChannelBuffer *) NULL; + chanPtr->inQueueTail = (ChannelBuffer *) NULL; + chanPtr->chPtr = (ChannelHandler *) NULL; + chanPtr->interestMask = 0; + chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; + chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; + chanPtr->timer = NULL; + chanPtr->csPtr = NULL; + + /* 06/12/1998: New for Tcl 8.1 + * + * Take over the encoding from the superceded channel, so that it will be + * executed in the future despite the replacement, and at the proper time + * (*after* / *before* our transformation, depending on the direction of + * the dataflow). + * + * *Important* + * The I/O functionality of the filtering channel has to use 'Tcl_Read' to + * get at the underlying information. This will circumvent the de/encoder + * stage [*] in the superceded channel and removes the need to trouble + * ourselves with 'ByteArray's too. + * + * [*] I'm talking about the conversion between UNICODE and other + * representations, like ASCII. + */ + + chanPtr->encoding=Tcl_GetEncoding(interp,Tcl_GetEncodingName(pt->encoding)); + chanPtr->inputEncodingState = pt->inputEncodingState; + chanPtr->inputEncodingFlags = pt->inputEncodingFlags; + chanPtr->outputEncodingState = pt->outputEncodingState; + chanPtr->outputEncodingFlags = pt->outputEncodingFlags; + + chanPtr->outputStage = NULL; + + if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) { + chanPtr->outputStage = (char *) + ckalloc((unsigned) (chanPtr->bufSize + 2)); + } + + chanPtr->supercedes = (Channel*) prevChan; + + chanPtr->channelName = (char *) ckalloc (strlen(pt->channelName)+1); + strcpy (chanPtr->channelName, pt->channelName); + + /* + * Link the new channel into the same spot in the per-interp + * channel list as the old channel was. + */ + + if (prevPt) { + prevPt->nextChanPtr = chanPtr; + } else { + tsdPtr->firstChanPtr = chanPtr; + } + + chanPtr->nextChanPtr = pt->nextChanPtr; + + /* + * The following call replaces the hash table mapping from name + * to channel with a pointer to the new channel. + */ + + Tcl_RegisterChannel (interp, (Tcl_Channel) chanPtr); + + /* + * The superceded channel is effectively unregistered + * We cannot decrement its reference count because that + * can cause it to get garbage collected out from under us. + * Don't add the following code: + * + * chanPtr->supercedes->refCount --; + * + */ + + return (Tcl_Channel) chanPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_UndoReplaceChannel -- + * + * Unstacks an entry in the hash table for a Tcl_Channel + * record. This is the reverse to 'Tcl_ReplaceChannel'. + * The old, superceded channel is uncovered and re-registered + * in the appropriate datastructures. + * + * Results: + * Returns the old Tcl_Channel, i.e. the one which was stacked over. + * + * Side effects: + * See above. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_UndoReplaceChannel (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) { + Tcl_HashTable *hTblPtr; /* Hash table of channels. */ + Tcl_HashEntry *hPtr; /* Search variable. */ + int new; /* Is the hash entry new or does it exist? */ + + /* + * Insert the channel we were stacked upon back into + * the list of open channels. Place it back into the hashtable too. + * Correct 'refCount', as this actually unregisters 'chan'. + */ + + chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr; + tsdPtr->firstChanPtr = chanPtr->supercedes; + + hTblPtr = GetChannelTable (interp); + hPtr = Tcl_CreateHashEntry (hTblPtr, chanPtr->channelName, &new); + + Tcl_SetHashValue(hPtr, (ClientData) chanPtr->supercedes); + chanPtr->refCount --; + + /* + * The superceded channel is effectively registered again + * Don't add the following code because we didn't + * decremented the reference count at replace time. + * + * chanPtr->supercedes->refCount ++; + * + */ + } + + /* + * Disconnect the channels, then do a regular close upon the + * stacked one, the filtering channel. This may cause flushing + * of data into the superceded channel (if the filtering channel + * ('chan') remembered its parent in itself). + */ + + chanPtr->supercedes = NULL; + + if (chanPtr->refCount == 0) { + Tcl_Close (interp, chan); + } +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetChannelMode -- * * Computes a mask indicating whether the channel is open for @@ -2005,6 +2270,42 @@ CloseChannel(interp, chanPtr, errorCode) } } + /* Andreas Kupries <a.kupries@westend.com>, 12/13/1998 + * "Trf-Patch for filtering channels" + * + * This is the change to 'CloseChannel'. + * + * Explanation + * Closing a filtering channel closes the one it + * superceded too. This basically ripples through + * the whole chain of filters until it reaches + * the underlying normal channel. + * + * This is done by reintegrating the superceded + * channel into the (thread) global list of open + * channels and then invoking a regular close. + * There is no need to handle the complexities of + * this process by ourselves. + * + * *Note* + * This has to be done after the call to the + * 'closeProc' of the filtering channel to allow + * that one to flush internal buffers into + * the underlying channel. + */ + + if (chanPtr->supercedes != (Channel*) NULL) { + /* + * Insert the channel we were stacked upon back into + * the list of open channels, then do a regular close. + */ + + chanPtr->supercedes->nextChanPtr = tsdPtr->firstChanPtr; + tsdPtr->firstChanPtr = chanPtr->supercedes; + chanPtr->supercedes->refCount --; /* is deregistered */ + Tcl_Close (interp, (Tcl_Channel) chanPtr->supercedes); + } + /* * Cancel any outstanding timer. */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 8b824cc..fc491f7 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.19 1999/06/17 19:32:15 stanton Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.20 1999/06/30 17:47:28 welch Exp $ */ #include "tclInt.h" @@ -661,8 +661,8 @@ TclStubs tclStubs = { #endif /* MAC_TCL */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ - NULL, /* 281 */ - NULL, /* 282 */ + Tcl_ReplaceChannel, /* 281 */ + Tcl_UndoReplaceChannel, /* 282 */ NULL, /* 283 */ NULL, /* 284 */ NULL, /* 285 */ diff --git a/generic/tclStubs.c b/generic/tclStubs.c index 21ebe06..0194243 100644 --- a/generic/tclStubs.c +++ b/generic/tclStubs.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubs.c,v 1.7 1999/04/16 00:46:53 stanton Exp $ + * RCS: @(#) $Id: tclStubs.c,v 1.8 1999/06/30 17:47:29 welch Exp $ */ #include "tcl.h" @@ -3263,5 +3263,26 @@ Tcl_ServiceModeHook(mode) (tclStubsPtr->tcl_ServiceModeHook)(mode); } +/* Slot 345 */ +Tcl_Channel +Tcl_ReplaceChannel(interp, typePtr, instanceData, mask, prevChan) + Tcl_Interp * interp; + Tcl_ChannelType * typePtr; + ClientData instanceData; + int mask; + Tcl_Channel prevChan; +{ + return (tclStubsPtr->tcl_ReplaceChannel)(interp, typePtr, instanceData, mask, prevChan); +} + +/* Slot 346 */ +void +Tcl_UndoReplaceChannel(interp, chan) + Tcl_Interp * interp; + Tcl_Channel chan; +{ + (tclStubsPtr->tcl_UndoReplaceChannel)(interp, chan); +} + /* !END!: Do not edit above this line. */ |