summaryrefslogtreecommitdiffstats
path: root/generic/tclIORChan.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-10-19 13:59:01 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-10-19 13:59:01 (GMT)
commit28491fd18e605b9ed59f018d696242461a875639 (patch)
tree4db1f54ddf56e3c4c847582207a40aa87b0d2993 /generic/tclIORChan.c
parent0e20ec5de2f4c95597a4c146ea2a6d469f37357f (diff)
downloadtcl-28491fd18e605b9ed59f018d696242461a875639.zip
tcl-28491fd18e605b9ed59f018d696242461a875639.tar.gz
tcl-28491fd18e605b9ed59f018d696242461a875639.tar.bz2
General cleanup of reflected channel code
Diffstat (limited to 'generic/tclIORChan.c')
-rw-r--r--generic/tclIORChan.c3099
1 files changed, 1490 insertions, 1609 deletions
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index a3012c0..064c5cc 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -1,21 +1,21 @@
-/*
+/*
* tclIORChan.c --
*
- * This file contains the implementation of Tcl's generic
- * channel reflection code, which allows the implementation
- * of Tcl channels in Tcl code.
+ * This file contains the implementation of Tcl's generic channel
+ * reflection code, which allows the implementation of Tcl channels in
+ * Tcl code.
*
- * Parts of this file are based on code contributed by
- * Jean-Claude Wippler.
+ * Parts of this file are based on code contributed by Jean-Claude
+ * Wippler.
*
- * See TIP #219 for the specification of this functionality.
+ * See TIP #219 for the specification of this functionality.
*
* Copyright (c) 2004-2005 ActiveState, a divison of Sophos
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIORChan.c,v 1.6 2005/10/05 17:44:58 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIORChan.c,v 1.7 2005/10/19 13:59:01 dkf Exp $
*/
#include <tclInt.h>
@@ -23,77 +23,56 @@
#include <assert.h>
#ifndef EINVAL
-#define EINVAL 9
+#define EINVAL 9
#endif
#ifndef EOK
-#define EOK 0
+#define EOK 0
#endif
/*
* Signatures of all functions used in the C layer of the reflection.
*/
-/* Required */
-static int RcClose _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
-
-/* Required, "read" is optional despite this. */
-static int RcInput _ANSI_ARGS_((ClientData clientData,
- char *buf, int toRead, int *errorCodePtr));
-
-/* Required, "write" is optional despite this. */
-static int RcOutput _ANSI_ARGS_((ClientData clientData,
- CONST char *buf, int toWrite, int *errorCodePtr));
-
-/* Required */
-static void RcWatch _ANSI_ARGS_((ClientData clientData, int mask));
-
-/* NULL'able - "blocking", is optional */
-static int RcBlock _ANSI_ARGS_((ClientData clientData,
- int mode));
-
-/* NULL'able - "seek", is optional */
-static Tcl_WideInt RcSeekWide _ANSI_ARGS_((ClientData clientData,
- Tcl_WideInt offset,
- int mode, int *errorCodePtr));
-
-static int RcSeek _ANSI_ARGS_((ClientData clientData,
- long offset, int mode, int *errorCodePtr));
-
-/* NULL'able - "cget" / "cgetall", are optional */
-static int RcGetOption _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp* interp,
- CONST char *optionName,
- Tcl_DString *dsPtr));
-
-/* NULL'able - "configure", is optional */
-static int RcSetOption _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp* interp,
- CONST char *optionName,
- CONST char *newValue));
-
+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);
/*
- * The C layer channel type/driver definition used by the reflection.
- * This is a version 3 structure.
+ * The C layer channel type/driver definition used by the reflection. This is
+ * a version 3 structure.
*/
static Tcl_ChannelType tclRChannelType = {
- "tclrchannel", /* Type name. */
- TCL_CHANNEL_VERSION_3,
- RcClose, /* Close channel, clean instance data */
- RcInput, /* Handle read request */
- RcOutput, /* Handle write request */
- RcSeek, /* Move location of access point. NULL'able */
- RcSetOption, /* Set options. NULL'able */
- RcGetOption, /* Get options. NULL'able */
- RcWatch, /* Initialize notifier */
- NULL, /* Get OS handle from the channel. NULL'able */
- NULL, /* No close2 support. NULL'able */
- RcBlock, /* Set blocking/nonblocking. NULL'able */
- NULL, /* Flush channel. Not used by core. NULL'able */
- NULL, /* Handle events. NULL'able */
- RcSeekWide /* Move access point (64 bit). NULL'able */
+ "tclrchannel", /* Type name. */
+ TCL_CHANNEL_VERSION_3,
+ ReflectClose, /* Close channel, clean instance data */
+ ReflectInput, /* Handle read request */
+ ReflectOutput, /* Handle write request */
+ ReflectSeek, /* Move location of access point. NULL'able */
+ ReflectSetOption, /* Set options. NULL'able */
+ ReflectGetOption, /* Get options. NULL'able */
+ ReflectWatch, /* Initialize notifier */
+ NULL, /* Get OS handle from the channel. NULL'able */
+ NULL, /* No close2 support. NULL'able */
+ ReflectBlock, /* Set blocking/nonblocking. NULL'able */
+ NULL, /* Flush channel. Not used by core. NULL'able */
+ NULL, /* Handle events. NULL'able */
+ ReflectSeekWide /* Move access point (64 bit). NULL'able */
};
/*
@@ -101,75 +80,69 @@ static Tcl_ChannelType tclRChannelType = {
*/
typedef struct {
- Tcl_Channel chan; /* Back reference to generic channel structure.
- */
- Tcl_Interp* interp; /* Reference to the interpreter containing the
- * Tcl level part of the channel. */
+ Tcl_Channel chan; /* Back reference to generic channel
+ * structure. */
+ Tcl_Interp *interp; /* Reference to the interpreter containing the
+ * Tcl level part of the channel. */
#ifdef TCL_THREADS
- Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
+ Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
#endif
- /* 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
- * NOTE (9): for the method names ?
- */
-
- /* ---------------------------------------- */
-
- int mode; /* Mask of R/W mode */
- int interest; /* Mask of events the channel is interested in. */
-
- /* Note regarding the usage of timers.
- *
- * Most channel implementations need a timer in the
- * C level to ensure that data in buffers is flushed
- * out through the generation of fake file events.
- *
- * See 'rechan', 'memchan', etc.
- *
- * Here this is _not_ required. Interest in events is
- * posted to the Tcl level via 'watch'. And posting of
- * events is possible from the Tcl level as well, via
- * 'chan postevent'. This means that the generation of
- * all events, fake or not, timer based or not, is
- * completely in the hands of the Tcl level. Therefore
- * no timer here.
- */
-
-} ReflectingChannel;
+ /* 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 interest; /* Mask of events the channel is interested
+ * in. */
+
+ /*
+ * Note regarding the usage of timers.
+ *
+ * Most channel implementations need a timer in the C level to ensure that
+ * data in buffers is flushed out through the generation of fake file
+ * events.
+ *
+ * See 'rechan', 'memchan', etc.
+ *
+ * Here this is _not_ required. Interest in events is posted to the Tcl
+ * level via 'watch'. And posting of events is possible from the Tcl level
+ * as well, via 'chan postevent'. This means that the generation of all
+ * events, fake or not, timer based or not, is completely in the hands of
+ * the Tcl level. Therefore no timer here.
+ */
+} ReflectedChannel;
/*
* Event literals. ==================================================
*/
static CONST char *eventOptions[] = {
- "read", "write", (char *) NULL
+ "read", "write", NULL
};
typedef enum {
- EVENT_READ, EVENT_WRITE
+ EVENT_READ, EVENT_WRITE
} EventOption;
/*
@@ -177,49 +150,51 @@ typedef enum {
*/
static CONST char *methodNames[] = {
- "blocking", /* OPT */
- "cget", /* OPT \/ Together or none */
- "cgetall", /* OPT /\ of these two */
- "configure", /* OPT */
- "finalize", /* */
- "initialize", /* */
- "read", /* OPT */
- "seek", /* OPT */
- "watch", /* */
- "write", /* OPT */
- (char *) NULL
+ "blocking", /* OPT */
+ "cget", /* OPT \/ Together or none */
+ "cgetall", /* OPT /\ of these two */
+ "configure", /* OPT */
+ "finalize", /* */
+ "initialize", /* */
+ "read", /* OPT */
+ "seek", /* OPT */
+ "watch", /* */
+ "write", /* OPT */
+ NULL
};
typedef enum {
- METH_BLOCKING,
- METH_CGET,
- METH_CGETALL,
- METH_CONFIGURE,
- METH_FINAL,
- METH_INIT,
- METH_READ,
- METH_SEEK,
- METH_WATCH,
- METH_WRITE,
+ METH_BLOCKING,
+ METH_CGET,
+ METH_CGETALL,
+ METH_CONFIGURE,
+ METH_FINAL,
+ METH_INIT,
+ METH_READ,
+ METH_SEEK,
+ METH_WATCH,
+ METH_WRITE,
} MethodName;
#define FLAG(m) (1 << (m))
-#define REQUIRED_METHODS (FLAG (METH_INIT) | FLAG (METH_FINAL) | FLAG (METH_WATCH))
-#define NULLABLE_METHODS (FLAG (METH_BLOCKING) | FLAG (METH_SEEK) | \
- FLAG (METH_CONFIGURE) | FLAG (METH_CGET) | FLAG (METH_CGETALL))
+#define REQUIRED_METHODS \
+ (FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
+#define NULLABLE_METHODS \
+ (FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
+ FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL))
-#define RANDW (TCL_READABLE|TCL_WRITABLE)
+#define RANDW \
+ (TCL_READABLE | TCL_WRITABLE)
-#define IMPLIES(a,b) ((!(a)) || (b))
+#define IMPLIES(a,b) ((!(a)) || (b))
#define NEGIMPL(a,b)
-#define HAS(x,f) (x & FLAG(f))
-
+#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'.
+ * We are here essentially creating a very specific implementation of 'thread
+ * send'.
*/
/*
@@ -227,216 +202,211 @@ typedef enum {
*/
typedef enum {
- RcOpClose,
- RcOpInput,
- RcOpOutput,
- RcOpSeek,
- RcOpWatch,
- RcOpBlock,
- RcOpSetOpt,
- RcOpGetOpt,
- RcOpGetOptAll
-} RcOperation;
+ ForwardedClose,
+ ForwardedInput,
+ ForwardedOutput,
+ ForwardedSeek,
+ ForwardedWatch,
+ ForwardedBlock,
+ ForwardedSetOpt,
+ ForwardedGetOpt,
+ ForwardedGetOptAll
+} 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.
+ * 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 RcForwardParamBase {
- int code; /* O: Ok/Fail of the cmd handler */
- char* msg; /* O: Error message for handler failure */
- int vol; /* O: True - msg is allocated, False - msg is static */
-} RcForwardParamBase;
+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.
+ * 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.)
*/
-typedef struct RcForwardParamClose {
- RcForwardParamBase b;
-} RcForwardParamClose;
-
-typedef struct RcForwardParamInput {
- RcForwardParamBase b;
- char* buf; /* O: Where to store the read bytes */
- int toRead; /* I: #bytes to read,
- * O: #bytes actually read */
-} RcForwardParamInput;
-
-typedef struct RcForwardParamOutput {
- RcForwardParamBase b;
- CONST char* buf; /* I: Where the bytes to write come from */
- int toWrite; /* I: #bytes to write,
- * O: #bytes actually written */
-} RcForwardParamOutput;
-
-typedef struct RcForwardParamSeek {
- RcForwardParamBase b;
- int seekMode; /* I: How to seek */
- Tcl_WideInt offset; /* I: Where to seek,
- * O: New location */
-} RcForwardParamSeek;
-
-typedef struct RcForwardParamWatch {
- RcForwardParamBase b;
- int mask; /* I: What events to watch for */
-} RcForwardParamWatch;
-
-typedef struct RcForwardParamBlock {
- RcForwardParamBase b;
- int nonblocking; /* I: What mode to activate */
-} RcForwardParamBlock;
-
-typedef struct RcForwardParamSetOpt {
- RcForwardParamBase b;
- CONST char* name; /* Name of option to set */
- CONST char* value; /* Value to set */
-} RcForwardParamSetOpt;
-
-typedef struct RcForwardParamGetOpt {
- RcForwardParamBase b;
- CONST char* name; /* Name of option to get, maybe NULL */
- Tcl_DString* value; /* Result */
-} RcForwardParamGetOpt;
+struct ForwardParamInput {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ char *buf; /* O: Where to store the read bytes */
+ int toRead; /* I: #bytes to read,
+ * O: #bytes actually read */
+};
+struct ForwardParamOutput {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ CONST char *buf; /* I: Where the bytes to write come from */
+ int toWrite; /* I: #bytes to write,
+ * O: #bytes actually written */
+};
+struct ForwardParamSeek {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ int seekMode; /* I: How to seek */
+ Tcl_WideInt offset; /* I: Where to seek,
+ * O: New location */
+};
+struct ForwardParamWatch {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ int mask; /* I: What events to watch for */
+};
+struct ForwardParamBlock {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ int nonblocking; /* I: What mode to activate */
+};
+struct ForwardParamSetOpt {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ CONST char *name; /* Name of option to set */
+ CONST char *value; /* Value to set */
+};
+struct ForwardParamGetOpt {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ CONST char *name; /* Name of option to get, maybe NULL */
+ Tcl_DString *value; /* Result */
+};
/*
- * General event structure, with reference to
- * operation specific data.
+ * Now join all these together in a single union for convenience.
*/
-typedef struct RcForwardingEvent {
- Tcl_Event event; /* Basic event data, has to be first item */
- struct RcForwardingResult* resultPtr;
-
- RcOperation op; /* Forwarded driver operation */
- ReflectingChannel* rcPtr; /* Channel instance */
- CONST RcForwardParamBase* param; /* Arguments, a RcForwardParamXXX pointer */
-} RcForwardingEvent;
+typedef union ForwardParam {
+ ForwardParamBase base;
+ struct ForwardParamInput input;
+ struct ForwardParamOutput output;
+ struct ForwardParamSeek seek;
+ struct ForwardParamWatch watch;
+ struct ForwardParamBlock block;
+ struct ForwardParamSetOpt setOpt;
+ struct ForwardParamGetOpt getOpt;
+} ForwardParam;
/*
- * 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.
+ * Forward declaration.
*/
-typedef struct RcForwardingResult {
-
- Tcl_ThreadId src; /* Originating thread. */
- Tcl_ThreadId dst; /* Thread the op was forwarded to. */
- Tcl_Condition done; /* Condition variable the forwarder blocks on. */
- int result; /* TCL_OK or TCL_ERROR */
-
- struct RcForwardingEvent* evPtr; /* Event the result belongs to. */
-
- struct RcForwardingResult* prevPtr; /* Links into the list of pending */
- struct RcForwardingResult* nextPtr; /* forwarded results. */
-
-} RcForwardingResult;
+typedef struct ForwardingResult ForwardingResult;
/*
- * List of forwarded operations which have not completed yet, plus the
- * mutex to protect the access to this process global list.
+ * General event structure, with reference to operation specific data.
*/
-static RcForwardingResult* forwardList = (RcForwardingResult*) NULL;
-TCL_DECLARE_MUTEX (rcForwardMutex)
+typedef struct ForwardingEvent {
+ Tcl_Event event; /* Basic event data, has to be first item */
+ ForwardingResult *resultPtr;
+ ForwardedOperation op; /* Forwarded driver operation */
+ ReflectedChannel *rcPtr; /* Channel instance */
+ CONST ForwardParam *param; /* Arguments, a ForwardParamXXX pointer */
+} ForwardingEvent;
/*
- * Function containing the generic code executing a forward, and
- * wrapper macros for the actual operations we wish to forward.
+ * 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.
*/
-static void
-RcForwardOp _ANSI_ARGS_ ((ReflectingChannel* rcPtr, RcOperation op,
- Tcl_ThreadId dst, CONST VOID* param));
+struct ForwardingResult {
+ Tcl_ThreadId src; /* Originating thread. */
+ Tcl_ThreadId dst; /* 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. */
+};
/*
- * The event function executed by the thread receiving a forwarding
- * event. Executes the appropriate function and collects the result,
- * if any.
+ * List of forwarded operations which have not completed yet, plus the mutex
+ * to protect the access to this process global list.
*/
-static int
-RcForwardProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int mask));
+static ForwardingResult *forwardList = NULL;
+TCL_DECLARE_MUTEX(rcForwardMutex)
/*
- * Helpers which intercept when threads are going away, and clean up
- * after pending forwarding events. Different actions depending on
- * which thread went away, originator (src), or receiver (dst).
+ * 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
-RcSrcExitProc _ANSI_ARGS_ ((ClientData clientData));
-
-static void
-RcDstExitProc _ANSI_ARGS_ ((ClientData clientData));
-
-#define RcFreeReceivedError(pb) \
- if ((pb).vol) {ckfree ((pb).msg);}
-
-#define RcPassReceivedErrorInterp(i,pb) \
- if ((i)) {Tcl_SetChannelErrorInterp ((i), Tcl_NewStringObj ((pb).msg,-1));} \
- RcFreeReceivedError (pb)
-
-#define RcPassReceivedError(c,pb) \
- Tcl_SetChannelError ((c), Tcl_NewStringObj ((pb).msg,-1)); \
- RcFreeReceivedError (pb)
-
-#define RcForwardSetStaticError(p,emsg) \
- (p)->code = TCL_ERROR; (p)->vol = 0; (p)->msg = (char*) (emsg);
-
-#define RcForwardSetDynError(p,emsg) \
- (p)->code = TCL_ERROR; (p)->vol = 1; (p)->msg = (char*) (emsg);
-
-static void
-RcForwardSetObjError _ANSI_ARGS_ ((RcForwardParamBase* p,
- Tcl_Obj* obj));
+static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr,
+ ForwardedOperation op, CONST VOID *param);
+static int ForwardProc(Tcl_Event *evPtr, int mask);
+static void SrcExitProc(ClientData clientData);
+static void DstExitProc(ClientData clientData);
+#define FreeReceivedError(p) \
+ if ((p)->base.mustFree) { \
+ ckfree((p)->base.msgStr); \
+ }
+#define PassReceivedErrorInterp(i,pb) \
+ if ((i) != NULL) { \
+ Tcl_Obj *preiTmpObj; \
+ TclNewStringObj(preiTmpObj, (p)->base.msgStr, -1); \
+ Tcl_SetChannelErrorInterp((i), preiTmpObj); \
+ } \
+ FreeReceivedError(p)
+#define PassReceivedError(c,p) \
+ { \
+ Tcl_Obj *preTmpObj; \
+ TclNewStringObj(preTmpObj, (p)->base.msgStr, -1); \
+ Tcl_SetChannelError((c), preTmpObj); \
+ FreeReceivedError(p); \
+ }
+#define ForwardSetStaticError(p,emsg) \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 0; \
+ (p)->base.msgStr = (char *) (emsg);
+#define ForwardSetDynamicError(p,emsg) \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 1; \
+ (p)->base.msgStr = (char *) (emsg);
+
+static void ForwardSetObjError(ForwardParam *p,
+ Tcl_Obj *objPtr);
#endif /* TCL_THREADS */
-#define RcSetChannelErrorStr(c,msg) \
- Tcl_SetChannelError ((c), Tcl_NewStringObj ((msg),-1))
-
-static Tcl_Obj* RcErrorMarshall _ANSI_ARGS_ ((Tcl_Interp *interp));
-static void RcErrorReturn _ANSI_ARGS_ ((Tcl_Interp* interp, Tcl_Obj* msg));
+#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 int RcEncodeEventMask _ANSI_ARGS_((Tcl_Interp* interp,
- CONST char* objName, Tcl_Obj* obj,
- int* mask));
-
-static Tcl_Obj* RcDecodeEventMask _ANSI_ARGS_ ((int mask));
-
-static ReflectingChannel* RcNew _ANSI_ARGS_ ((Tcl_Interp* interp,
- Tcl_Obj* cmdpfxObj, int mode,
- Tcl_Obj* id));
-
-static Tcl_Obj* RcNewHandle _ANSI_ARGS_ ((void));
+static int EncodeEventMask(Tcl_Interp *interp,
+ CONST char *objName, Tcl_Obj *obj, int *mask);
+static Tcl_Obj * DecodeEventMask(int mask);
+static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
+ Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
+static Tcl_Obj * NextHandle(void);
+static void FreeReflectedChannel(ReflectedChannel *rcPtr);
+static int InvokeTclMethod(ReflectedChannel *rcPtr,
+ CONST char *method, Tcl_Obj *argOneObj,
+ Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr,
+ int flags);
-static void RcFree _ANSI_ARGS_ ((ReflectingChannel* rcPtr));
-
-static void
-RcInvokeTclMethod _ANSI_ARGS_((ReflectingChannel* rcPtr,
- CONST char* method, Tcl_Obj* argone, Tcl_Obj* argtwo,
- int* result, Tcl_Obj** resultObj, int capture));
-
-#define NO_CAPTURE (0)
-#define DO_CAPTURE (1)
+#define INVOKE_NO_CAPTURE 0x01
/*
* Global constant strings (messages). ==================
@@ -445,15 +415,14 @@ RcInvokeTclMethod _ANSI_ARGS_((ReflectingChannel* rcPtr,
* 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_read_toomuch = "{read delivered more than requested}";
-static CONST char* msg_write_unsup = "{write not supported by Tcl driver}";
-static CONST char* msg_write_toomuch = "{write wrote more than requested}";
-static CONST char* msg_seek_beforestart = "{Tried to seek before origin}";
-
+static CONST char *msg_read_unsup = "{read not supported by Tcl driver}";
+static CONST char *msg_read_toomuch = "{read delivered more than requested}";
+static CONST char *msg_write_unsup = "{write not supported by Tcl driver}";
+static CONST char *msg_write_toomuch = "{write wrote more than requested}";
+static CONST char *msg_seek_beforestart = "{Tried to seek before origin}";
#ifdef TCL_THREADS
-static CONST char* msg_send_originlost = "{Origin thread lost}";
-static CONST char* msg_send_dstlost = "{Destination thread lost}";
+static CONST char *msg_send_originlost = "{Origin thread lost}";
+static CONST char *msg_send_dstlost = "{Destination thread lost}";
#endif /* TCL_THREADS */
/*
@@ -465,12 +434,12 @@ static CONST char* msg_send_dstlost = "{Destination thread lost}";
*
* TclChanCreateObjCmd --
*
- * This procedure is invoked to process the "chan create" Tcl
- * command. See the user documentation for details on what it does.
+ * This function is invoked to process the "chan create" 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.
+ * A standard Tcl result. The handle of the new channel is placed in the
+ * interp result.
*
* Side effects:
* Creates a new channel.
@@ -479,223 +448,226 @@ static CONST char* msg_send_dstlost = "{Destination thread lost}";
*/
int
-TclChanCreateObjCmd (/*ignored*/ clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp* interp;
- int objc;
- Tcl_Obj* CONST* objv;
+TclChanCreateObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
- ReflectingChannel* rcPtr; /* Instance data of the new channel */
- Tcl_Obj* rcId; /* Handle of the new channel */
- int mode; /* R/W mode of new channel. Has to
- * match abilities of handler commands */
- Tcl_Obj* cmdObj; /* Command prefix, list of words */
- Tcl_Obj* cmdNameObj; /* Command name */
- Tcl_Channel chan; /* Token for the new 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 res; /* Result code for 'initialize' */
- Tcl_Obj* resObj; /* Result data for 'initialize' */
- int methods; /* Bitmask for supported methods. */
- Channel* chanPtr; /* 'chan' resolved to internal struct. */
-
- /* Syntax: chan create MODE CMDPREFIX
+ ReflectedChannel *rcPtr; /* Instance data of the new channel */
+ Tcl_Obj *rcId; /* Handle of the new channel */
+ int mode; /* R/W mode of new channel. Has to match
+ * abilities of handler commands */
+ Tcl_Obj *cmdObj; /* Command prefix, list of words */
+ Tcl_Obj *cmdNameObj; /* Command name */
+ Tcl_Channel chan; /* Token for the new 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. */
+ Channel *chanPtr; /* 'chan' resolved to internal struct. */
+
+ /*
+ * Syntax: chan create MODE CMDPREFIX
* [0] [1] [2] [3]
*
* Actually: rCreate MODE CMDPREFIX
* [0] [1] [2]
*/
-#define MODE (1)
-#define CMD (2)
+#define MODE (1)
+#define CMD (2)
- /* Number of arguments ... */
+ /*
+ * Number of arguments...
+ */
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix");
+ Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix");
return TCL_ERROR;
}
- /* First argument is a list of modes. Allowed entries are "read",
- * "write". Expect at least one list element. Abbreviations are
- * ok.
+ /*
+ * First argument is a list of modes. Allowed entries are "read", "write".
+ * Expect at least one list element. Abbreviations are ok.
*/
- modeObj = objv [MODE];
- if (RcEncodeEventMask (interp, "mode", objv [MODE], &mode) != TCL_OK) {
- return TCL_ERROR;
+ modeObj = objv[MODE];
+ if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
+ return TCL_ERROR;
}
- /* Second argument is command prefix, i.e. list of words, first
- * word is name of handler command, other words are fixed
- * arguments. Run 'initialize' method to get the list of supported
- * methods. Validate this.
+ /*
+ * Second argument is command prefix, i.e. list of words, first word is
+ * name of handler command, other words are fixed arguments. Run
+ * 'initialize' method to get the list of supported methods. Validate
+ * this.
*/
- cmdObj = objv [CMD];
+ cmdObj = objv[CMD];
- /* Basic check that the command prefix truly is a list. */
+ /*
+ * Basic check that the command prefix truly is a list.
+ */
if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
- /* Now create the channel.
+ /*
+ * Now create the channel.
*/
- rcId = RcNewHandle ();
- rcPtr = RcNew (interp, cmdObj, mode, rcId);
- chan = Tcl_CreateChannel (&tclRChannelType,
- Tcl_GetString (rcId),
- rcPtr, mode);
+ rcId = NextHandle();
+ rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
+ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+ mode);
rcPtr->chan = chan;
- chanPtr = (Channel*) chan;
-
- /* Invoke 'initialize' and validate that the handler
- * is present and ok. Squash the channel if not.
- */
+ chanPtr = (Channel *) chan;
- /* Note: The conversion of 'mode' back into a Tcl_Obj ensures that
+ /*
+ * Invoke 'initialize' and validate that the handler is present and ok.
+ * Squash the channel if not.
+ *
+ * Note: The conversion of 'mode' back into a Tcl_Obj ensures that
* 'initialize' is invoked with canonical mode names, and no
- * abbreviations. Using modeObj directly could feed abbreviations
- * into the handler, and the handler is not specified to handle
- * such.
+ * abbreviations. Using modeObj directly could feed abbreviations into the
+ * handler, and the handler is not specified to handle such.
*/
- modeObj = RcDecodeEventMask (mode);
- RcInvokeTclMethod (rcPtr, "initialize", modeObj, NULL,
- &res, &resObj, NO_CAPTURE);
- Tcl_DecrRefCount (modeObj);
+ modeObj = DecodeEventMask(mode);
+ result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj,
+ INVOKE_NO_CAPTURE);
+ Tcl_DecrRefCount(modeObj);
+ if (result != TCL_OK) {
+ Tcl_Obj *err = Tcl_NewStringObj("Initialize failure: ", -1);
- if (res != TCL_OK) {
- Tcl_Obj* err = Tcl_NewStringObj ("Initialize failure: ",-1);
-
- Tcl_AppendObjToObj(err,resObj);
- Tcl_SetObjResult (interp,err);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ Tcl_AppendObjToObj(err, resObj);
+ Tcl_SetObjResult(interp, err);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
goto error;
}
- /* Verify the result.
+ /*
+ * Verify the result.
* - List, of method names. Convert to mask.
* Check for non-optionals through the mask.
* Compare open mode against optional r/w.
*/
- Tcl_AppendResult (interp, "Initialize failure: ", (char*) NULL);
+ Tcl_AppendResult(interp, "Initialize failure: ", NULL);
- if (Tcl_ListObjGetElements (interp, resObj,
- &listc, &listv) != TCL_OK) {
- /* The function above replaces my prefix in case of an error,
- * so more work for us to get the prefix back into the error
- * message
+ if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
+ /*
+ * The function above replaces my prefix in case of an error, so more
+ * work for us to get the prefix back into the error message
*/
- Tcl_Obj* err = Tcl_NewStringObj ("Initialize failure: ",-1);
+ Tcl_Obj *err = Tcl_NewStringObj("Initialize failure: ", -1);
- Tcl_AppendObjToObj(err,Tcl_GetObjResult (interp));
- Tcl_SetObjResult (interp,err);
+ Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
+ Tcl_SetObjResult(interp, err);
goto error;
}
methods = 0;
while (listc > 0) {
- if (Tcl_GetIndexFromObj (interp, listv [listc-1],
- methodNames, "method", TCL_EXACT, &methIndex) != TCL_OK) {
- Tcl_Obj* err = Tcl_NewStringObj ("Initialize failure: ",-1);
+ if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
+ "method", TCL_EXACT, &methIndex) != TCL_OK) {
+ Tcl_Obj *err = Tcl_NewStringObj("Initialize failure: ", -1);
- Tcl_AppendObjToObj(err,Tcl_GetObjResult (interp));
- Tcl_SetObjResult (interp,err);
+ Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
+ Tcl_SetObjResult(interp, err);
goto error;
}
- methods |= FLAG (methIndex);
- listc --;
+ methods |= FLAG(methIndex);
+ listc--;
}
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- Tcl_AppendResult (interp, "Not all required methods supported",
- (char*) NULL);
+ Tcl_AppendResult(interp, "Not all required methods supported", NULL);
goto error;
}
- if ((mode & TCL_READABLE) && !HAS(methods,METH_READ)) {
- Tcl_AppendResult (interp, "Reading not supported, but requested",
- (char*) NULL);
+ if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
+ Tcl_AppendResult(interp, "Reading not supported, but requested", NULL);
goto error;
}
- if ((mode & TCL_WRITABLE) && !HAS(methods,METH_WRITE)) {
- Tcl_AppendResult (interp, "Writing not supported, but requested",
- (char*) NULL);
+ if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
+ Tcl_AppendResult(interp, "Writing not supported, but requested", NULL);
goto error;
}
- if (!IMPLIES (HAS(methods,METH_CGET), HAS(methods,METH_CGETALL))) {
- Tcl_AppendResult (interp, "'cgetall' not supported, but should be, as 'cget' is",
- (char*) NULL);
+ if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
+ Tcl_AppendResult(interp,
+ "'cgetall' not supported, but should be, as 'cget' is", NULL);
goto error;
}
- if (!IMPLIES (HAS(methods,METH_CGETALL),HAS(methods,METH_CGET))) {
- Tcl_AppendResult (interp, "'cget' not supported, but should be, as 'cgetall' is",
- (char*) NULL);
+ if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
+ Tcl_AppendResult(interp,
+ "'cget' not supported, but should be, as 'cgetall' is", NULL);
goto error;
}
- Tcl_ResetResult (interp);
+ Tcl_ResetResult(interp);
- /* Everything is fine now */
+ /*
+ * Everything is fine now.
+ */
rcPtr->methods = methods;
if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
- /* Some of the nullable methods are not supported. We clone
- * the channel type, null the associated C functions, and use
- * the result as the actual channel type.
+ /*
+ * Some of the nullable methods are not supported. We clone the
+ * channel type, null the associated C functions, and use the result
+ * as the actual channel type.
*/
- Tcl_ChannelType* clonePtr = (Tcl_ChannelType*) ckalloc (sizeof (Tcl_ChannelType));
- if (clonePtr == (Tcl_ChannelType*) NULL) {
- Tcl_Panic ("Out of memory in Tcl_RcCreate");
- }
+ Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)
+ ckalloc(sizeof(Tcl_ChannelType));
- memcpy (clonePtr, &tclRChannelType, sizeof (Tcl_ChannelType));
+ memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));
- if (!(methods & FLAG (METH_CONFIGURE))) {
- clonePtr->setOptionProc = NULL;
+ if (!(methods & FLAG(METH_CONFIGURE))) {
+ clonePtr->setOptionProc = NULL;
}
- if (
- !(methods & FLAG (METH_CGET)) &&
- !(methods & FLAG (METH_CGETALL))
- ) {
+ if (!(methods & FLAG(METH_CGET)) && !(methods & FLAG(METH_CGETALL))) {
clonePtr->getOptionProc = NULL;
}
- if (!(methods & FLAG (METH_BLOCKING))) {
+ if (!(methods & FLAG(METH_BLOCKING))) {
clonePtr->blockModeProc = NULL;
}
- if (!(methods & FLAG (METH_SEEK))) {
- clonePtr->seekProc = NULL;
+ if (!(methods & FLAG(METH_SEEK))) {
+ clonePtr->seekProc = NULL;
clonePtr->wideSeekProc = NULL;
}
chanPtr->typePtr = clonePtr;
}
- Tcl_RegisterChannel (interp, chan);
+ Tcl_RegisterChannel(interp, chan);
- /* Return handle as result of command */
+ /*
+ * Return handle as result of command.
+ */
- Tcl_SetObjResult (interp, rcId);
+ Tcl_SetObjResult(interp, rcId);
return TCL_OK;
error:
- /* Signal to RcClose to not call 'finalize' */
+ /*
+ * Signal to ReflectClose to not call 'finalize'.
+ */
rcPtr->methods = 0;
- Tcl_Close (interp, chan);
+ Tcl_Close(interp, chan);
return TCL_ERROR;
#undef MODE
@@ -707,190 +679,198 @@ TclChanCreateObjCmd (/*ignored*/ clientData, interp, objc, objv)
*
* TclChanPostEventObjCmd --
*
- * This procedure is invoked to process the "chan postevent"
- * Tcl command. See the user documentation for details on what it does.
+ * This function is invoked to process the "chan postevent" 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.
+ * Posts events to a reflected channel, invokes event handlers. The
+ * latter implies that arbitrary side effects are possible.
*
*----------------------------------------------------------------------
*/
int
-TclChanPostEventObjCmd (/*ignored*/ clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp* interp;
- int objc;
- Tcl_Obj* CONST* objv;
+TclChanPostEventObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST *objv)
{
- /* Syntax: chan postevent CHANNEL EVENTSPEC
+ /*
+ * Syntax: chan postevent CHANNEL EVENTSPEC
* [0] [1] [2] [3]
*
* Actually: rPostevent CHANNEL EVENTSPEC
* [0] [1] [2]
*
- * where EVENTSPEC = {read write ...} (Abbreviations allowed as well.
+ * where EVENTSPEC = {read write ...} (Abbreviations allowed as well).
*/
-#define CHAN (1)
-#define EVENT (2)
+#define CHAN (1)
+#define EVENT (2)
- CONST char* chanId; /* Tcl level channel handle */
- Tcl_Channel chan; /* Channel associated to the handle */
- Tcl_ChannelType* chanTypePtr; /* Its associated driver structure */
- ReflectingChannel* rcPtr; /* Associated instance data */
- int mode; /* Dummy, r|w mode of the channel */
- int events; /* Mask of events to post */
+ CONST char *chanId; /* Tcl level channel handle */
+ Tcl_Channel chan; /* Channel associated to the handle */
+ Tcl_ChannelType *chanTypePtr;
+ /* Its associated driver structure */
+ ReflectedChannel *rcPtr; /* Associated instance data */
+ int mode; /* Dummy, r|w mode of the channel */
+ int events; /* Mask of events to post */
- /* Number of arguments ... */
+ /*
+ * Number of arguments...
+ */
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec");
+ Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec");
return TCL_ERROR;
}
- /* First argument is a channel, a reflected channel, and the call
- * of this command is done from the interp defining the channel
- * handler cmd.
+ /*
+ * First argument is a channel, a reflected channel, and the call of this
+ * command is done from the interp defining the channel handler cmd.
*/
- chanId = Tcl_GetString (objv [CHAN]);
- chan = Tcl_GetChannel(interp, chanId, &mode);
+ chanId = TclGetString(objv[CHAN]);
+ chan = Tcl_GetChannel(interp, chanId, &mode);
- if (chan == (Tcl_Channel) NULL) {
- return TCL_ERROR;
+ if (chan == NULL) {
+ return TCL_ERROR;
}
- chanTypePtr = Tcl_GetChannelType (chan);
+ chanTypePtr = Tcl_GetChannelType(chan);
- /* We use a function referenced by the channel type as our cookie
- * to detect calls to non-reflecting channels. The channel type
- * itself is not suitable, as it might not be the static
- * definition in this file, but a clone thereof. And while we have
- * reserved the name of the type nothing in the core checks
- * against violation, so someone else might have created a channel
- * type using our name, clashing with ourselves.
+ /*
+ * We use a function referenced by the channel type as our cookie to
+ * detect calls to non-reflecting channels. The channel type itself is not
+ * suitable, as it might not be the static definition in this file, but a
+ * clone thereof. And while we have reserved the name of the type nothing
+ * in the core checks against violation, so someone else might have
+ * created a channel type using our name, clashing with ourselves.
*/
- if (chanTypePtr->watchProc != &RcWatch) {
- Tcl_AppendResult(interp, "channel \"", chanId,
- "\" is not a reflected channel",
- (char *) NULL);
+ if (chanTypePtr->watchProc != &ReflectWatch) {
+ Tcl_AppendResult(interp, "channel \"", chanId,
+ "\" is not a reflected channel", NULL);
return TCL_ERROR;
}
- rcPtr = (ReflectingChannel*) Tcl_GetChannelInstanceData (chan);
+ rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);
if (rcPtr->interp != interp) {
- Tcl_AppendResult(interp, "postevent for channel \"", chanId,
- "\" called from outside interpreter",
- (char *) NULL);
+ Tcl_AppendResult(interp, "postevent for channel \"", chanId,
+ "\" called from outside interpreter", NULL);
return TCL_ERROR;
}
- /* Second argument is a list of events. Allowed entries are
- * "read", "write". Expect at least one list element.
- * Abbreviations are ok.
+ /*
+ * Second argument is a list of events. Allowed entries are "read",
+ * "write". Expect at least one list element. Abbreviations are ok.
*/
- if (RcEncodeEventMask (interp, "event", objv [EVENT], &events) != TCL_OK) {
- return TCL_ERROR;
+ if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) {
+ return TCL_ERROR;
}
-
- /* Check that the channel is actually interested in the provided
- * events.
+
+ /*
+ * Check that the channel is actually interested in the provided events.
*/
if (events & ~rcPtr->interest) {
- Tcl_AppendResult(interp, "tried to post events channel \"", chanId,
- "\" is not interested in",
- (char *) NULL);
+ Tcl_AppendResult(interp, "tried to post events channel \"", chanId,
+ "\" is not interested in", NULL);
return TCL_ERROR;
}
- /* We have the channel and the events to post.
+ /*
+ * We have the channel and the events to post.
*/
- Tcl_NotifyChannel (chan, events);
+ Tcl_NotifyChannel(chan, events);
- /* Squash interp results left by the event script.
+ /*
+ * Squash interp results left by the event script.
*/
- Tcl_ResetResult (interp);
+ Tcl_ResetResult(interp);
return TCL_OK;
#undef CHAN
#undef EVENT
}
+/*
+ * Channel error message marshalling utilities.
+ */
static Tcl_Obj*
-RcErrorMarshall (interp)
- Tcl_Interp *interp;
+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.
+ /*
+ * 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_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR);
+
+ /*
+ * => returnOpt.refCount == 0. We can append directly.
*/
- Tcl_ListObjAppendElement (NULL, returnOpt, Tcl_GetObjResult (interp));
+ Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp));
return returnOpt;
}
static void
-RcErrorReturn (interp, msg)
- Tcl_Interp *interp;
- Tcl_Obj *msg;
+UnmarshallErrorResult(
+ Tcl_Interp *interp,
+ Tcl_Obj *msgObj)
{
- int res;
- int lc;
- Tcl_Obj** lv;
- int explicitResult;
- int numOptions;
+ int lc;
+ Tcl_Obj **lv;
+ int explicitResult;
+ int numOptions;
- /* Process the caught message.
+ /*
+ * Process the caught message.
*
* Syntax = (option value)... ?message?
*
- * Bad syntax causes a panic. Because the other side uses
+ * Bad syntax causes a panic. This is OK because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
- * information.
+ * information; if we panic here, something has gone badly wrong already.
*/
- res = Tcl_ListObjGetElements (interp, msg, &lc, &lv);
- if (res != TCL_OK) {
- Tcl_Panic ("TclChanCaughtErrorBypass: Bad syntax of caught result");
+ if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
+ Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
}
- explicitResult = (1 == (lc % 2));
- numOptions = lc - explicitResult;
+ explicitResult = lc & 1; /* Odd number of values? */
+ numOptions = lc - explicitResult;
if (explicitResult) {
- Tcl_SetObjResult (interp, lv [lc-1]);
+ Tcl_SetObjResult(interp, lv[lc-1]);
}
- (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj (numOptions, lv));
+ (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
}
int
-TclChanCaughtErrorBypass (interp, chan)
- Tcl_Interp *interp;
- Tcl_Channel chan;
+TclChanCaughtErrorBypass(
+ Tcl_Interp *interp,
+ Tcl_Channel chan)
{
- Tcl_Obj* msgc = NULL;
- Tcl_Obj* msgi = NULL;
- Tcl_Obj* msg = NULL;
+ Tcl_Obj *chanMsgObj = NULL;
+ Tcl_Obj *interpMsgObj = NULL;
+ Tcl_Obj *msgObj = NULL;
- /* Get a bypassed error message from channel and/or interpreter, save the
+ /*
+ * Get a bypassed error message from channel and/or interpreter, save the
* reference, then kill the returned objects, if there were any. If there
* are messages in both the channel has preference.
*/
@@ -900,37 +880,39 @@ TclChanCaughtErrorBypass (interp, chan)
}
if (chan != NULL) {
- Tcl_GetChannelError (chan, &msgc);
+ Tcl_GetChannelError(chan, &chanMsgObj);
}
if (interp != NULL) {
- Tcl_GetChannelErrorInterp (interp, &msgi);
+ Tcl_GetChannelErrorInterp(interp, &interpMsgObj);
}
- if (msgc != NULL) {
- msg = msgc;
- Tcl_IncrRefCount (msg);
- } else if (msgi != NULL) {
- msg = msgi;
- Tcl_IncrRefCount (msg);
+ if (chanMsgObj != NULL) {
+ msgObj = chanMsgObj;
+ } else if (interpMsgObj != NULL) {
+ msg = interpMsgObj;
+ }
+ if (msgObj != NULL) {
+ Tcl_IncrRefCount(msgObj);
}
- if (msgc != NULL) {
- Tcl_DecrRefCount (msgc);
+ if (chanMsgObj != NULL) {
+ Tcl_DecrRefCount(chanMsgObj);
}
- if (msgi != NULL) {
- Tcl_DecrRefCount (msgi);
+ if (interpMsgObj != NULL) {
+ Tcl_DecrRefCount(interpMsgObj);
}
- /* No message returned, nothing caught.
+ /*
+ * No message returned, nothing caught.
*/
- if (msg == NULL) {
+ if (msgObj == NULL) {
return 0;
}
- RcErrorReturn (interp, msg);
+ UnmarshallErrorResult(interp, msgObj);
- Tcl_DecrRefCount (msg);
+ Tcl_DecrRefCount(msgObj);
return 1;
}
@@ -941,10 +923,10 @@ TclChanCaughtErrorBypass (interp, chan)
/*
*----------------------------------------------------------------------
*
- * RcClose --
+ * ReflectClose --
*
- * This function is invoked when the channel is closed, to delete
- * the driver specific instance data.
+ * This function is invoked when the channel is closed, to delete the
+ * driver specific instance data.
*
* Results:
* A posix error.
@@ -956,107 +938,106 @@ TclChanCaughtErrorBypass (interp, chan)
*/
static int
-RcClose (clientData, interp)
- ClientData clientData;
- Tcl_Interp* interp;
+ReflectClose(
+ ClientData clientData,
+ Tcl_Interp *interp)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- int res; /* Result code for 'close' */
- Tcl_Obj* resObj; /* Result data for 'close' */
-
- if (interp == (Tcl_Interp*) NULL) {
- /* This call comes from TclFinalizeIOSystem. There are no
- * interpreters, and therefore we cannot call upon the handler
- * command anymore. Threading is irrelevant as well. We
- * simply clean up all our C level data structures and leave
- * the Tcl level to the other finalization functions.
+ ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+ int result; /* Result code for 'close' */
+ Tcl_Obj *resObj; /* Result data for 'close' */
+
+ if (interp == NULL) {
+ /*
+ * This call comes from TclFinalizeIOSystem. There are no
+ * interpreters, and therefore we cannot call upon the handler command
+ * anymore. Threading is irrelevant as well. We simply clean up all
+ * our C level data structures and leave the Tcl level to the other
+ * finalization functions.
*/
- /* THREADED => Forward this to the origin thread */
- /* Note: Have a thread delete handler for the origin
- * thread. Use this to clean up the structure!
- */
-
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * THREADED => Forward this to the origin thread
+ *
+ * Note: Have a thread delete handler for the origin thread. Use this
+ * to clean up the structure!
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamClose p;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- RcForwardOp (rcPtr, RcOpClose, rcPtr->thread, &p);
- res = p.b.code;
+ ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
+ result = p.base.code;
- /* RcFree is done in the forwarded operation!,
- * in the other thread. rcPtr here is gone!
+ /*
+ * FreeReflectedChannel is done in the forwarded operation!, in
+ * the other thread. rcPtr here is gone!
*/
- if (res != TCL_OK) {
- RcFreeReceivedError (p.b);
+ if (result != TCL_OK) {
+ FreeReceivedError(&p);
}
- } else {
-#endif
- RcFree (rcPtr);
-#ifdef TCL_THREADS
+ return EOK;
}
#endif
+
+ FreeReflectedChannel(rcPtr);
return EOK;
}
- /* -------- */
+ /*
+ * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL)
+ *
+ * A cleaned method mask here implies that the channel creation was
+ * aborted, and "finalize" must not be called.
+ */
- /* -- No -- ASSERT rcPtr->methods & FLAG (METH_FINAL) */
+ if (rcPtr->methods == 0) {
+ FreeReflectedChannel(rcPtr);
+ return EOK;
+ }
- /* A cleaned method mask here implies that the channel creation
- * was aborted, and "finalize" must not be called.
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->methods == 0) {
- RcFree (rcPtr);
- return EOK;
- } else {
#ifdef TCL_THREADS
- /* Are we in the correct thread ?
- */
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamClose p;
+ ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
+ result = p.base.code;
- RcForwardOp (rcPtr, RcOpClose, rcPtr->thread, &p);
- res = p.b.code;
-
- /* RcFree is done in the forwarded operation!,
- * in the other thread. rcPtr here is gone!
- */
+ /*
+ * FreeReflectedChannel is done in the forwarded operation!, in the
+ * other thread. rcPtr here is gone!
+ */
- if (res != TCL_OK) {
- RcPassReceivedErrorInterp (interp, p.b);
- }
- } else {
+ if (result != TCL_OK) {
+ PassReceivedErrorInterp(interp, &p);
+ }
+ } else {
#endif
- RcInvokeTclMethod (rcPtr, "finalize", NULL, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if ((res != TCL_OK) && (interp != NULL)) {
- Tcl_SetChannelErrorInterp (interp, resObj);
- }
+ result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj, 0);
+ if ((result != TCL_OK) && (interp != NULL)) {
+ Tcl_SetChannelErrorInterp(interp, resObj);
+ }
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ Tcl_DecrRefCount(resObj); /* Remove reference we held from the
+ * invoke */
#ifdef TCL_THREADS
- RcFree (rcPtr);
- }
-#endif
- return (res == TCL_OK) ? EOK : EINVAL;
+ FreeReflectedChannel(rcPtr);
}
+#endif
+ return (result == TCL_OK) ? EOK : EINVAL;
}
/*
*----------------------------------------------------------------------
*
- * RcInput --
+ * ReflectInput --
*
- * This function is invoked when more data is requested from the
- * channel.
+ * This function is invoked when more data is requested from the channel.
*
* Results:
* The number of bytes read.
@@ -1068,69 +1049,61 @@ RcClose (clientData, interp)
*/
static int
-RcInput (clientData, buf, toRead, errorCodePtr)
- ClientData clientData;
- char* buf;
- int toRead;
- int* errorCodePtr;
+ReflectInput(
+ ClientData clientData,
+ char *buf,
+ int toRead,
+ int *errorCodePtr)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* toReadObj;
- int bytec; /* Number of returned bytes */
- unsigned char* bytev; /* Array of returned bytes */
- int res; /* Result code for 'read' */
- Tcl_Obj* resObj; /* Result data for 'read' */
+ ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+ Tcl_Obj *toReadObj;
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev; /* Array of returned bytes */
+ Tcl_Obj *resObj; /* Result data for 'read' */
- /* The following check can be done before thread redirection,
- * because we are reading from an item which is readonly, i.e.
- * will never change during the lifetime of the channel.
+ /*
+ * 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 (!(rcPtr->methods & FLAG (METH_READ))) {
- RcSetChannelErrorStr (rcPtr->chan, msg_read_unsup);
+ if (!(rcPtr->methods & FLAG(METH_READ))) {
+ SetChannelErrorStr(rcPtr->chan, msg_read_unsup);
*errorCodePtr = EINVAL;
return -1;
}
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamInput p;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- p.buf = buf;
- p.toRead = toRead;
+ p.input.buf = buf;
+ p.input.toRead = toRead;
- RcForwardOp (rcPtr, RcOpInput, rcPtr->thread, &p);
+ ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p);
- if (p.b.code != TCL_OK) {
- RcPassReceivedError (rcPtr->chan, p.b);
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rcPtr->chan, &p);
*errorCodePtr = EINVAL;
} else {
*errorCodePtr = EOK;
}
- return p.toRead;
+ return p.input.toRead;
}
#endif
- /* -------- */
-
- /* ASSERT: rcPtr->method & FLAG (METH_READ) */
+ /* ASSERT: rcPtr->method & FLAG(METH_READ) */
/* ASSERT: rcPtr->mode & TCL_READABLE */
toReadObj = Tcl_NewIntObj(toRead);
- if (toReadObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcInput");
- }
-
- RcInvokeTclMethod (rcPtr, "read", toReadObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- Tcl_SetChannelError (rcPtr->chan, resObj);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj, 0)!=TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return -1;
}
@@ -1138,8 +1111,8 @@ RcInput (clientData, buf, toRead, errorCodePtr)
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
if (toRead < bytec) {
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- RcSetChannelErrorStr (rcPtr->chan, msg_read_toomuch);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
*errorCodePtr = EINVAL;
return -1;
}
@@ -1147,20 +1120,19 @@ RcInput (clientData, buf, toRead, errorCodePtr)
*errorCodePtr = EOK;
if (bytec > 0) {
- memcpy (buf, bytev, bytec);
+ memcpy(buf, bytev, bytec);
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return bytec;
}
/*
*----------------------------------------------------------------------
*
- * RcOutput --
+ * ReflectOutput --
*
- * This function is invoked when data is writen to the
- * channel.
+ * This function is invoked when data is writen to the channel.
*
* Results:
* The number of bytes actually written.
@@ -1172,90 +1144,81 @@ RcInput (clientData, buf, toRead, errorCodePtr)
*/
static int
-RcOutput (clientData, buf, toWrite, errorCodePtr)
- ClientData clientData;
- CONST char* buf;
- int toWrite;
- int* errorCodePtr;
+ReflectOutput(
+ ClientData clientData,
+ CONST char *buf,
+ int toWrite,
+ int *errorCodePtr)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* bufObj;
- int res; /* Result code for 'write' */
- Tcl_Obj* resObj; /* Result data for 'write' */
- int written;
+ ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+ Tcl_Obj *bufObj;
+ Tcl_Obj *resObj; /* Result data for 'write' */
+ int written;
- /* 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.
+ /*
+ * 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 (!(rcPtr->methods & FLAG (METH_WRITE))) {
- RcSetChannelErrorStr (rcPtr->chan, msg_write_unsup);
- *errorCodePtr = EINVAL;
+ if (!(rcPtr->methods & FLAG(METH_WRITE))) {
+ SetChannelErrorStr(rcPtr->chan, msg_write_unsup);
+ *errorCodePtr = EINVAL;
return -1;
}
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamOutput p;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- p.buf = buf;
- p.toWrite = toWrite;
+ p.output.buf = buf;
+ p.output.toWrite = toWrite;
- RcForwardOp (rcPtr, RcOpOutput, rcPtr->thread, &p);
+ ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p);
- if (p.b.code != TCL_OK) {
- RcPassReceivedError (rcPtr->chan, p.b);
- *errorCodePtr = EINVAL;
- } else {
- *errorCodePtr = EOK;
- }
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rcPtr->chan, &p);
+ *errorCodePtr = EINVAL;
+ } else {
+ *errorCodePtr = EOK;
+ }
- return p.toWrite;
+ return p.output.toWrite;
}
#endif
- /* -------- */
-
- /* ASSERT: rcPtr->method & FLAG (METH_WRITE) */
+ /* ASSERT: rcPtr->method & FLAG(METH_WRITE) */
/* ASSERT: rcPtr->mode & TCL_WRITABLE */
-
- bufObj = Tcl_NewByteArrayObj((unsigned char*) buf, toWrite);
- if (bufObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcOutput");
- }
- RcInvokeTclMethod (rcPtr, "write", bufObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- Tcl_SetChannelError (rcPtr->chan, resObj);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
+ if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj, 0) != TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return -1;
}
- res = Tcl_GetIntFromObj (rcPtr->interp, resObj, &written);
- if (res != TCL_OK) {
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- Tcl_SetChannelError (rcPtr->chan, RcErrorMarshall (rcPtr->interp));
+ if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
*errorCodePtr = EINVAL;
return -1;
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
if ((written == 0) || (toWrite < written)) {
- /* The handler claims to have written more than it was given.
- * That is bad. Note that the I/O core would crash if we were
- * to return this information, trying to write -nnn bytes in
- * the next iteration.
+ /*
+ * The handler claims to have written more than it was given. That is
+ * bad. Note that the I/O core would crash if we were to return this
+ * information, trying to write -nnn bytes in the next iteration.
*/
- RcSetChannelErrorStr (rcPtr->chan, msg_write_toomuch);
+ SetChannelErrorStr(rcPtr->chan, msg_write_toomuch);
*errorCodePtr = EINVAL;
return -1;
}
@@ -1267,10 +1230,9 @@ RcOutput (clientData, buf, toWrite, errorCodePtr)
/*
*----------------------------------------------------------------------
*
- * RcSeekWide / RcSeek --
+ * ReflectSeekWide / ReflectSeek --
*
- * This function is invoked when the user wishes to seek on
- * the channel.
+ * This function is invoked when the user wishes to seek on the channel.
*
* Results:
* The new location of the access point.
@@ -1282,84 +1244,66 @@ RcOutput (clientData, buf, toWrite, errorCodePtr)
*/
static Tcl_WideInt
-RcSeekWide (clientData, offset, seekMode, errorCodePtr)
- ClientData clientData;
- Tcl_WideInt offset;
- int seekMode;
- int* errorCodePtr;
+ReflectSeekWide(
+ ClientData clientData,
+ Tcl_WideInt offset,
+ int seekMode,
+ int *errorCodePtr)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* offObj;
- Tcl_Obj* baseObj;
- int res; /* Result code for 'seek' */
- Tcl_Obj* resObj; /* Result data for 'seek' */
- Tcl_WideInt newLoc;
+ ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+ Tcl_Obj *offObj;
+ Tcl_Obj *baseObj;
+ Tcl_Obj *resObj; /* Result for 'seek' */
+ Tcl_WideInt newLoc;
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamSeek p;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- p.seekMode = seekMode;
- p.offset = offset;
+ p.seek.seekMode = seekMode;
+ p.seek.offset = offset;
- RcForwardOp (rcPtr, RcOpSeek, rcPtr->thread, &p);
+ ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p);
- if (p.b.code != TCL_OK) {
- RcPassReceivedError (rcPtr->chan, p.b);
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rcPtr->chan, &p);
*errorCodePtr = EINVAL;
} else {
*errorCodePtr = EOK;
}
- return p.offset;
+ return p.seek.offset;
}
#endif
- /* -------- */
-
- /* ASSERT: rcPtr->method & FLAG (METH_SEEK) */
+ /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */
offObj = Tcl_NewWideIntObj(offset);
- if (offObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSeekWide");
- }
-
- baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ?
- "start" :
- ((seekMode == SEEK_CUR) ?
- "current" :
- "end"), -1);
-
- if (baseObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSeekWide");
- }
-
- RcInvokeTclMethod (rcPtr, "seek", offObj, baseObj,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- Tcl_SetChannelError (rcPtr->chan, resObj);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" :
+ ((seekMode == SEEK_CUR) ? "current" : "end"), -1);
+ if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj, 0)!=TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return -1;
}
- res = Tcl_GetWideIntFromObj (rcPtr->interp, resObj, &newLoc);
- if (res != TCL_OK) {
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- Tcl_SetChannelError (rcPtr->chan, RcErrorMarshall (rcPtr->interp));
+ if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
*errorCodePtr = EINVAL;
return -1;
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
- if (newLoc < Tcl_LongAsWide (0)) {
- RcSetChannelErrorStr (rcPtr->chan, msg_seek_beforestart);
- *errorCodePtr = EINVAL;
+ if (newLoc < Tcl_LongAsWide(0)) {
+ SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
+ *errorCodePtr = EINVAL;
return -1;
}
@@ -1368,29 +1312,30 @@ RcSeekWide (clientData, offset, seekMode, errorCodePtr)
}
static int
-RcSeek (clientData, offset, seekMode, errorCodePtr)
- ClientData clientData;
- long offset;
- int seekMode;
- int* errorCodePtr;
+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 o this we have to
- * implement it, a dummy is not enough. We simply delegate the call
- * to the wide routine.
- */
-
- return (int) RcSeekWide (clientData, Tcl_LongAsWide (offset),
- seekMode, 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);
}
/*
*----------------------------------------------------------------------
*
- * RcWatch --
+ * ReflectWatch --
*
- * This function is invoked to tell the channel what events
- * the I/O system is interested in.
+ * This function is invoked to tell the channel what events the I/O
+ * system is interested in.
*
* Results:
* None.
@@ -1402,62 +1347,66 @@ RcSeek (clientData, offset, seekMode, errorCodePtr)
*/
static void
-RcWatch (clientData, mask)
- ClientData clientData;
- int mask;
+ReflectWatch(
+ ClientData clientData,
+ int mask)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* maskObj;
+ ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+ Tcl_Obj *maskObj;
- /* ASSERT rcPtr->methods & FLAG (METH_WATCH) */
+ /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */
- /* We restrict the interest to what the channel can support
- * IOW there will never be write events for a channel which is
- * not writable. Analoguous for read events.
+ /*
+ * We restrict the interest to what the channel can support. IOW there
+ * will never be write events for a channel which is not writable.
+ * Analoguously for read events and non-readable channels.
*/
- mask = mask & rcPtr->mode;
+ mask &= rcPtr->mode;
if (mask == rcPtr->interest) {
- /* Same old, same old, why should we do something ? */
- return;
+ /*
+ * Same old, same old, why should we do something?
+ */
+
+ return;
}
rcPtr->interest = mask;
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamWatch p;
-
- p.mask = mask;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- RcForwardOp (rcPtr, RcOpWatch, rcPtr->thread, &p);
+ p.watch.mask = mask;
+ ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p);
- /* Any failure from the forward is ignored. We have no place to
- * put this.
+ /*
+ * Any failure from the forward is ignored. We have no place to put
+ * this.
*/
+
return;
}
#endif
- /* -------- */
-
- maskObj = RcDecodeEventMask (mask);
- RcInvokeTclMethod (rcPtr, "watch", maskObj, NULL,
- NULL, NULL, NO_CAPTURE);
- Tcl_DecrRefCount (maskObj);
+ maskObj = DecodeEventMask(mask);
+ (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL,
+ INVOKE_NO_CAPTURE);
+ Tcl_DecrRefCount(maskObj);
}
/*
*----------------------------------------------------------------------
*
- * RcBlock --
+ * ReflectBlock --
*
- * This function is invoked to tell the channel which blocking
- * behaviour is required of it.
+ * This function is invoked to tell the channel which blocking behaviour
+ * is required of it.
*
* Results:
* A posix error number.
@@ -1469,60 +1418,54 @@ RcWatch (clientData, mask)
*/
static int
-RcBlock (clientData, nonblocking)
- ClientData clientData;
- int nonblocking;
+ReflectBlock(
+ ClientData clientData,
+ int nonblocking)
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* blockObj;
- int res; /* Result code for 'blocking' */
- Tcl_Obj* resObj; /* Result data for 'blocking' */
+ ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+ Tcl_Obj *blockObj;
+ int errorNum; /* EINVAL or EOK (success). */
+ Tcl_Obj *resObj; /* Result data for 'blocking' */
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamBlock p;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- p.nonblocking = nonblocking;
+ p.block.nonblocking = nonblocking;
- RcForwardOp (rcPtr, RcOpBlock, rcPtr->thread, &p);
+ ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p);
- if (p.b.code != TCL_OK) {
- RcPassReceivedError (rcPtr->chan, p.b);
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rcPtr->chan, &p);
return EINVAL;
- } else {
- return EOK;
}
+
+ return EOK;
}
#endif
- /* -------- */
-
blockObj = Tcl_NewBooleanObj(!nonblocking);
- if (blockObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcBlock");
- }
- RcInvokeTclMethod (rcPtr, "blocking", blockObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- Tcl_SetChannelError (rcPtr->chan, resObj);
- res = EINVAL;
+ if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj,
+ 0) != TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ errorNum = EINVAL;
} else {
- res = EOK;
+ errorNum = EOK;
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ return errorNum;
}
/*
*----------------------------------------------------------------------
*
- * RcSetOption --
+ * ReflectSetOption --
*
* This function is invoked to configure a channel option.
*
@@ -1536,70 +1479,58 @@ RcBlock (clientData, nonblocking)
*/
static int
-RcSetOption (clientData, interp, optionName, newValue)
- 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 */
+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 */
{
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* optionObj;
- Tcl_Obj* valueObj;
- int res; /* Result code for 'configure' */
- Tcl_Obj* resObj; /* Result data for 'configure' */
+ ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
+ Tcl_Obj *optionObj;
+ Tcl_Obj *valueObj;
+ int result; /* Result code for 'configure' */
+ Tcl_Obj *resObj; /* Result data for 'configure' */
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- RcForwardParamSetOpt p;
-
- p.name = optionName;
- p.value = newValue;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
- RcForwardOp (rcPtr, RcOpSetOpt, rcPtr->thread, &p);
+ p.setOpt.name = optionName;
+ p.setOpt.value = newValue;
- if (p.b.code != TCL_OK) {
- Tcl_Obj* err = Tcl_NewStringObj (p.b.msg, -1);
+ ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p);
- RcErrorReturn (interp, err);
+ if (p.base.code != TCL_OK) {
+ Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
- Tcl_DecrRefCount (err);
- if (p.b.vol) {ckfree (p.b.msg);}
+ UnmarshallErrorResult(interp, err);
+ Tcl_DecrRefCount(err);
+ FreeReceivedError(&p);
}
- return p.b.code;
+ return p.base.code;
}
#endif
- /* -------- */
-
- optionObj = Tcl_NewStringObj(optionName,-1);
- if (optionObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSetOption");
- }
-
- valueObj = Tcl_NewStringObj(newValue,-1);
- if (valueObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSetOption");
- }
-
- RcInvokeTclMethod (rcPtr, "configure", optionObj, valueObj,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcErrorReturn (interp, resObj);
- }
+ optionObj = Tcl_NewStringObj(optionName, -1);
+ valueObj = Tcl_NewStringObj(newValue, -1);
+ result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj,0);
+ if (result != TCL_OK) {
+ UnmarshallErrorResult(interp, resObj);
+ }
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * RcGetOption --
+ * ReflectGetOption --
*
* This function is invoked to retrieve all or a channel option.
*
@@ -1613,135 +1544,130 @@ RcSetOption (clientData, interp, optionName, newValue)
*/
static int
-RcGetOption (clientData, interp, optionName, dsPtr)
- 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 */
+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 */
{
- /* This code is special. It has regular passing of Tcl result, and
- * errors. The bypass functions are not required.
+ /*
+ * This code is special. It has regular passing of Tcl result, and errors.
+ * The bypass functions are not required.
*/
- ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
- Tcl_Obj* optionObj;
- int res; /* Result code for 'configure' */
- Tcl_Obj* resObj; /* Result data for 'configure' */
- int listc;
- Tcl_Obj** listv;
- const char* method;
+ ReflectedChannel *rcPtr = (ReflectedChannel*) clientData;
+ Tcl_Obj *optionObj;
+ Tcl_Obj *resObj; /* Result data for 'configure' */
+ int listc;
+ Tcl_Obj **listv;
+ const char *method;
-#ifdef TCL_THREADS
- /* Are we in the correct thread ?
+ /*
+ * Are we in the correct thread?
*/
- if (rcPtr->thread != Tcl_GetCurrentThread ()) {
- int opcode;
- RcForwardParamGetOpt p;
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ int opcode;
+ ForwardParam p;
- p.name = optionName;
- p.value = dsPtr;
+ p.getOpt.name = optionName;
+ p.getOpt.value = dsPtr;
- if (optionName == (char*) NULL) {
- opcode = RcOpGetOptAll;
+ if (optionName == NULL) {
+ opcode = ForwardedGetOptAll;
} else {
- opcode = RcOpGetOpt;
+ opcode = ForwardedGetOpt;
}
- RcForwardOp (rcPtr, opcode, rcPtr->thread, &p);
-
- if (p.b.code != TCL_OK) {
- Tcl_Obj* err = Tcl_NewStringObj (p.b.msg, -1);
+ ForwardOpToOwnerThread(rcPtr, opcode, &p);
- RcErrorReturn (interp, err);
+ if (p.base.code != TCL_OK) {
+ Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
- Tcl_DecrRefCount (err);
- if (p.b.vol) {ckfree (p.b.msg);}
+ UnmarshallErrorResult(interp, err);
+ Tcl_DecrRefCount(err);
+ FreeReceivedError(&p);
}
- return p.b.code;
+ return p.base.code;
}
#endif
- /* -------- */
+ if (optionName == NULL) {
+ /*
+ * Retrieve all options.
+ */
- if (optionName == (char*) NULL) {
- /* Retrieve all options. */
- method = "cgetall";
+ method = "cgetall";
optionObj = NULL;
} else {
- /* Retrieve the value of one option */
-
- method = "cget";
- optionObj = Tcl_NewStringObj(optionName,-1);
- if (optionObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcGetOption");
- }
- }
+ /*
+ * Retrieve the value of one option.
+ */
- RcInvokeTclMethod (rcPtr, method, optionObj, NULL,
- &res, &resObj, DO_CAPTURE);
+ method = "cget";
+ optionObj = Tcl_NewStringObj(optionName, -1);
+ }
- if (res != TCL_OK) {
- RcErrorReturn (interp, resObj);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj, 0)!=TCL_OK) {
+ UnmarshallErrorResult(interp, resObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ return TCL_ERROR;
}
- /* The result has to go into the 'dsPtr' for propagation to the
- * caller of the driver.
+ /*
+ * The result has to go into the 'dsPtr' for propagation to the caller of
+ * the driver.
*/
if (optionObj != NULL) {
- Tcl_DStringAppend (dsPtr, Tcl_GetString (resObj), -1);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ return TCL_OK;
}
- /* Extract the list and append each item as element.
+ /*
+ * Extract the list and append each item as element.
*/
- /* NOTE (4): If we extract the string rep we can assume a
- * NOTE (4): properly quoted string. Together with a separating
- * NOTE (4): space this way of simply appending the whole string
- * NOTE (4): rep might be faster. It also doesn't check if the
- * NOTE (4): result is a valid list. Nor that the list has an
- * NOTE (4): even number elements.
- * NOTE (4): ---
+ /*
+ * NOTE (4): If we extract the string rep we can assume a properly quoted
+ * string. Together with a separating space this way of simply appending
+ * the whole string rep might be faster. It also doesn't check if the
+ * result is a valid list. Nor that the list has an even number elements.
*/
- res = Tcl_ListObjGetElements (interp, resObj, &listc, &listv);
-
- if (res != TCL_OK) {
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
+ if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ return TCL_ERROR;
}
if ((listc % 2) == 1) {
- /* Odd number of elements is wrong.
+ /*
+ * Odd number of elements is wrong.
*/
+
Tcl_Obj *objPtr = Tcl_NewObj();
+
Tcl_ResetResult(interp);
TclObjPrintf(NULL, objPtr, "Expected list with even number of "
- "elements, got %d element%s instead", listc,
+ "elements, got %d element%s instead", listc,
(listc == 1 ? "" : "s"));
Tcl_SetObjResult(interp, objPtr);
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return TCL_ERROR;
- }
-
-
- {
- int len;
- char* str = Tcl_GetStringFromObj (resObj, &len);
+ } else {
+ int len;
+ char *str = Tcl_GetStringFromObj(resObj, &len);
if (len) {
- Tcl_DStringAppend (dsPtr, " ", 1);
- Tcl_DStringAppend (dsPtr, str, len);
+ Tcl_DStringAppend(dsPtr, " ", 1);
+ Tcl_DStringAppend(dsPtr, str, len);
}
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ return TCL_OK;
}
- Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
- return res;
}
/*
@@ -1751,58 +1677,60 @@ RcGetOption (clientData, interp, optionName, dsPtr)
/*
*----------------------------------------------------------------------
*
- * RcEncodeEventMask --
+ * EncodeEventMask --
*
* This function takes a list of event items and constructs the
- * equivalent internal bitmask. The list has to contain at
- * least one element. Elements are "read", "write", or any unique
- * abbreviation thereof. Note that the bitmask is not changed if
- * problems are encountered.
+ * equivalent internal bitmask. The list has to contain at least one
+ * element. Elements are "read", "write", or any unique abbreviation
+ * thereof. Note that the bitmask is not changed if problems are
+ * encountered.
*
* Results:
- * A standard Tcl error code. A bitmask where TCL_READABLE
- * and/or TCL_WRITABLE can be set.
+ * A standard Tcl error code. A bitmask where TCL_READABLE and/or
+ * TCL_WRITABLE can be set.
*
* Side effects:
- * May shimmer 'obj' to a list representation. May place an
- * error message into the interp result.
+ * May shimmer 'obj' to a list representation. May place an error message
+ * into the interp result.
*
*----------------------------------------------------------------------
*/
static int
-RcEncodeEventMask (interp, objName, obj, mask)
- Tcl_Interp* interp;
- CONST char* objName;
- Tcl_Obj* obj;
- int* mask;
+EncodeEventMask(
+ Tcl_Interp *interp,
+ CONST char *objName,
+ Tcl_Obj *obj,
+ int *mask)
{
- int events; /* Mask of events to post */
- int listc; /* #elements in eventspec list */
- Tcl_Obj** listv; /* Elements of eventspec list */
- int evIndex; /* Id of event for an element of the
- * eventspec list */
+ int events; /* Mask of events to post */
+ int listc; /* #elements in eventspec list */
+ Tcl_Obj **listv; /* Elements of eventspec list */
+ int evIndex; /* Id of event for an element of the eventspec
+ * list. */
- if (Tcl_ListObjGetElements (interp, obj,
- &listc, &listv) != TCL_OK) {
- return TCL_ERROR;
+ if (Tcl_ListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
+ return TCL_ERROR;
}
if (listc < 1) {
- Tcl_AppendResult(interp, "bad ", objName, " list: is empty",
- (char *) NULL);
+ Tcl_AppendResult(interp, "bad ", objName, " list: is empty", NULL);
return TCL_ERROR;
}
events = 0;
while (listc > 0) {
- if (Tcl_GetIndexFromObj (interp, listv [listc-1],
- eventOptions, objName, 0, &evIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions,
+ objName, 0, &evIndex) != TCL_OK) {
return TCL_ERROR;
}
switch (evIndex) {
- case EVENT_READ: events |= TCL_READABLE; break;
- case EVENT_WRITE: events |= TCL_WRITABLE; break;
+ case EVENT_READ:
+ events |= TCL_READABLE;
+ break;
+ case EVENT_WRITE:
+ events |= TCL_WRITABLE;
+ break;
}
listc --;
}
@@ -1814,14 +1742,14 @@ RcEncodeEventMask (interp, objName, obj, mask)
/*
*----------------------------------------------------------------------
*
- * RcDecodeEventMask --
+ * DecodeEventMask --
*
- * This function takes an internal bitmask of events and
- * constructs the equivalent list of event items.
+ * 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.
+ * 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.
@@ -1829,31 +1757,40 @@ RcEncodeEventMask (interp, objName, obj, mask)
*----------------------------------------------------------------------
*/
-static Tcl_Obj*
-RcDecodeEventMask (mask)
- int mask;
+static Tcl_Obj *
+DecodeEventMask(
+ int mask)
{
- Tcl_Obj* evObj = Tcl_NewStringObj (((mask & RANDW) == RANDW) ?
- "read write" :
- ((mask & TCL_READABLE) ?
- "read" :
- ((mask & TCL_WRITABLE) ?
- "write" : "")), -1);
- if (evObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcDecodeEventMask");
+ 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;
}
- Tcl_IncrRefCount (evObj);
+ evObj = Tcl_NewStringObj(eventStr, -1);
+ Tcl_IncrRefCount(evObj);
return evObj;
}
/*
*----------------------------------------------------------------------
*
- * RcNew --
+ * NewReflectedChannel --
*
- * This function is invoked to allocate and initialize the
- * instance data of a new reflected channel.
+ * This function is invoked to allocate and initialize the instance data
+ * of a new reflected channel.
*
* Results:
* A heap-allocated channel instance.
@@ -1864,42 +1801,44 @@ RcDecodeEventMask (mask)
*----------------------------------------------------------------------
*/
-static ReflectingChannel*
-RcNew (interp, cmdpfxObj, mode, id)
- Tcl_Interp* interp;
- Tcl_Obj* cmdpfxObj;
- int mode;
- Tcl_Obj* id;
+static ReflectedChannel *
+NewReflectedChannel(
+ Tcl_Interp *interp,
+ Tcl_Obj *cmdpfxObj,
+ int mode,
+ Tcl_Obj *handleObj)
{
- ReflectingChannel* rcPtr;
- int listc;
- Tcl_Obj** listv;
- Tcl_Obj* word;
- int i;
+ ReflectedChannel *rcPtr;
+ int listc;
+ Tcl_Obj **listv;
+ int i;
- rcPtr = (ReflectingChannel*) ckalloc (sizeof(ReflectingChannel));
+ rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
- /* rcPtr->chan : Assigned by caller. Dummy data here. */
- /* rcPtr->methods : Assigned by caller. Dummy data here. */
+ /* rcPtr->chan: Assigned by caller. Dummy data here. */
+ /* rcPtr->methods: Assigned by caller. Dummy data here. */
- rcPtr->chan = (Tcl_Channel) NULL;
- rcPtr->methods = 0;
- rcPtr->interp = interp;
+ rcPtr->chan = NULL;
+ rcPtr->methods = 0;
+ rcPtr->interp = interp;
#ifdef TCL_THREADS
- rcPtr->thread = Tcl_GetCurrentThread ();
+ rcPtr->thread = Tcl_GetCurrentThread();
#endif
- rcPtr->mode = mode;
- rcPtr->interest = 0; /* Initially no interest registered */
+ rcPtr->mode = mode;
+ rcPtr->interest = 0; /* Initially no interest registered */
- /* Method placeholder */
+ /*
+ * Method placeholder.
+ */
/* ASSERT: cmdpfxObj is a Tcl List */
- Tcl_ListObjGetElements (interp, cmdpfxObj, &listc, &listv);
+ 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.
+ /*
+ * 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]
@@ -1907,284 +1846,299 @@ RcNew (interp, cmdpfxObj, mode, id)
*/
rcPtr->argc = listc + 2;
- rcPtr->argv = (Tcl_Obj**) ckalloc (sizeof (Tcl_Obj*) * (listc+4));
+ rcPtr->argv = (Tcl_Obj**) ckalloc(sizeof(Tcl_Obj*) * (listc+4));
+
+ /*
+ * Duplicate object references.
+ */
- for (i = 0; i < listc ; i++) {
- word = rcPtr->argv [i] = listv [i];
- Tcl_IncrRefCount (word);
+ for (i=0; i<listc ; i++) {
+ Tcl_Obj *word = rcPtr->argv[i] = listv[i];
+ Tcl_IncrRefCount(word);
}
- i++; /* Skip placeholder for method */
+ i++; /* Skip placeholder for method */
+
+ rcPtr->argv[i] = handleObj;
+ Tcl_IncrRefCount(handleObj);
- rcPtr->argv [i] = id ; Tcl_IncrRefCount (id);
+ /*
+ * The next two objects are kept empty, varying arguments.
+ */
- /* The next two objects are kept empty, varying arguments */
+ /*
+ * Initialization complete.
+ */
- /* Initialization complete */
return rcPtr;
}
/*
*----------------------------------------------------------------------
*
- * RcNewHandle --
+ * NextHandle --
*
- * This function is invoked to generate a channel handle for
- * a new reflected channel.
+ * 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 --.
+ * 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.
+ * May allocate memory. Mutex protected critical section locks out other
+ * threads for a short time.
*
*----------------------------------------------------------------------
*/
-static Tcl_Obj*
-RcNewHandle ()
+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).
+ /*
+ * 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).
*/
-#ifdef TCL_THREADS
- TCL_DECLARE_MUTEX (rcCounterMutex)
-#endif
+ TCL_DECLARE_MUTEX(rcCounterMutex)
static unsigned long rcCounter = 0;
+ Tcl_Obj *resObj;
- Tcl_Obj* res = Tcl_NewObj ();
-
-#ifdef TCL_THREADS
- Tcl_MutexLock (&rcCounterMutex);
-#endif
-
- TclObjPrintf(NULL, res, "rc%lu", rcCounter);
- rcCounter ++;
+ TclNewObj(resObj);
+ Tcl_MutexLock(&rcCounterMutex);
+ TclObjPrintf(NULL, resObj, "rc%lu", rcCounter);
+ rcCounter++;
+ Tcl_MutexUnlock(&rcCounterMutex);
-#ifdef TCL_THREADS
- Tcl_MutexUnlock (&rcCounterMutex);
-#endif
-
- return res;
+ return resObj;
}
-
static void
-RcFree (rcPtr)
- ReflectingChannel* rcPtr;
+FreeReflectedChannel(rcPtr)
+ ReflectedChannel *rcPtr;
{
- Channel* chanPtr = (Channel*) rcPtr->chan;
- int i, n;
+ Channel *chanPtr = (Channel *) rcPtr->chan;
+ int i, n;
if (chanPtr->typePtr != &tclRChannelType) {
- /* Delete a cloned ChannelType structure. */
- ckfree ((char*) chanPtr->typePtr);
+ /*
+ * Delete a cloned ChannelType structure.
+ */
+
+ ckfree((char*) chanPtr->typePtr);
}
n = rcPtr->argc - 2;
- for (i = 0; i < n; i++) {
- Tcl_DecrRefCount (rcPtr->argv[i]);
+ for (i=0; i<n; i++) {
+ Tcl_DecrRefCount(rcPtr->argv[i]);
}
- ckfree ((char*) rcPtr->argv);
- ckfree ((char*) rcPtr);
- return;
+ ckfree((char*) rcPtr->argv);
+ ckfree((char*) rcPtr);
}
/*
*----------------------------------------------------------------------
*
- * RcInvokeTclMethod --
+ * 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.
+ * 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.
+ * Result code and data as returned by the method.
*
* Side effects:
- * Arbitrary, as it calls upo na Tcl script.
+ * Arbitrary, as it calls upon a Tcl script.
*
*----------------------------------------------------------------------
*/
-static void
-RcInvokeTclMethod (rcPtr, method, argone, argtwo, result, resultObj, capture)
- ReflectingChannel* rcPtr;
- CONST char* method;
- Tcl_Obj* argone; /* NULL'able */
- Tcl_Obj* argtwo; /* NULL'able */
- int* result; /* NULL'able */
- Tcl_Obj** resultObj; /* NULL'able */
- int capture;
+static int
+InvokeTclMethod(
+ ReflectedChannel *rcPtr;
+ CONST char *method;
+ Tcl_Obj *argOneObj; /* NULL'able */
+ Tcl_Obj *argTwoObj; /* NULL'able */
+ Tcl_Obj **resultObjPtr; /* NULL'able */
+ int flags;
{
- /* Thread redirection was done by higher layers */
- /* ASSERT: Tcl_GetCurrentThread () == rcPtr->thread */
-
- int cmdc; /* #words in constructed command */
- Tcl_Obj* methObj = NULL; /* Method name in object form */
- Tcl_InterpState sr; /* State of handler interp */
- int res; /* Result code of method invokation */
- Tcl_Obj* resObj = NULL; /* Result of method invokation. */
+ 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. */
- /* NOTE (5): Decide impl. issue: Cache objects with method names ?
- * NOTE (5): Requires TSD data as reflections can be created in
- * NOTE (5): many different threads.
- * NOTE (5): ---
+ /*
+ * NOTE (5): Decide impl. issue: Cache objects with method names?
+ * Requires TSD data as reflections can be created in many different
+ * threads.
*/
- /* Insert method into the pre-allocated area, after the command
- * prefix, before the channel id.
+ /*
+ * Insert method into the pre-allocated area, after the command prefix,
+ * before the channel id.
*/
- methObj = Tcl_NewStringObj (method, -1);
- if (methObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcInvokeTclMethod");
- }
- Tcl_IncrRefCount (methObj);
- rcPtr->argv [rcPtr->argc - 2] = methObj;
+ methObj = Tcl_NewStringObj(method, -1);
+ Tcl_IncrRefCount(methObj);
+ rcPtr->argv[rcPtr->argc - 2] = methObj;
- /* Append the additional argument containing method specific
- * details behind the channel id. If specified.
+ /*
+ * Append the additional argument containing method specific details
+ * behind the channel id. If specified.
*/
- cmdc = rcPtr->argc ;
- if (argone) {
- Tcl_IncrRefCount (argone);
- rcPtr->argv [cmdc] = argone;
- cmdc++;
- }
- if (argtwo) {
- Tcl_IncrRefCount (argtwo);
- rcPtr->argv [cmdc] = argtwo;
+ cmdc = rcPtr->argc;
+ if (argOneObj) {
+ Tcl_IncrRefCount(argOneObj);
+ rcPtr->argv[cmdc] = argOneObj;
cmdc++;
+ if (argTwoObj) {
+ Tcl_IncrRefCount(argTwoObj);
+ rcPtr->argv[cmdc] = argTwoObj;
+ cmdc++;
+ }
}
- /* And run the handler ... This is done in auch a manner which
- * leaves any existing state intact.
+ /*
+ * And run the handler... This is done in auch a manner which leaves any
+ * existing state intact.
*/
- sr = Tcl_SaveInterpState (rcPtr->interp, 0 /* Dummy */);
- res = Tcl_EvalObjv (rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+ sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
+ Tcl_Preserve(rcPtr->interp);
+ result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
- /* We do not try to extract the result information if the caller has no
+ /*
+ * 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 (resultObj) {
- if ((res == TCL_OK) || !capture) {
- /* Ok result taken as is, also if the caller requests that there
+ if (resultObjPtr) {
+ if ((result == TCL_OK) || (flags & INVOKE_NO_CAPTURE)) {
+ /*
+ * Ok result taken as is, also if the caller requests that there
* is no capture.
*/
- resObj = Tcl_GetObjResult (rcPtr->interp);
+ resObj = Tcl_GetObjResult(rcPtr->interp);
} else {
- /* Non-ok ressult is always treated as an error.
- * We have to capture the full state of the result,
- * including additional options.
+ /*
+ * Non-ok result is always treated as an error. We have to capture
+ * the full state of the result, including additional options.
*/
- res = TCL_ERROR;
- resObj = RcErrorMarshall (rcPtr->interp);
+ result = TCL_ERROR;
+ resObj = MarshallError(rcPtr->interp);
}
Tcl_IncrRefCount(resObj);
}
- Tcl_RestoreInterpState (rcPtr->interp, sr);
-
- /* ... */
+ Tcl_RestoreInterpState(rcPtr->interp, sr);
+ Tcl_Release(rcPtr->interp);
- /* Cleanup of the dynamic parts of the command */
+ /*
+ * Cleanup of the dynamic parts of the command.
+ */
- Tcl_DecrRefCount (methObj);
- if (argone) {Tcl_DecrRefCount (argone);}
- if (argtwo) {Tcl_DecrRefCount (argtwo);}
+ Tcl_DecrRefCount(methObj);
+ if (argOneObj) {
+ Tcl_DecrRefCount(argOneObj);
+ if (argTwoObj) {
+ Tcl_DecrRefCount(argTwoObj);
+ }
+ }
- /* The resObj has a ref count of 1 at this location. This means
- * that the caller of RcInvoke has to dispose of it (but only if
- * it was returned to it).
+ /*
+ * 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 (result) {
- *result = res;
- }
- if (resultObj) {
- *resultObj = resObj;
+ if (resultObjPtr != NULL) {
+ *resultObjPtr = resObj;
}
- /* There no need to handle the case where nothing is returned, because for
+
+ /*
+ * There no need to handle the case where nothing is returned, because for
* that case resObj was not set anyway.
*/
+
+ return result;
}
#ifdef TCL_THREADS
static void
-RcForwardOp (rcPtr, op, dst, param)
- ReflectingChannel* rcPtr; /* Channel instance */
- RcOperation op; /* Forwarded driver operation */
- Tcl_ThreadId dst; /* Destination thread */
- CONST VOID* param; /* Arguments */
+ForwardOpToOwnerThread(
+ ReflectedChannel *rcPtr, /* Channel instance */
+ ForwardedOperation op, /* Forwarded driver operation */
+ CONST VOID *param) /* Arguments */
{
- RcForwardingEvent* evPtr;
- RcForwardingResult* resultPtr;
- int result;
+ Tcl_ThreadId dst = rcPtr->thread;
+ ForwardingEvent *evPtr;
+ ForwardingResult *resultPtr;
+ int result;
- /* Create and initialize the event and data structures */
+ /*
+ * Create and initialize the event and data structures.
+ */
- evPtr = (RcForwardingEvent*) ckalloc (sizeof (RcForwardingEvent));
- resultPtr = (RcForwardingResult*) ckalloc (sizeof (RcForwardingResult));
+ evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
+ resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
- evPtr->event.proc = RcForwardProc;
- evPtr->resultPtr = resultPtr;
- evPtr->op = op;
- evPtr->rcPtr = rcPtr;
- evPtr->param = param;
+ evPtr->event.proc = ForwardProc;
+ evPtr->resultPtr = resultPtr;
+ evPtr->op = op;
+ evPtr->rcPtr = rcPtr;
+ evPtr->param = param;
- resultPtr->src = Tcl_GetCurrentThread ();
- resultPtr->dst = dst;
- resultPtr->done = (Tcl_Condition) NULL;
+ resultPtr->src = Tcl_GetCurrentThread();
+ resultPtr->dst = dst;
+ resultPtr->done = NULL;
resultPtr->result = -1;
- resultPtr->evPtr = evPtr;
+ resultPtr->evPtr = evPtr;
- /* Now execute the forward */
+ /*
+ * Now execute the forward.
+ */
Tcl_MutexLock(&rcForwardMutex);
TclSpliceIn(resultPtr, forwardList);
/*
- * Ensure cleanup of the event if any of the two involved threads
- * exits while this event is pending or in progress.
+ * Ensure cleanup of the event if any of the two involved threads exits
+ * while this event is pending or in progress.
*/
- Tcl_CreateThreadExitHandler(RcSrcExitProc, (ClientData) evPtr);
- Tcl_CreateThreadExitHandler(RcDstExitProc, (ClientData) evPtr);
+ Tcl_CreateThreadExitHandler(SrcExitProc, (ClientData) evPtr);
+ Tcl_CreateThreadExitHandler(DstExitProc, (ClientData) evPtr);
/*
* Queue the event and poke the other thread's notifier.
*/
- Tcl_ThreadQueueEvent(dst, (Tcl_Event*)evPtr, TCL_QUEUE_TAIL);
+ 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.
+ * (*) 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 ?
- * NOTE (1): IOW Is it possible that "RcSrcExitProc" is called while we are here ?
- * NOTE (1): See complementary note (2) in "RcSrcExitProc"
- * NOTE (1): ---
+ /*
+ * 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"
*/
- Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL);
+ Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL);
}
/*
@@ -2193,362 +2147,294 @@ RcForwardOp (rcPtr, op, dst, param)
TclSpliceOut(resultPtr, forwardList);
- resultPtr->nextPtr = NULL;
- resultPtr->prevPtr = NULL;
+ resultPtr->nextPtr = NULL;
+ resultPtr->prevPtr = NULL;
Tcl_MutexUnlock(&rcForwardMutex);
Tcl_ConditionFinalize(&resultPtr->done);
/*
- * Kill the cleanup handlers now, and the result structure as well,
- * before returning the success code.
+ * Kill the cleanup handlers now, and the result structure as well, before
+ * returning the success code.
*
* Note: The event structure has already been deleted.
*/
- Tcl_DeleteThreadExitHandler(RcSrcExitProc, (ClientData) evPtr);
- Tcl_DeleteThreadExitHandler(RcDstExitProc, (ClientData) evPtr);
-
- result = resultPtr->result;
- ckfree ((char*) resultPtr);
+ Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr);
+ Tcl_DeleteThreadExitHandler(DstExitProc, (ClientData) evPtr);
+
+ result = resultPtr->result;
+ ckfree((char*) resultPtr);
}
static int
-RcForwardProc (evGPtr, mask)
- Tcl_Event *evGPtr;
- int mask;
+ForwardProc(
+ Tcl_Event *evGPtr,
+ int mask)
{
- /* Notes regarding access to the referenced data.
+ /*
+ * 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.
+ * 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.
+ * 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.
*/
- RcForwardingEvent* evPtr = (RcForwardingEvent*) evGPtr;
- RcForwardingResult* resultPtr = evPtr->resultPtr;
- ReflectingChannel* rcPtr = evPtr->rcPtr;
- Tcl_Interp* interp = rcPtr->interp;
- RcForwardParamBase* paramPtr = (RcForwardParamBase*) evPtr->param;
- int res = TCL_OK; /* Result code of RcInvokeTclMethod */
- Tcl_Obj* resObj = NULL; /* Interp result of RcInvokeTclMethod */
+ ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr;
+ ForwardingResult *resultPtr = evPtr->resultPtr;
+ ReflectedChannel *rcPtr = evPtr->rcPtr;
+ Tcl_Interp *interp = rcPtr->interp;
+ ForwardParam *paramPtr = evPtr->param;
+ Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */
- /* Ignore the event if no one is waiting for its result anymore.
+ /*
+ * Ignore the event if no one is waiting for its result anymore.
*/
if (!resultPtr) {
- return 1;
+ return 1;
}
paramPtr->code = TCL_OK;
- paramPtr->msg = NULL;
- paramPtr->vol = 0;
+ paramPtr->msgStr = NULL;
+ paramPtr->mustFree = 0;
switch (evPtr->op) {
- /* The destination thread for the following operations is
- * rcPtr->thread, which contains rcPtr->interp, the interp
- * we have to call upon for the driver.
- */
-
- case RcOpClose:
- {
- /* No parameters/results */
- RcInvokeTclMethod (rcPtr, "finalize", NULL, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (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
- */
-
- RcFree (rcPtr);
- }
- break;
-
- case RcOpInput:
- {
- RcForwardParamInput* p = (RcForwardParamInput*) paramPtr;
- Tcl_Obj* toReadObj = Tcl_NewIntObj (p->toRead);
-
- if (toReadObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcInput");
- }
-
- RcInvokeTclMethod (rcPtr, "read", toReadObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- p->toRead = -1;
- } else {
- /* Process a regular result. */
-
- int bytec; /* Number of returned bytes */
- unsigned char* bytev; /* Array of returned bytes */
-
- bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-
- if (p->toRead < bytec) {
- RcForwardSetStaticError (paramPtr, msg_read_toomuch);
- p->toRead = -1;
-
- } else {
- if (bytec > 0) {
- memcpy (p->buf, bytev, bytec);
- }
-
- p->toRead = bytec;
- }
- }
- }
- break;
-
- case RcOpOutput:
- {
- RcForwardParamOutput* p = (RcForwardParamOutput*) paramPtr;
- Tcl_Obj* bufObj = Tcl_NewByteArrayObj((unsigned char*) p->buf, p->toWrite);
-
- if (bufObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcOutput");
- }
-
- RcInvokeTclMethod (rcPtr, "write", bufObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- p->toWrite = -1;
- } else {
- /* Process a regular result. */
-
- int written;
-
- res = Tcl_GetIntFromObj (interp, resObj, &written);
- if (res != TCL_OK) {
-
- RcForwardSetObjError (paramPtr, RcErrorMarshall (interp));
- p->toWrite = -1;
-
- } else if ((written == 0) || (p->toWrite < written)) {
-
- RcForwardSetStaticError (paramPtr, msg_write_toomuch);
- p->toWrite = -1;
-
- } else {
- p->toWrite = written;
- }
- }
- }
- break;
-
- case RcOpSeek:
- {
- RcForwardParamSeek* p = (RcForwardParamSeek*) paramPtr;
-
- Tcl_Obj* offObj;
- Tcl_Obj* baseObj;
-
- offObj = Tcl_NewWideIntObj(p->offset);
- if (offObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSeekWide");
- }
-
- baseObj = Tcl_NewStringObj((p->seekMode == SEEK_SET) ?
- "start" :
- ((p->seekMode == SEEK_CUR) ?
- "current" :
- "end"), -1);
-
- if (baseObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSeekWide");
- }
-
- RcInvokeTclMethod (rcPtr, "seek", offObj, baseObj,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- p->offset = -1;
- } else {
- /* Process a regular result. If the type is wrong this
- * may change into an error.
- */
-
- Tcl_WideInt newLoc;
- res = Tcl_GetWideIntFromObj (interp, resObj, &newLoc);
-
- if (res == TCL_OK) {
- if (newLoc < Tcl_LongAsWide (0)) {
- RcForwardSetStaticError (paramPtr, msg_seek_beforestart);
- p->offset = -1;
- } else {
- p->offset = newLoc;
- }
- } else {
- RcForwardSetObjError (paramPtr, RcErrorMarshall (interp));
- p->offset = -1;
- }
- }
- }
- break;
-
- case RcOpWatch:
- {
- RcForwardParamWatch* p = (RcForwardParamWatch*) paramPtr;
-
- Tcl_Obj* maskObj = RcDecodeEventMask (p->mask);
- RcInvokeTclMethod (rcPtr, "watch", maskObj, NULL,
- NULL, NULL, NO_CAPTURE);
- Tcl_DecrRefCount (maskObj);
- }
- break;
-
- case RcOpBlock:
- {
- RcForwardParamBlock* p = (RcForwardParamBlock*) evPtr->param;
- Tcl_Obj* blockObj = Tcl_NewBooleanObj(!p->nonblocking);
-
- if (blockObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcBlock");
- }
-
- RcInvokeTclMethod (rcPtr, "blocking", blockObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- }
- }
- break;
-
- case RcOpSetOpt:
- {
- RcForwardParamSetOpt* p = (RcForwardParamSetOpt*) paramPtr;
- Tcl_Obj* optionObj;
- Tcl_Obj* valueObj;
-
- optionObj = Tcl_NewStringObj(p->name,-1);
- if (optionObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSetOption");
- }
-
- valueObj = Tcl_NewStringObj(p->value,-1);
- if (valueObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcSetOption");
- }
-
- RcInvokeTclMethod (rcPtr, "configure", optionObj, valueObj,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- }
- }
- break;
-
- case RcOpGetOpt:
- {
- /* Retrieve the value of one option */
-
- RcForwardParamGetOpt* p = (RcForwardParamGetOpt*) paramPtr;
- Tcl_Obj* optionObj;
-
- optionObj = Tcl_NewStringObj(p->name,-1);
- if (optionObj == (Tcl_Obj*) NULL) {
- Tcl_Panic ("Out of memory in RcGetOption");
- }
-
- RcInvokeTclMethod (rcPtr, "cget", optionObj, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- } else {
- Tcl_DStringAppend (p->value, Tcl_GetString (resObj), -1);
- }
- }
- break;
-
- case RcOpGetOptAll:
- {
- /* Retrieve all options. */
-
- RcForwardParamGetOpt* p = (RcForwardParamGetOpt*) paramPtr;
-
- RcInvokeTclMethod (rcPtr, "cgetall", NULL, NULL,
- &res, &resObj, DO_CAPTURE);
-
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, resObj);
- } else {
- /* Extract list, validate that it is a list, and
- * #elements. See NOTE (4) as well.
- */
-
- int listc;
- Tcl_Obj** listv;
-
- res = Tcl_ListObjGetElements (interp, resObj, &listc, &listv);
- if (res != TCL_OK) {
- RcForwardSetObjError (paramPtr, RcErrorMarshall (interp));
-
- } else if ((listc % 2) == 1) {
- /* Odd number of elements is wrong.
- * [x].
- */
-
- char* buf = ckalloc (200);
- sprintf (buf,
- "{Expected list with even number of elements, got %d %s instead}",
- listc,
- (listc == 1 ? "element" : "elements"));
-
- RcForwardSetDynError (paramPtr, buf);
- } else {
- int len;
- char* str = Tcl_GetStringFromObj (resObj, &len);
-
- if (len) {
- Tcl_DStringAppend (p->value, " ", 1);
- Tcl_DStringAppend (p->value, str, len);
- }
- }
- }
- }
- break;
+ /*
+ * The destination thread for the following operations is
+ * rcPtr->thread, which contains rcPtr->interp, the interp we have to
+ * call upon for the driver.
+ */
+
+ case ForwardedClose:
+ /*
+ * No parameters/results.
+ */
+
+ if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj,
+ 0) != 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
+ */
+
+ FreeReflectedChannel(rcPtr);
+ break;
+
+ case ForwardedInput: {
+ Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
+
+ if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj,
+ 0) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->input.toRead = -1;
+ } else {
+ /*
+ * Process a regular result.
+ */
+
+ int bytec; /* Number of returned bytes */
+ unsigned char *bytev; /* Array of returned bytes */
+
+ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+ if (paramPtr->input.toRead < bytec) {
+ ForwardSetStaticError(paramPtr, msg_read_toomuch);
+ paramPtr->input.toRead = -1;
+ } else {
+ if (bytec > 0) {
+ memcpy(paramPtr->input.buf, bytev, bytec);
+ }
+ paramPtr->input.toRead = bytec;
+ }
+ }
+ break;
+ }
+
+ case ForwardedOutput: {
+ Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
+ paramPtr->output.buf, paramPtr->output.toWrite);
+
+ if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj,
+ 0) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->output.toWrite = -1;
+ } else {
+ /*
+ * Process a regular result.
+ */
+
+ int written;
+
+ if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) {
+ ForwardSetObjError(paramPtr, MarshallError(interp));
+ paramPtr->output.toWrite = -1;
+ } else if (written==0 || paramPtr->output.toWrite<written) {
+ ForwardSetStaticError(paramPtr, msg_write_toomuch);
+ paramPtr->output.toWrite = -1;
+ } else {
+ paramPtr->output.toWrite = written;
+ }
+ }
+ break;
+ }
+
+ case ForwardedSeek: {
+ Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset);
+ Tcl_Obj *baseObj = Tcl_NewStringObj(
+ (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
+ (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end"), -1);
+
+ if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj,
+ 0) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ paramPtr->seek.offset = -1;
+ } else {
+ /*
+ * Process a regular result. If the type is wrong this may change
+ * into an error.
+ */
+
+ Tcl_WideInt newLoc;
+
+ if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
+ if (newLoc < Tcl_LongAsWide(0)) {
+ ForwardSetStaticError(paramPtr, msg_seek_beforestart);
+ paramPtr->seek.offset = -1;
+ } else {
+ paramPtr->seek.offset = newLoc;
+ }
+ } else {
+ ForwardSetObjError(paramPtr, MarshallError(interp));
+ paramPtr->seek.offset = -1;
+ }
+ }
+ break;
+ }
+
+ case ForwardedWatch: {
+ Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask);
+
+ (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL, NULL,
+ INVOKE_NO_CAPTURE);
+ Tcl_DecrRefCount(maskObj);
+ break;
+ }
+
+ case ForwardedBlock: {
+ Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
+
+ if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj,
+ 0) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+ break;
+ }
+
+ case ForwardedSetOpt: {
+ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
+ Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1);
+
+ if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj, &resObj,
+ 0) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+ break;
+ }
+
+ case ForwardedGetOpt: {
+ /*
+ * Retrieve the value of one option.
+ */
+
+ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
+
+ if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj,
+ 0) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ } else {
+ Tcl_DStringAppend(paramPtr->getOpt.value, TclGetString(resObj),-1);
+ }
+ break;
+ }
+
+ case ForwardedGetOptAll:
+ /*
+ * Retrieve all options.
+ */
+
+ if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj,
+ 0) != TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ } else {
+ /*
+ * Extract list, validate that it is a list, and #elements. See
+ * NOTE (4) as well.
+ */
+
+ int listc;
+ Tcl_Obj** listv;
+
+ if (Tcl_ListObjGetElements(interp, resObj, &listc,
+ &listv) != TCL_OK) {
+ ForwardSetObjError(paramPtr, MarshallError(interp));
+ } else if ((listc % 2) == 1) {
+ /*
+ * Odd number of elements is wrong. [x].
+ */
+
+ char *buf = ckalloc(200);
+ sprintf(buf,
+ "{Expected list with even number of elements, got %d %s instead}",
+ listc, (listc == 1 ? "element" : "elements"));
+
+ ForwardSetDynamicError(paramPtr, buf);
+ } else {
+ int len;
+ CONST char *str = Tcl_GetStringFromObj(resObj, &len);
+
+ if (len) {
+ Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1);
+ Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
+ }
+ }
+ }
+ break;
default:
- /* Bad operation code */
- Tcl_Panic ("Bad operation code in RcForwardProc");
- break;
+ /*
+ * 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
+ /*
+ * Remove the reference we held on the result of the invoke, if we had
+ * such.
*/
+
if (resObj != NULL) {
- Tcl_DecrRefCount (resObj);
+ 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.
+ /*
+ * 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(&rcForwardMutex);
+ Tcl_MutexLock(&rcForwardMutex);
resultPtr->result = TCL_OK;
Tcl_ConditionNotify(&resultPtr->done);
Tcl_MutexUnlock(&rcForwardMutex);
@@ -2557,97 +2443,92 @@ RcForwardProc (evGPtr, mask)
return 1;
}
-
static void
-RcSrcExitProc (clientData)
- ClientData clientData;
+SrcExitProc(
+ ClientData clientData)
{
- RcForwardingEvent* evPtr = (RcForwardingEvent*) clientData;
- RcForwardingResult* resultPtr;
- RcForwardParamBase* paramPtr;
-
- /* NOTE (2): Can this handler be called with the originator blocked ?
- * NOTE (2): ---
- */
+ ForwardingEvent *evPtr = (ForwardingEvent *) clientData;
+ ForwardingResult *resultPtr;
+ ForwardParam *paramPtr;
- /* 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.
- */
+ /*
+ * NOTE (2): Can this handler be called with the originator blocked?
+ */
- /*
- * 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 "RcForwardProc", should it already execute the
- * event.
- */
+ /*
+ * 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(&rcForwardMutex);
+ Tcl_MutexLock(&rcForwardMutex);
- resultPtr = evPtr->resultPtr;
- paramPtr = (RcForwardParamBase*) evPtr->param;
+ resultPtr = evPtr->resultPtr;
+ paramPtr = evPtr->param;
- evPtr->resultPtr = NULL;
- resultPtr->evPtr = NULL;
- resultPtr->result = TCL_ERROR;
+ evPtr->resultPtr = NULL;
+ resultPtr->evPtr = NULL;
+ resultPtr->result = TCL_ERROR;
- RcForwardSetStaticError (paramPtr, msg_send_originlost);
+ ForwardSetStaticError(paramPtr, msg_send_originlost);
- /* See below: TclSpliceOut(resultPtr, forwardList); */
+ /*
+ * See below: TclSpliceOut(resultPtr, forwardList);
+ */
- Tcl_MutexUnlock(&rcForwardMutex);
+ Tcl_MutexUnlock(&rcForwardMutex);
- /*
- * This unlocks (*). The structure will be spliced out and freed by
- * "RcForwardProc". Maybe.
- */
+ /*
+ * This unlocks (*). The structure will be spliced out and freed by
+ * "ForwardProc". Maybe.
+ */
- Tcl_ConditionNotify(&resultPtr->done);
+ Tcl_ConditionNotify(&resultPtr->done);
}
-
static void
-RcDstExitProc (clientData)
- ClientData clientData;
+DstExitProc(
+ ClientData clientData)
{
- RcForwardingEvent* evPtr = (RcForwardingEvent*) clientData;
- RcForwardingResult* resultPtr = evPtr->resultPtr;
- RcForwardParamBase* paramPtr = (RcForwardParamBase*) evPtr->param;
+ ForwardingEvent *evPtr = (ForwardingEvent *) clientData;
+ ForwardingResult *resultPtr = evPtr->resultPtr;
+ ForwardParam *paramPtr = evPtr->param;
- /* NOTE (3): It is not clear if the event still exists when this handler is called..
- * NOTE (3): We might have to use 'resultPtr' as our clientData instead.
- * NOTE (3): ---
- */
+ /*
+ * NOTE (3): It is not clear if the event still exists when this handler
+ * is called. We might have to use 'resultPtr' as our clientData instead.
+ */
- /* The receiver for the event exited, before processing the
- * event. We detach the result now, wake the originator up
- * and signal failure.
- */
+ /*
+ * The receiver for the event exited, before processing the event. We
+ * detach the result now, wake the originator up and signal failure.
+ */
- evPtr->resultPtr = NULL;
- resultPtr->evPtr = NULL;
- resultPtr->result = TCL_ERROR;
+ evPtr->resultPtr = NULL;
+ resultPtr->evPtr = NULL;
+ resultPtr->result = TCL_ERROR;
- RcForwardSetStaticError (paramPtr, msg_send_dstlost);
+ ForwardSetStaticError(paramPtr, msg_send_dstlost);
- Tcl_ConditionNotify(&resultPtr->done);
+ Tcl_ConditionNotify(&resultPtr->done);
}
-
static void
-RcForwardSetObjError (p,obj)
- RcForwardParamBase* p;
- Tcl_Obj* obj;
+ForwardSetObjError(
+ ForwardParam *p,
+ Tcl_Obj *obj)
{
- int len;
- char* msg;
-
- msg = Tcl_GetStringFromObj (obj, &len);
+ int len;
+ CONST char *msgStr = Tcl_GetStringFromObj(obj, &len);
- p->code = TCL_ERROR;
- p->vol = 1;
- p->msg = strcpy(ckalloc (1+len), msg);
+ len++;
+ ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len));
+ memcpy(p->base.msgStr, msgStr, (unsigned) len);
}
#endif