/* * 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 #include #include #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; iargv[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; iargv[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: */