Attachment "tclIORTrans.c" to
ticket [1163274fff]
added by
andreas_kupries
2007-11-15 05:51:25.
/*
* tclIORTrans.c --
*
* This file contains the implementation of Tcl's generic transformation
* reflection code, which allows the implementation of Tcl channel
* transformations in Tcl code.
*
* Parts of this file are based on code contributed by Jean-Claude
* Wippler.
*
* See TIP #230 for the specification of this functionality.
*
* Copyright (c) 2007 ActiveState.
*
* 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.24 2007/04/24 02:42:18 kennykb Exp $
*/
#include <tclInt.h>
#include <tclIO.h>
#include <assert.h>
#ifndef EINVAL
#define EINVAL 9
#endif
#ifndef EOK
#define EOK 0
#endif
/* DUPLICATE of HaveVersion() in tclIO.c // TODO - MODULE_SCOPE */
static int HaveVersion(const Tcl_ChannelType *typePtr,
Tcl_ChannelTypeVersion minimumVersion);
/*
* Signatures of all functions used in the C layer of the reflection.
*/
static int ReflectClose(ClientData clientData,
Tcl_Interp *interp);
static int ReflectInput(ClientData clientData, char *buf,
int toRead, int *errorCodePtr);
static int ReflectOutput(ClientData clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
static Tcl_WideInt ReflectSeekWide(ClientData clientData,
Tcl_WideInt offset, int mode, int *errorCodePtr);
static int ReflectSeek(ClientData clientData, long offset,
int mode, int *errorCodePtr);
static int ReflectGetOption(ClientData clientData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
static int ReflectSetOption(ClientData clientData,
Tcl_Interp *interp, const char *optionName,
const char *newValue);
static int ReflectHandle(ClientData clientData, int direction,
ClientData* handle);
static int ReflectNotify(ClientData clientData, int mask);
/*
* The C layer channel type/driver definition used by the reflection. This is
* a version 3 structure.
*/
static Tcl_ChannelType tclRTransformType = {
"tclrtransform", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
ReflectClose, /* Close channel, clean instance data */
ReflectInput, /* Handle read request */
ReflectOutput, /* Handle write request */
ReflectSeek, /* Move location of access point. */
ReflectSetOption, /* Set options. */
ReflectGetOption, /* Get options. */
ReflectWatch, /* Initialize notifier */
ReflectHandle, /* Get OS handle from the channel. */
NULL, /* No close2 support. NULL'able */
ReflectBlock, /* Set blocking/nonblocking. */
NULL, /* Flush channel. Not used by core. NULL'able */
ReflectNotify, /* Handle events. */
ReflectSeekWide, /* Move access point (64 bit). */
NULL, /* thread action */
NULL, /* truncate */
};
/*
* Structure of the buffer to hold transform results to be consumed by higher
* layers upon reading from the channel, plus the functions to manage such.
*/
typedef struct _ResultBuffer_ {
unsigned char* buf; /* Reference to the buffer area */
int allocated; /* Allocated size of the buffer area */
int used; /* Number of bytes in the buffer, <= allocated */
} ResultBuffer;
#define ResultLength(r) ((r)->used)
/* static int ResultLength (ResultBuffer* r); */
static void ResultClear (ResultBuffer* r);
static void ResultInit (ResultBuffer* r);
static void ResultAdd (ResultBuffer* r, unsigned char* buf, int toWrite);
static int ResultCopy (ResultBuffer* r, unsigned char* buf, int toRead);
#define RB_INCREMENT (512)
/*
* Instance data for a reflected transformation. ===========================
*/
typedef struct {
Tcl_Channel chan; /* Back reference to the channel of the
* transformation itself. */
Tcl_Channel parent; /* Reference to the channel the transformation
* was pushed on. */
Tcl_Interp *interp; /* Reference to the interpreter containing the
* Tcl level part of the channel. */
#ifdef TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
#endif
Tcl_TimerToken timer;
/* See [==] as well.
* Storage for the command prefix and the additional words required for
* the invocation of methods in the command handler.
*
* argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
* cmd ... pfx | method chan | detail1 detail2
* ~~~~ CT ~~~ ~~ CT ~~
*
* CT = Belongs to the 'Command handler Thread'.
*/
int argc; /* Number of preallocated words - 2 */
Tcl_Obj **argv; /* Preallocated array for calling the handler.
* args[0] is placeholder for cmd word.
* Followed by the arguments in the prefix,
* plus 4 placeholders for method, channel,
* and at most two varying (method specific)
* words. */
int methods; /* Bitmask of supported methods */
/*
* NOTE (9): Should we have predefined shared literals for the method
* names?
*/
int mode; /* Mask of R/W mode */
int interest; /* Mask of events the channel is interested
* in. */
int blocking; /* Flag: Channel is blocking or not */
int readIsDrained; /* Flag: Read buffers are flushed*/
ResultBuffer result;
} ReflectedTransform;
/*
* Event literals. ==================================================
*/
static const char *eventOptions[] = {
"read", "write", NULL
};
typedef enum {
EVENT_READ, EVENT_WRITE
} EventOption;
/*
* Method literals. ==================================================
*/
static const char *methodNames[] = {
"clear", /* OPT */
"drain", /* OPT, drain => read */
"event", /* OPT, event <=> watch */
"finalize", /* */
"flush", /* OPT, flush => write */
"initialize", /* */
"limit?", /* OPT */
"read", /* OPT */
"watch", /* OPT, watch <=> event */
"write", /* OPT */
NULL
};
typedef enum {
METH_CLEAR,
METH_DRAIN,
METH_EVENT,
METH_FINAL,
METH_FLUSH,
METH_INIT,
METH_LIMIT,
METH_READ,
METH_WATCH,
METH_WRITE
} MethodName;
#define FLAG(m) (1 << (m))
#define REQUIRED_METHODS \
(FLAG(METH_INIT) | FLAG(METH_FINAL))
#define RANDW \
(TCL_READABLE | TCL_WRITABLE)
#define IMPLIES(a,b) ((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f) (x & FLAG(f))
#ifdef TCL_THREADS
/*
* Thread specific types and structures.
*
* We are here essentially creating a very specific implementation of 'thread
* send'.
*/
/*
* Enumeration of all operations which can be forwarded.
*/
typedef enum {
ForwardedClear,
ForwardedClose,
ForwardedDrain,
ForwardedEvent,
ForwardedFlush,
ForwardedInput,
ForwardedLimit,
ForwardedOutput,
ForwardedWatch
} ForwardedOperation;
/*
* Event used to forward driver invocations to the thread actually managing
* the channel. We cannot construct the command to execute and forward
* that. Because then it will contain a mixture of Tcl_Obj's belonging to both
* the command handler thread (CT), and the thread managing the channel (MT),
* executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
* forward an operation code, the argument details, and reference to results.
* The command is assembled in the CT and belongs fully to that thread. No
* sharing problems.
*/
typedef struct ForwardParamBase {
int code; /* O: Ok/Fail of the cmd handler */
char *msgStr; /* O: Error message for handler failure */
int mustFree; /* O: True if msgStr is allocated, false if
* otherwise (static). */
} ForwardParamBase;
/*
* Operation specific parameter/result structures. (These are "subtypes" of
* ForwardParamBase. Where an operation does not need any special types, it
* has no "subtype" and just uses ForwardParamBase, as listed above.)
*/
struct ForwardParamTransform {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
char *buf; /* I: Bytes to transform,
* O: Bytes in transform result */
int size; /* I: #bytes to transform,
* O: #bytes in the transform result */
};
struct ForwardParamMask {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
int mask; /* I: Mask of the signaled events,
* O: Mask of events which are of interest */
};
struct ForwardParamLimit {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
int max; /* O: Character read limit */
};
/*
* Now join all these together in a single union for convenience.
*/
typedef union ForwardParam {
ForwardParamBase base;
struct ForwardParamTransform transform;
struct ForwardParamMask mask;
struct ForwardParamLimit limit;
} ForwardParam;
/*
* Forward declaration.
*/
typedef struct ForwardingResult ForwardingResult;
/*
* General event structure, with reference to operation specific data.
*/
typedef struct ForwardingEvent {
Tcl_Event event; /* Basic event data, has to be first item */
ForwardingResult *resultPtr;
ForwardedOperation op; /* Forwarded driver operation */
ReflectedTransform *rtPtr; /* Channel instance */
ForwardParam *param; /* Packaged arguments and return values, a
* ForwardParam pointer. */
} ForwardingEvent;
/*
* Structure to manage the result of the forwarding. This is not the result of
* the operation itself, but about the success of the forward event itself.
* The event can be successful, even if the operation which was forwarded
* failed. It is also there to manage the synchronization between the involved
* threads.
*/
struct ForwardingResult {
Tcl_ThreadId src; /* Originating thread. */
Tcl_ThreadId dst; /* Thread the op was forwarded to. */
Tcl_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. */
};
/*
* List of forwarded operations which have not completed yet, plus the mutex
* to protect the access to this process global list.
*/
static ForwardingResult *forwardList = NULL;
TCL_DECLARE_MUTEX(rcForwardMutex)
/*
* Function containing the generic code executing a forward, and wrapper
* macros for the actual operations we wish to forward. Uses ForwardProc as
* the event function executed by the thread receiving a forwarding event
* (which executes the appropriate function and collects the result, if any).
*
* The two ExitProcs are handlers so that things do not deadlock when either
* thread involved in the forwarding exits. They also clean things up so that
* we don't leak resources when threads go away.
*/
static void ForwardOpToOwnerThread(ReflectedTransform *rtPtr,
ForwardedOperation op, const VOID *param);
static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(ClientData clientData);
static void DstExitProc(ClientData clientData);
#define FreeReceivedError(p) \
if ((p)->base.mustFree) { \
ckfree((p)->base.msgStr); \
}
#define PassReceivedErrorInterp(i,p) \
if ((i) != NULL) { \
Tcl_SetChannelErrorInterp((i), \
Tcl_NewStringObj((p)->base.msgStr, -1)); \
} \
FreeReceivedError(p)
#define PassReceivedError(c,p) \
Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
FreeReceivedError(p)
#define ForwardSetStaticError(p,emsg) \
(p)->base.code = TCL_ERROR; \
(p)->base.mustFree = 0; \
(p)->base.msgStr = (char *) (emsg)
#define ForwardSetDynamicError(p,emsg) \
(p)->base.code = TCL_ERROR; \
(p)->base.mustFree = 1; \
(p)->base.msgStr = (char *) (emsg)
static void ForwardSetObjError(ForwardParam *p,
Tcl_Obj *objPtr);
#endif /* TCL_THREADS */
#define SetChannelErrorStr(c,msgStr) \
Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))
static Tcl_Obj * MarshallError(Tcl_Interp *interp);
static void UnmarshallErrorResult(Tcl_Interp *interp,
Tcl_Obj *msgObj);
/*
* Static functions for this file:
*/
static int EncodeEventMask(Tcl_Interp *interp,
const char *objName, Tcl_Obj *obj, int *mask);
static Tcl_Obj * DecodeEventMask(int mask);
static ReflectedTransform * NewReflectedTransform(Tcl_Interp *interp,
Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj,
Tcl_Channel parentChan);
static Tcl_Obj * NextHandle(void);
static void FreeReflectedTransform(ReflectedTransform *rtPtr);
static int InvokeTclMethod(ReflectedTransform *rtPtr,
const char *method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
/*
* Global constant strings (messages). ==================
* These string are used directly as bypass errors, thus they have to be valid
* Tcl lists where the last element is the message itself. Hence the
* list-quoting to keep the words of the message together. See also [x].
*/
static const char *msg_read_badlimit = "{Tcl driver returned bad read limit '0'}";
static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Origin thread lost}";
static const char *msg_send_dstlost = "{Destination thread lost}";
#endif /* TCL_THREADS */
/*
* Timer management (flushing out buffered data via artificial events).
*/
/*
* Number of milliseconds to wait before firing an event to try to
* flush out information waiting in buffers (fileevent support).
*/
#define FLUSH_DELAY (5)
static void TimerKill (ReflectedTransform* rtPtr);
static void TimerSetup (ReflectedTransform* rtPtr);
static void TimerRun (ClientData clientData);
/*
* Helper functions encapsulating some of the thread forwarding to make the
* control flow in callers easier.
*/
static int TransformRead (ReflectedTransform* rtPtr, int* errorCodePtr, unsigned char* buf, int toRead);
static int TransformWrite (ReflectedTransform* rtPtr, int* errorCodePtr, unsigned char* buf, int toWrite);
static int TransformDrain (ReflectedTransform* rtPtr, int* errorCodePtr);
static int TransformFlush (ReflectedTransform* rtPtr, int* errorCodePtr);
static void TransformClear (ReflectedTransform* rtPtr);
static int TransformLimit (ReflectedTransform* rtPtr, int* errorCodePtr, int* maxPtr);
static int TransformMask (ReflectedTransform* rtPtr);
/*
* Main methods to plug into the 'chan' ensemble'. ==================
*/
/*
*----------------------------------------------------------------------
*
* TclChanPushObjCmd --
*
* This function is invoked to process the "chan push" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result. The handle of the new channel is placed in the
* interp result.
*
* Side effects:
* Creates a new channel.
*
*----------------------------------------------------------------------
*/
int
TclChanPushObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
ReflectedTransform *rtPtr; /* Instance data of the new channel */
Tcl_Obj* chanObj; /* Handle of parent channel */
Tcl_Channel parentChan; /* Token of parent channel */
int mode; /* R/W mode of parent, later the new
* channel. Has to match the abilities of the
* handler commands */
Tcl_Obj *cmdObj; /* Command prefix, list of words */
Tcl_Obj *cmdNameObj; /* Command name */
Tcl_Obj *rcId; /* Handle of 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. */
Tcl_Obj *err; /* Error message */
/*
* Syntax: chan push CHANNEL CMDPREFIX
* [0] [1] [2] [3]
*
* Actually: rPush CHANNEL CMDPREFIX
* [0] [1] [2]
*/
#define CHAN (1)
#define CMD (2)
/*
* Number of arguments...
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "channel cmdprefix");
return TCL_ERROR;
}
/*
* First argument is a channel handle.
*/
chanObj = objv[CHAN];
parentChan = Tcl_GetChannel (interp, Tcl_GetString (chanObj), &mode);
if (parentChan == NULL) {
return TCL_ERROR;
}
parentChan = Tcl_GetTopChannel (parentChan);
/*
* Second argument is command prefix, i.e. list of words, first word is
* name of handler command, other words are fixed arguments. Run
* 'initialize' method to get the list of supported methods. Validate
* this.
*/
cmdObj = objv[CMD];
/*
* Basic check that the command prefix truly is a list.
*/
if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) {
return TCL_ERROR;
}
/*
* Now create the transformation (channel).
*/
rcId = NextHandle();
rtPtr = NewReflectedTransform(interp, cmdObj, mode, rcId, parentChan);
/*
* Invoke 'initialize' and validate that the handler is present and ok.
* Squash the transformation 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.
*/
modeObj = DecodeEventMask(mode);
result = InvokeTclMethod(rtPtr, "initialize", modeObj, NULL, &resObj);
Tcl_DecrRefCount(modeObj);
if (result != TCL_OK) {
UnmarshallErrorResult(interp, resObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
goto error;
}
/*
* Verify the result.
* - List, of method names. Convert to mask.
* Check for non-optionals through the mask.
* Compare open mode against optional r/w.
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
Tcl_AppendObjToObj(err, resObj);
Tcl_SetObjResult(interp, err);
Tcl_DecrRefCount(resObj);
goto error;
}
methods = 0;
while (listc > 0) {
if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
"method", TCL_EXACT, &methIndex) != TCL_OK) {
TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, " initialize\" returned ", -1);
Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
Tcl_SetObjResult(interp, err);
Tcl_DecrRefCount(resObj);
goto error;
}
methods |= FLAG(methIndex);
listc--;
}
Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" does not support all required methods", -1);
Tcl_SetObjResult(interp, err);
goto error;
}
/*
* Mode tell us what the parent channel supports. The methods tell us what
* the handler supports. We remove the non-supported bits from the mode
* and check that the channel is not completely inacessible. Afterward the
* mode tells us which methods are still required, and these methods will
* also be supported by the handler, by design of the check.
*/
if (!HAS(methods, METH_READ)) { mode &= ~TCL_READABLE; }
if (!HAS(methods, METH_WRITE)) { mode &= ~TCL_WRITABLE; }
if (!mode) {
TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" makes the channel inacessible", -1);
Tcl_SetObjResult(interp, err);
goto error;
}
/*
* The mode and support for it is ok, now check the internal constraints.
*/
if (!IMPLIES(HAS(methods, METH_WATCH), HAS(methods, METH_EVENT))) {
TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" supports \"watch\" but not \"event\"", -1);
Tcl_SetObjResult(interp, err);
goto error;
}
if (!IMPLIES(HAS(methods, METH_EVENT), HAS(methods, METH_WATCH))) {
TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" supports \"event\" but not \"watch\"", -1);
Tcl_SetObjResult(interp, err);
goto error;
}
if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" supports \"drain\" but not \"read\"", -1);
Tcl_SetObjResult(interp, err);
goto error;
}
if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" supports \"flush\" but not \"write\"", -1);
Tcl_SetObjResult(interp, err);
goto error;
}
Tcl_ResetResult(interp);
/*
* Everything is fine now.
*/
rtPtr->methods = methods;
rtPtr->mode = mode;
rtPtr->chan = Tcl_StackChannel (interp, &tclRTransformType,
(ClientData) rtPtr, mode,
rtPtr->parent);
/*
* Return handle as result of command.
*/
Tcl_AppendResult (interp, Tcl_GetChannelName (rtPtr->chan),
(char*) NULL);
return TCL_OK;
error:
/*
* We are not going through ReflectClose as we never had a channel
* structure.
*/
FreeReflectedTransform(rtPtr);
return TCL_ERROR;
#undef CHAN
#undef CMD
}
/*
*----------------------------------------------------------------------
*
* TclChanPopObjCmd --
*
* This function is invoked to process the "chan pop" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Posts events to a reflected channel, invokes event handlers. The
* latter implies that arbitrary side effects are possible.
*
*----------------------------------------------------------------------
*/
int
TclChanPopObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
/*
* Syntax: chan pop CHANNEL
* [0] [1] [2]
*
* Actually: rPop CHANNEL
* [0] [1]
*/
#define CHAN (1)
const char *chanId; /* Tcl level channel handle */
Tcl_Channel chan; /* Channel associated to the handle */
int mode; /* Channel r/w mode */
/*
* Number of arguments...
*/
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel");
return TCL_ERROR;
}
/*
* First argument is a channel, which may have a (reflected)
* transformation.
*/
chanId = TclGetString(objv[CHAN]);
chan = Tcl_GetChannel(interp, chanId, &mode);
if (chan == NULL) {
return TCL_ERROR;
}
/* Removing transformations is generic, and not restricted to reflected
* transformations.
*/
Tcl_UnstackChannel(interp, chan);
/* TODO: Check for inactive reflected transformations at the top and */
/* TODO: remove them as well. */
return TCL_OK;
#undef CHAN
}
/*
* Channel error message marshalling utilities.
*/
static Tcl_Obj*
MarshallError(
Tcl_Interp *interp)
{
/*
* Capture the result status of the interpreter into a string. => List of
* options and values, followed by the error message. The result has
* refCount 0.
*/
Tcl_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR);
/*
* => returnOpt.refCount == 0. We can append directly.
*/
Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp));
return returnOpt;
}
static void
UnmarshallErrorResult(
Tcl_Interp *interp,
Tcl_Obj *msgObj)
{
int lc;
Tcl_Obj **lv;
int explicitResult;
int numOptions;
/*
* Process the caught message.
*
* Syntax = (option value)... ?message?
*
* Bad syntax causes a panic. This is OK because the other side uses
* Tcl_GetReturnOptions and list construction functions to marshall the
* information; if we panic here, something has gone badly wrong already.
*/
if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
}
if (interp == NULL) {
return;
}
explicitResult = lc & 1; /* Odd number of values? */
numOptions = lc - explicitResult;
if (explicitResult) {
Tcl_SetObjResult(interp, lv[lc-1]);
}
(void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
((Interp *)interp)->flags &= ~ERR_ALREADY_LOGGED;
}
/*
* Driver functions. ================================================
*/
/*
*----------------------------------------------------------------------
*
* ReflectClose --
*
* This function is invoked when the channel is closed, to delete the
* driver specific instance data.
*
* Results:
* A posix error.
*
* Side effects:
* Releases memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectClose(
ClientData clientData,
Tcl_Interp *interp)
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
int result; /* Result code for 'close' */
Tcl_Obj *resObj; /* Result data for 'close' */
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
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
result = p.base.code;
/*
* FreeReflectedTransform is done in the forwarded operation!, in
* the other thread. rtPtr here is gone!
*/
if (result != TCL_OK) {
FreeReceivedError(&p);
}
return EOK;
}
#endif
FreeReflectedTransform(rtPtr);
return EOK;
}
/*
* In the reflected channel implementation a cleaned method mask here
* implies that the channel creation was aborted, and "finalize" must not
* be called. for transformations however we are not going through here on
* such an abort, but directly through FreeReflectedTransform. So for us
* that check is not necessary. We always go through 'finalize'.
*/
if (HAS(rtPtr->methods, METH_DRAIN) && (!rtPtr->readIsDrained)) {
int errorCode;
if (!TransformDrain (rtPtr, &errorCode)) {
return errorCode;
}
}
if (HAS(rtPtr->methods, METH_FLUSH)) {
int errorCode;
if (!TransformFlush (rtPtr, &errorCode)) {
return errorCode;
}
}
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
result = p.base.code;
/*
* FreeReflectedTransform is done in the forwarded operation!, in the
* other thread. rtPtr here is gone!
*/
if (result != TCL_OK) {
PassReceivedErrorInterp(interp, &p);
}
} else {
#endif
result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj);
if ((result != TCL_OK) && (interp != NULL)) {
Tcl_SetChannelErrorInterp(interp, resObj);
}
Tcl_DecrRefCount(resObj); /* Remove reference we held from the
* invoke */
FreeReflectedTransform(rtPtr);
#ifdef TCL_THREADS
}
#endif
return (result == TCL_OK) ? EOK : EINVAL;
}
/*
*----------------------------------------------------------------------
*
* ReflectInput --
*
* This function is invoked when more data is requested from the channel.
*
* Results:
* The number of bytes read.
*
* Side effects:
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectInput(
ClientData clientData,
char *buf,
int toRead,
int *errorCodePtr)
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
int gotBytes, copied, read;
/*
* The following check can be done before thread redirection, because we
* are reading from an item which is readonly, i.e. will never change
* during the lifetime of the channel.
*/
if (!(rtPtr->methods & FLAG(METH_READ))) {
SetChannelErrorStr(rtPtr->chan, msg_read_unsup);
*errorCodePtr = EINVAL;
return -1;
}
gotBytes = 0;
while (toRead > 0) {
/* Loop until the request is satisfied (or no data available from
* below, possibly EOF).
*/
copied = ResultCopy (&rtPtr->result, (unsigned char*) buf, toRead);
toRead -= copied;
buf += copied;
gotBytes += copied;
if (toRead == 0) {
return gotBytes;
}
/*
* The buffer is exhausted, but the caller wants even more. We now
* have to go to the underlying channel, get more bytes and then
* transform them for delivery. We may not get that we want (full EOF
* or temporary out of data).
*/
/*
* Length (rtPtr->result) == 0, toRead > 0 here. Use 'buf'! as target
* to store the intermediary information read from the parent channel.
*
* Ask the transform how much data it allows us to read from the
* underlying channel. This feature allows the transform to signal EOF
* upstream although there is none downstream. Useful to control an
* unbounded 'fcopy' for example, either through counting bytes, or by
* pattern matching.
*/
if ((rtPtr->methods & FLAG(METH_LIMIT))) {
int maxRead = -1;
if (!TransformLimit (rtPtr, errorCodePtr, &maxRead)) {
return -1;
}
if (maxRead == 0) {
SetChannelErrorStr(rtPtr->chan, msg_read_badlimit);
return -1;
} else if (maxRead > 0) {
if (maxRead < toRead) {
toRead = maxRead;
}
} /* else: 'maxRead < 0' == Accept the current value of toRead */
}
if (toRead <= 0) {
return gotBytes;
}
read = Tcl_ReadRaw (rtPtr->parent, buf, toRead);
if (read < 0) {
/* Report errors to caller.
* The state of the seek system is unchanged!
*/
if ((Tcl_GetErrno () == EAGAIN) && (gotBytes > 0)) {
/* EAGAIN is a special situation. If we had some data
* before we report that instead of the request to re-try.
*/
return gotBytes;
}
*errorCodePtr = Tcl_GetErrno ();
return -1;
}
if (read == 0) {
/*
* Check wether we hit on EOF in 'parent' or not. If not
* differentiate between blocking and non-blocking modes. In
* non-blocking mode we ran temporarily out of data. Signal this
* to the caller via EWOULDBLOCK and error return (-1). In the
* other cases we simply return what we got and let the caller
* wait for more. On the other hand, if we got an EOF we have to
* convert and flush all waiting partial data.
*/
if (!Tcl_Eof (rtPtr->parent)) {
/* The state of the seek system is unchanged! */
if (gotBytes == 0 && !rtPtr->blocking) {
*errorCodePtr = EWOULDBLOCK;
return -1;
} else {
return gotBytes;
}
} else {
/* Eof in parent */
if (rtPtr->readIsDrained) {
return gotBytes;
}
/*
* Now this is a bit different. The partial data waiting is
* converted and returned.
*/
if (HAS(rtPtr->methods, METH_DRAIN)) {
if(!TransformDrain (rtPtr, errorCodePtr)) {
return -1;
}
}
if (ResultLength (&rtPtr->result) == 0) {
/* The drain delivered nothing */
return gotBytes;
}
continue; /* at: while (toRead > 0) */
}
} /* read == 0 */
/*
* Transform the read chunk, which was not empty. Anything we got back
* is a transformation result is put into our buffers, and the next
* iteration will put it into the result.
*/
if (!TransformRead (rtPtr, errorCodePtr, buf, read)) {
return -1;
}
} /* while toRead > 0 */
return gotBytes;
}
/*
*----------------------------------------------------------------------
*
* ReflectOutput --
*
* This function is invoked when data is writen to the channel.
*
* Results:
* The number of bytes actually written.
*
* Side effects:
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectOutput(
ClientData clientData,
const char *buf,
int toWrite,
int *errorCodePtr)
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
/*
* The following check can be done before thread redirection, because we
* are reading from an item which is readonly, i.e. will never change
* during the lifetime of the channel.
*/
if (!(rtPtr->methods & FLAG(METH_WRITE))) {
SetChannelErrorStr(rtPtr->chan, msg_write_unsup);
*errorCodePtr = EINVAL;
return -1;
}
if (toWrite == 0) {
/* Nothing came in to write, ignore the call
*/
return 0;
}
/*
* Discard partial data in the input buffers, i.e. on the read side. Like
* we do when explicitly seeking as well.
*/
if ((rtPtr->methods & FLAG(METH_CLEAR))) {
TransformClear (rtPtr);
}
/*
* Hand the data to the transformation itself. Anything it deigned to
* return to us is a (partial) transformation result and written to the
* parent channel for further processing.
*/
if (!TransformWrite (rtPtr, errorCodePtr, (unsigned char*) buf, toWrite)) {
return -1;
}
*errorCodePtr = EOK;
return toWrite;
}
/*
*----------------------------------------------------------------------
*
* ReflectSeekWide / ReflectSeek --
*
* This function is invoked when the user wishes to seek on the channel.
*
* Results:
* The new location of the access point.
*
* Side effects:
* Allocates memory. Arbitrary, per the parent channel, and the called scripts.
*
*----------------------------------------------------------------------
*/
static Tcl_WideInt
ReflectSeekWide(
ClientData clientData,
Tcl_WideInt offset,
int seekMode,
int *errorCodePtr)
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
Channel* parent = (Channel*) rtPtr->parent;
Tcl_WideInt curPos; /* Position on the device. */
Tcl_DriverSeekProc *seekProc =
Tcl_ChannelSeekProc(Tcl_GetChannelType (rtPtr->parent));
/*
* Fail if the parent channel is not seekable.
*/
if (seekProc == NULL) {
Tcl_SetErrno(EINVAL);
return Tcl_LongAsWide(-1);
}
/*
* Check if we can leave out involving the Tcl level, i.e. transformation
* handler. This is true for tell requests, and transformations which
* support neither flush, nor drain. For these cases we can pass the
* request down and the result back up unchanged.
*/
if (
((seekMode != SEEK_CUR) || (offset != 0)) &&
(HAS(rtPtr->methods, METH_CLEAR) ||
HAS(rtPtr->methods, METH_FLUSH))
) {
/*
* Neither a tell request, nor clear/flush both not supported. We
* have to go through the Tcl level to clear and/or flush the
* transformation.
*/
if ((rtPtr->methods & FLAG(METH_CLEAR))) {
TransformClear (rtPtr);
}
if (HAS(rtPtr->methods, METH_FLUSH)) {
if (!TransformFlush (rtPtr, errorCodePtr)) {
return -1;
}
}
}
/*
* Now seek to the new position in the channel as requested by the
* caller. Note that we prefer the wideSeekProc if that is available and
* non-NULL...
*/
if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
parent->typePtr->wideSeekProc != NULL) {
curPos = (parent->typePtr->wideSeekProc) (parent->instanceData,
offset, seekMode, errorCodePtr);
} else if (offset < Tcl_LongAsWide(LONG_MIN) ||
offset > Tcl_LongAsWide(LONG_MAX)) {
*errorCodePtr = EOVERFLOW;
curPos = Tcl_LongAsWide(-1);
} else {
curPos = Tcl_LongAsWide((parent->typePtr->seekProc) (
parent->instanceData, Tcl_WideAsLong(offset), seekMode,
errorCodePtr));
}
if (curPos == Tcl_LongAsWide(-1)) {
Tcl_SetErrno(*errorCodePtr);
}
*errorCodePtr = EOK;
return curPos;
}
static int
ReflectSeek(
ClientData clientData,
long offset,
int seekMode,
int *errorCodePtr)
{
/*
* This function can be invoked from a transformation which is based on
* standard seeking, i.e. non-wide. Because of this we have to implement
* it, a dummy is not enough. We simply delegate the call to the wide
* routine.
*/
return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
errorCodePtr);
}
/*
*----------------------------------------------------------------------
*
* ReflectWatch --
*
* This function is invoked to tell the channel what events the I/O
* system is interested in.
*
* Results:
* None.
*
* Side effects:
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static void
ReflectWatch(
ClientData clientData,
int mask)
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
Tcl_DriverWatchProc* watchProc;
/* ASSERT rtPtr->methods & FLAG(METH_WATCH) */
/*
* We restrict the interest to what the transformation 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 &= rtPtr->mode;
if (mask == rtPtr->interest) {
/*
* Same old, same old, why should we do something?
*/
return;
}
rtPtr->interest = mask;
/* We will be notified automatically about events on the channel below via
* a call to 'ReflectNotify'. For this to work we have to pass the
* interest to the parent, possibly with more events added in by the
* transformation (--> TransformMask).
*/
watchProc = Tcl_ChannelWatchProc (Tcl_GetChannelType (rtPtr->parent));
(*watchProc) (Tcl_GetChannelInstanceData(rtPtr->parent),
mask | TransformMask (rtPtr));
/*
* Management of the internal timer.
*/
if (!(mask & TCL_READABLE) || (ResultLength(&rtPtr->result) == 0)) {
/*
* A pending timer may exist, but either is there no (more) interest
* in the events it generates or nothing is available for
* reading. Remove it, if existing.
*/
TimerKill (rtPtr);
} else {
/*
* There might be no pending timer, but there is interest in readable
* events and we actually have data waiting, so generate a timer to
* flush that if it does not exist.
*/
TimerSetup (rtPtr);
}
}
static int
TransformMask (ReflectedTransform* rtPtr)
{
Tcl_Obj *resObj;
int mask;
/* We are allowed to add additional events of interest to a watch mask if
* we want to, if the transformation needs them. For this we have to ask
* it, with all that entails (thread forwarding).
*/
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
ForwardOpToOwnerThread(rtPtr, ForwardedWatch, &p);
return p.mask.mask;
}
#endif
if (InvokeTclMethod(rtPtr, "watch", NULL, NULL, &resObj) != TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return 0;
}
if (EncodeEventMask(rtPtr->interp, "mask", resObj, &mask) != TCL_OK) {
Tcl_SetChannelError (rtPtr->chan, Tcl_GetObjResult(rtPtr->interp));
Tcl_DecrRefCount(resObj);
return 0;
}
Tcl_DecrRefCount(resObj);
return mask;
}
/*
*----------------------------------------------------------------------
*
* ReflectBlock --
*
* This function is invoked to tell the channel which blocking behaviour
* is required of it.
*
* Results:
* A posix error number.
*
* Side effects:
* Allocates memory. Arbitrary, as it calls upon a script.
*
*----------------------------------------------------------------------
*/
static int
ReflectBlock(
ClientData clientData,
int nonblocking)
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
/*
* Transformations simply record the blocking mode in their C level
* structure for use by --> ReflectInput. The Tcl level doesn't see this
* information or change. As such thread forwarding is not required.
*/
rtPtr->blocking = !nonblocking;
return EOK;
}
/*
*----------------------------------------------------------------------
*
* ReflectSetOption --
*
* This function is invoked to configure a channel option.
*
* Results:
* A standard Tcl result code.
*
* Side effects:
* Arbitrary, per the parent channel.
*
*----------------------------------------------------------------------
*/
static int
ReflectSetOption(
ClientData clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of requested option */
const char *newValue) /* The new value */
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
/*
* Transformations have no options. Thus the call is passed down unchanged
* to the parent channel for processing. Its results are passed back
* unchanged as well. This all happens in the thread we are in. As the Tcl
* level is not involved there is no need for thread forwarding.
*/
Tcl_DriverSetOptionProc *setOptionProc =
Tcl_ChannelSetOptionProc (Tcl_GetChannelType (rtPtr->parent));
if (setOptionProc != NULL) {
return (*setOptionProc) (Tcl_GetChannelInstanceData (rtPtr->parent),
interp, optionName, newValue);
} else {
return TCL_ERROR;
}
}
/*
*----------------------------------------------------------------------
*
* ReflectGetOption --
*
* This function is invoked to retrieve all or a channel options.
*
* Results:
* A standard Tcl result code.
*
* Side effects:
* Arbitrary, per the parent channel.
*
*----------------------------------------------------------------------
*/
static int
ReflectGetOption(
ClientData clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of reuqested option */
Tcl_DString *dsPtr) /* String to place the result into */
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
/*
* Transformations have no options. Thus the call is passed down unchanged
* to the parent channel for processing. Its results are passed back
* unchanged as well. This all happens in the thread we are in. As the Tcl
* level is not involved there is no need for thread forwarding.
*
* Note that the parent not having a driver for option retrieval is not an
* immediate error. A query for all options is ok. Only a request for a
* specific option has to fail.
*/
Tcl_DriverGetOptionProc *getOptionProc =
Tcl_ChannelGetOptionProc (Tcl_GetChannelType (rtPtr->parent));
if (getOptionProc != NULL) {
return (*getOptionProc) (Tcl_GetChannelInstanceData (rtPtr->parent),
interp, optionName, dsPtr);
} else if (optionName == (char*) NULL) {
return TCL_OK;
} else {
return TCL_ERROR;
}
}
/*
*----------------------------------------------------------------------
*
* ReflectHandle --
*
* This function is invoked to retrieve the associated file handle.
*
* Results:
* A standard Tcl result code.
*
* Side effects:
* Arbitrary, per the parent channel.
*
*----------------------------------------------------------------------
*/
static int
ReflectHandle(
ClientData clientData,
int direction,
ClientData* handlePtr)
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
/*
* Transformations have no handle of their own. As such we simply query
* the parent channel for it. This way the qery will ripple down through
* all transformations until reaches the base channel. Which then returns
* its handle, or fails. The former will then ripple up the stack.
*
* This all happens in the thread we are in. As the Tcl level is not
* involved no forwarding is required.
*/
return Tcl_GetChannelHandle (rtPtr->parent, direction, handlePtr);
}
/*
*----------------------------------------------------------------------
*
* ReflectNotify --
*
* This function is invoked to reported incoming events.
*
* Results:
* A standard Tcl result code.
*
* Side effects:
* Arbitrary, per the parent channel.
*
*----------------------------------------------------------------------
*/
static int
ReflectNotify(
ClientData clientData,
int mask)
{
ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
Tcl_Obj* maskObj;
/*
* An event occured in the underlying channel. This transformation may or
* many not process such events. If not we return the incoming mask
* unchanged for further processing by the core.
*
* We do delete an existing timer. It was not fired, yet we are here, so
* the channel below generated such an event and we don't have to. The
* renewal of the interest after the execution of channel handlers will
* eventually cause us to recreate the timer (in ReflectWatch).
*/
TimerKill (rtPtr);
/*
* The following check can be done before thread redirection, because we
* are reading from an item which is readonly, i.e. will never change
* during the lifetime of the channel.
*/
if (!(rtPtr->methods & FLAG(METH_EVENT))) {
/*
* No processing by the transformation, pass unchanged
*/
return mask;
}
/*
* Another quick check we can do, does the mask contain events which are
* of interest to the transformation ? For if not we can simply pass the
* data up without incurring the expense of invoking the Tcl handler.
*
* NOTE that --> ReflectWatch updates the 'interest' field in the current
* thread as well, so no mutex exclusion is required when querying the
* field.
*/
if ((mask & rtPtr->interest) == 0) {
return mask;
}
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
p.mask.mask = mask & rtPtr->interest;
ForwardOpToOwnerThread(rtPtr, ForwardedEvent, &p);
return mask & ~rtPtr->interest;
}
#endif
/*
* We call the Tcl level only with events of interest to the
* transformation, and pass the remainder up.
*/
maskObj = DecodeEventMask(mask & rtPtr->interest);
(void) InvokeTclMethod(rtPtr, "event", maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
return mask & ~rtPtr->interest;
}
/*
* Helpers. =========================================================
*/
/*
*----------------------------------------------------------------------
*
* 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.
*
* Results:
* 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.
*
*----------------------------------------------------------------------
* DUPLICATE of 'EncodeEventMask' in tclIORChan.c
*/
static int
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. */
if (Tcl_ListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
return TCL_ERROR;
}
if (listc < 1) {
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) {
return TCL_ERROR;
}
switch (evIndex) {
case EVENT_READ:
events |= TCL_READABLE;
break;
case EVENT_WRITE:
events |= TCL_WRITABLE;
break;
}
listc --;
}
*mask = events;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* DecodeEventMask --
*
* This function takes an internal bitmask of events and constructs the
* equivalent list of event items.
*
* Results:
* A Tcl_Obj reference. The object will have a refCount of one. The user
* has to decrement it to release the object.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
* DUPLICATE of 'DecodeEventMask' in tclIORChan.c
*/
static Tcl_Obj *
DecodeEventMask(
int mask)
{
register const char *eventStr;
Tcl_Obj *evObj;
switch (mask & RANDW) {
case RANDW:
eventStr = "read write";
break;
case TCL_READABLE:
eventStr = "read";
break;
case TCL_WRITABLE:
eventStr = "write";
break;
default:
eventStr = "";
break;
}
evObj = Tcl_NewStringObj(eventStr, -1);
Tcl_IncrRefCount(evObj);
return evObj;
}
/*
*----------------------------------------------------------------------
*
* NewReflectedTransform --
*
* This function is invoked to allocate and initialize the instance data
* of a new reflected channel.
*
* Results:
* A heap-allocated channel instance.
*
* Side effects:
* Allocates memory.
*
*----------------------------------------------------------------------
*/
static ReflectedTransform *
NewReflectedTransform(
Tcl_Interp *interp,
Tcl_Obj *cmdpfxObj,
int mode,
Tcl_Obj *handleObj,
Tcl_Channel parentChan)
{
ReflectedTransform *rtPtr;
int listc;
Tcl_Obj **listv;
int i;
rtPtr = (ReflectedTransform *) ckalloc(sizeof(ReflectedTransform));
/* rtPtr->chan: Assigned by caller. Dummy data here. */
/* rtPtr->methods: Assigned by caller. Dummy data here. */
rtPtr->chan = NULL;
rtPtr->parent = parentChan;
rtPtr->interp = interp;
#ifdef TCL_THREADS
rtPtr->thread = Tcl_GetCurrentThread();
#endif
rtPtr->timer = (Tcl_TimerToken) NULL;
rtPtr->methods = 0;
rtPtr->mode = 0;
rtPtr->interest = 0; /* Initially no interest registered */
rtPtr->readIsDrained = 0;
rtPtr->blocking = 1; /* Initially a blocking channel ?
* TODO // Query parent for current mode.
*/
ResultInit (&rtPtr->result);
/*
* Method placeholder.
*/
/* ASSERT: cmdpfxObj is a Tcl List */
Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
/*
* See [==] as well.
* Storage for the command prefix and the additional words required for
* the invocation of methods in the command handler.
*
* listv [0] [listc-1] | [listc] [listc+1] |
* argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
* cmd ... pfx | method chan | detail1 detail2
*/
rtPtr->argc = listc + 2;
rtPtr->argv = (Tcl_Obj**) ckalloc(sizeof(Tcl_Obj*) * (listc+4));
/*
* Duplicate object references.
*/
for (i=0; i<listc ; i++) {
Tcl_Obj *word = rtPtr->argv[i] = listv[i];
Tcl_IncrRefCount(word);
}
i++; /* Skip placeholder for method */
/*
* See [x] in FreeReflectedTransform for release
*/
rtPtr->argv[i] = handleObj;
Tcl_IncrRefCount(handleObj);
/*
* The next two objects are kept empty, varying arguments.
*/
/*
* Initialization complete.
*/
return rtPtr;
}
/*
*----------------------------------------------------------------------
*
* NextHandle --
*
* This function is invoked to generate a channel handle for a new
* reflected channel.
*
* Results:
* A Tcl_Obj containing the string of the new channel handle. The
* refcount of the returned object is -- zero --.
*
* Side effects:
* May allocate memory. Mutex protected critical section locks out other
* threads for a short time.
*
*----------------------------------------------------------------------
*/
static Tcl_Obj *
NextHandle(void)
{
/*
* Count number of generated reflected channels. Used for id generation.
* Ids are never reclaimed and there is no dealing with wrap around. On
* the other hand, "unsigned long" should be big enough except for
* absolute longrunners (generate a 100 ids per second => overflow will
* occur in 1 1/3 years).
*/
TCL_DECLARE_MUTEX(rtCounterMutex)
static unsigned long rtCounter = 0;
Tcl_Obj *resObj;
Tcl_MutexLock(&rtCounterMutex);
resObj = Tcl_ObjPrintf("rt%lu", rtCounter);
rtCounter++;
Tcl_MutexUnlock(&rtCounterMutex);
return resObj;
}
static void
FreeReflectedTransform(
ReflectedTransform *rtPtr)
{
int i, n;
TimerKill (rtPtr);
ResultClear (&rtPtr->result);
n = rtPtr->argc - 2;
for (i=0; i<n; i++) {
Tcl_DecrRefCount(rtPtr->argv[i]);
}
/*
* See [x] in NewReflectedTransform for lock
* n+1 = argc-1.
*/
Tcl_DecrRefCount(rtPtr->argv[n+1]);
ckfree((char*) rtPtr->argv);
ckfree((char*) rtPtr);
}
/*
*----------------------------------------------------------------------
*
* InvokeTclMethod --
*
* This function is used to invoke the Tcl level of a reflected channel.
* It handles all the command assembly, invokation, and generic state and
* result mgmt. It does *not* handle thread redirection; that is the
* responsibility of clients of this function.
*
* Results:
* Result code and data as returned by the method.
*
* Side effects:
* Arbitrary, as it calls upon a Tcl script.
*
*----------------------------------------------------------------------
* Semi-DUPLICATE of 'InvokeTclMethod' in tclIORChan.c
* - Semi because different structures are used.
* - Still possible to factor out the commonalities into a separate structure.
*/
static int
InvokeTclMethod(
ReflectedTransform *rtPtr,
const char *method,
Tcl_Obj *argOneObj, /* NULL'able */
Tcl_Obj *argTwoObj, /* NULL'able */
Tcl_Obj **resultObjPtr) /* NULL'able */
{
int cmdc; /* #words in constructed command */
Tcl_Obj *methObj = NULL; /* Method name in object form */
Tcl_InterpState sr; /* State of handler interp */
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
/*
* 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.
*/
methObj = Tcl_NewStringObj(method, -1);
Tcl_IncrRefCount(methObj);
rtPtr->argv[rtPtr->argc - 2] = methObj;
/*
* Append the additional argument containing method specific details
* behind the channel id. If specified.
*/
cmdc = rtPtr->argc;
if (argOneObj) {
Tcl_IncrRefCount(argOneObj);
rtPtr->argv[cmdc] = argOneObj;
cmdc++;
if (argTwoObj) {
Tcl_IncrRefCount(argTwoObj);
rtPtr->argv[cmdc] = argTwoObj;
cmdc++;
}
}
/*
* And run the handler... This is done in auch a manner which leaves any
* existing state intact.
*/
sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
Tcl_Preserve(rtPtr->interp);
result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);
/*
* We do not try to extract the result information if the caller has no
* interest in it. I.e. there is no need to put effort into creating
* something which is discarded immediately after.
*/
if (resultObjPtr) {
if (result == TCL_OK) {
/*
* Ok result taken as is, also if the caller requests that there
* is no capture.
*/
resObj = Tcl_GetObjResult(rtPtr->interp);
} else {
/*
* Non-ok result is always treated as an error. We have to capture
* the full state of the result, including additional options.
*
* This is complex and ugly, and would be completely unnecessary
* if we only added support for a TCL_FORBID_EXCEPTIONS flag.
*/
if (result != TCL_ERROR) {
Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
int cmdLen;
const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
Tcl_IncrRefCount(cmd);
Tcl_ResetResult(rtPtr->interp);
Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
"chan handler returned bad code: %d", result));
Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
Tcl_DecrRefCount(cmd);
result = TCL_ERROR;
}
Tcl_AppendObjToErrorInfo(rtPtr->interp, Tcl_ObjPrintf(
"\n (chan handler subcommand \"%s\")", method));
resObj = MarshallError(rtPtr->interp);
}
Tcl_IncrRefCount(resObj);
}
Tcl_RestoreInterpState(rtPtr->interp, sr);
Tcl_Release(rtPtr->interp);
/*
* Cleanup of the dynamic parts of the command.
*/
Tcl_DecrRefCount(methObj);
if (argOneObj) {
Tcl_DecrRefCount(argOneObj);
if (argTwoObj) {
Tcl_DecrRefCount(argTwoObj);
}
}
/*
* The resObj has a ref count of 1 at this location. This means that the
* caller of InvokeTclMethod has to dispose of it (but only if it was
* returned to it).
*/
if (resultObjPtr != NULL) {
*resultObjPtr = resObj;
}
/*
* There no need to handle the case where nothing is returned, because for
* that case resObj was not set anyway.
*/
return result;
}
#ifdef TCL_THREADS
static void
ForwardOpToOwnerThread(
ReflectedTransform *rtPtr, /* Channel instance */
ForwardedOperation op, /* Forwarded driver operation */
const VOID *param) /* Arguments */
{
Tcl_ThreadId dst = rtPtr->thread;
ForwardingEvent *evPtr;
ForwardingResult *resultPtr;
int result;
/*
* Create and initialize the event and data structures.
*/
evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
evPtr->event.proc = ForwardProc;
evPtr->resultPtr = resultPtr;
evPtr->op = op;
evPtr->rtPtr = rtPtr;
evPtr->param = (ForwardParam *) param;
resultPtr->src = Tcl_GetCurrentThread();
resultPtr->dst = dst;
resultPtr->done = NULL;
resultPtr->result = -1;
resultPtr->evPtr = evPtr;
/*
* Now execute the forward.
*/
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.
*/
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_ThreadAlert(dst);
/*
* (*) Block until the other thread has either processed the transfer or
* rejected it.
*/
while (resultPtr->result < 0) {
/*
* NOTE (1): Is it possible that the current thread goes away while
* waiting here? IOW Is it possible that "SrcExitProc" is called
* while we are here? See complementary note (2) in "SrcExitProc"
*/
Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL);
}
/*
* Unlink result from the forwarder list.
*/
TclSpliceOut(resultPtr, forwardList);
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.
*
* Note: The event structure has already been deleted.
*/
Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr);
Tcl_DeleteThreadExitHandler(DstExitProc, (ClientData) evPtr);
result = resultPtr->result;
ckfree((char*) resultPtr);
}
static int
ForwardProc(
Tcl_Event *evGPtr,
int mask)
{
/*
* Notes regarding access to the referenced data.
*
* In principle the data belongs to the originating thread (see
* evPtr->src), however this thread is currently blocked at (*), i.e.
* quiescent. Because of this we can treat the data as belonging to us,
* without fear of race conditions. I.e. we can read and write as we like.
*
* The only thing we cannot be sure of is the resultPtr. This can be be
* NULLed if the originating thread went away while the event is handled
* here now.
*/
ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr;
ForwardingResult *resultPtr = evPtr->resultPtr;
ReflectedTransform *rtPtr = evPtr->rtPtr;
Tcl_Interp *interp = rtPtr->interp;
ForwardParam *paramPtr = evPtr->param;
Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */
/*
* Ignore the event if no one is waiting for its result anymore.
*/
if (!resultPtr) {
return 1;
}
paramPtr->base.code = TCL_OK;
paramPtr->base.msgStr = NULL;
paramPtr->base.mustFree = 0;
switch (evPtr->op) {
/*
* The destination thread for the following operations is
* rtPtr->thread, which contains rtPtr->interp, the interp we have to
* call upon for the driver.
*/
case ForwardedClose:
/*
* No parameters/results.
*/
if (InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
/*
* Freeing is done here, in the origin thread, because the argv[]
* objects belong to this thread. Deallocating them in a different
* thread is not allowed
*/
FreeReflectedTransform(rtPtr);
break;
case ForwardedInput: {
Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->transform.buf,
paramPtr->transform.size);
if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
} else {
/*
* Process a regular return. Contains the transformation result.
* Sent it back to the request originator.
*/
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
paramPtr->transform.size = bytec;
if (bytec > 0) {
paramPtr->transform.buf = ckalloc (bytec);
memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
} else {
paramPtr->transform.buf = NULL;
}
}
break;
}
case ForwardedOutput: {
Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->transform.buf,
paramPtr->transform.size);
if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
} else {
/*
* Process a regular return. Contains the transformation result.
* Sent it back to the request originator.
*/
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
paramPtr->transform.size = bytec;
if (bytec > 0) {
paramPtr->transform.buf = ckalloc (bytec);
memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
} else {
paramPtr->transform.buf = NULL;
}
}
break;
}
case ForwardedDrain: {
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
} else {
/*
* Process a regular return. Contains the transformation result.
* Sent it back to the request originator.
*/
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
paramPtr->transform.size = bytec;
if (bytec > 0) {
paramPtr->transform.buf = ckalloc (bytec);
memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
} else {
paramPtr->transform.buf = NULL;
}
}
break;
}
case ForwardedFlush: {
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
} else {
/*
* Process a regular return. Contains the transformation result.
* Sent it back to the request originator.
*/
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
paramPtr->transform.size = bytec;
if (bytec > 0) {
paramPtr->transform.buf = ckalloc (bytec);
memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
} else {
paramPtr->transform.buf = NULL;
}
}
break;
}
case ForwardedEvent: {
Tcl_Obj *maskObj = DecodeEventMask(paramPtr->mask.mask);
(void) InvokeTclMethod(rtPtr, "event", maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
break;
}
case ForwardedClear: {
(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
break;
}
case ForwardedLimit: {
Tcl_Obj* resObj;
if (InvokeTclMethod(rtPtr, "limit", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->limit.max = -1;
} else if (Tcl_GetIntFromObj(interp, resObj, ¶mPtr->limit.max) != TCL_OK) {
ForwardSetObjError(paramPtr, MarshallError(interp));
paramPtr->limit.max = -1;
}
Tcl_DecrRefCount(resObj);
break;
}
case ForwardedWatch: {
Tcl_Obj* resObj;
if (InvokeTclMethod(rtPtr, "watch", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->mask.mask = 0;
} else if (EncodeEventMask(rtPtr->interp, "mask", resObj, ¶mPtr->mask.mask) != TCL_OK) {
ForwardSetObjError(paramPtr, MarshallError(interp));
paramPtr->mask.mask = 0;
}
Tcl_DecrRefCount(resObj);
break;
}
default:
/*
* Bad operation code.
*/
Tcl_Panic("Bad operation code in ForwardProc");
break;
}
/*
* Remove the reference we held on the result of the invoke, if we had
* such.
*/
if (resObj != NULL) {
Tcl_DecrRefCount(resObj);
}
if (resultPtr) {
/*
* Report the forwarding result synchronously to the waiting caller.
* This unblocks (*) as well. This is wrapped into a conditional
* because the caller may have exited in the mean time.
*/
Tcl_MutexLock(&rcForwardMutex);
resultPtr->result = TCL_OK;
Tcl_ConditionNotify(&resultPtr->done);
Tcl_MutexUnlock(&rcForwardMutex);
}
return 1;
}
static void
SrcExitProc(
ClientData clientData)
{
ForwardingEvent *evPtr = (ForwardingEvent *) clientData;
ForwardingResult *resultPtr;
ForwardParam *paramPtr;
/*
* NOTE (2): Can this handler be called with the originator blocked?
*/
/*
* The originator for the event exited. It is not sure if this can happen,
* as the originator should be blocked at (*) while the event is in
* transit/pending.
*
* We make sure that the event cannot refer to the result anymore, remove
* it from the list of pending results and free the structure. Locking the
* access ensures that we cannot get in conflict with "ForwardProc",
* should it already execute the event.
*/
Tcl_MutexLock(&rcForwardMutex);
resultPtr = evPtr->resultPtr;
paramPtr = evPtr->param;
evPtr->resultPtr = NULL;
resultPtr->evPtr = NULL;
resultPtr->result = TCL_ERROR;
ForwardSetStaticError(paramPtr, msg_send_originlost);
/*
* See below: TclSpliceOut(resultPtr, forwardList);
*/
Tcl_MutexUnlock(&rcForwardMutex);
/*
* This unlocks (*). The structure will be spliced out and freed by
* "ForwardProc". Maybe.
*/
Tcl_ConditionNotify(&resultPtr->done);
}
static void
DstExitProc(
ClientData clientData)
{
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. 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.
*/
evPtr->resultPtr = NULL;
resultPtr->evPtr = NULL;
resultPtr->result = TCL_ERROR;
ForwardSetStaticError(paramPtr, msg_send_dstlost);
Tcl_ConditionNotify(&resultPtr->done);
}
static void
ForwardSetObjError(
ForwardParam *paramPtr,
Tcl_Obj *obj)
{
int len;
const char *msgStr = Tcl_GetStringFromObj(obj, &len);
len++;
ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len));
memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif
/*
*----------------------------------------------------------------------
*
* TimerKill --
*
* Timer management. Removes the internal timer
* if it exists.
*
* Sideeffects:
* See above.
*
* Result:
* None.
*
*----------------------------------------------------------------------
*/
static void
TimerKill (ReflectedTransform* rtPtr)
{
if (rtPtr->timer == (Tcl_TimerToken) NULL) return;
/* Delete an existing flush-out timer, prevent it from firing on a
* removed/dead channel.
*/
Tcl_DeleteTimerHandler (rtPtr->timer);
rtPtr->timer = (Tcl_TimerToken) NULL;
}
/*
*----------------------------------------------------------------------
*
* TimerSetup --
*
* Timer management. Creates the internal timer
* if it does not exist.
*
* Sideeffects:
* See above.
*
* Result:
* None.
*
*----------------------------------------------------------------------
*/
static void
TimerSetup (ReflectedTransform* rtPtr)
{
if (rtPtr->timer != (Tcl_TimerToken) NULL) return;
rtPtr->timer = Tcl_CreateTimerHandler (FLUSH_DELAY, TimerRun,
(ClientData) rtPtr);
}
/*
*----------------------------------------------------------------------
*
* TimerRun --
*
* Called by the notifier (-> timer) to flush out
* information waiting in channel buffers.
*
* Sideeffects:
* As of 'Tcl_NotifyChannel'.
*
* Result:
* None.
*
*----------------------------------------------------------------------
*/
static void
TimerRun (ClientData clientData)
{
ReflectedTransform* rtPtr = (ReflectedTransform*) clientData;
rtPtr->timer = (Tcl_TimerToken) NULL;
Tcl_NotifyChannel (rtPtr->chan, TCL_READABLE);
}
/*
*----------------------------------------------------------------------
*
* ResultInit --
*
* Initializes the specified buffer structure. The
* structure will contain valid information for an
* emtpy buffer.
*
* Sideeffects:
* See above.
*
* Result:
* None.
*
*----------------------------------------------------------------------
*/
static void
ResultInit (ResultBuffer* r) /* Reference to the structure to initialize */
{
r->used = 0;
r->allocated = 0;
r->buf = (unsigned char*) NULL;
}
/*
*----------------------------------------------------------------------
*
* ResultClear --
*
* Deallocates any memory allocated by 'ResultAdd'.
*
* Sideeffects:
* See above.
*
* Result:
* None.
*
*----------------------------------------------------------------------
*/
static void
ResultClear (ResultBuffer* r) /* Reference to the buffer to clear out */
{
r->used = 0;
if (!r->allocated) return;
Tcl_Free ((char*) r->buf);
r->buf = (unsigned char*) NULL;
r->allocated = 0;
}
/*
*----------------------------------------------------------------------
*
* ResultAdd --
*
* Adds the bytes in the specified array to the
* buffer, by appending it.
*
* Sideeffects:
* See above.
*
* Result:
* None.
*
*----------------------------------------------------------------------
*/
static void
ResultAdd (r, buf, toWrite)
ResultBuffer* r; /* The buffer to extend */
unsigned char* buf; /* The buffer to read from */
int toWrite; /* The number of bytes in 'buf' */
{
if ((r->used + toWrite + 1) > r->allocated) {
/* Extension of the internal buffer is required.
* NOTE: Currently linear. Should be doubling to amortize.
*/
if (r->allocated == 0) {
r->allocated = toWrite + RB_INCREMENT;
r->buf = (unsigned char*) Tcl_Alloc (r->allocated);
} else {
r->allocated += toWrite + RB_INCREMENT;
r->buf = (unsigned char*) Tcl_Realloc((char*) r->buf,
r->allocated);
}
}
/* now copy data */
memcpy (r->buf + r->used, buf, toWrite);
r->used += toWrite;
}
/*
*----------------------------------------------------------------------
*
* ResultCopy --
*
* Copies the requested number of bytes from the
* buffer into the specified array and removes them
* from the buffer afterward. Copies less if there
* is not enough data in the buffer.
*
* Sideeffects:
* See above.
*
* Result:
* The number of actually copied bytes,
* possibly less than 'toRead'.
*
*----------------------------------------------------------------------
*/
static int
ResultCopy (ResultBuffer* r, /* The buffer to read from */
unsigned char* buf, /* The buffer to copy into */
int toRead) /* Number of requested bytes */
{
int copied;
if (r->used == 0) {
/* Nothing to copy in the case of an empty buffer.
*/
copied = 0;
goto done;
}
if (r->used == toRead) {
/* We have just enough. Copy everything to the caller.
*/
memcpy ((VOID*) buf, (VOID*) r->buf, toRead);
r->used = 0;
copied = toRead;
goto done;
}
if (r->used > toRead) {
/* The internal buffer contains more than requested.
* Copy the requested subset to the caller, and shift
* the remaining bytes down.
*/
memcpy ((VOID*) buf, (VOID*) r->buf, toRead);
memmove ((VOID*) r->buf, (VOID*) (r->buf + toRead), r->used - toRead);
r->used -= toRead;
copied = toRead;
goto done;
}
/* There is not enough in the buffer to satisfy the caller, so
* take everything.
*/
memcpy ((VOID*) buf, (VOID*) r->buf, r->used);
toRead = r->used;
r->used = 0;
copied = toRead;
/* -- common postwork code ------- */
done:
return copied;
}
static int
TransformRead (
ReflectedTransform* rtPtr,
int* errorCodePtr,
unsigned char* buf,
int toRead)
{
Tcl_Obj* bufObj;
Tcl_Obj* resObj;
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
p.transform.buf = buf;
p.transform.size = toRead;
ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rtPtr->chan, &p);
*errorCodePtr = EINVAL;
return 0;
} else {
*errorCodePtr = EOK;
}
ResultAdd (&rtPtr->result, p.transform.buf, p.transform.size);
ckfree (p.transform.buf);
} else {
#endif
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead);
if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return 0;
}
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
ResultAdd (&rtPtr->result, bytev, bytec);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
#ifdef TCL_THREADS
}
#endif
return 1;
}
static int
TransformWrite (
ReflectedTransform* rtPtr,
int* errorCodePtr,
unsigned char* buf,
int toWrite)
{
Tcl_Obj *bufObj;
Tcl_Obj *resObj;
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
int res;
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
p.transform.buf = buf;
p.transform.size = toWrite;
ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rtPtr->chan, &p);
*errorCodePtr = EINVAL;
return 0;
} else {
*errorCodePtr = EOK;
}
res = Tcl_WriteRaw (rtPtr->parent,
(char*) p.transform.buf, p.transform.size);
ckfree (p.transform.buf);
} else {
#endif
/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
/* ASSERT: rtPtr->mode & TCL_WRITABLE */
bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return 0;
}
*errorCodePtr = EOK;
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
res = Tcl_WriteRaw (rtPtr->parent, (char*) bytev, bytec);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
#ifdef TCL_THREADS
}
#endif
if (res < 0) {
*errorCodePtr = EINVAL;
return 0;
}
return 1;
}
static int
TransformDrain(
ReflectedTransform* rtPtr,
int* errorCodePtr)
{
Tcl_Obj* resObj;
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rtPtr->chan, &p);
*errorCodePtr = EINVAL;
return 0;
} else {
*errorCodePtr = EOK;
}
ResultAdd (&rtPtr->result, p.transform.buf, p.transform.size);
ckfree (p.transform.buf);
} else {
#endif
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return 0;
}
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
ResultAdd (&rtPtr->result, bytev, bytec);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
#ifdef TCL_THREADS
}
#endif
rtPtr->readIsDrained = 1;
return 1;
}
static int
TransformFlush(
ReflectedTransform* rtPtr,
int* errorCodePtr)
{
Tcl_Obj* resObj;
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
int res;
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
ForwardOpToOwnerThread(rtPtr, ForwardedFlush, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rtPtr->chan, &p);
*errorCodePtr = EINVAL;
return 0;
} else {
*errorCodePtr = EOK;
}
res = Tcl_WriteRaw (rtPtr->parent,
(char*) p.transform.buf, p.transform.size);
ckfree(p.transform.buf);
} else {
#endif
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return 0;
}
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
res = Tcl_WriteRaw (rtPtr->parent, (char*) bytev, bytec);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
#ifdef TCL_THREADS
}
#endif
if (res < 0) {
*errorCodePtr = EINVAL;
return 0;
}
return 1;
}
static void
TransformClear (
ReflectedTransform* rtPtr)
{
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
return;
} else {
#endif
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
#ifdef TCL_THREADS
}
#endif
rtPtr->readIsDrained = 0;
ResultClear (&rtPtr->result);
}
static int
TransformLimit (
ReflectedTransform* rtPtr,
int* errorCodePtr,
int* maxPtr)
{
Tcl_Obj* resObj;
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
ForwardOpToOwnerThread(rtPtr, ForwardedLimit, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rtPtr->chan, &p);
*errorCodePtr = EINVAL;
return 0;
} else {
*errorCodePtr = EOK;
*maxPtr = p.limit.max;
return 1;
}
}
#endif
/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
/* ASSERT: rtPtr->mode & TCL_WRITABLE */
if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return 0;
}
if (Tcl_GetIntFromObj(rtPtr->interp, resObj, maxPtr) != TCL_OK) {
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_SetChannelError(rtPtr->chan, MarshallError(rtPtr->interp));
*errorCodePtr = EINVAL;
return 0;
}
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return 1;
}
/* DUPLICATE of HaveVersion() in tclIO.c
*----------------------------------------------------------------------
*
* HaveVersion --
*
* Return whether a channel type is (at least) of a given version.
*
* Results:
* True if the minimum version is exceeded by the version actually
* present.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
HaveVersion(
const Tcl_ChannelType *chanTypePtr,
Tcl_ChannelTypeVersion minimumVersion)
{
Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
return (PTR2INT(actualVersion)) >= (PTR2INT(minimumVersion));
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
