Merge commit '98acd3f494b28ddd8c345a2bb9311e41e2d56ddd' as 'tcl8.6'

1 files changed, 3427 insertions, 0 deletions

diff --git a/tcl8.6/generic/tclIORTrans.c b/tcl8.6/generic/tclIORTrans.c
new file mode 100644
index 0000000..af86ba5
--- /dev/null
+++ b/tcl8.6/generic/tclIORTrans.c
@@ -0,0 +1,3427 @@
+/*
+ * 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.
+ */
+
+#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.
+ */
+
+static const 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)
+
+/*
+ * Convenience macro to make some casts easier to use.
+ */
+
+#define UCHARP(x)	((unsigned char *) (x))
+
+/*
+ * 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. */
+    int eofPending;		/* Flag: EOF seen down, but not raised up */
+    int dead;			/* Boolean signal that some operations
+				 * should no longer be attempted. */
+    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 *const 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) \
+	do {								\
+	    if ((p)->base.mustFree) {					\
+		ckfree((p)->base.msgStr);				\
+	    }								\
+	} while (0)
+#define PassReceivedErrorInterp(i,p) \
+	do {								\
+	    if ((i) != NULL) {						\
+		Tcl_SetChannelErrorInterp((i),				\
+			Tcl_NewStringObj((p)->base.msgStr, -1));	\
+	    }								\
+	    FreeReceivedError(p);					\
+	} while (0)
+#define PassReceivedError(c,p) \
+	do {								\
+	    Tcl_SetChannelError((c),					\
+		    Tcl_NewStringObj((p)->base.msgStr, -1));		\
+	    FreeReceivedError(p);					\
+	} while (0)
+#define ForwardSetStaticError(p,emsg) \
+	do {								\
+	    (p)->base.code = TCL_ERROR;					\
+	    (p)->base.mustFree = 0;					\
+	    (p)->base.msgStr = (char *) (emsg);				\
+	} while (0)
+#define ForwardSetDynamicError(p,emsg) \
+	do {								\
+	    (p)->base.code = TCL_ERROR;					\
+	    (p)->base.mustFree = 1;					\
+	    (p)->base.msgStr = (char *) (emsg);				\
+	} while (0)
+
+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 void		FreeReflectedTransformArgs(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_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).
+ */
+
+/*
+ * Helper functions encapsulating some of the thread forwarding to make the
+ * control flow in callers easier.
+ */
+
+static void		TimerKill(ReflectedTransform *rtPtr);
+static void		TimerSetup(ReflectedTransform *rtPtr);
+static void		TimerRun(ClientData clientData);
+static int		TransformRead(ReflectedTransform *rtPtr,
+			    int *errorCodePtr, Tcl_Obj *bufObj);
+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);
+
+/*
+ * Operation 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. */
+    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 the
+     * '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);
+    /* assert modeObj.refCount == 1 */
+    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) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "chan handler \"%s initialize\" returned non-list: %s",
+                Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
+	Tcl_DecrRefCount(resObj);
+	goto error;
+    }
+
+    methods = 0;
+    while (listc > 0) {
+	if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
+		"method", TCL_EXACT, &methIndex) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "chan handler \"%s initialize\" returned %s",
+		    Tcl_GetString(cmdObj),
+		    Tcl_GetString(Tcl_GetObjResult(interp))));
+	    Tcl_DecrRefCount(resObj);
+	    goto error;
+	}
+
+	methods |= FLAG(methIndex);
+	listc--;
+    }
+    Tcl_DecrRefCount(resObj);
+
+    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "chan handler \"%s\" does not support all required methods",
+                Tcl_GetString(cmdObj)));
+	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) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "chan handler \"%s\" makes the channel inaccessible",
+                Tcl_GetString(cmdObj)));
+	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))) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "chan handler \"%s\" supports \"drain\" but not \"read\"",
+                Tcl_GetString(cmdObj)));
+	goto error;
+    }
+
+    if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "chan handler \"%s\" supports \"flush\" but not \"write\"",
+                Tcl_GetString(cmdObj)));
+	goto error;
+    }
+
+    Tcl_ResetResult(interp);
+
+    /*
+     * Everything is fine now.
+     */
+
+    rtPtr->methods = methods;
+    rtPtr->mode = mode;
+    rtPtr->chan = Tcl_StackChannel(interp, &tclRTransformType, 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 /* TCL_THREADS */
+
+    /*
+     * Return the channel as the result of the command.
+     */
+
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    Tcl_GetChannelName(rtPtr->chan), -1));
+    return TCL_OK;
+
+  error:
+    /*
+     * We are not going through ReflectClose as we never had a channel
+     * structure.
+     */
+
+    Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+    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]);
+    }
+
+    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 = clientData;
+    int errorCode, errorCodeSet = 0;
+    int result = TCL_OK;	/* 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 (TclInThreadExit()) {
+	/*
+	 * 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;
+
+	    if (result != TCL_OK) {
+		FreeReceivedError(&p);
+	    }
+	}
+#endif /* TCL_THREADS */
+
+	Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+	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) {
+	if (!TransformDrain(rtPtr, &errorCode)) {
+#ifdef TCL_THREADS
+	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+		Tcl_EventuallyFree(rtPtr,
+			(Tcl_FreeProc *) FreeReflectedTransform);
+		return errorCode;
+	    }
+#endif /* TCL_THREADS */
+	    errorCodeSet = 1;
+	    goto cleanup;
+	}
+    }
+
+    if (HAS(rtPtr->methods, METH_FLUSH)) {
+	if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
+#ifdef TCL_THREADS
+	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+		Tcl_EventuallyFree(rtPtr,
+			(Tcl_FreeProc *) FreeReflectedTransform);
+		return errorCode;
+	    }
+#endif /* TCL_THREADS */
+	    errorCodeSet = 1;
+	    goto cleanup;
+	}
+    }
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rtPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
+	result = p.base.code;
+
+	Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+
+	if (result != TCL_OK) {
+	    PassReceivedErrorInterp(interp, &p);
+	    return EINVAL;
+	}
+	return EOK;
+    }
+#endif /* TCL_THREADS */
+
+    /*
+     * Do the actual invokation of "finalize" now; we're in the right thread.
+     */
+
+    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. */
+
+  cleanup:
+
+    /*
+     * 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.
+     *
+     * NOTE: The channel may have been removed from the map already via
+     * the per-interp DeleteReflectedTransformMap exit-handler.
+     */
+
+    if (!rtPtr->dead) {
+	rtmPtr = GetReflectedTransformMap(rtPtr->interp);
+	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+	if (hPtr) {
+	    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.
+	 */
+
+#ifdef TCL_THREADS
+	rtmPtr = GetThreadReflectedTransformMap();
+	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+	if (hPtr) {
+	    Tcl_DeleteHashEntry(hPtr);
+	}
+#endif /* TCL_THREADS */
+    }
+
+    Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+    return errorCodeSet ? errorCode : ((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 = clientData;
+    int gotBytes, copied, readBytes;
+    Tcl_Obj *bufObj;
+
+    /*
+     * 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;
+    }
+
+    Tcl_Preserve(rtPtr);
+
+    /* TODO: Consider a more appropriate buffer size. */
+    bufObj = Tcl_NewByteArrayObj(NULL, toRead);
+    Tcl_IncrRefCount(bufObj);
+    gotBytes = 0;
+    if (rtPtr->eofPending) {
+	goto stop;
+    }
+    rtPtr->readIsDrained = 0;
+    while (toRead > 0) {
+	/*
+	 * Loop until the request is satisfied (or no data available from
+	 * below, possibly EOF).
+	 */
+
+	copied = ResultCopy(&rtPtr->result, UCHARP(buf), toRead);
+	toRead -= copied;
+	buf += copied;
+	gotBytes += copied;
+
+	if (toRead == 0) {
+	    goto stop;
+	}
+
+	if (rtPtr->eofPending) {
+	    goto stop;
+	}
+
+
+	/*
+	 * 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 what we want (full EOF
+	 * or temporarily 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)) {
+		goto error;
+	    }
+	    if (maxRead == 0) {
+		goto stop;
+	    } else if (maxRead > 0) {
+		if (maxRead < toRead) {
+		    toRead = maxRead;
+		}
+	    } /* else: 'maxRead < 0' == Accept the current value of toRead */
+	}
+
+	if (toRead <= 0) {
+	    goto stop;
+	}
+
+
+	readBytes = Tcl_ReadRaw(rtPtr->parent,
+		(char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead);
+	if (readBytes < 0) {
+	    if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) {
+
+		/*
+		 * Down channel is blocked and offers zero additional bytes.
+		 * The nonzero gotBytes already returned makes the total
+		 * operation a valid short read.  Return to caller.
+		 */
+
+		goto stop;
+	    }
+
+	    /*
+	     * Either the down channel is not blocked (a real error)
+	     * or it is and there are gotBytes==0 byte copied so far.
+	     * In either case, pass up the error, so we either report
+	     * any real error, or do not mistakenly signal EOF by
+	     * returning 0 to the caller.
+	     */
+
+	    *errorCodePtr = Tcl_GetErrno();
+	    goto error;
+	}
+
+	if (readBytes == 0) {
+
+	    /*
+	     * Zero returned from Tcl_ReadRaw() always indicates EOF
+	     * on the down channel.
+	     */
+
+	    rtPtr->eofPending = 1;
+
+		/*
+		 * Now this is a bit different. The partial data waiting is
+		 * converted and returned.
+		 */
+
+		if (HAS(rtPtr->methods, METH_DRAIN)) {
+		    if (!TransformDrain(rtPtr, errorCodePtr)) {
+			goto error;
+		    }
+		}
+
+		if (ResultLength(&rtPtr->result) == 0) {
+		    /*
+		     * The drain delivered nothing.
+		     */
+
+		    goto stop;
+		}
+
+		continue; /* at: while (toRead > 0) */
+	} /* readBytes == 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.
+	 */
+
+	Tcl_SetByteArrayLength(bufObj, readBytes);
+	if (!TransformRead(rtPtr, errorCodePtr, bufObj)) {
+	    goto error;
+	}
+	if (Tcl_IsShared(bufObj)) {
+	    Tcl_DecrRefCount(bufObj);
+	    bufObj = Tcl_NewObj();
+	    Tcl_IncrRefCount(bufObj);
+	}
+	Tcl_SetByteArrayLength(bufObj, 0);
+    } /* while toRead > 0 */
+
+ stop:
+    if (gotBytes == 0) {
+	rtPtr->eofPending = 0;
+    }
+    Tcl_DecrRefCount(bufObj);
+    Tcl_Release(rtPtr);
+    return gotBytes;
+
+ error:
+    gotBytes = -1;
+    goto stop;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectOutput --
+ *
+ *	This function is invoked when data is written 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 = 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.
+     */
+
+    Tcl_Preserve(rtPtr);
+
+    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, UCHARP(buf), toWrite)) {
+	Tcl_Release(rtPtr);
+	return -1;
+    }
+
+    *errorCodePtr = EOK;
+    Tcl_Release(rtPtr);
+    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 = 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.
+     */
+
+    Tcl_Preserve(rtPtr);
+
+    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)) {
+		Tcl_Release(rtPtr);
+		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;
+    Tcl_Release(rtPtr);
+    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 = 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 = 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 = 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 TCL_ERROR;
+    }
+    return setOptionProc(Tcl_GetChannelInstanceData(rtPtr->parent), interp,
+	    optionName, newValue);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = 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 == 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 = 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 = 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 = 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 = NULL;
+    rtPtr->mode = 0;
+    rtPtr->readIsDrained = 0;
+    rtPtr->eofPending = 0;
+    rtPtr->nonblocking =
+	    (((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING);
+    rtPtr->dead = 0;
+
+    /*
+     * 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 = 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
+FreeReflectedTransformArgs(
+    ReflectedTransform *rtPtr)
+{
+    int i, n = rtPtr->argc - 2;
+
+    if (n < 0) {
+	return;
+    }
+
+    Tcl_DecrRefCount(rtPtr->handle);
+    rtPtr->handle = NULL;
+
+    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]);
+
+    rtPtr->argc = 1;
+}
+
+static void
+FreeReflectedTransform(
+    ReflectedTransform *rtPtr)
+{
+    TimerKill(rtPtr);
+    ResultClear(&rtPtr->result);
+
+    FreeReflectedTransformArgs(rtPtr);
+
+    ckfree(rtPtr->argv);
+    ckfree(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.
+ *
+ * Contract:
+ *	argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL
+ *	argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL
+ *	resObj.refCount in {0, 1, ...}
+ *
+ *----------------------------------------------------------------------
+ * 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->dead) {
+	/*
+	 * 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.
+     *
+     * Because of the contract there is no need to increment the refcounts.
+     * The objects will survive the Tcl_EvalObjv without change.
+     */
+
+    cmdc = rtPtr->argc;
+    if (argOneObj) {
+	rtPtr->argv[cmdc] = argOneObj;
+	cmdc++;
+	if (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);
+    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);
+    Tcl_Release(rtPtr);
+
+    /*
+     * Cleanup of the dynamic parts of the command.
+     *
+     * The detail objects survived the Tcl_EvalObjv without change because of
+     * the contract. Therefore there is no need to decrement the refcounts. Only
+     * the internal method object has to be disposed of.
+     */
+
+    Tcl_DecrRefCount(methObj);
+
+    /*
+     * 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 = 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 /* TCL_THREADS */
+
+    /*
+     * 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 = Tcl_GetHashValue(hPtr);
+
+	rtPtr->dead = 1;
+	Tcl_DeleteHashEntry(hPtr);
+    }
+    Tcl_DeleteHashTable(&rtmPtr->map);
+    ckfree(&rtmPtr->map);
+
+#ifdef TCL_THREADS
+    /*
+     * The origin interpreter for one or more reflected channels is gone.
+     */
+
+    /*
+     * 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 = Tcl_GetHashValue(hPtr);
+
+	if (rtPtr->interp != interp) {
+	    /*
+	     * Ignore entries for other interpreters.
+	     */
+
+	    continue;
+	}
+
+	rtPtr->dead = 1;
+	FreeReflectedTransformArgs(rtPtr);
+	Tcl_DeleteHashEntry(hPtr);
+    }
+
+    /*
+     * 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;
+	if (evPtr == NULL) {
+	    continue;
+	}
+	paramPtr = evPtr->param;
+
+	evPtr->resultPtr = NULL;
+	resultPtr->evPtr = NULL;
+	resultPtr->result = TCL_ERROR;
+
+	ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+	Tcl_ConditionNotify(&resultPtr->done);
+    }
+    Tcl_MutexUnlock(&rtForwardMutex);
+#endif /* TCL_THREADS */
+}
+
+#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 = 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.
+     */
+
+    /*
+     * 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 = Tcl_GetHashValue(hPtr);
+
+	rtPtr->dead = 1;
+	FreeReflectedTransformArgs(rtPtr);
+	Tcl_DeleteHashEntry(hPtr);
+    }
+    ckfree(rtmPtr);
+
+    /*
+     * 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;
+	if (evPtr == NULL) {
+	    continue;
+	}
+	paramPtr = evPtr->param;
+
+	evPtr->resultPtr = NULL;
+	resultPtr->evPtr = NULL;
+	resultPtr->result = TCL_ERROR;
+
+	ForwardSetStaticError(paramPtr, msg_send_dstlost);
+
+	Tcl_ConditionNotify(&resultPtr->done);
+    }
+    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;
+
+    /*
+     * We gather the lock early. This allows us to check the liveness of the
+     * channel without interference from DeleteThreadReflectedTransformMap().
+     */
+
+    Tcl_MutexLock(&rtForwardMutex);
+
+    if (rtPtr->dead) {
+	/*
+	 * 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 = ckalloc(sizeof(ForwardingEvent));
+    resultPtr = 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->dsti = rtPtr->interp;
+    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, 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, evPtr);
+
+    ckfree(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);
+
+	FreeReflectedTransformArgs(rtPtr);
+	break;
+
+    case ForwardedInput: {
+	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
+		paramPtr->transform.buf, paramPtr->transform.size);
+	Tcl_IncrRefCount(bufObj);
+
+	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;
+	    }
+	}
+
+	Tcl_DecrRefCount(bufObj);
+	break;
+    }
+
+    case ForwardedOutput: {
+	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
+		paramPtr->transform.buf, paramPtr->transform.size);
+	Tcl_IncrRefCount(bufObj);
+
+	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;
+	    }
+	}
+
+	Tcl_DecrRefCount(bufObj);
+	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:
+	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;
+	}
+	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 = 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(len));
+    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
+}
+#endif /* TCL_THREADS */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerKill --
+ *
+ *	Timer management. Removes the internal timer if it exists.
+ *
+ * Side effects:
+ *	See above.
+ *
+ * Result:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerKill(
+    ReflectedTransform *rtPtr)
+{
+    if (rtPtr->timer == NULL) {
+	return;
+    }
+
+    /*
+     * Delete an existing flush-out timer, prevent it from firing on a
+     * removed/dead channel.
+     */
+
+    Tcl_DeleteTimerHandler(rtPtr->timer);
+    rtPtr->timer = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerSetup --
+ *
+ *	Timer management. Creates the internal timer if it does not exist.
+ *
+ * Side effects:
+ *	See above.
+ *
+ * Result:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerSetup(
+    ReflectedTransform *rtPtr)
+{
+    if (rtPtr->timer != NULL) {
+	return;
+    }
+
+    rtPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+	    TimerRun, rtPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TimerRun --
+ *
+ *	Called by the notifier (-> timer) to flush out information waiting in
+ *	channel buffers.
+ *
+ * Side effects:
+ *	As of 'Tcl_NotifyChannel'.
+ *
+ * Result:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimerRun(
+    ClientData clientData)
+{
+    ReflectedTransform *rtPtr = clientData;
+
+    rtPtr->timer = NULL;
+    Tcl_NotifyChannel(rtPtr->chan, TCL_READABLE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultInit --
+ *
+ *	Initializes the specified buffer structure. The structure will contain
+ *	valid information for an emtpy buffer.
+ *
+ * Side effects:
+ *	See above.
+ *
+ * Result:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResultInit(
+    ResultBuffer *rPtr)		/* Reference to the structure to
+				 * initialize. */
+{
+    rPtr->used = 0;
+    rPtr->allocated = 0;
+    rPtr->buf = NULL;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultClear --
+ *
+ *	Deallocates any memory allocated by 'ResultAdd'.
+ *
+ * Side effects:
+ *	See above.
+ *
+ * Result:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResultClear(
+    ResultBuffer *rPtr)		/* Reference to the buffer to clear out */
+{
+    rPtr->used = 0;
+
+    if (!rPtr->allocated) {
+	return;
+    }
+
+    ckfree((char *) rPtr->buf);
+    rPtr->buf = NULL;
+    rPtr->allocated = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ResultAdd --
+ *
+ *	Adds the bytes in the specified array to the buffer, by appending it.
+ *
+ * Side effects:
+ *	See above.
+ *
+ * Result:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ResultAdd(
+    ResultBuffer *rPtr,		/* The buffer to extend */
+    unsigned char *buf,		/* The buffer to read from */
+    int toWrite)		/* The number of bytes in 'buf' */
+{
+    if ((rPtr->used + toWrite + 1) > rPtr->allocated) {
+	/*
+	 * Extension of the internal buffer is required.
+	 * NOTE: Currently linear. Should be doubling to amortize.
+	 */
+
+	if (rPtr->allocated == 0) {
+	    rPtr->allocated = toWrite + RB_INCREMENT;
+	    rPtr->buf = UCHARP(ckalloc(rPtr->allocated));
+	} else {
+	    rPtr->allocated += toWrite + RB_INCREMENT;
+	    rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf,
+		    rPtr->allocated));
+	}
+    }
+
+    /*
+     * Now copy data.
+     */
+
+    memcpy(rPtr->buf + rPtr->used, buf, toWrite);
+    rPtr->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.
+ *
+ * Side effects:
+ *	See above.
+ *
+ * Result:
+ *	The number of actually copied bytes, possibly less than 'toRead'.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ResultCopy(
+    ResultBuffer *rPtr,		/* The buffer to read from */
+    unsigned char *buf,		/* The buffer to copy into */
+    int toRead)			/* Number of requested bytes */
+{
+    int copied;
+
+    if (rPtr->used == 0) {
+	/*
+	 * Nothing to copy in the case of an empty buffer.
+	 */
+
+	copied = 0;
+    } else if (rPtr->used == toRead) {
+	/*
+	 * We have just enough. Copy everything to the caller.
+	 */
+
+	memcpy(buf, rPtr->buf, toRead);
+	rPtr->used = 0;
+	copied = toRead;
+    } else if (rPtr->used > toRead) {
+	/*
+	 * The internal buffer contains more than requested. Copy the
+	 * requested subset to the caller, and shift the remaining bytes down.
+	 */
+
+	memcpy(buf, rPtr->buf, toRead);
+	memmove(rPtr->buf, rPtr->buf + toRead, rPtr->used - toRead);
+
+	rPtr->used -= toRead;
+	copied = toRead;
+    } else {
+	/*
+	 * There is not enough in the buffer to satisfy the caller, so take
+	 * everything.
+	 */
+
+	memcpy(buf, rPtr->buf, rPtr->used);
+	toRead = rPtr->used;
+	rPtr->used = 0;
+	copied = toRead;
+    }
+
+    /* -- common postwork code ------- */
+
+    return copied;
+}
+
+static int
+TransformRead(
+    ReflectedTransform *rtPtr,
+    int *errorCodePtr,
+    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 = (char *) Tcl_GetByteArrayFromObj(bufObj,
+		&(p.transform.size));
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rtPtr->chan, &p);
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	}
+
+	*errorCodePtr = EOK;
+	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
+	ckfree(p.transform.buf);
+	return 1;
+    }
+#endif /* TCL_THREADS */
+
+    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
+    /* ASSERT: rtPtr->mode & TCL_READABLE */
+
+    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 */
+    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 = (char *) buf;
+	p.transform.size = toWrite;
+
+	ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rtPtr->chan, &p);
+	    *errorCodePtr = EINVAL;
+	    return 0;
+	}
+
+	*errorCodePtr = EOK;
+	res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
+		p.transform.size);
+	ckfree(p.transform.buf);
+    } else
+#endif /* TCL_THREADS */
+    {
+	/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
+	/* ASSERT: rtPtr->mode & TCL_WRITABLE */
+
+	bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
+	Tcl_IncrRefCount(bufObj);
+	if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+	    *errorCodePtr = EINVAL;
+	    Tcl_SetChannelError(rtPtr->chan, resObj);
+
+	    Tcl_DecrRefCount(bufObj);
+	    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(bufObj);
+	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+    }
+
+    if (res < 0) {
+	*errorCodePtr = Tcl_GetErrno();
+	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;
+	}
+
+	*errorCodePtr = EOK;
+	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
+	ckfree(p.transform.buf);
+    } else
+#endif /* TCL_THREADS */
+    {
+	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 */
+    }
+
+    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;
+	}
+
+	*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 /* TCL_THREADS */
+    {
+	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 */
+    }
+
+    if (res < 0) {
+	*errorCodePtr = Tcl_GetErrno();
+	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;
+    }
+#endif /* TCL_THREADS */
+
+    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
+    /* ASSERT: rtPtr->mode & TCL_READABLE */
+
+    (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
+
+    rtPtr->readIsDrained = 0;
+    rtPtr->eofPending = 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;
+	}
+
+	*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:
+ */