summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorwelch <welch>1999-06-30 17:47:27 (GMT)
committerwelch <welch>1999-06-30 17:47:27 (GMT)
commit31463576a06dda5ee5f81f24cb119b3dd469dc71 (patch)
treecad9dceb9c65e0526946c63abbc976527f5d47ce /generic
parentcf9b05a0bbf76349c46744b72706db558588a9e7 (diff)
downloadtcl-31463576a06dda5ee5f81f24cb119b3dd469dc71.zip
tcl-31463576a06dda5ee5f81f24cb119b3dd469dc71.tar.gz
tcl-31463576a06dda5ee5f81f24cb119b3dd469dc71.tar.bz2
Initial version of the Tcl_ReplaceChannel and Tcl_UndoReplaceChannel
functions.
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls29
-rw-r--r--generic/tclDecls.h26
-rw-r--r--generic/tclIO.c305
-rw-r--r--generic/tclStubInit.c6
-rw-r--r--generic/tclStubs.c23
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. */