TIP #230 IMPLEMENTATION

	* generic/tclIOCmd.c: Integration of transform commands into 'chan' ensemble.
	* generic/tclInt.h: Definitions of the transform commands.
	* generic/tclIORTrans.c: Implementation of the reflection transforms.
	* tests/chan.test: Tests updated for new sub-commands of 'chan'.
	* tests/ioCmd.test: Tests updated for new sub-commands of 'chan'.
	* tests/ioTrans.test: Whole new set of tests for the reflection transform.
	* unix/Makefile.in: Integration of new files into build rules.
	* win/Makefile.in: Integration of new files into build rules.
	* win/makefile.vc: Integration of new files into build rules.

	NOTE: The file 'tclIORTrans.c' has a lot of code in common with
	      the file 'tclIORChan.c', as that made it much easier to
	      develop the reference implementation as a separate
	      module. Now that the transforms have been committed the one
	      thing left to do is to go over both modules and see which of
	      the common parts we can factor out and share.

4 files changed, 3356 insertions, 3 deletions

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index be34dc1..131b905 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.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: tclIOCmd.c,v 1.53 2008/04/10 20:58:59 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.54 2008/06/06 19:46:36 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1838,7 +1838,9 @@ TclInitChanCmd(
 	{"flush",	Tcl_FlushObjCmd},
 	{"gets",	Tcl_GetsObjCmd},
 	{"pending",	ChanPendingObjCmd},		/* TIP #287 */
+	{"pop",         TclChanPopObjCmd},              /* TIP #230 */
 	{"postevent",	TclChanPostEventObjCmd},	/* TIP #219 */
+	{"push",        TclChanPushObjCmd},             /* TIP #230 */
 	{"puts",	Tcl_PutsObjCmd},
 	{"read",	Tcl_ReadObjCmd},
 	{"seek",	Tcl_SeekObjCmd},
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
new file mode 100644
index 0000000..908c480
--- /dev/null
+++ b/generic/tclIORTrans.c
@@ -0,0 +1,3345 @@
+/*
+ * tclIORTrans.c --
+ *
+ *	This file contains the implementation of Tcl's generic transformation
+ *	reflection code, which allows the implementation of Tcl channel
+ *	transformations in Tcl code.
+ *
+ *	Parts of this file are based on code contributed by Jean-Claude
+ *	Wippler.
+ *
+ *	See TIP #230 for the specification of this functionality.
+ *
+ * Copyright (c) 2007-2008 ActiveState.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclIORTrans.c,v 1.1 2008/06/06 19:46:37 andreas_kupries Exp $
+ */
+
+#include <tclInt.h>
+#include <tclIO.h>
+#include <assert.h>
+
+#ifndef EINVAL
+#define EINVAL	9
+#endif
+#ifndef EOK
+#define EOK	0
+#endif
+
+/* DUPLICATE of HaveVersion() in tclIO.c // TODO - MODULE_SCOPE */
+static int		HaveVersion(const Tcl_ChannelType *typePtr,
+			    Tcl_ChannelTypeVersion minimumVersion);
+
+/*
+ * Signatures of all functions used in the C layer of the reflection.
+ */
+
+static int		ReflectClose(ClientData clientData,
+			    Tcl_Interp *interp);
+static int		ReflectInput(ClientData clientData, char *buf,
+			    int toRead, int *errorCodePtr);
+static int		ReflectOutput(ClientData clientData, const char *buf,
+			    int toWrite, int *errorCodePtr);
+static void		ReflectWatch(ClientData clientData, int mask);
+static int		ReflectBlock(ClientData clientData, int mode);
+static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
+			    Tcl_WideInt offset, int mode, int *errorCodePtr);
+static int		ReflectSeek(ClientData clientData, long offset,
+			    int mode, int *errorCodePtr);
+static int		ReflectGetOption(ClientData clientData,
+			    Tcl_Interp *interp, const char *optionName,
+			    Tcl_DString *dsPtr);
+static int		ReflectSetOption(ClientData clientData,
+			    Tcl_Interp *interp, const char *optionName,
+			    const char *newValue);
+static int		ReflectHandle(ClientData clientData, int direction,
+				      ClientData* handle);
+static int		ReflectNotify(ClientData clientData, int mask);
+
+/*
+ * The C layer channel type/driver definition used by the reflection. This is
+ * a version 3 structure.
+ */
+
+static Tcl_ChannelType tclRTransformType = {
+    "tclrtransform",       /* Type name.                                  */
+    TCL_CHANNEL_VERSION_5, /* v5 channel */
+    ReflectClose,          /* Close channel, clean instance data          */
+    ReflectInput,          /* Handle read request                         */
+    ReflectOutput,         /* Handle write request                        */
+    ReflectSeek,           /* Move location of access point.              */
+    ReflectSetOption,      /* Set options.                                */
+    ReflectGetOption,      /* Get options.                                */
+    ReflectWatch,          /* Initialize notifier                         */
+    ReflectHandle,         /* Get OS handle from the channel.             */
+    NULL,                  /* No close2 support.               NULL'able  */
+    ReflectBlock,          /* Set blocking/nonblocking.                   */
+    NULL,                  /* Flush channel. Not used by core. NULL'able  */
+    ReflectNotify,         /* Handle events.                              */
+    ReflectSeekWide,       /* Move access point (64 bit).                 */
+    NULL,                  /* thread action */
+    NULL,                  /* truncate */
+};
+
+/*
+ * Structure of the buffer to hold transform results to be consumed by higher
+ * layers upon reading from the channel, plus the functions to manage such.
+ */
+
+typedef struct _ResultBuffer_ {
+  unsigned char* buf;       /* Reference to the buffer area */
+  int            allocated; /* Allocated size of the buffer area */
+  int            used;      /* Number of bytes in the buffer, <= allocated */
+} ResultBuffer;
+
+#define ResultLength(r) ((r)->used)
+/* static int ResultLength        (ResultBuffer* r); */
+
+static void  ResultClear          (ResultBuffer* r);
+static void  ResultInit           (ResultBuffer* r);
+static void  ResultAdd            (ResultBuffer* r, unsigned char* buf, int toWrite);
+static int   ResultCopy           (ResultBuffer* r, unsigned char* buf, int toRead);
+
+#define RB_INCREMENT (512)
+
+/*
+ * Instance data for a reflected transformation. ===========================
+ */
+
+typedef struct {
+    Tcl_Channel chan;		/* Back reference to the channel of the
+				 * transformation itself. */
+    Tcl_Channel parent;         /* Reference to the channel the transformation
+				 * was pushed on. */
+    Tcl_Interp *interp;		/* Reference to the interpreter containing the
+				 * Tcl level part of the channel. */
+    Tcl_Obj    *handle;         /* Reference to transform handle. Also stored
+				 * in the argv, see below. The separate field
+				 * gives us direct access, needed when working
+				 * with the reflection maps.
+				 */
+#ifdef TCL_THREADS
+    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
+#endif
+
+    Tcl_TimerToken timer;
+
+    /* See [==] as well.
+     * Storage for the command prefix and the additional words required for
+     * the invocation of methods in the command handler.
+     *
+     * argv [0] ... [.] | [argc-2] [argc-1] | [argc]  [argc+2]
+     *      cmd ... pfx | method   chan     | detail1 detail2
+     *      ~~~~ CT ~~~            ~~ CT ~~
+     *
+     * CT = Belongs to the 'Command handler Thread'.
+     */
+
+    int argc;			/* Number of preallocated words - 2 */
+    Tcl_Obj **argv;		/* Preallocated array for calling the handler.
+				 * args[0] is placeholder for cmd word.
+				 * Followed by the arguments in the prefix,
+				 * plus 4 placeholders for method, channel,
+				 * and at most two varying (method specific)
+				 * words. */
+    int methods;		/* Bitmask of supported methods */
+
+    /*
+     * NOTE (9): Should we have predefined shared literals for the method
+     * names?
+     */
+
+    int mode;			/* Mask of R/W mode */
+    int nonblocking;            /* Flag: Channel is blocking or not */
+    int readIsDrained;          /* Flag: Read buffers are flushed*/
+
+    ResultBuffer result;
+
+} ReflectedTransform;
+
+/*
+ * Structure of the table mapping from transform handles to reflected
+ * transform (channels). Each interpreter which has the handler command for
+ * one or more reflected transforms records them in such a table, so that we
+ * are able to find them during interpreter/thread cleanup even if the actual
+ * channel they belong to was moved to a different interpreter and/or thread.
+ *
+ * The table is reachable via the standard interpreter AssocData, the key is
+ * defined below.
+ */
+
+typedef struct {
+    Tcl_HashTable map;
+} ReflectedTransformMap;
+
+#define RTMKEY "ReflectedTransformMap"
+
+/*
+ * Method literals. ==================================================
+ */
+
+static const char *methodNames[] = {
+    "clear",		/* OPT */
+    "drain",		/* OPT, drain => read */
+    "finalize",		/*     */
+    "flush",		/* OPT, flush => write */
+    "initialize",	/*     */
+    "limit?",		/* OPT */
+    "read",		/* OPT */
+    "write",		/* OPT */
+    NULL
+};
+typedef enum {
+    METH_CLEAR,
+    METH_DRAIN,
+    METH_FINAL,
+    METH_FLUSH,
+    METH_INIT,
+    METH_LIMIT,
+    METH_READ,
+    METH_WRITE
+} MethodName;
+
+#define FLAG(m) (1 << (m))
+#define REQUIRED_METHODS \
+	(FLAG(METH_INIT) | FLAG(METH_FINAL))
+#define RANDW \
+	(TCL_READABLE | TCL_WRITABLE)
+
+#define IMPLIES(a,b)	((!(a)) || (b))
+#define NEGIMPL(a,b)
+#define HAS(x,f)	(x & FLAG(f))
+
+#ifdef TCL_THREADS
+/*
+ * Thread specific types and structures.
+ *
+ * We are here essentially creating a very specific implementation of 'thread
+ * send'.
+ */
+
+/*
+ * Enumeration of all operations which can be forwarded.
+ */
+
+typedef enum {
+    ForwardedClear,
+    ForwardedClose,
+    ForwardedDrain,
+    ForwardedFlush,
+    ForwardedInput,
+    ForwardedLimit,
+    ForwardedOutput
+} ForwardedOperation;
+
+/*
+ * Event used to forward driver invocations to the thread actually managing
+ * the channel. We cannot construct the command to execute and forward
+ * that. Because then it will contain a mixture of Tcl_Obj's belonging to both
+ * the command handler thread (CT), and the thread managing the channel (MT),
+ * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
+ * forward an operation code, the argument details, and reference to results.
+ * The command is assembled in the CT and belongs fully to that thread. No
+ * sharing problems.
+ */
+
+typedef struct ForwardParamBase {
+    int code;			/* O: Ok/Fail of the cmd handler */
+    char *msgStr;		/* O: Error message for handler failure */
+    int mustFree;		/* O: True if msgStr is allocated, false if
+				 * otherwise (static). */
+} ForwardParamBase;
+
+/*
+ * Operation specific parameter/result structures. (These are "subtypes" of
+ * ForwardParamBase. Where an operation does not need any special types, it
+ * has no "subtype" and just uses ForwardParamBase, as listed above.)
+ */
+
+struct ForwardParamTransform {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    char *buf;			/* I: Bytes to transform,
+				 * O: Bytes in transform result */
+    int size;			/* I: #bytes to transform,
+				 * O: #bytes in the transform result */
+};
+struct ForwardParamLimit {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    int max;			/* O: Character read limit */
+};
+
+/*
+ * Now join all these together in a single union for convenience.
+ */
+
+typedef union ForwardParam {
+    ForwardParamBase base;
+    struct ForwardParamTransform transform;
+    struct ForwardParamLimit     limit;
+} ForwardParam;
+
+/*
+ * Forward declaration.
+ */
+
+typedef struct ForwardingResult ForwardingResult;
+
+/*
+ * General event structure, with reference to operation specific data.
+ */
+
+typedef struct ForwardingEvent {
+    Tcl_Event event;		/* Basic event data, has to be first item */
+    ForwardingResult *resultPtr;
+    ForwardedOperation op;	/* Forwarded driver operation */
+    ReflectedTransform *rtPtr;	/* Channel instance */
+    ForwardParam *param;	/* Packaged arguments and return values, a
+				 * ForwardParam pointer. */
+} ForwardingEvent;
+
+/*
+ * Structure to manage the result of the forwarding. This is not the result of
+ * the operation itself, but about the success of the forward event itself.
+ * The event can be successful, even if the operation which was forwarded
+ * failed. It is also there to manage the synchronization between the involved
+ * threads.
+ */
+
+struct ForwardingResult {
+    Tcl_ThreadId src;		/* Originating thread. */
+    Tcl_ThreadId dst;		/* Thread the op was forwarded to. */
+    Tcl_Interp *dsti;		/* Interpreter in the thread the op was
+				 * forwarded to. */
+    Tcl_Condition done;		/* Condition variable the forwarder blocks
+				 * on. */
+    int result;			/* TCL_OK or TCL_ERROR */
+    ForwardingEvent *evPtr;	/* Event the result belongs to. */
+    ForwardingResult *prevPtr, *nextPtr;
+				/* Links into the list of pending forwarded
+				 * results. */
+};
+
+typedef struct ThreadSpecificData {
+    /*
+     * Table of all reflected transformations owned by this thread.
+     */
+
+    ReflectedTransformMap* rtmPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * List of forwarded operations which have not completed yet, plus the mutex
+ * to protect the access to this process global list.
+ */
+
+static ForwardingResult *forwardList = NULL;
+TCL_DECLARE_MUTEX(rtForwardMutex)
+
+/*
+ * Function containing the generic code executing a forward, and wrapper
+ * macros for the actual operations we wish to forward. Uses ForwardProc as
+ * the event function executed by the thread receiving a forwarding event
+ * (which executes the appropriate function and collects the result, if any).
+ *
+ * The two ExitProcs are handlers so that things do not deadlock when either
+ * thread involved in the forwarding exits. They also clean things up so that
+ * we don't leak resources when threads go away.
+ */
+
+static void		ForwardOpToOwnerThread(ReflectedTransform *rtPtr,
+			    ForwardedOperation op, const VOID *param);
+static int		ForwardProc(Tcl_Event *evPtr, int mask);
+static void		SrcExitProc(ClientData clientData);
+
+#define FreeReceivedError(p) \
+	if ((p)->base.mustFree) { \
+	    ckfree((p)->base.msgStr); \
+	}
+#define PassReceivedErrorInterp(i,p) \
+	if ((i) != NULL) { \
+	    Tcl_SetChannelErrorInterp((i), \
+		    Tcl_NewStringObj((p)->base.msgStr, -1)); \
+	} \
+	FreeReceivedError(p)
+#define PassReceivedError(c,p) \
+	Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
+	FreeReceivedError(p)
+#define ForwardSetStaticError(p,emsg) \
+	(p)->base.code = TCL_ERROR; \
+	(p)->base.mustFree = 0; \
+	(p)->base.msgStr = (char *) (emsg)
+#define ForwardSetDynamicError(p,emsg) \
+	(p)->base.code = TCL_ERROR; \
+	(p)->base.mustFree = 1; \
+	(p)->base.msgStr = (char *) (emsg)
+
+static void		ForwardSetObjError(ForwardParam *p,
+			    Tcl_Obj *objPtr);
+
+static ReflectedTransformMap *	GetThreadReflectedTransformMap(void);
+static void		DeleteThreadReflectedTransformMap(ClientData clientData);
+
+#endif /* TCL_THREADS */
+
+#define SetChannelErrorStr(c,msgStr) \
+	Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))
+
+static Tcl_Obj *	MarshallError(Tcl_Interp *interp);
+static void		UnmarshallErrorResult(Tcl_Interp *interp,
+			    Tcl_Obj *msgObj);
+
+/*
+ * Static functions for this file:
+ */
+
+static Tcl_Obj *	DecodeEventMask(int mask);
+static ReflectedTransform * NewReflectedTransform(Tcl_Interp *interp,
+			    Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj,
+			    Tcl_Channel parentChan);
+static Tcl_Obj *	NextHandle(void);
+static void		FreeReflectedTransform(ReflectedTransform *rtPtr);
+static int		InvokeTclMethod(ReflectedTransform *rtPtr,
+			    const char *method, Tcl_Obj *argOneObj,
+			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
+
+static ReflectedTransformMap *	GetReflectedTransformMap(Tcl_Interp *interp);
+static void		DeleteReflectedTransformMap(ClientData clientData,
+			    Tcl_Interp *interp);
+
+/*
+ * Global constant strings (messages). ==================
+ * These string are used directly as bypass errors, thus they have to be valid
+ * Tcl lists where the last element is the message itself. Hence the
+ * list-quoting to keep the words of the message together. See also [x].
+ */
+
+static const char *msg_read_badlimit = "{Tcl driver returned bad read limit '0'}";
+static const char *msg_read_unsup = "{read not supported by Tcl driver}";
+static const char *msg_write_unsup = "{write not supported by Tcl driver}";
+#ifdef TCL_THREADS
+static const char *msg_send_originlost = "{Channel thread lost}";
+static const char *msg_send_dstlost = "{Owner lost}";
+#endif /* TCL_THREADS */
+static const char *msg_dstlost    = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
+
+/*
+ * Timer management (flushing out buffered data via artificial events).
+ */
+
+/*
+ * Number of milliseconds to wait before firing an event to try to
+ * flush out information waiting in buffers (fileevent support).
+ */
+
+#define FLUSH_DELAY (5)
+
+static void TimerKill  (ReflectedTransform* rtPtr);
+static void TimerSetup (ReflectedTransform* rtPtr);
+static void TimerRun   (ClientData clientData);
+
+/*
+ * Helper functions encapsulating some of the thread forwarding to make the
+ * control flow in callers easier.
+ */
+
+static int  TransformRead  (ReflectedTransform* rtPtr, int* errorCodePtr, unsigned char* buf, int toRead);
+static int  TransformWrite (ReflectedTransform* rtPtr, int* errorCodePtr, unsigned char* buf, int toWrite);
+static int  TransformDrain (ReflectedTransform* rtPtr, int* errorCodePtr);
+static int  TransformFlush (ReflectedTransform* rtPtr, int* errorCodePtr, int op);
+static void TransformClear (ReflectedTransform* rtPtr);
+static int  TransformLimit (ReflectedTransform* rtPtr, int* errorCodePtr, int* maxPtr);
+
+/* op'codes for TransformFlush */
+#define FLUSH_WRITE   1
+#define FLUSH_DISCARD 0
+
+/*
+ * Main methods to plug into the 'chan' ensemble'. ==================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChanPushObjCmd --
+ *
+ *	This function is invoked to process the "chan push" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result. The handle of the new channel is placed in the
+ *	interp result.
+ *
+ * Side effects:
+ *	Creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChanPushObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    ReflectedTransform *rtPtr;	/* Instance data of the new (transform) channel */
+    Tcl_Obj*    chanObj;        /* Handle of parent channel */
+    Tcl_Channel parentChan;     /* Token of parent channel */
+    int mode;			/* R/W mode of parent, later the new
+				 * channel. Has to match the abilities of the
+				 * handler commands */
+    Tcl_Obj *cmdObj;		/* Command prefix, list of words */
+    Tcl_Obj *cmdNameObj;	/* Command name */
+    Tcl_Obj *rtId;		/* Handle of the new transform (channel) */
+    Tcl_Obj *modeObj;		/* mode in obj form for method call */
+
+    int listc;			/* Result of 'initialize', and of */
+    Tcl_Obj **listv;		/* its sublist in the 2nd element */
+    int methIndex;		/* Encoded method name */
+    int result;			/* Result code for 'initialize' */
+    Tcl_Obj *resObj;		/* Result data for 'initialize' */
+    int methods;		/* Bitmask for supported methods. */
+    Tcl_Obj *err;		/* Error message */
+    ReflectedTransformMap *rtmPtr;
+				/* Map of reflected transforms with handlers in
+				 * this interp. */
+    Tcl_HashEntry *hPtr;	/* Entry in the above map */
+    int isNew;			/* Placeholder. */
+
+    /*
+     * Syntax:   chan push CHANNEL CMDPREFIX
+     *           [0]  [1]  [2]     [3]
+     *
+     * Actually: rPush CHANNEL CMDPREFIX
+     *           [0]   [1]     [2]
+     */
+
+#define CHAN	(1)
+#define CMD	(2)
+
+    /*
+     * Number of arguments...
+     */
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channel cmdprefix");
+	return TCL_ERROR;
+    }
+
+    /*
+     * First argument is a channel handle.
+     */
+
+    chanObj    = objv[CHAN];
+    parentChan = Tcl_GetChannel (interp, Tcl_GetString (chanObj), &mode);
+    if (parentChan == NULL) {
+	return TCL_ERROR;
+    }
+    parentChan = Tcl_GetTopChannel (parentChan);
+
+    /*
+     * Second argument is command prefix, i.e. list of words, first word is
+     * name of handler command, other words are fixed arguments. Run
+     * 'initialize' method to get the list of supported methods. Validate
+     * this.
+     */
+
+    cmdObj = objv[CMD];
+
+    /*
+     * Basic check that the command prefix truly is a list.
+     */
+
+    if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now create the transformation (channel).
+     */
+
+    rtId  = NextHandle();
+    rtPtr = NewReflectedTransform(interp, cmdObj, mode, rtId, parentChan);
+
+    /*
+     * Invoke 'initialize' and validate that the handler is present and ok.
+     * Squash the transformation if not.
+     */
+
+    modeObj = DecodeEventMask(mode);
+    result  = InvokeTclMethod(rtPtr, "initialize", modeObj, NULL, &resObj);
+    Tcl_DecrRefCount(modeObj);
+    if (result != TCL_OK) {
+	UnmarshallErrorResult(interp, resObj);
+	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+	goto error;
+    }
+
+    /*
+     * Verify the result.
+     * - List, of method names. Convert to mask.
+     *   Check for non-optionals through the mask.
+     *   Compare open mode against optional r/w.
+     */
+
+    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
+	Tcl_AppendObjToObj(err, resObj);
+	Tcl_SetObjResult(interp, err);
+	Tcl_DecrRefCount(resObj);
+	goto error;
+    }
+
+    methods = 0;
+    while (listc > 0) {
+	if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
+		"method", TCL_EXACT, &methIndex) != TCL_OK) {
+	    TclNewLiteralStringObj(err, "chan handler \"");
+	    Tcl_AppendObjToObj(err, cmdObj);
+	    Tcl_AppendToObj(err, " initialize\" returned ", -1);
+	    Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
+	    Tcl_SetObjResult(interp, err);
+	    Tcl_DecrRefCount(resObj);
+	    goto error;
+	}
+
+	methods |= FLAG(methIndex);
+	listc--;
+    }
+    Tcl_DecrRefCount(resObj);
+
+    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, "\" does not support all required methods", -1);
+	Tcl_SetObjResult(interp, err);
+	goto error;
+    }
+
+    /*
+     * Mode tell us what the parent channel supports. The methods tell us what
+     * the handler supports. We remove the non-supported bits from the mode
+     * and check that the channel is not completely inacessible. Afterward the
+     * mode tells us which methods are still required, and these methods will
+     * also be supported by the handler, by design of the check.
+     */
+
+    if (!HAS(methods, METH_READ))  { mode &= ~TCL_READABLE; }
+    if (!HAS(methods, METH_WRITE)) { mode &= ~TCL_WRITABLE; }
+
+    if (!mode) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, "\" makes the channel inacessible", -1);
+	Tcl_SetObjResult(interp, err);
+	goto error;
+    }
+
+    /*
+     * The mode and support for it is ok, now check the internal constraints.
+     */
+
+    if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, "\" supports \"drain\" but not \"read\"", -1);
+	Tcl_SetObjResult(interp, err);
+	goto error;
+    }
+
+    if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
+	TclNewLiteralStringObj(err, "chan handler \"");
+	Tcl_AppendObjToObj(err, cmdObj);
+	Tcl_AppendToObj(err, "\" supports \"flush\" but not \"write\"", -1);
+	Tcl_SetObjResult(interp, err);
+	goto error;
+    }
+
+    Tcl_ResetResult(interp);
+
+    /*
+     * Everything is fine now.
+     */
+
+    rtPtr->methods = methods;
+    rtPtr->mode    = mode;
+    rtPtr->chan    = Tcl_StackChannel (interp, &tclRTransformType,
+				       (ClientData) rtPtr, mode,
+				       rtPtr->parent);
+
+    /*
+     * Register the transform in our our map for proper handling of deleted
+     * interpreters and/or threads.
+     */
+
+    rtmPtr = GetReflectedTransformMap (interp);
+    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId),
+	    &isNew);
+    if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
+	Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
+    }
+    Tcl_SetHashValue(hPtr, rtPtr);
+#ifdef TCL_THREADS
+    rtmPtr = GetThreadReflectedTransformMap();
+    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId),
+	    &isNew);
+    Tcl_SetHashValue(hPtr, rtPtr);
+#endif
+
+    /*
+     * Return the channel as the result of the command.
+     */
+
+    Tcl_AppendResult (interp, Tcl_GetChannelName (rtPtr->chan),
+		    (char*) NULL);
+    return TCL_OK;
+
+ error:
+    /*
+     * We are not going through ReflectClose as we never had a channel
+     * structure.
+     */
+
+    FreeReflectedTransform(rtPtr);
+    return TCL_ERROR;
+
+#undef CHAN
+#undef CMD
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChanPopObjCmd --
+ *
+ *	This function is invoked to process the "chan pop" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Posts events to a reflected channel, invokes event handlers. The
+ *	latter implies that arbitrary side effects are possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChanPopObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    /*
+     * Syntax:   chan pop CHANNEL
+     *           [0]  [1] [2]
+     *
+     * Actually: rPop CHANNEL
+     *           [0]  [1]
+     */
+
+#define CHAN	(1)
+
+    const char *chanId;		/* Tcl level channel handle */
+    Tcl_Channel chan;		/* Channel associated to the handle */
+    int         mode;           /* Channel r/w mode */
+
+    /*
+     * Number of arguments...
+     */
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channel");
+	return TCL_ERROR;
+    }
+
+    /*
+     * First argument is a channel, which may have a (reflected)
+     * transformation.
+     */
+
+    chanId = TclGetString(objv[CHAN]);
+    chan   = Tcl_GetChannel(interp, chanId, &mode);
+
+    if (chan == NULL) {
+	return TCL_ERROR;
+    }
+
+    /* Removing transformations is generic, and not restricted to reflected
+     * transformations.
+     */
+
+    Tcl_UnstackChannel(interp, chan);
+    return TCL_OK;
+
+#undef CHAN
+}
+
+/*
+ * Channel error message marshalling utilities.
+ */
+
+static Tcl_Obj*
+MarshallError(
+    Tcl_Interp *interp)
+{
+    /*
+     * Capture the result status of the interpreter into a string. => List of
+     * options and values, followed by the error message. The result has
+     * refCount 0.
+     */
+
+    Tcl_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR);
+
+    /*
+     * => returnOpt.refCount == 0. We can append directly.
+     */
+
+    Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp));
+    return returnOpt;
+}
+
+static void
+UnmarshallErrorResult(
+    Tcl_Interp *interp,
+    Tcl_Obj *msgObj)
+{
+    int lc;
+    Tcl_Obj **lv;
+    int explicitResult;
+    int numOptions;
+
+    /*
+     * Process the caught message.
+     *
+     * Syntax = (option value)... ?message?
+     *
+     * Bad syntax causes a panic. This is OK because the other side uses
+     * Tcl_GetReturnOptions and list construction functions to marshall the
+     * information; if we panic here, something has gone badly wrong already.
+     */
+
+    if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
+	Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
+    }
+    if (interp == NULL) {
+	return;
+    }
+
+    explicitResult = lc & 1;		/* Odd number of values? */
+    numOptions = lc - explicitResult;
+
+    if (explicitResult) {
+	Tcl_SetObjResult(interp, lv[lc-1]);
+    }
+
+    (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
+    ((Interp *)interp)->flags &= ~ERR_ALREADY_LOGGED;
+}
+
+/*
+ * Driver functions. ================================================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectClose --
+ *
+ *	This function is invoked when the channel is closed, to delete the
+ *	driver specific instance data.
+ *
+ * Results:
+ *	A posix error.
+ *
+ * Side effects:
+ *	Releases memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectClose(
+    ClientData clientData,
+    Tcl_Interp *interp)
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+    int result;			/* Result code for 'close' */
+    Tcl_Obj *resObj;		/* Result data for 'close' */
+    ReflectedTransformMap *rtmPtr;/* Map of reflected transforms with handlers in
+				 * this interp */
+    Tcl_HashEntry *hPtr;	/* Entry in the above map */
+
+    if (interp == NULL) {
+	/*
+	 * This call comes from TclFinalizeIOSystem. There are no
+	 * interpreters, and therefore we cannot call upon the handler command
+	 * anymore. Threading is irrelevant as well. We simply clean up all
+	 * our C level data structures and leave the Tcl level to the other
+	 * finalization functions.
+	 */
+
+	/*
+	 * THREADED => Forward this to the origin thread
+	 *
+	 * Note: DeleteThreadReflectedTransformMap() is the thread exit handler
+	 * for the origin thread. Use this to clean up the structure? Except
+	 * if lost?
+	 */
+
+#ifdef TCL_THREADS
+	if (rtPtr->thread != Tcl_GetCurrentThread()) {
+	    ForwardParam p;
+
+	    ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
+	    result = p.base.code;
+
+	    /*
+	     * FreeReflectedTransform is done in the forwarded operation!, in
+	     * the other thread. rtPtr here is gone!
+	     */
+
+	    if (result != TCL_OK) {
+		FreeReceivedError(&p);
+	    }
+	    return EOK;
+	}
+#endif
+
+	FreeReflectedTransform(rtPtr);
+	return EOK;
+    }
+
+    /*
+     * In the reflected channel implementation a cleaned method mask here
+     * implies that the channel creation was aborted, and "finalize" must not
+     * be called. for transformations however we are not going through here on
+     * such an abort, but directly through FreeReflectedTransform. So for us
+     * that check is not necessary. We always go through 'finalize'.
+     */
+
+    if (HAS(rtPtr->methods, METH_DRAIN) && (!rtPtr->readIsDrained)) {
+	int errorCode;
+	if (!TransformDrain (rtPtr, &errorCode)) {
+	    return errorCode;
+	}
+    }
+
+    if (HAS(rtPtr->methods, METH_FLUSH)) {
+	int errorCode;
+	if (!TransformFlush (rtPtr, &errorCode, FLUSH_WRITE)) {
+	    return errorCode;
+	}
+    }
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
+	result = p.base.code;
+
+	/*
+	 * FreeReflectedTransform is done in the forwarded operation!, in the
+	 * other thread. rtPtr here is gone!
+	 */
+
+	if (result != TCL_OK) {
+	    PassReceivedErrorInterp(interp, &p);
+	}
+    } else {
+#endif
+	result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj);
+	if ((result != TCL_OK) && (interp != NULL)) {
+	    Tcl_SetChannelErrorInterp(interp, resObj);
+	}
+
+	Tcl_DecrRefCount(resObj);	/* Remove reference we held from the
+					 * invoke */
+
+	/*
+	 * Remove the transform from the map before releasing the memory, to
+	 * prevent future accesses from finding and dereferencing a dangling
+	 * pointer.
+	 *
+	 * NOTE: The transform may not be in the map. This is ok, that happens
+	 * when the transform was created in a different interpreter and/or
+	 * thread and then was moved here.
+	 */
+
+	rtmPtr = GetReflectedTransformMap(interp);
+ 	hPtr = Tcl_FindHashEntry (&rtmPtr->map, 
+ 				  Tcl_GetString(rtPtr->handle));
+	if (hPtr) {
+	    Tcl_DeleteHashEntry (hPtr);
+	}
+#ifdef TCL_THREADS
+	/*
+	 * In a threaded interpreter we manage a per-thread map as well, to
+	 * allow us to survive if the script level pulls the rug out under a
+	 * channel by deleting the owning thread.
+	 */
+ 
+        rtmPtr = GetThreadReflectedTransformMap();
+	hPtr = Tcl_FindHashEntry (&rtmPtr->map, 
+				  Tcl_GetString(rtPtr->handle));
+	if (hPtr) {
+	    Tcl_DeleteHashEntry (hPtr);
+	}
+#endif
+
+	FreeReflectedTransform(rtPtr);
+#ifdef TCL_THREADS
+    }
+#endif
+    return (result == TCL_OK) ? EOK : EINVAL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectInput --
+ *
+ *	This function is invoked when more data is requested from the channel.
+ *
+ * Results:
+ *	The number of bytes read.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectInput(
+	     ClientData clientData,
+	     char *buf,
+	     int toRead,
+	     int *errorCodePtr)
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+    int gotBytes, copied, read;
+
+    /*
+     * The following check can be done before thread redirection, because we
+     * are reading from an item which is readonly, i.e. will never change
+     * during the lifetime of the channel.
+     */
+
+    if (!(rtPtr->methods & FLAG(METH_READ))) {
+	SetChannelErrorStr(rtPtr->chan, msg_read_unsup);
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    gotBytes = 0;
+
+    while (toRead > 0) {
+	/* Loop until the request is satisfied (or no data available from
+	 * below, possibly EOF).
+	 */
+
+	copied    = ResultCopy (&rtPtr->result, (unsigned char*) buf, toRead);
+	toRead   -= copied;
+	buf      += copied;
+	gotBytes += copied;
+
+	if (toRead == 0) {
+	    return gotBytes;
+	}
+
+	/*
+	 * The buffer is exhausted, but the caller wants even more. We now
+	 * have to go to the underlying channel, get more bytes and then
+	 * transform them for delivery. We may not get that we want (full EOF
+	 * or temporary out of data).
+	 */
+
+	/*
+	 * Length (rtPtr->result) == 0, toRead > 0 here. Use 'buf'! as target
+	 * to store the intermediary information read from the parent channel.
+	 *
+	 * Ask the transform how much data it allows us to read from the
+	 * underlying channel. This feature allows the transform to signal EOF
+	 * upstream although there is none downstream. Useful to control an
+	 * unbounded 'fcopy' for example, either through counting bytes, or by
+	 * pattern matching.
+	 */
+
+	if ((rtPtr->methods & FLAG(METH_LIMIT))) {
+	    int maxRead = -1;
+	    if (!TransformLimit (rtPtr, errorCodePtr, &maxRead)) {
+		return -1;
+	    }
+	    if (maxRead == 0) {
+		SetChannelErrorStr(rtPtr->chan, msg_read_badlimit);
+		return -1;
+	    } else if (maxRead > 0) {
+		if (maxRead < toRead) {
+		    toRead = maxRead;
+		}
+	    } /* else: 'maxRead < 0' == Accept the current value of toRead */
+	}
+
+	if (toRead <= 0) {
+	    return gotBytes;
+	}
+
+	read = Tcl_ReadRaw (rtPtr->parent, buf, toRead);
+	if (read < 0) {
+	    /* Report errors to caller.
+	     * The state of the seek system is unchanged!
+	     */
+
+	    if ((Tcl_GetErrno () == EAGAIN) && (gotBytes > 0)) {
+		/* EAGAIN is a special situation.  If we had some data
+		 * before we report that instead of the request to re-try.
+		 */
+
+		return gotBytes;
+	    }
+
+	    *errorCodePtr = Tcl_GetErrno ();
+	    return -1;      
+	}
+
+	if (read == 0) {
+	    /*
+	     * Check wether we hit on EOF in 'parent' or not. If not
+	     * differentiate between blocking and non-blocking modes. In
+	     * non-blocking mode we ran temporarily out of data. Signal this
+	     * to the caller via EWOULDBLOCK and error return (-1). In the
+	     * other cases we simply return what we got and let the caller
+	     * wait for more. On the other hand, if we got an EOF we have to
+	     * convert and flush all waiting partial data.
+	     */
+
+	    if (!Tcl_Eof (rtPtr->parent)) {
+		/* The state of the seek system is unchanged! */
+
+		if ((gotBytes == 0) && rtPtr->nonblocking) {
+		    *errorCodePtr = EWOULDBLOCK;
+		    return -1;
+		} else {
+		    return gotBytes;
+		}
+	    } else {
+		/* Eof in parent */
+		if (rtPtr->readIsDrained) {
+		    return gotBytes;
+		}
+
+		/*
+		 * Now this is a bit different. The partial data waiting is
+		 * converted and returned.
+		 */
+
+		if (HAS(rtPtr->methods, METH_DRAIN)) {
+		    if(!TransformDrain (rtPtr, errorCodePtr)) {
+			return -1;
+		    }
+		}
+
+		if (ResultLength (&rtPtr->result) == 0) {
+		    /* The drain delivered nothing */
+		    return gotBytes;
+		}
+		continue; /* at: while (toRead > 0) */
+	    }
+	} /* read == 0 */
+
+	/*
+	 * Transform the read chunk, which was not empty. Anything we got back
+	 * is a transformation result is put into our buffers, and the next
+	 * iteration will put it into the result.
+	 */
+
+	if (!TransformRead (rtPtr, errorCodePtr, buf, read)) {
+	    return -1;
+	}
+    } /* while toRead > 0 */
+
+    return gotBytes;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectOutput --
+ *
+ *	This function is invoked when data is writen to the channel.
+ *
+ * Results:
+ *	The number of bytes actually written.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectOutput(
+    ClientData clientData,
+    const char *buf,
+    int toWrite,
+    int *errorCodePtr)
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+
+    /*
+     * The following check can be done before thread redirection, because we
+     * are reading from an item which is readonly, i.e. will never change
+     * during the lifetime of the channel.
+     */
+
+    if (!(rtPtr->methods & FLAG(METH_WRITE))) {
+	SetChannelErrorStr(rtPtr->chan, msg_write_unsup);
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    if (toWrite == 0) {
+	/* Nothing came in to write, ignore the call
+	 */
+	return 0;
+    }
+
+    /*
+     * Discard partial data in the input buffers, i.e. on the read side. Like
+     * we do when explicitly seeking as well.
+     */
+
+    if ((rtPtr->methods & FLAG(METH_CLEAR))) {
+	TransformClear (rtPtr);
+    }
+
+    /*
+     * Hand the data to the transformation itself. Anything it deigned to
+     * return to us is a (partial) transformation result and written to the
+     * parent channel for further processing.
+     */
+
+    if (!TransformWrite (rtPtr, errorCodePtr, (unsigned char*) buf, toWrite)) {
+	return -1;
+    }
+
+    *errorCodePtr = EOK;
+    return toWrite;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectSeekWide / ReflectSeek --
+ *
+ *	This function is invoked when the user wishes to seek on the channel.
+ *
+ * Results:
+ *	The new location of the access point.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, per the parent channel, and the called scripts.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+ReflectSeekWide(
+    ClientData clientData,
+    Tcl_WideInt offset,
+    int seekMode,
+    int *errorCodePtr)
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+    Channel* parent = (Channel*) rtPtr->parent;
+    Tcl_WideInt curPos;		/* Position on the device. */
+
+    Tcl_DriverSeekProc *seekProc      =
+	Tcl_ChannelSeekProc(Tcl_GetChannelType (rtPtr->parent));
+
+    /*
+     * Fail if the parent channel is not seekable.
+     */
+
+    if (seekProc == NULL) {
+	Tcl_SetErrno(EINVAL);
+	return Tcl_LongAsWide(-1);
+    }
+
+    /*
+     * Check if we can leave out involving the Tcl level, i.e. transformation
+     * handler. This is true for tell requests, and transformations which
+     * support neither flush, nor drain. For these cases we can pass the
+     * request down and the result back up unchanged.
+     */
+
+    if (
+	((seekMode != SEEK_CUR) || (offset != 0)) &&
+	(HAS(rtPtr->methods, METH_CLEAR) ||
+	 HAS(rtPtr->methods, METH_FLUSH))
+	) {
+	/*
+	 * Neither a tell request, nor clear/flush both not supported.  We
+	 * have to go through the Tcl level to clear and/or flush the
+	 * transformation.
+	 */
+
+	if ((rtPtr->methods & FLAG(METH_CLEAR))) {
+	    TransformClear (rtPtr);
+	}
+
+	/*
+	 * When flushing the transform for seeking the generated results are
+	 * irrelevant. We cannot put them into the channel, this would move
+	 * the location, throwing it off with regard to where we are and are
+	 * seeking to.
+	 */
+
+	if (HAS(rtPtr->methods, METH_FLUSH)) {
+	    if (!TransformFlush (rtPtr, errorCodePtr, FLUSH_DISCARD)) {
+		return -1;
+	    }
+	}
+    }
+
+    /*
+     * Now seek to the new position in the channel as requested by the
+     * caller. Note that we prefer the wideSeekProc if that is available and
+     * non-NULL...
+     */
+
+    if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
+	parent->typePtr->wideSeekProc != NULL) {
+	curPos = (parent->typePtr->wideSeekProc) (parent->instanceData,
+						  offset, seekMode, errorCodePtr);
+    } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
+	       offset > Tcl_LongAsWide(LONG_MAX)) {
+	*errorCodePtr = EOVERFLOW;
+	curPos = Tcl_LongAsWide(-1);
+    } else {
+	curPos = Tcl_LongAsWide((parent->typePtr->seekProc) (
+							     parent->instanceData, Tcl_WideAsLong(offset), seekMode,
+							     errorCodePtr));
+    }
+    if (curPos == Tcl_LongAsWide(-1)) {
+	Tcl_SetErrno(*errorCodePtr);
+    }
+
+    *errorCodePtr = EOK;
+    return curPos;
+}
+
+static int
+ReflectSeek(
+    ClientData clientData,
+    long offset,
+    int seekMode,
+    int *errorCodePtr)
+{
+    /*
+     * This function can be invoked from a transformation which is based on
+     * standard seeking, i.e. non-wide. Because of this we have to implement
+     * it, a dummy is not enough. We simply delegate the call to the wide
+     * routine.
+     */
+
+    return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
+	    errorCodePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectWatch --
+ *
+ *	This function is invoked to tell the channel what events the I/O
+ *	system is interested in.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReflectWatch(
+    ClientData clientData,
+    int mask)
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+    Tcl_DriverWatchProc* watchProc;
+
+    watchProc = Tcl_ChannelWatchProc (Tcl_GetChannelType (rtPtr->parent));
+    (*watchProc) (Tcl_GetChannelInstanceData(rtPtr->parent),
+		  mask);
+
+    /*
+     * Management of the internal timer.
+     */
+
+    if (!(mask & TCL_READABLE) || (ResultLength(&rtPtr->result) == 0)) {
+	/*
+	 * A pending timer may exist, but either is there no (more) interest
+	 * in the events it generates or nothing is available for
+	 * reading. Remove it, if existing.
+	 */
+
+	TimerKill (rtPtr);
+    } else {
+	/*
+	 * There might be no pending timer, but there is interest in readable
+	 * events and we actually have data waiting, so generate a timer to
+	 * flush that if it does not exist.
+	 */
+
+	TimerSetup (rtPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectBlock --
+ *
+ *	This function is invoked to tell the channel which blocking behaviour
+ *	is required of it.
+ *
+ * Results:
+ *	A posix error number.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectBlock(
+    ClientData clientData,
+    int nonblocking)
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+
+    /*
+     * Transformations simply record the blocking mode in their C level
+     * structure for use by --> ReflectInput. The Tcl level doesn't see this
+     * information or change. As such thread forwarding is not required.
+     */
+
+    rtPtr->nonblocking = nonblocking;
+    return EOK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectSetOption --
+ *
+ *	This function is invoked to configure a channel option.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side effects:
+ *	Arbitrary, per the parent channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectSetOption(
+    ClientData clientData,	/* Channel to query */
+    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
+    const char *optionName,	/* Name of requested option */
+    const char *newValue)	/* The new value */
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+
+    /*
+     * Transformations have no options. Thus the call is passed down unchanged
+     * to the parent channel for processing. Its results are passed back
+     * unchanged as well. This all happens in the thread we are in. As the Tcl
+     * level is not involved there is no need for thread forwarding.
+     */
+
+    Tcl_DriverSetOptionProc *setOptionProc = 
+      Tcl_ChannelSetOptionProc (Tcl_GetChannelType (rtPtr->parent));
+
+    if (setOptionProc != NULL) {
+      return (*setOptionProc) (Tcl_GetChannelInstanceData (rtPtr->parent),
+			       interp, optionName, newValue);
+    } else {
+      return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectGetOption --
+ *
+ *	This function is invoked to retrieve all or a channel options.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side effects:
+ *	Arbitrary, per the parent channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectGetOption(
+    ClientData clientData,	/* Channel to query */
+    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
+    const char *optionName,	/* Name of reuqested option */
+    Tcl_DString *dsPtr)		/* String to place the result into */
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+
+    /*
+     * Transformations have no options. Thus the call is passed down unchanged
+     * to the parent channel for processing. Its results are passed back
+     * unchanged as well. This all happens in the thread we are in. As the Tcl
+     * level is not involved there is no need for thread forwarding.
+     *
+     * Note that the parent not having a driver for option retrieval is not an
+     * immediate error. A query for all options is ok. Only a request for a
+     * specific option has to fail.
+     */
+
+    Tcl_DriverGetOptionProc *getOptionProc = 
+      Tcl_ChannelGetOptionProc (Tcl_GetChannelType (rtPtr->parent));
+
+    if (getOptionProc != NULL) {
+      return (*getOptionProc) (Tcl_GetChannelInstanceData (rtPtr->parent),
+			       interp, optionName, dsPtr);
+    } else if (optionName == (char*) NULL) {
+      return TCL_OK;
+    } else {
+      return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectHandle --
+ *
+ *	This function is invoked to retrieve the associated file handle.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side effects:
+ *	Arbitrary, per the parent channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectHandle(
+	      ClientData  clientData,
+	      int         direction,
+	      ClientData* handlePtr)
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+
+    /*
+     * Transformations have no handle of their own. As such we simply query
+     * the parent channel for it. This way the qery will ripple down through
+     * all transformations until reaches the base channel. Which then returns
+     * its handle, or fails. The former will then ripple up the stack.
+     *
+     * This all happens in the thread we are in. As the Tcl level is not
+     * involved no forwarding is required.
+     */
+
+    return Tcl_GetChannelHandle (rtPtr->parent, direction, handlePtr);
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectNotify --
+ *
+ *	This function is invoked to reported incoming events.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side effects:
+ *	Arbitrary, per the parent channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectNotify(
+	      ClientData clientData,
+	      int mask)
+{
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
+
+    /*
+     * An event occured in the underlying channel.
+     *
+     * We delete our timer. It was not fired, yet we are here, so the channel
+     * below generated such an event and we don't have to. The renewal of the
+     * interest after the execution of channel handlers will eventually cause
+     * us to recreate the timer (in ReflectWatch).
+     */
+
+    TimerKill (rtPtr);
+
+    /*
+     * Pass to higher layers.
+     */
+
+    return mask;
+}
+
+/*
+ * Helpers. =========================================================
+ */
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DecodeEventMask --
+ *
+ *	This function takes an internal bitmask of events and constructs the
+ *	equivalent list of event items.
+ *
+ * Results:
+ *	A Tcl_Obj reference. The object will have a refCount of one. The user
+ *	has to decrement it to release the object.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ * DUPLICATE of 'DecodeEventMask' in tclIORChan.c
+ */
+
+static Tcl_Obj *
+DecodeEventMask(
+    int mask)
+{
+    register const char *eventStr;
+    Tcl_Obj *evObj;
+
+    switch (mask & RANDW) {
+    case RANDW:
+	eventStr = "read write";
+	break;
+    case TCL_READABLE:
+	eventStr = "read";
+	break;
+    case TCL_WRITABLE:
+	eventStr = "write";
+	break;
+    default:
+	eventStr = "";
+	break;
+    }
+
+    evObj = Tcl_NewStringObj(eventStr, -1);
+    Tcl_IncrRefCount(evObj);
+    return evObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewReflectedTransform --
+ *
+ *	This function is invoked to allocate and initialize the instance data
+ *	of a new reflected channel.
+ *
+ * Results:
+ *	A heap-allocated channel instance.
+ *
+ * Side effects:
+ *	Allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedTransform *
+NewReflectedTransform(
+    Tcl_Interp *interp,
+    Tcl_Obj *cmdpfxObj,
+    int mode,
+    Tcl_Obj *handleObj,
+    Tcl_Channel parentChan)
+{
+    ReflectedTransform *rtPtr;
+    int listc;
+    Tcl_Obj **listv;
+    int i;
+
+    rtPtr = (ReflectedTransform *) ckalloc(sizeof(ReflectedTransform));
+
+    /* rtPtr->chan: Assigned by caller. Dummy data here. */
+    /* rtPtr->methods: Assigned by caller. Dummy data here. */
+
+    rtPtr->chan = NULL;
+    rtPtr->methods = 0;
+#ifdef TCL_THREADS
+    rtPtr->thread = Tcl_GetCurrentThread();
+#endif
+    rtPtr->parent = parentChan;
+    rtPtr->interp = interp;
+    rtPtr->handle = handleObj;
+    Tcl_IncrRefCount(handleObj);
+    rtPtr->timer  = (Tcl_TimerToken) NULL;
+    rtPtr->mode = 0;
+    rtPtr->readIsDrained = 0;
+    rtPtr->nonblocking = 
+	(((Channel*) parentChan)->state->flags & CHANNEL_NONBLOCKING);
+    /* Query parent for current blocking mode. */
+
+    ResultInit (&rtPtr->result);
+
+    /*
+     * Method placeholder.
+     */
+
+    /* ASSERT: cmdpfxObj is a Tcl List */
+
+    Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
+
+    /*
+     * See [==] as well.
+     * Storage for the command prefix and the additional words required for
+     * the invocation of methods in the command handler.
+     *
+     * listv [0] [listc-1] | [listc]  [listc+1] |
+     * argv  [0]   ... [.] | [argc-2] [argc-1]  | [argc]  [argc+2]
+     *       cmd   ... pfx | method   chan      | detail1 detail2
+     */
+
+    rtPtr->argc = listc + 2;
+    rtPtr->argv = (Tcl_Obj**) ckalloc(sizeof(Tcl_Obj*) * (listc+4));
+
+    /*
+     * Duplicate object references.
+     */
+
+    for (i=0; i<listc ; i++) {
+	Tcl_Obj *word = rtPtr->argv[i] = listv[i];
+	Tcl_IncrRefCount(word);
+    }
+
+    i++;				/* Skip placeholder for method */
+
+    /*
+     * See [x] in FreeReflectedTransform for release
+     */
+    rtPtr->argv[i] = handleObj;
+    Tcl_IncrRefCount(handleObj);
+
+    /*
+     * The next two objects are kept empty, varying arguments.
+     */
+
+    /*
+     * Initialization complete.
+     */
+
+    return rtPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NextHandle --
+ *
+ *	This function is invoked to generate a channel handle for a new
+ *	reflected channel.
+ *
+ * Results:
+ *	A Tcl_Obj containing the string of the new channel handle. The
+ *	refcount of the returned object is -- zero --.
+ *
+ * Side effects:
+ *	May allocate memory. Mutex protected critical section locks out other
+ *	threads for a short time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NextHandle(void)
+{
+    /*
+     * Count number of generated reflected channels. Used for id generation.
+     * Ids are never reclaimed and there is no dealing with wrap around. On
+     * the other hand, "unsigned long" should be big enough except for
+     * absolute longrunners (generate a 100 ids per second => overflow will
+     * occur in 1 1/3 years).
+     */
+
+    TCL_DECLARE_MUTEX(rtCounterMutex)
+    static unsigned long rtCounter = 0;
+    Tcl_Obj *resObj;
+
+    Tcl_MutexLock(&rtCounterMutex);
+    resObj = Tcl_ObjPrintf("rt%lu", rtCounter);
+    rtCounter++;
+    Tcl_MutexUnlock(&rtCounterMutex);
+
+    return resObj;
+}
+
+static void
+FreeReflectedTransform(
+    ReflectedTransform *rtPtr)
+{
+    int i, n;
+
+    TimerKill   (rtPtr);
+    ResultClear (&rtPtr->result);
+
+    Tcl_DecrRefCount(rtPtr->handle);
+    rtPtr->handle = NULL;
+
+    n = rtPtr->argc - 2;
+    for (i=0; i<n; i++) {
+	Tcl_DecrRefCount(rtPtr->argv[i]);
+    }
+
+    /*
+     * See [x] in NewReflectedTransform for lock
+     * n+1 = argc-1.
+     */
+    Tcl_DecrRefCount(rtPtr->argv[n+1]);
+
+    ckfree((char*) rtPtr->argv);
+    ckfree((char*) rtPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvokeTclMethod --
+ *
+ *	This function is used to invoke the Tcl level of a reflected channel.
+ *	It handles all the command assembly, invokation, and generic state and
+ *	result mgmt. It does *not* handle thread redirection; that is the
+ *	responsibility of clients of this function.
+ *
+ * Results:
+ *	Result code and data as returned by the method.
+ *
+ * Side effects:
+ *	Arbitrary, as it calls upon a Tcl script.
+ *
+ *----------------------------------------------------------------------
+ * Semi-DUPLICATE of 'InvokeTclMethod' in tclIORChan.c
+ * - Semi because different structures are used.
+ * - Still possible to factor out the commonalities into a separate structure.
+ */
+
+static int
+InvokeTclMethod(
+    ReflectedTransform *rtPtr,
+    const char *method,
+    Tcl_Obj *argOneObj,		/* NULL'able */
+    Tcl_Obj *argTwoObj,		/* NULL'able */
+    Tcl_Obj **resultObjPtr)	/* NULL'able */
+{
+    int cmdc;			/* #words in constructed command */
+    Tcl_Obj *methObj = NULL;	/* Method name in object form */
+    Tcl_InterpState sr;		/* State of handler interp */
+    int result;			/* Result code of method invokation */
+    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
+
+    if (!rtPtr->interp) {
+	/*
+	 * The transform is marked as dead. Bail out immediately, with an
+	 * appropriate error.
+	 */
+
+	if (resultObjPtr != NULL) {
+	    resObj = Tcl_NewStringObj(msg_dstlost,-1);
+	    *resultObjPtr = resObj;
+	    Tcl_IncrRefCount(resObj);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     * NOTE (5): Decide impl. issue: Cache objects with method names?
+     * Requires TSD data as reflections can be created in many different
+     * threads.
+     * NO: Caching of command resolutions means storage per channel.
+     */
+
+    /*
+     * Insert method into the pre-allocated area, after the command prefix,
+     * before the channel id.
+     */
+
+    methObj = Tcl_NewStringObj(method, -1);
+    Tcl_IncrRefCount(methObj);
+    rtPtr->argv[rtPtr->argc - 2] = methObj;
+
+    /*
+     * Append the additional argument containing method specific details
+     * behind the channel id. If specified.
+     */
+
+    cmdc = rtPtr->argc;
+    if (argOneObj) {
+	Tcl_IncrRefCount(argOneObj);
+	rtPtr->argv[cmdc] = argOneObj;
+	cmdc++;
+	if (argTwoObj) {
+	    Tcl_IncrRefCount(argTwoObj);
+	    rtPtr->argv[cmdc] = argTwoObj;
+	    cmdc++;
+	}
+    }
+
+    /*
+     * And run the handler... This is done in auch a manner which leaves any
+     * existing state intact.
+     */
+
+    sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
+    Tcl_Preserve(rtPtr->interp);
+    result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);
+
+    /*
+     * We do not try to extract the result information if the caller has no
+     * interest in it. I.e. there is no need to put effort into creating
+     * something which is discarded immediately after.
+     */
+
+    if (resultObjPtr) {
+	if (result == TCL_OK) {
+	    /*
+	     * Ok result taken as is, also if the caller requests that there
+	     * is no capture.
+	     */
+
+	    resObj = Tcl_GetObjResult(rtPtr->interp);
+	} else {
+	    /*
+	     * Non-ok result is always treated as an error. We have to capture
+	     * the full state of the result, including additional options.
+	     *
+	     * This is complex and ugly, and would be completely unnecessary
+	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
+	     */
+	    if (result != TCL_ERROR) {
+		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
+		int cmdLen;
+		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
+
+		Tcl_IncrRefCount(cmd);
+		Tcl_ResetResult(rtPtr->interp);
+		Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
+			"chan handler returned bad code: %d", result));
+		Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
+		Tcl_DecrRefCount(cmd);
+		result = TCL_ERROR;
+	    }
+	    Tcl_AppendObjToErrorInfo(rtPtr->interp, Tcl_ObjPrintf(
+		    "\n    (chan handler subcommand \"%s\")", method));
+	    resObj = MarshallError(rtPtr->interp);
+	}
+	Tcl_IncrRefCount(resObj);
+    }
+    Tcl_RestoreInterpState(rtPtr->interp, sr);
+    Tcl_Release(rtPtr->interp);
+
+    /*
+     * Cleanup of the dynamic parts of the command.
+     */
+
+    Tcl_DecrRefCount(methObj);
+    if (argOneObj) {
+	Tcl_DecrRefCount(argOneObj);
+	if (argTwoObj) {
+	    Tcl_DecrRefCount(argTwoObj);
+	}
+    }
+
+    /*
+     * The resObj has a ref count of 1 at this location. This means that the
+     * caller of InvokeTclMethod has to dispose of it (but only if it was
+     * returned to it).
+     */
+
+    if (resultObjPtr != NULL) {
+	*resultObjPtr = resObj;
+    }
+
+    /*
+     * There no need to handle the case where nothing is returned, because for
+     * that case resObj was not set anyway.
+     */
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetReflectedTransformMap --
+ *
+ *	Gets and potentially initializes the reflected channel map for an
+ *	interpreter.
+ *
+ * Results:
+ *	A pointer to the map created, for use by the caller.
+ *
+ * Side effects:
+ *	Initializes the reflected channel map for an interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedTransformMap *
+GetReflectedTransformMap(
+    Tcl_Interp *interp)
+{
+    ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL);
+
+    if (rtmPtr == NULL) {
+	rtmPtr = (ReflectedTransformMap *) ckalloc(sizeof(ReflectedTransformMap));
+	Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
+	Tcl_SetAssocData(interp, RTMKEY,
+		(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
+    }
+    return rtmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteReflectedTransformMap --
+ *
+ *	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
+DeleteReflectedTransformMap(
+    ClientData clientData,	/* The per-interpreter data structure. */
+    Tcl_Interp *interp)		/* The interpreter being deleted. */
+{
+    ReflectedTransformMap *rtmPtr; /* The map */
+    Tcl_HashSearch hSearch;	 /* Search variable. */
+    Tcl_HashEntry *hPtr;	 /* Search variable. */
+    ReflectedTransform *rtPtr;
+
+#ifdef TCL_THREADS
+    ForwardingResult *resultPtr;
+    ForwardingEvent *evPtr;
+    ForwardParam *paramPtr;
+#endif
+
+    /*
+     * Delete all entries. The channels may have been closed already, or will
+     * be closed later, by the standard IO finalization of an interpreter
+     * under destruction. Except for the channels which were moved to a
+     * different interpreter and/or thread. They do not exist from the IO
+     * systems point of view and will not get closed. Therefore mark all as
+     * dead so that any future access will cause a proper error. For channels
+     * in a different thread we actually do the same as
+     * DeleteThreadReflectedTransformMap(), just restricted to the channels of
+     * this interp.
+     */
+
+    rtmPtr = clientData;
+    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
+	    hPtr != NULL;
+	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
+	rtPtr = (ReflectedTransform *) Tcl_GetHashValue (hPtr);
+
+	//fprintf(stdout,"[%ld] dd t-rcm %p /h %p  /rt %p\n", (long)Tcl_GetCurrentThread(),rtmPtr,hPtr,rtPtr);fflush(stdout);
+
+
+	rtPtr->interp = NULL;
+	Tcl_DeleteHashEntry(hPtr);
+    }
+    Tcl_DeleteHashTable(&rtmPtr->map);
+    ckfree((char *) &rtmPtr->map);
+
+#ifdef TCL_THREADS
+    /*
+     * The origin interpreter for one or more reflected channels is gone.
+     */
+
+    /*
+     * Go through the list of pending results and cancel all whose events were
+     * destined for this interpreter. While this is in progress we block any
+     * other access to the list of pending results.
+     */
+
+    Tcl_MutexLock(&rtForwardMutex);
+
+    for (resultPtr = forwardList;
+	    resultPtr != NULL;
+	    resultPtr = resultPtr->nextPtr) {
+	if (resultPtr->dsti != interp) {
+	    /*
+	     * Ignore results/events for other interpreters.
+	     */
+
+	    continue;
+	}
+
+	/*
+	 * The receiver for the event exited, before processing the event. We
+	 * detach the result now, wake the originator up and signal failure.
+	 */
+
+	evPtr = resultPtr->evPtr;
+	paramPtr = evPtr->param;
+
+	evPtr->resultPtr = NULL;
+	resultPtr->evPtr = NULL;
+	resultPtr->result = TCL_ERROR;
+
+	ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+	Tcl_ConditionNotify(&resultPtr->done);
+    }
+
+    /*
+     * Get the map of all channels handled by the current thread. This is a
+     * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
+     * through the channels and remove all which were handled by this
+     * interpreter. They have already been marked as dead.
+     */
+
+    rtmPtr = GetThreadReflectedTransformMap();
+    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
+	    hPtr != NULL;
+	    hPtr = Tcl_NextHashEntry(&hSearch)) {
+	rtPtr = (ReflectedTransform *) Tcl_GetHashValue (hPtr);
+
+	if (rtPtr->interp != interp) {
+	    /*
+	     * Ignore entries for other interpreters.
+	     */
+
+	    continue;
+	}
+
+	Tcl_DeleteHashEntry(hPtr);
+    }
+
+    Tcl_MutexUnlock(&rtForwardMutex);
+#endif
+}
+
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetThreadReflectedTransformMap --
+ *
+ *	Gets and potentially initializes the reflected channel map for a
+ *	thread.
+ *
+ * Results:
+ *	A pointer to the map created, for use by the caller.
+ *
+ * Side effects:
+ *	Initializes the reflected channel map for a thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectedTransformMap *
+GetThreadReflectedTransformMap(void)
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    if (!tsdPtr->rtmPtr) {
+	tsdPtr->rtmPtr = (ReflectedTransformMap *)
+		ckalloc(sizeof(ReflectedTransformMap));
+	Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
+	Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
+    }
+
+    return tsdPtr->rtmPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteThreadReflectedTransformMap --
+ *
+ *	Deletes the channel table for a thread. This procedure is invoked when
+ *	a thread is deleted. The channels have already been marked as dead, in
+ *      DeleteReflectedTransformMap().
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes the hash table of channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteThreadReflectedTransformMap(
+    ClientData clientData)	/* The per-thread data structure. */
+{
+    Tcl_HashSearch hSearch;	 /* Search variable. */
+    Tcl_HashEntry *hPtr;	 /* Search variable. */
+    Tcl_ThreadId self = Tcl_GetCurrentThread();
+    ReflectedTransformMap *rtmPtr; /* The map */
+    ForwardingResult *resultPtr;
+
+    /*
+     * The origin thread for one or more reflected channels is gone.
+     * NOTE: If this function is called due to a thread getting killed the
+     *       per-interp DeleteReflectedTransformMap is apparently not called.
+     */
+
+    /*
+     * Go through the list of pending results and cancel all whose events were
+     * destined for this thread. While this is in progress we block any
+     * other access to the list of pending results.
+     */
+
+    Tcl_MutexLock(&rtForwardMutex);
+
+    for (resultPtr = forwardList;
+	    resultPtr != NULL;
+	    resultPtr = resultPtr->nextPtr) {
+	ForwardingEvent *evPtr;
+	ForwardParam *paramPtr;
+
+	if (resultPtr->dst != self) {
+	    /*
+	     * Ignore results/events for other threads.
+	     */
+
+	    continue;
+	}
+
+	/*
+	 * The receiver for the event exited, before processing the event. We
+	 * detach the result now, wake the originator up and signal failure.
+	 */
+
+	evPtr = resultPtr->evPtr;
+	paramPtr = evPtr->param;
+
+	evPtr->resultPtr = NULL;
+	resultPtr->evPtr = NULL;
+	resultPtr->result = TCL_ERROR;
+
+	ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+	Tcl_ConditionNotify(&resultPtr->done);
+    }
+
+    /*
+     * Get the map of all channels handled by the current thread. This is a
+     * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
+     * through the channels, remove all, mark them as dead.
+     */
+
+    rtmPtr = GetThreadReflectedTransformMap();
+    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
+	    hPtr != NULL;
+	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
+	ReflectedTransform *rtPtr = (ReflectedTransform *) Tcl_GetHashValue(hPtr);
+
+	rtPtr->interp = NULL;
+	Tcl_DeleteHashEntry(hPtr);
+    }
+
+    Tcl_MutexUnlock(&rtForwardMutex);
+}
+
+static void
+ForwardOpToOwnerThread(
+    ReflectedTransform *rtPtr,	/* Channel instance */
+    ForwardedOperation op,	/* Forwarded driver operation */
+    const VOID *param)		/* Arguments */
+{
+    Tcl_ThreadId dst = rtPtr->thread;
+    ForwardingEvent *evPtr;
+    ForwardingResult *resultPtr;
+    int result;
+
+    /*
+     * We gather the lock early. This allows us to check the liveness of the
+     * channel without interference from DeleteThreadReflectedTransformMap().
+     */
+
+    Tcl_MutexLock(&rtForwardMutex);
+
+    if (rtPtr->interp == NULL) {
+	/*
+	 * The channel is marked as dead. Bail out immediately, with an
+	 * appropriate error. Do not forget to unlock the mutex on this path.
+	 */
+
+	ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost);
+	Tcl_MutexUnlock(&rtForwardMutex);
+	return;
+    }
+
+    /*
+     * Create and initialize the event and data structures.
+     */
+
+    evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
+    resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
+
+    evPtr->event.proc = ForwardProc;
+    evPtr->resultPtr = resultPtr;
+    evPtr->op = op;
+    evPtr->rtPtr = rtPtr;
+    evPtr->param = (ForwardParam *) param;
+
+    resultPtr->src = Tcl_GetCurrentThread();
+    resultPtr->dst = dst;
+    resultPtr->done = NULL;
+    resultPtr->result = -1;
+    resultPtr->evPtr = evPtr;
+
+    /*
+     * Now execute the forward.
+     */
+
+    TclSpliceIn(resultPtr, forwardList);
+    /* Do not unlock here. That is done by the ConditionWait */
+
+    /*
+     * Ensure cleanup of the event if the origin thread exits while this event
+     * is pending or in progress. Exit of the destination thread is handled by
+     * DeleteThreadReflectionChannelMap(), this is set up by
+     * GetThreadReflectedTransformMap(). This is what we use the 'forwardList'
+     * (see above) for.
+     */
+
+    Tcl_CreateThreadExitHandler(SrcExitProc, (ClientData) evPtr);
+
+    /*
+     * Queue the event and poke the other thread's notifier.
+     */
+
+    Tcl_ThreadQueueEvent(dst, (Tcl_Event *)evPtr, TCL_QUEUE_TAIL);
+    Tcl_ThreadAlert(dst);
+
+    /*
+     * (*) Block until the other thread has either processed the transfer or
+     * rejected it.
+     */
+
+    while (resultPtr->result < 0) {
+	/*
+	 * NOTE (1): Is it possible that the current thread goes away while
+	 * waiting here? IOW Is it possible that "SrcExitProc" is called
+	 * while we are here? See complementary note (2) in "SrcExitProc"
+	 *
+	 * The ConditionWait unlocks the mutex during the wait and relocks it
+	 * immediately after.
+	 */
+
+	Tcl_ConditionWait(&resultPtr->done, &rtForwardMutex, NULL);
+    }
+
+    /*
+     * Unlink result from the forwarder list. No need to lock. Either still
+     * locked, or locked by the ConditionWait
+     */
+
+    TclSpliceOut(resultPtr, forwardList);
+
+    resultPtr->nextPtr = NULL;
+    resultPtr->prevPtr = NULL;
+
+    Tcl_MutexUnlock(&rtForwardMutex);
+    Tcl_ConditionFinalize(&resultPtr->done);
+
+    /*
+     * Kill the cleanup handler now, and the result structure as well, before
+     * returning the success code.
+     *
+     * Note: The event structure has already been deleted by the destination
+     * notifier, after it serviced the event.
+     */
+
+    Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr);
+
+    result = resultPtr->result;
+    ckfree((char*) resultPtr);
+}
+
+static int
+ForwardProc(
+    Tcl_Event *evGPtr,
+    int mask)
+{
+    /*
+     * Notes regarding access to the referenced data.
+     *
+     * In principle the data belongs to the originating thread (see
+     * evPtr->src), however this thread is currently blocked at (*), i.e.
+     * quiescent. Because of this we can treat the data as belonging to us,
+     * without fear of race conditions. I.e. we can read and write as we like.
+     *
+     * The only thing we cannot be sure of is the resultPtr. This can be be
+     * NULLed if the originating thread went away while the event is handled
+     * here now.
+     */
+
+    ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr;
+    ForwardingResult *resultPtr = evPtr->resultPtr;
+    ReflectedTransform *rtPtr = evPtr->rtPtr;
+    Tcl_Interp *interp = rtPtr->interp;
+    ForwardParam *paramPtr = evPtr->param;
+    Tcl_Obj *resObj = NULL;	/* Interp result of InvokeTclMethod */
+    ReflectedTransformMap* rtmPtr; /* Map of reflected channels with handlers in this interp */
+    Tcl_HashEntry* hPtr;         /* Entry in the above map */
+
+    /*
+     * Ignore the event if no one is waiting for its result anymore.
+     */
+
+    if (!resultPtr) {
+	return 1;
+    }
+
+    paramPtr->base.code = TCL_OK;
+    paramPtr->base.msgStr = NULL;
+    paramPtr->base.mustFree = 0;
+
+    switch (evPtr->op) {
+	/*
+	 * The destination thread for the following operations is
+	 * rtPtr->thread, which contains rtPtr->interp, the interp we have to
+	 * call upon for the driver.
+	 */
+
+    case ForwardedClose:
+	/*
+	 * No parameters/results.
+	 */
+
+	if (InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj) != TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	}
+
+	/*
+	 * Freeing is done here, in the origin thread, because the argv[]
+	 * objects belong to this thread. Deallocating them in a different
+	 * thread is not allowed
+	 */
+
+	/*
+	 * Remove the channel from the map before releasing the memory, to
+	 * prevent future accesses (like by 'postevent') from finding and
+	 * dereferencing a dangling pointer.
+	 */
+
+	rtmPtr = GetReflectedTransformMap (interp);
+	hPtr = Tcl_FindHashEntry (&rtmPtr->map, 
+				  Tcl_GetString(rtPtr->handle));
+	Tcl_DeleteHashEntry (hPtr);
+
+	/*
+	 * In a threaded interpreter we manage a per-thread map as well, to
+	 * allow us to survive if the script level pulls the rug out under a
+	 * channel by deleting the owning thread.
+	 */
+
+        rtmPtr = GetThreadReflectedTransformMap();
+	hPtr = Tcl_FindHashEntry (&rtmPtr->map, 
+				  Tcl_GetString(rtPtr->handle));
+	Tcl_DeleteHashEntry (hPtr);
+	FreeReflectedTransform(rtPtr);
+	break;
+
+    case ForwardedInput: {
+	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->transform.buf,
+					      paramPtr->transform.size);
+
+	if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	    paramPtr->transform.size = -1;
+	} else {
+	    /*
+	     * Process a regular return. Contains the transformation result.
+	     * Sent it back to the request originator.
+	     */
+
+	    int bytec;		/* Number of returned bytes */
+	    unsigned char *bytev; /* Array of returned bytes */
+
+	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+	    paramPtr->transform.size = bytec;
+
+	    if (bytec > 0) {
+		paramPtr->transform.buf = ckalloc (bytec);
+		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
+	    } else {
+		paramPtr->transform.buf = NULL;
+	    }
+	}
+	break;
+    }
+
+    case ForwardedOutput: {
+	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->transform.buf,
+					      paramPtr->transform.size);
+
+	if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	    paramPtr->transform.size = -1;
+	} else {
+	    /*
+	     * Process a regular return. Contains the transformation result.
+	     * Sent it back to the request originator.
+	     */
+
+	    int bytec;		/* Number of returned bytes */
+	    unsigned char *bytev; /* Array of returned bytes */
+
+	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+	    paramPtr->transform.size = bytec;
+
+	    if (bytec > 0) {
+		paramPtr->transform.buf = ckalloc (bytec);
+		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
+	    } else {
+		paramPtr->transform.buf = NULL;
+	    }
+	}
+	break;
+    }
+
+    case ForwardedDrain: {
+	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	    paramPtr->transform.size = -1;
+	} else {
+	    /*
+	     * Process a regular return. Contains the transformation result.
+	     * Sent it back to the request originator.
+	     */
+
+	    int bytec;		/* Number of returned bytes */
+	    unsigned char *bytev; /* Array of returned bytes */
+
+	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+	    paramPtr->transform.size = bytec;
+
+	    if (bytec > 0) {
+		paramPtr->transform.buf = ckalloc (bytec);
+		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
+	    } else {
+		paramPtr->transform.buf = NULL;
+	    }
+	}
+	break;
+    }
+
+    case ForwardedFlush: {
+	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	    paramPtr->transform.size = -1;
+	} else {
+	    /*
+	     * Process a regular return. Contains the transformation result.
+	     * Sent it back to the request originator.
+	     */
+
+	    int bytec;		/* Number of returned bytes */
+	    unsigned char *bytev; /* Array of returned bytes */
+
+	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+	    paramPtr->transform.size = bytec;
+
+	    if (bytec > 0) {
+		paramPtr->transform.buf = ckalloc (bytec);
+		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
+	    } else {
+		paramPtr->transform.buf = NULL;
+	    }
+	}
+	break;
+    }
+
+    case ForwardedClear: {
+	(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
+	break;
+    }
+
+    case ForwardedLimit: {
+	Tcl_Obj* resObj;
+
+	if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	    paramPtr->limit.max = -1;
+	} else if (Tcl_GetIntFromObj(interp, resObj, &paramPtr->limit.max) != TCL_OK) {
+	    ForwardSetObjError(paramPtr, MarshallError(interp));
+	    paramPtr->limit.max = -1;
+	}
+
+	Tcl_DecrRefCount(resObj);
+	break;
+    }
+
+    default:
+	/*
+	 * Bad operation code.
+	 */
+	Tcl_Panic("Bad operation code in ForwardProc");
+	break;
+    }
+
+    /*
+     * Remove the reference we held on the result of the invoke, if we had
+     * such.
+     */
+
+    if (resObj != NULL) {
+	Tcl_DecrRefCount(resObj);
+    }
+
+    if (resultPtr) {
+	/*
+	 * Report the forwarding result synchronously to the waiting caller.
+	 * This unblocks (*) as well. This is wrapped into a conditional
+	 * because the caller may have exited in the mean time.
+	 */
+
+	Tcl_MutexLock(&rtForwardMutex);
+	resultPtr->result = TCL_OK;
+	Tcl_ConditionNotify(&resultPtr->done);
+	Tcl_MutexUnlock(&rtForwardMutex);
+    }
+
+    return 1;
+}
+
+static void
+SrcExitProc(
+    ClientData clientData)
+{
+    ForwardingEvent *evPtr = (ForwardingEvent *) clientData;
+    ForwardingResult *resultPtr;
+    ForwardParam *paramPtr;
+
+    /*
+     * NOTE (2): Can this handler be called with the originator blocked?
+     */
+
+    /*
+     * The originator for the event exited. It is not sure if this can happen,
+     * as the originator should be blocked at (*) while the event is in
+     * transit/pending.
+     *
+     * We make sure that the event cannot refer to the result anymore, remove
+     * it from the list of pending results and free the structure. Locking the
+     * access ensures that we cannot get in conflict with "ForwardProc",
+     * should it already execute the event.
+     */
+
+    Tcl_MutexLock(&rtForwardMutex);
+
+    resultPtr = evPtr->resultPtr;
+    paramPtr = evPtr->param;
+
+    evPtr->resultPtr = NULL;
+    resultPtr->evPtr = NULL;
+    resultPtr->result = TCL_ERROR;
+
+    ForwardSetStaticError(paramPtr, msg_send_originlost);
+
+    /*
+     * See below: TclSpliceOut(resultPtr, forwardList);
+     */
+
+    Tcl_MutexUnlock(&rtForwardMutex);
+
+    /*
+     * This unlocks (*). The structure will be spliced out and freed by
+     * "ForwardProc". Maybe.
+     */
+
+    Tcl_ConditionNotify(&resultPtr->done);
+}
+
+static void
+ForwardSetObjError(
+    ForwardParam *paramPtr,
+    Tcl_Obj *obj)
+{
+    int len;
+    const char *msgStr = Tcl_GetStringFromObj(obj, &len);
+
+    len++;
+    ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len));
+    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ *	TimerKill --
+ *
+ *	Timer management. Removes the internal timer
+ *	if it exists.
+ *
+ *	Sideeffects:
+ *		See above.
+ *
+ *	Result:
+ *		None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerKill (ReflectedTransform* rtPtr)
+{
+    if (rtPtr->timer == (Tcl_TimerToken) NULL) return;
+
+    /* Delete an existing flush-out timer, prevent it from firing on a
+     * removed/dead channel.
+     */
+
+    Tcl_DeleteTimerHandler (rtPtr->timer);
+    rtPtr->timer = (Tcl_TimerToken) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ *	TimerSetup --
+ *
+ *	Timer management. Creates the internal timer
+ *	if it does not exist.
+ *
+ *	Sideeffects:
+ *		See above.
+ *
+ *	Result:
+ *		None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerSetup (ReflectedTransform* rtPtr)
+{
+    if (rtPtr->timer != (Tcl_TimerToken) NULL) return;
+
+    rtPtr->timer = Tcl_CreateTimerHandler (FLUSH_DELAY, TimerRun,
+					   (ClientData) rtPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ *	TimerRun --
+ *
+ *	Called by the notifier (-> timer) to flush out
+ *	information waiting in channel buffers.
+ *
+ *	Sideeffects:
+ *		As of 'Tcl_NotifyChannel'.
+ *
+ *	Result:
+ *		None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerRun (ClientData clientData)
+{
+    ReflectedTransform* rtPtr = (ReflectedTransform*) clientData;
+
+    rtPtr->timer = (Tcl_TimerToken) NULL;
+    Tcl_NotifyChannel (rtPtr->chan, TCL_READABLE);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ *	ResultInit --
+ *
+ *	Initializes the specified buffer structure. The
+ *	structure will contain valid information for an
+ *	emtpy buffer.
+ *
+ *	Sideeffects:
+ *		See above.
+ *
+ *	Result:
+ *		None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResultInit (ResultBuffer* r) /* Reference to the structure to initialize */
+{
+    r->used      = 0;
+    r->allocated = 0;
+    r->buf       = (unsigned char*) NULL;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ *	ResultClear --
+ *
+ *	Deallocates any memory allocated by 'ResultAdd'.
+ *
+ *	Sideeffects:
+ *		See above.
+ *
+ *	Result:
+ *		None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResultClear (ResultBuffer* r) /* Reference to the buffer to clear out */
+{
+    r->used = 0;
+
+    if (!r->allocated) return;
+
+    Tcl_Free ((char*) r->buf);
+    r->buf       = (unsigned char*) NULL;
+    r->allocated = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ *	ResultAdd --
+ *
+ *	Adds the bytes in the specified array to the
+ *	buffer, by appending it.
+ *
+ *	Sideeffects:
+ *		See above.
+ *
+ *	Result:
+ *		None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResultAdd (r, buf, toWrite)
+     ResultBuffer*  r;       /* The buffer to extend */
+     unsigned char* buf;     /* The buffer to read from */
+     int            toWrite; /* The number of bytes in 'buf' */
+{
+    if ((r->used + toWrite + 1) > r->allocated) {
+	/* Extension of the internal buffer is required.
+	 * NOTE: Currently linear. Should be doubling to amortize.
+	 */
+
+	if (r->allocated == 0) {
+	    r->allocated = toWrite + RB_INCREMENT;
+	    r->buf       = (unsigned char*) Tcl_Alloc (r->allocated);
+	} else {
+	    r->allocated += toWrite + RB_INCREMENT;
+	    r->buf        = (unsigned char*) Tcl_Realloc((char*) r->buf,
+							 r->allocated);
+	}
+    }
+
+    /* now copy data */
+    memcpy (r->buf + r->used, buf, toWrite);
+    r->used += toWrite;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ *	ResultCopy --
+ *
+ *	Copies the requested number of bytes from the
+ *	buffer into the specified array and removes them
+ *	from the buffer afterward. Copies less if there
+ *	is not enough data in the buffer.
+ *
+ *	Sideeffects:
+ *		See above.
+ *
+ *	Result:
+ *		The number of actually copied bytes,
+ *		possibly less than 'toRead'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ResultCopy (ResultBuffer*  r,      /* The buffer to read from */
+	    unsigned char* buf,    /* The buffer to copy into */
+	    int            toRead) /* Number of requested bytes */
+{
+    int copied;
+
+    if (r->used == 0) {
+	/* Nothing to copy in the case of an empty buffer.
+	 */
+
+	copied = 0;
+	goto done;
+    }
+
+    if (r->used == toRead) {
+	/* We have just enough. Copy everything to the caller.
+	 */
+
+	memcpy ((VOID*) buf, (VOID*) r->buf, toRead);
+	r->used = 0;
+	copied  = toRead;
+	goto done;
+    }
+
+    if (r->used > toRead) {
+	/* The internal buffer contains more than requested.
+	 * Copy the requested subset to the caller, and shift
+	 * the remaining bytes down.
+	 */
+
+	memcpy  ((VOID*) buf,    (VOID*) r->buf,            toRead);
+	memmove ((VOID*) r->buf, (VOID*) (r->buf + toRead), r->used - toRead);
+
+	r->used -= toRead;
+	copied   = toRead;
+	goto done;
+    }
+
+    /* There is not enough in the buffer to satisfy the caller, so
+     * take everything.
+     */
+
+    memcpy ((VOID*) buf, (VOID*) r->buf, r->used);
+    toRead  = r->used;
+    r->used = 0;
+    copied  = toRead;
+
+    /* -- common postwork code ------- */
+
+ done:
+    return copied;
+}
+
+
+static int
+TransformRead (
+       ReflectedTransform* rtPtr,
+       int* errorCodePtr,
+       unsigned char* buf,
+       int toRead)
+{
+    Tcl_Obj* bufObj;
+    Tcl_Obj* resObj;
+    int bytec;			/* Number of returned bytes */
+    unsigned char *bytev;	/* Array of returned bytes */
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	p.transform.buf  = buf;
+	p.transform.size = toRead;
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rtPtr->chan, &p);
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	} else {
+	    *errorCodePtr = EOK;
+	}
+
+	ResultAdd (&rtPtr->result, p.transform.buf, p.transform.size);
+	ckfree (p.transform.buf);
+    } else {
+#endif
+	/* ASSERT: rtPtr->method & FLAG(METH_READ) */
+	/* ASSERT: rtPtr->mode & TCL_READABLE */
+
+	bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead);
+	if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
+	    Tcl_SetChannelError(rtPtr->chan, resObj);
+	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	}
+
+	bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+	ResultAdd (&rtPtr->result, bytev, bytec);
+	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+#ifdef TCL_THREADS
+    }
+#endif
+
+    return 1;
+}
+
+static int
+TransformWrite (
+	ReflectedTransform* rtPtr,
+	int* errorCodePtr,
+	unsigned char* buf,
+	int toWrite)
+{
+    Tcl_Obj *bufObj;
+    Tcl_Obj *resObj;
+    int bytec;			/* Number of returned bytes */
+    unsigned char *bytev;	/* Array of returned bytes */
+    int res;
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	p.transform.buf  = buf;
+	p.transform.size = toWrite;
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rtPtr->chan, &p);
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	} else {
+	    *errorCodePtr = EOK;
+	}
+
+	res = Tcl_WriteRaw (rtPtr->parent,
+			    (char*) p.transform.buf, p.transform.size);
+	ckfree (p.transform.buf);
+    } else {
+#endif
+	/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
+	/* ASSERT: rtPtr->mode & TCL_WRITABLE */
+
+	bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
+	if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+	    *errorCodePtr = EINVAL;
+	    Tcl_SetChannelError(rtPtr->chan, resObj);
+	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+	    return 0;
+	}
+
+	*errorCodePtr = EOK;
+
+	bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+	res   = Tcl_WriteRaw (rtPtr->parent,  (char*) bytev, bytec);
+	Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+#ifdef TCL_THREADS
+    }
+#endif
+
+    if (res < 0) {
+	*errorCodePtr = EINVAL;
+	return 0;
+    }
+
+    return 1;
+}
+
+
+
+static int
+TransformDrain(
+      ReflectedTransform* rtPtr,
+      int* errorCodePtr)
+{
+    Tcl_Obj* resObj;
+    int bytec;			/* Number of returned bytes */
+    unsigned char *bytev;	/* Array of returned bytes */
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rtPtr->chan, &p);
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	} else {
+	    *errorCodePtr = EOK;
+	}
+
+	ResultAdd (&rtPtr->result, p.transform.buf, p.transform.size);
+	ckfree (p.transform.buf);
+    } else {
+#endif
+	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
+	    Tcl_SetChannelError(rtPtr->chan, resObj);
+	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	}
+
+	bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+	ResultAdd (&rtPtr->result, bytev, bytec);
+
+	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+
+#ifdef TCL_THREADS
+    }
+#endif
+
+    rtPtr->readIsDrained = 1;
+    return 1;
+}
+
+
+static int
+TransformFlush(
+      ReflectedTransform* rtPtr,
+      int* errorCodePtr,
+      int  op)
+{
+    Tcl_Obj* resObj;
+    int bytec;			/* Number of returned bytes */
+    unsigned char *bytev;	/* Array of returned bytes */
+    int res;
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedFlush, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rtPtr->chan, &p);
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	} else {
+	    *errorCodePtr = EOK;
+	}
+
+	if (op == FLUSH_WRITE) {
+	    res = Tcl_WriteRaw (rtPtr->parent,
+				(char*) p.transform.buf, p.transform.size);
+	} else {
+	    res = 0;
+	}
+	ckfree(p.transform.buf);
+    } else {
+#endif
+	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
+	    Tcl_SetChannelError(rtPtr->chan, resObj);
+	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	}
+
+	if (op == FLUSH_WRITE) {
+	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+	    res   = Tcl_WriteRaw (rtPtr->parent,  (char*) bytev, bytec);
+	} else {
+	    res = 0;
+	}
+	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+
+#ifdef TCL_THREADS
+    }
+#endif
+    if (res < 0) {
+	*errorCodePtr = EINVAL;
+	return 0;
+    }
+
+    return 1;
+}
+
+static void
+TransformClear (
+	ReflectedTransform* rtPtr)
+{
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
+	return;
+    } else {
+#endif
+	/* ASSERT: rtPtr->method & FLAG(METH_READ) */
+	/* ASSERT: rtPtr->mode & TCL_READABLE */
+
+	(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
+
+#ifdef TCL_THREADS
+    }
+#endif
+
+    rtPtr->readIsDrained = 0;
+    ResultClear (&rtPtr->result);
+}
+
+static int
+TransformLimit (
+	ReflectedTransform* rtPtr,
+	int* errorCodePtr,
+	int* maxPtr)
+{
+    Tcl_Obj* resObj;
+    Tcl_InterpState sr;		/* State of handler interp */
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedLimit, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rtPtr->chan, &p);
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	} else {
+	    *errorCodePtr = EOK;
+	    *maxPtr = p.limit.max;
+	    return 1;
+	}
+    }
+#endif
+
+    /* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
+    /* ASSERT: rtPtr->mode & TCL_WRITABLE */
+
+    if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
+	Tcl_SetChannelError(rtPtr->chan, resObj);
+	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+	*errorCodePtr = EINVAL;
+	return 0;
+    }
+
+    sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
+
+    if (Tcl_GetIntFromObj(rtPtr->interp, resObj, maxPtr) != TCL_OK) {
+	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+	Tcl_SetChannelError(rtPtr->chan, MarshallError(rtPtr->interp));
+	*errorCodePtr = EINVAL;
+
+	Tcl_RestoreInterpState(rtPtr->interp, sr);
+	return 0;
+    }
+
+    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_RestoreInterpState(rtPtr->interp, sr);
+    return 1;
+}
+
+/* DUPLICATE of HaveVersion() in tclIO.c
+ *----------------------------------------------------------------------
+ *
+ * HaveVersion --
+ *
+ *	Return whether a channel type is (at least) of a given version.
+ *
+ * Results:
+ *	True if the minimum version is exceeded by the version actually
+ *	present.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HaveVersion(
+    const Tcl_ChannelType *chanTypePtr,
+    Tcl_ChannelTypeVersion minimumVersion)
+{
+    Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
+
+    return (PTR2INT(actualVersion)) >= (PTR2INT(minimumVersion));
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3ec57b4..3fe993d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.369 2008/05/31 11:42:14 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.370 2008/06/06 19:46:37 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -2744,6 +2744,10 @@ MODULE_SCOPE int	TclChanCreateObjCmd(ClientData clientData,
 MODULE_SCOPE int	TclChanPostEventObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclChanPopObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int	TclChanPushObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
 MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
 MODULE_SCOPE int	TclClockOldscanObjCmd(
 			    ClientData clientData, Tcl_Interp *interp,
diff --git a/generic/tclVar.c b/generic/tclVar.c
index b7bdcaf..6279064 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.162 2008/05/23 21:05:13 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.163 2008/06/06 19:46:37 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -67,8 +67,10 @@ VarHashCreateVar(
 
 #define VarHashFindVar(tablePtr, key) \
     VarHashCreateVar((tablePtr), (key), NULL)
+
 #define VarHashInvalidateEntry(varPtr) \
     ((varPtr)->flags |= VAR_DEAD_HASH)
+
 #define VarHashDeleteEntry(varPtr) \
     Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry))