diff options
Diffstat (limited to 'generic/tclIORChan.c')
| -rw-r--r-- | generic/tclIORChan.c | 1673 |
1 files changed, 1187 insertions, 486 deletions
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index faaaca1..94428bb 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -14,12 +14,10 @@ * * 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.12 2005/12/13 22:43:17 kennykb Exp $ */ -#include <tclInt.h> -#include <tclIO.h> +#include "tclInt.h" +#include "tclIO.h" #include <assert.h> #ifndef EINVAL @@ -37,42 +35,51 @@ 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, +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); +#ifdef TCL_THREADS +static void ReflectThread(ClientData clientData, int action); +#endif 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_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int ReflectSetOption(ClientData clientData, - Tcl_Interp *interp, CONST char *optionName, - CONST char *newValue); + Tcl_Interp *interp, const char *optionName, + const char *newValue); /* * The C layer channel type/driver definition used by the reflection. This is * a version 3 structure. */ -static Tcl_ChannelType tclRChannelType = { - "tclrchannel", /* Type name. */ - TCL_CHANNEL_VERSION_3, - ReflectClose, /* Close channel, clean instance data */ - ReflectInput, /* Handle read request */ - ReflectOutput, /* Handle write request */ - ReflectSeek, /* Move location of access point. NULL'able */ - ReflectSetOption, /* Set options. NULL'able */ - ReflectGetOption, /* Get options. NULL'able */ - ReflectWatch, /* Initialize notifier */ - NULL, /* Get OS handle from the channel. NULL'able */ - NULL, /* No close2 support. NULL'able */ - ReflectBlock, /* Set blocking/nonblocking. NULL'able */ - NULL, /* Flush channel. Not used by core. NULL'able */ - NULL, /* Handle events. NULL'able */ - ReflectSeekWide /* Move access point (64 bit). NULL'able */ +static const Tcl_ChannelType tclRChannelType = { + "tclrchannel", /* 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. NULL'able */ + ReflectSetOption, /* Set options. NULL'able */ + ReflectGetOption, /* Get options. NULL'able */ + ReflectWatch, /* Initialize notifier */ + NULL, /* Get OS handle from the channel. NULL'able */ + NULL, /* No close2 support. NULL'able */ + ReflectBlock, /* Set blocking/nonblocking. NULL'able */ + NULL, /* Flush channel. Not used by core. NULL'able */ + NULL, /* Handle events. NULL'able */ + ReflectSeekWide, /* Move access point (64 bit). NULL'able */ +#ifdef TCL_THREADS + ReflectThread, /* thread action, tracking owner */ +#else + NULL, /* thread action */ +#endif + NULL /* truncate */ }; /* @@ -83,40 +90,26 @@ typedef struct { Tcl_Channel chan; /* Back reference to generic channel * structure. */ Tcl_Interp *interp; /* Reference to the interpreter containing the - * Tcl level part of the channel. */ + * Tcl level part of the channel. NULL here + * signals the channel is dead because the + * interpreter/thread containing its Tcl + * command is gone. + */ #ifdef TCL_THREADS - Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */ + Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ + Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif - - /* See [==] as well. - * Storage for the command prefix and the additional words required for - * the invocation of methods in the command handler. - * - * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2] - * cmd ... pfx | method chan | detail1 detail2 - * ~~~~ CT ~~~ ~~ CT ~~ - * - * CT = Belongs to the 'Command handler Thread'. - */ - - int argc; /* Number of preallocated words - 2 */ - Tcl_Obj **argv; /* Preallocated array for calling the handler. - * args[0] is placeholder for cmd word. - * Followed by the arguments in the prefix, - * plus 4 placeholders for method, channel, - * and at most two varying (method specific) - * words. */ - int methods; /* Bitmask of supported methods */ - - /* - * NOTE (9): Should we have predefined shared literals for the method - * names? - */ + Tcl_Obj *cmd; /* Callback command prefix */ + Tcl_Obj *methods; /* Methods to append to command prefix */ + Tcl_Obj *name; /* Name of the channel as created */ int mode; /* Mask of R/W mode */ int interest; /* Mask of events the channel is interested * in. */ + int dead; /* Boolean signal that some operations + * should no longer be attempted. */ + /* * Note regarding the usage of timers. * @@ -135,10 +128,27 @@ typedef struct { } ReflectedChannel; /* + * Structure of the table maping from channel handles to reflected + * channels. Each interpreter which has the handler command for one or more + * reflected channels records them in such a table, so that 'chan postevent' + * is able to find them even if the actual channel was moved to a different + * interpreter and/or thread. + * + * The table is reachable via the standard interpreter AssocData, the key is + * defined below. + */ + +typedef struct { + Tcl_HashTable map; +} ReflectedChannelMap; + +#define RCMKEY "ReflectedChannelMap" + +/* * Event literals. ================================================== */ -static CONST char *eventOptions[] = { +static const char *const eventOptions[] = { "read", "write", NULL }; typedef enum { @@ -149,7 +159,7 @@ typedef enum { * Method literals. ================================================== */ -static CONST char *methodNames[] = { +static const char *const methodNames[] = { "blocking", /* OPT */ "cget", /* OPT \/ Together or none */ "cgetall", /* OPT /\ of these two */ @@ -172,7 +182,7 @@ typedef enum { METH_READ, METH_SEEK, METH_WATCH, - METH_WRITE, + METH_WRITE } MethodName; #define FLAG(m) (1 << (m)) @@ -215,9 +225,9 @@ typedef enum { /* * 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), + * 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 @@ -245,7 +255,7 @@ struct ForwardParamInput { }; struct ForwardParamOutput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ - CONST char *buf; /* I: Where the bytes to write come from */ + const char *buf; /* I: Where the bytes to write come from */ int toWrite; /* I: #bytes to write, * O: #bytes actually written */ }; @@ -265,12 +275,12 @@ struct ForwardParamBlock { }; struct ForwardParamSetOpt { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ - CONST char *name; /* Name of option to set */ - CONST char *value; /* Value to set */ + const char *name; /* Name of option to set */ + const char *value; /* Value to set */ }; struct ForwardParamGetOpt { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ - CONST char *name; /* Name of option to get, maybe NULL */ + const char *name; /* Name of option to get, maybe NULL */ Tcl_DString *value; /* Result */ }; @@ -319,6 +329,14 @@ typedef struct ForwardingEvent { struct ForwardingResult { Tcl_ThreadId src; /* Originating thread. */ Tcl_ThreadId dst; /* Thread the op was forwarded to. */ + Tcl_Interp *dsti; /* Interpreter in the thread the op was + * forwarded to. */ + /* + * Note regarding 'dsti' above: Its information is also available via the + * chain evPtr->rcPtr->interp, however, as can be seen, two more + * indirections are needed to retrieve it. And the evPtr may be gone, + * breaking the chain. + */ Tcl_Condition done; /* Condition variable the forwarder blocks * on. */ int result; /* TCL_OK or TCL_ERROR */ @@ -328,6 +346,17 @@ struct ForwardingResult { * results. */ }; +typedef struct ThreadSpecificData { + /* + * Table of all reflected channels owned by this thread. This is the + * per-thread version of the per-interpreter map. + */ + + ReflectedChannelMap *rcmPtr; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + /* * List of forwarded operations which have not completed yet, plus the mutex * to protect the access to this process global list. @@ -342,41 +371,43 @@ TCL_DECLARE_MUTEX(rcForwardMutex) * 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. + * The ExitProc ensures that things do not deadlock when the sending thread + * involved in the forwarding exits. It also clean things up so that we don't + * leak resources when threads go away. */ -static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr, - ForwardedOperation op, CONST VOID *param); +static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr, + ForwardedOperation op, const void *param); static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(ClientData clientData); -static void DstExitProc(ClientData clientData); #define FreeReceivedError(p) \ - if ((p)->base.mustFree) { \ - ckfree((p)->base.msgStr); \ + if ((p)->base.mustFree) { \ + ckfree((p)->base.msgStr); \ } #define PassReceivedErrorInterp(i,p) \ - if ((i) != NULL) { \ - Tcl_SetChannelErrorInterp((i), \ - Tcl_NewStringObj((p)->base.msgStr, -1)); \ - } \ + 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.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.code = TCL_ERROR; \ + (p)->base.mustFree = 1; \ (p)->base.msgStr = (char *) (emsg) -static void ForwardSetObjError(ForwardParam *p, - Tcl_Obj *objPtr); +static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); + +static ReflectedChannelMap * GetThreadReflectedChannelMap(void); +static void DeleteThreadReflectedChannelMap(ClientData clientData); + #endif /* TCL_THREADS */ #define SetChannelErrorStr(c,msgStr) \ @@ -385,24 +416,26 @@ static void ForwardSetObjError(ForwardParam *p, 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); + const char *objName, Tcl_Obj *obj, int *mask); static Tcl_Obj * DecodeEventMask(int mask); static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj); static Tcl_Obj * NextHandle(void); static void FreeReflectedChannel(ReflectedChannel *rcPtr); static int InvokeTclMethod(ReflectedChannel *rcPtr, - CONST char *method, Tcl_Obj *argOneObj, - Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr, - int flags); + MethodName method, Tcl_Obj *argOneObj, + Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); -#define INVOKE_NO_CAPTURE 0x01 +static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); +static void DeleteReflectedChannelMap(ClientData clientData, + Tcl_Interp *interp); +static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); /* * Global constant strings (messages). ================== @@ -411,16 +444,16 @@ static int InvokeTclMethod(ReflectedChannel *rcPtr, * list-quoting to keep the words of the message together. See also [x]. */ -static CONST char *msg_read_unsup = "{read not supported by Tcl driver}"; -static CONST char *msg_read_toomuch = "{read delivered more than requested}"; -static CONST char *msg_write_unsup = "{write not supported by Tcl driver}"; -static CONST char *msg_write_toomuch = "{write wrote more than requested}"; -static CONST char *msg_seek_beforestart = "{Tried to seek before origin}"; +static const char *msg_read_toomuch = "{read delivered more than requested}"; +static const char *msg_write_toomuch = "{write wrote more than requested}"; +static const char *msg_write_nothing = "{write wrote nothing}"; +static const char *msg_seek_beforestart = "{Tried to seek before origin}"; #ifdef TCL_THREADS -static CONST char *msg_send_originlost = "{Origin thread lost}"; -static CONST char *msg_send_dstlost = "{Destination thread lost}"; +static const char *msg_send_originlost = "{Channel thread lost}"; +static const char *msg_send_dstlost = "{Owner lost}"; #endif /* TCL_THREADS */ - +static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}"; + /* * Main methods to plug into the 'chan' ensemble'. ================== */ @@ -448,7 +481,7 @@ TclChanCreateObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST *objv) + Tcl_Obj *const *objv) { ReflectedChannel *rcPtr; /* Instance data of the new channel */ Tcl_Obj *rcId; /* Handle of the new channel */ @@ -465,6 +498,12 @@ TclChanCreateObjCmd( Tcl_Obj *resObj; /* Result data for 'initialize' */ int methods; /* Bitmask for supported methods. */ Channel *chanPtr; /* 'chan' resolved to internal struct. */ + Tcl_Obj *err; /* Error message */ + ReflectedChannelMap *rcmPtr; + /* Map of reflected channels with handlers in + * this interp. */ + Tcl_HashEntry *hPtr; /* Entry in the above map */ + int isNew; /* Placeholder. */ /* * Syntax: chan create MODE CMDPREFIX @@ -498,7 +537,7 @@ TclChanCreateObjCmd( /* * Second argument is command prefix, i.e. list of words, first word is - * name of handler command, other words are fixed arguments. Run + * name of handler command, other words are fixed arguments. Run the * 'initialize' method to get the list of supported methods. Validate * this. */ @@ -519,10 +558,6 @@ TclChanCreateObjCmd( rcId = NextHandle(); rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId); - chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, - mode); - rcPtr->chan = chan; - chanPtr = (Channel *) chan; /* * Invoke 'initialize' and validate that the handler is present and ok. @@ -535,14 +570,12 @@ TclChanCreateObjCmd( */ modeObj = DecodeEventMask(mode); - result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj, - INVOKE_NO_CAPTURE); + /* assert modeObj.refCount == 1 */ + result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj); Tcl_DecrRefCount(modeObj); - if (result != TCL_OK) { - Tcl_Obj *err = Tcl_NewStringObj("Initialize failure: ", -1); - Tcl_AppendObjToObj(err, resObj); - Tcl_SetObjResult(interp, err); + if (result != TCL_OK) { + UnmarshallErrorResult(interp, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ goto error; } @@ -554,18 +587,11 @@ TclChanCreateObjCmd( * Compare open mode against optional r/w. */ - Tcl_AppendResult(interp, "Initialize failure: ", NULL); - - if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { - /* - * The function above replaces my prefix in case of an error, so more - * work for us to get the prefix back into the error message - */ - - Tcl_Obj *err = Tcl_NewStringObj("Initialize failure: ", -1); - - Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp)); - Tcl_SetObjResult(interp, err); + if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s initialize\" returned non-list: %s", + Tcl_GetString(cmdObj), Tcl_GetString(resObj))); + Tcl_DecrRefCount(resObj); goto error; } @@ -573,41 +599,52 @@ TclChanCreateObjCmd( while (listc > 0) { if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, "method", TCL_EXACT, &methIndex) != TCL_OK) { - Tcl_Obj *err = Tcl_NewStringObj("Initialize failure: ", -1); - + 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) { - Tcl_AppendResult(interp, "Not all required methods supported", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" does not support all required methods", + Tcl_GetString(cmdObj))); goto error; } if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) { - Tcl_AppendResult(interp, "Reading not supported, but requested", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" lacks a \"read\" method", + Tcl_GetString(cmdObj))); goto error; } if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) { - Tcl_AppendResult(interp, "Writing not supported, but requested", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" lacks a \"write\" method", + Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) { - Tcl_AppendResult(interp, - "'cgetall' not supported, but should be, as 'cget' is", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", + Tcl_GetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) { - Tcl_AppendResult(interp, - "'cget' not supported, but should be, as 'cgetall' is", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", + Tcl_GetString(cmdObj))); goto error; } @@ -617,7 +654,11 @@ TclChanCreateObjCmd( * Everything is fine now. */ - rcPtr->methods = methods; + chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, + mode); + rcPtr->chan = chan; + Tcl_Preserve(chan); + chanPtr = (Channel *) chan; if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) { /* @@ -626,8 +667,7 @@ TclChanCreateObjCmd( * as the actual channel type. */ - Tcl_ChannelType *clonePtr = (Tcl_ChannelType *) - ckalloc(sizeof(Tcl_ChannelType)); + Tcl_ChannelType *clonePtr = ckalloc(sizeof(Tcl_ChannelType)); memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType)); @@ -649,21 +689,40 @@ TclChanCreateObjCmd( chanPtr->typePtr = clonePtr; } + /* + * Register the channel in the I/O system, and in our our map for 'chan + * postevent'. + */ + Tcl_RegisterChannel(interp, chan); + rcmPtr = GetReflectedChannelMap(interp); + hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName, + &isNew); + if (!isNew && chanPtr != Tcl_GetHashValue(hPtr)) { + Tcl_Panic("TclChanCreateObjCmd: duplicate channel names"); + } + Tcl_SetHashValue(hPtr, chan); +#ifdef TCL_THREADS + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName, + &isNew); + Tcl_SetHashValue(hPtr, chan); +#endif + /* * Return handle as result of command. */ - Tcl_SetObjResult(interp, rcId); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(chanPtr->state->channelName, -1)); return TCL_OK; - error: - /* - * Signal to ReflectClose to not call 'finalize'. - */ - rcPtr->methods = 0; - Tcl_Close(interp, chan); + error: + Tcl_DecrRefCount(rcPtr->name); + Tcl_DecrRefCount(rcPtr->methods); + Tcl_DecrRefCount(rcPtr->cmd); + ckfree((char*) rcPtr); return TCL_ERROR; #undef MODE @@ -688,14 +747,60 @@ TclChanCreateObjCmd( *---------------------------------------------------------------------- */ +typedef struct ReflectEvent { + Tcl_Event header; + ReflectedChannel *rcPtr; + int events; +} ReflectEvent; + +static int +ReflectEventRun( + Tcl_Event *ev, + int flags) +{ + /* OWNER thread + * + * Note: When the channel is closed any pending events of this type are + * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls + * accomplishing that. + */ + + ReflectEvent *e = (ReflectEvent *) ev; + + Tcl_NotifyChannel(e->rcPtr->chan, e->events); + return 1; +} + +static int +ReflectEventDelete( + Tcl_Event *ev, + ClientData cd) +{ + /* OWNER thread + * + * Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The + * latter ensures that no pending events of this type are run on an + * invalid channel. + */ + + ReflectEvent *e = (ReflectEvent *) ev; + + if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) { + return 0; + } + return 1; +} + int TclChanPostEventObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST *objv) + Tcl_Obj *const *objv) { /* + * Ensure -> HANDLER thread + * * Syntax: chan postevent CHANNEL EVENTSPEC * [0] [1] [2] [3] * @@ -708,13 +813,15 @@ TclChanPostEventObjCmd( #define CHAN (1) #define EVENT (2) - CONST char *chanId; /* Tcl level channel handle */ + const char *chanId; /* Tcl level channel handle */ Tcl_Channel chan; /* Channel associated to the handle */ - Tcl_ChannelType *chanTypePtr; + const Tcl_ChannelType *chanTypePtr; /* Its associated driver structure */ ReflectedChannel *rcPtr; /* Associated instance data */ - int mode; /* Dummy, r|w mode of the channel */ int events; /* Mask of events to post */ + ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in + * this interp. */ + Tcl_HashEntry *hPtr; /* Entry in the above map */ /* * Number of arguments... @@ -731,12 +838,34 @@ TclChanPostEventObjCmd( */ chanId = TclGetString(objv[CHAN]); - chan = Tcl_GetChannel(interp, chanId, &mode); - if (chan == NULL) { + rcmPtr = GetReflectedChannelMap(interp); + hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId); + + if (hPtr == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can not find reflected channel named \"%s\"", chanId)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL); return TCL_ERROR; } + /* + * Note that the search above subsumes several of the older checks, namely: + * + * (1) Does the channel handle refer to a reflected channel ? + * (2) Is the post event issued from the interpreter holding the handler + * of the reflected channel ? + * + * A successful search answers yes to both. Because the map holds only + * handles of reflected channels, and only of such whose handler is + * defined in this interpreter. + * + * We keep the old checks for both, for paranioa, but abort now instead of + * throwing errors, as failure now means that our internal datastructures + * have gone seriously haywire. + */ + + chan = Tcl_GetHashValue(hPtr); chanTypePtr = Tcl_GetChannelType(chan); /* @@ -749,17 +878,13 @@ TclChanPostEventObjCmd( */ if (chanTypePtr->watchProc != &ReflectWatch) { - Tcl_AppendResult(interp, "channel \"", chanId, - "\" is not a reflected channel", NULL); - return TCL_ERROR; + Tcl_Panic("TclChanPostEventObjCmd: channel is not a reflected channel"); } - rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); + rcPtr = Tcl_GetChannelInstanceData(chan); if (rcPtr->interp != interp) { - Tcl_AppendResult(interp, "postevent for channel \"", chanId, - "\" called from outside interpreter", NULL); - return TCL_ERROR; + Tcl_Panic("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter"); } /* @@ -776,8 +901,9 @@ TclChanPostEventObjCmd( */ if (events & ~rcPtr->interest) { - Tcl_AppendResult(interp, "tried to post events channel \"", chanId, - "\" is not interested in", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "tried to post events channel \"%s\" is not interested in", + chanId)); return TCL_ERROR; } @@ -785,7 +911,44 @@ TclChanPostEventObjCmd( * We have the channel and the events to post. */ - Tcl_NotifyChannel(chan, events); +#ifdef TCL_THREADS + if (rcPtr->owner == rcPtr->thread) { +#endif + Tcl_NotifyChannel(chan, events); +#ifdef TCL_THREADS + } else { + ReflectEvent *ev = ckalloc(sizeof(ReflectEvent)); + + ev->header.proc = ReflectEventRun; + ev->events = events; + ev->rcPtr = rcPtr; + + /* + * We are not preserving the structure here. When the channel is + * closed any pending events are deleted, see ReflectClose(), and + * ReflectEventDelete(). Trying to preserve and later release when the + * event is run may generate a situation where the channel structure + * is deleted but not our structure, crashing in + * FreeReflectedChannel(). + * + * Force creation of the RCM, for proper cleanup on thread teardown. + * The teardown of unprocessed events is currently coupled to the + * thread reflected channel map + */ + + (void) GetThreadReflectedChannelMap(); + + /* XXX Race condition !! + * XXX The destination thread may not exist anymore already. + * XXX (Delayed postevent executed after channel got removed). + * XXX Can we detect this ? (check the validity of the owner threadid ?) + * XXX Actually, in that case the channel should be dead also ! + */ + + Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL); + Tcl_ThreadAlert(rcPtr->owner); + } +#endif /* * Squash interp results left by the event script. @@ -802,7 +965,7 @@ TclChanPostEventObjCmd( * Channel error message marshalling utilities. */ -static Tcl_Obj* +static Tcl_Obj * MarshallError( Tcl_Interp *interp) { @@ -845,6 +1008,9 @@ UnmarshallErrorResult( 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; @@ -854,6 +1020,7 @@ UnmarshallErrorResult( } (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv)); + ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED; } int @@ -938,11 +1105,14 @@ ReflectClose( ClientData clientData, Tcl_Interp *interp) { - ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; + ReflectedChannel *rcPtr = clientData; int result; /* Result code for 'close' */ Tcl_Obj *resObj; /* Result data for 'close' */ + ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in + * this interp */ + Tcl_HashEntry *hPtr; /* Entry in the above map */ - if (interp == NULL) { + if (TclInThreadExit()) { /* * This call comes from TclFinalizeIOSystem. There are no * interpreters, and therefore we cannot call upon the handler command @@ -954,21 +1124,23 @@ ReflectClose( /* * THREADED => Forward this to the origin thread * - * Note: Have a thread delete handler for the origin thread. Use this - * to clean up the structure! + * Note: DeleteThreadReflectedChannelMap() is the thread exit handler + * for the origin thread. Use this to clean up the structure? Except + * if lost? */ #ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; - /* - * FreeReflectedChannel is done in the forwarded operation!, in - * the other thread. rcPtr here is gone! - */ + /* + * Now squash the pending reflection events for this channel. + */ + + Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { FreeReceivedError(&p); @@ -977,19 +1149,7 @@ ReflectClose( } #endif - FreeReflectedChannel(rcPtr); - return EOK; - } - - /* - * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL) - * - * A cleaned method mask here implies that the channel creation was - * aborted, and "finalize" must not be called. - */ - - if (rcPtr->methods == 0) { - FreeReflectedChannel(rcPtr); + Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); return EOK; } @@ -1001,28 +1161,60 @@ ReflectClose( if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; - /* - * FreeReflectedChannel is done in the forwarded operation!, in the - * other thread. rcPtr here is gone! - */ + /* + * Now squash the pending reflection events for this channel. + */ + + Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); } } else { #endif - result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj, 0); + result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj); if ((result != TCL_OK) && (interp != NULL)) { Tcl_SetChannelErrorInterp(interp, resObj); } Tcl_DecrRefCount(resObj); /* Remove reference we held from the * invoke */ + + /* + * Remove the channel from the map before releasing the memory, to + * prevent future accesses (like by 'postevent') from finding and + * dereferencing a dangling pointer. + * + * NOTE: The channel may not be in the map. This is ok, that happens + * when the channel was created in a different interpreter and/or + * thread and then was moved here. + * + * NOTE: The channel may have been removed from the map already via + * the per-interp DeleteReflectedChannelMap exit-handler. + */ + + if (!rcPtr->dead) { + rcmPtr = GetReflectedChannelMap(rcPtr->interp); + hPtr = Tcl_FindHashEntry(&rcmPtr->map, + Tcl_GetChannelName(rcPtr->chan)); + if (hPtr) { + Tcl_DeleteHashEntry(hPtr); + } + } +#ifdef TCL_THREADS + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_FindHashEntry(&rcmPtr->map, + Tcl_GetChannelName(rcPtr->chan)); + if (hPtr) { + Tcl_DeleteHashEntry(hPtr); + } +#endif + + Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); #ifdef TCL_THREADS - FreeReflectedChannel(rcPtr); } #endif return (result == TCL_OK) ? EOK : EINVAL; @@ -1051,25 +1243,13 @@ ReflectInput( int toRead, int *errorCodePtr) { - ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; + ReflectedChannel *rcPtr = clientData; Tcl_Obj *toReadObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ /* - * The following check can be done before thread redirection, because we - * are reading from an item which is readonly, i.e. will never change - * during the lifetime of the channel. - */ - - if (!(rcPtr->methods & FLAG(METH_READ))) { - SetChannelErrorStr(rcPtr->chan, msg_read_unsup); - *errorCodePtr = EINVAL; - return -1; - } - - /* * Are we in the correct thread? */ @@ -1080,11 +1260,17 @@ ReflectInput( p.input.buf = buf; p.input.toRead = toRead; - ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p); if (p.base.code != TCL_OK) { - PassReceivedError(rcPtr->chan, &p); - *errorCodePtr = EINVAL; + if (p.base.code < 0) { + /* No error message, this is an errno signal. */ + *errorCodePtr = -p.base.code; + } else { + PassReceivedError(rcPtr->chan, &p); + *errorCodePtr = EINVAL; + } + p.input.toRead = -1; } else { *errorCodePtr = EOK; } @@ -1096,31 +1282,46 @@ ReflectInput( /* ASSERT: rcPtr->method & FLAG(METH_READ) */ /* ASSERT: rcPtr->mode & TCL_READABLE */ + Tcl_Preserve(rcPtr); + toReadObj = Tcl_NewIntObj(toRead); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj, 0)!=TCL_OK) { + Tcl_IncrRefCount(toReadObj); + + if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { + int code = ErrnoReturn(rcPtr, resObj); + + if (code < 0) { + *errorCodePtr = -code; + goto error; + } + Tcl_SetChannelError(rcPtr->chan, resObj); - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - *errorCodePtr = EINVAL; - return -1; + goto invalid; } bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); if (toRead < bytec) { - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); - *errorCodePtr = EINVAL; - return -1; + goto invalid; } *errorCodePtr = EOK; if (bytec > 0) { - memcpy(buf, bytev, (size_t)bytec); + memcpy(buf, bytev, (size_t) bytec); } + stop: + Tcl_DecrRefCount(toReadObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + Tcl_Release(rcPtr); return bytec; + invalid: + *errorCodePtr = EINVAL; + error: + bytec = -1; + goto stop; } /* @@ -1142,28 +1343,16 @@ ReflectInput( static int ReflectOutput( ClientData clientData, - CONST char *buf, + const char *buf, int toWrite, int *errorCodePtr) { - ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; + ReflectedChannel *rcPtr = clientData; Tcl_Obj *bufObj; Tcl_Obj *resObj; /* Result data for 'write' */ int written; /* - * The following check can be done before thread redirection, because we - * are reading from an item which is readonly, i.e. will never change - * during the lifetime of the channel. - */ - - if (!(rcPtr->methods & FLAG(METH_WRITE))) { - SetChannelErrorStr(rcPtr->chan, msg_write_unsup); - *errorCodePtr = EINVAL; - return -1; - } - - /* * Are we in the correct thread? */ @@ -1174,11 +1363,17 @@ ReflectOutput( p.output.buf = buf; p.output.toWrite = toWrite; - ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p); if (p.base.code != TCL_OK) { - PassReceivedError(rcPtr->chan, &p); - *errorCodePtr = EINVAL; + if (p.base.code < 0) { + /* No error message, this is an errno signal. */ + *errorCodePtr = -p.base.code; + } else { + PassReceivedError(rcPtr->chan, &p); + *errorCodePtr = EINVAL; + } + p.output.toWrite = -1; } else { *errorCodePtr = EOK; } @@ -1190,24 +1385,38 @@ ReflectOutput( /* ASSERT: rcPtr->method & FLAG(METH_WRITE) */ /* ASSERT: rcPtr->mode & TCL_WRITABLE */ + Tcl_Preserve(rcPtr); + bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite); - if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj, 0) != TCL_OK) { + Tcl_IncrRefCount(bufObj); + + if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { + int code = ErrnoReturn(rcPtr, resObj); + + if (code < 0) { + *errorCodePtr = -code; + goto error; + } + Tcl_SetChannelError(rcPtr->chan, resObj); - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - *errorCodePtr = EINVAL; - return -1; + goto invalid; } if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) { - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); - *errorCodePtr = EINVAL; - return -1; + goto invalid; } - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + if ((written == 0) && (toWrite > 0)) { + /* + * The handler claims to have written nothing of what it was + * given. That is bad. + */ - if ((written == 0) || (toWrite < written)) { + SetChannelErrorStr(rcPtr->chan, msg_write_nothing); + goto invalid; + } + if (toWrite < written) { /* * The handler claims to have written more than it was given. That is * bad. Note that the I/O core would crash if we were to return this @@ -1215,12 +1424,20 @@ ReflectOutput( */ SetChannelErrorStr(rcPtr->chan, msg_write_toomuch); - *errorCodePtr = EINVAL; - return -1; + goto invalid; } *errorCodePtr = EOK; + stop: + Tcl_DecrRefCount(bufObj); + Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + Tcl_Release(rcPtr); return written; + invalid: + *errorCodePtr = EINVAL; + error: + written = -1; + goto stop; } /* @@ -1246,9 +1463,8 @@ ReflectSeekWide( int seekMode, int *errorCodePtr) { - ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; - Tcl_Obj *offObj; - Tcl_Obj *baseObj; + ReflectedChannel *rcPtr = clientData; + Tcl_Obj *offObj, *baseObj; Tcl_Obj *resObj; /* Result for 'seek' */ Tcl_WideInt newLoc; @@ -1263,11 +1479,12 @@ ReflectSeekWide( p.seek.seekMode = seekMode; p.seek.offset = offset; - ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; + p.seek.offset = -1; } else { *errorCodePtr = EOK; } @@ -1278,33 +1495,41 @@ ReflectSeekWide( /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */ - offObj = Tcl_NewWideIntObj(offset); - baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" : - ((seekMode == SEEK_CUR) ? "current" : "end"), -1); - if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj, 0)!=TCL_OK) { + Tcl_Preserve(rcPtr); + + offObj = Tcl_NewWideIntObj(offset); + baseObj = Tcl_NewStringObj( + (seekMode == SEEK_SET) ? "start" : + (seekMode == SEEK_CUR) ? "current" : "end", -1); + Tcl_IncrRefCount(offObj); + Tcl_IncrRefCount(baseObj); + + if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - *errorCodePtr = EINVAL; - return -1; + goto invalid; } if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) { - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); - *errorCodePtr = EINVAL; - return -1; + goto invalid; } - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - if (newLoc < Tcl_LongAsWide(0)) { SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart); - *errorCodePtr = EINVAL; - return -1; + goto invalid; } *errorCodePtr = EOK; + stop: + Tcl_DecrRefCount(offObj); + Tcl_DecrRefCount(baseObj); + Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + Tcl_Release(rcPtr); return newLoc; + invalid: + *errorCodePtr = EINVAL; + newLoc = -1; + goto stop; } static int @@ -1347,11 +1572,9 @@ ReflectWatch( ClientData clientData, int mask) { - ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; + ReflectedChannel *rcPtr = clientData; Tcl_Obj *maskObj; - /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */ - /* * We restrict the interest to what the channel can support. IOW there * will never be write events for a channel which is not writable. @@ -1379,7 +1602,7 @@ ReflectWatch( ForwardParam p; p.watch.mask = mask; - ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p); /* * Any failure from the forward is ignored. We have no place to put @@ -1390,10 +1613,14 @@ ReflectWatch( } #endif + Tcl_Preserve(rcPtr); + maskObj = DecodeEventMask(mask); - (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL, - INVOKE_NO_CAPTURE); + /* assert maskObj.refCount == 1 */ + (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); + + Tcl_Release(rcPtr); } /* @@ -1418,7 +1645,7 @@ ReflectBlock( ClientData clientData, int nonblocking) { - ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; + ReflectedChannel *rcPtr = clientData; Tcl_Obj *blockObj; int errorNum; /* EINVAL or EOK (success). */ Tcl_Obj *resObj; /* Result data for 'blocking' */ @@ -1433,7 +1660,7 @@ ReflectBlock( p.block.nonblocking = nonblocking; - ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); @@ -1445,19 +1672,62 @@ ReflectBlock( #endif blockObj = Tcl_NewBooleanObj(!nonblocking); + Tcl_IncrRefCount(blockObj); - if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj, - 0) != TCL_OK) { + Tcl_Preserve(rcPtr); + + if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { errorNum = EOK; } + Tcl_DecrRefCount(blockObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + + Tcl_Release(rcPtr); return errorNum; } +#ifdef TCL_THREADS +/* + *---------------------------------------------------------------------- + * + * ReflectThread -- + * + * This function is invoked to tell the channel about thread movements. + * + * Results: + * None. + * + * Side effects: + * Allocates memory. Arbitrary, as it calls upon a script. + * + *---------------------------------------------------------------------- + */ + +static void +ReflectThread( + ClientData clientData, + int action) +{ + ReflectedChannel *rcPtr = clientData; + + switch (action) { + case TCL_CHANNEL_THREAD_INSERT: + rcPtr->owner = Tcl_GetCurrentThread(); + break; + case TCL_CHANNEL_THREAD_REMOVE: + rcPtr->owner = NULL; + break; + default: + Tcl_Panic("Unknown thread action code."); + break; + } +} + +#endif /* *---------------------------------------------------------------------- * @@ -1478,12 +1748,11 @@ 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 */ + const char *optionName, /* Name of requested option */ + const char *newValue) /* The new value */ { - ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; - Tcl_Obj *optionObj; - Tcl_Obj *valueObj; + ReflectedChannel *rcPtr = clientData; + Tcl_Obj *optionObj, *valueObj; int result; /* Result code for 'configure' */ Tcl_Obj *resObj; /* Result data for 'configure' */ @@ -1498,7 +1767,7 @@ ReflectSetOption( p.setOpt.name = optionName; p.setOpt.value = newValue; - ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); @@ -1511,15 +1780,23 @@ ReflectSetOption( return p.base.code; } #endif + Tcl_Preserve(rcPtr); optionObj = Tcl_NewStringObj(optionName, -1); valueObj = Tcl_NewStringObj(newValue, -1); - result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj,0); + + Tcl_IncrRefCount(optionObj); + Tcl_IncrRefCount(valueObj); + + result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); } + Tcl_DecrRefCount(optionObj); + Tcl_DecrRefCount(valueObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + Tcl_Release(rcPtr); return result; } @@ -1543,7 +1820,7 @@ static int ReflectGetOption( ClientData clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ - CONST char *optionName, /* Name of reuqested option */ + const char *optionName, /* Name of reuqested option */ Tcl_DString *dsPtr) /* String to place the result into */ { /* @@ -1551,12 +1828,12 @@ ReflectGetOption( * The bypass functions are not required. */ - ReflectedChannel *rcPtr = (ReflectedChannel*) clientData; + ReflectedChannel *rcPtr = clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ - int listc; + int listc, result = TCL_OK; Tcl_Obj **listv; - const char *method; + MethodName method; /* * Are we in the correct thread? @@ -1576,7 +1853,7 @@ ReflectGetOption( opcode = ForwardedGetOpt; } - ForwardOpToOwnerThread(rcPtr, opcode, &p); + ForwardOpToHandlerThread(rcPtr, opcode, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); @@ -1595,21 +1872,23 @@ ReflectGetOption( * Retrieve all options. */ - method = "cgetall"; + method = METH_CGETALL; optionObj = NULL; } else { /* * Retrieve the value of one option. */ - method = "cget"; + method = METH_CGET; optionObj = Tcl_NewStringObj(optionName, -1); + Tcl_IncrRefCount(optionObj); } - if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj, 0)!=TCL_OK) { + Tcl_Preserve(rcPtr); + + if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) { UnmarshallErrorResult(interp, resObj); - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - return TCL_ERROR; + goto error; } /* @@ -1618,9 +1897,8 @@ ReflectGetOption( */ if (optionObj != NULL) { - Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1); - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - return TCL_OK; + TclDStringAppendObj(dsPtr, resObj); + goto ok; } /* @@ -1635,8 +1913,7 @@ ReflectGetOption( */ if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - return TCL_ERROR; + goto error; } if ((listc % 2) == 1) { @@ -1644,26 +1921,35 @@ ReflectGetOption( * Odd number of elements is wrong. */ - Tcl_Obj *objPtr = Tcl_NewObj(); - Tcl_ResetResult(interp); - TclObjPrintf(NULL, objPtr, "Expected list with even number of " + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Expected list with even number of " "elements, got %d element%s instead", listc, - (listc == 1 ? "" : "s")); - Tcl_SetObjResult(interp, objPtr); - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - return TCL_ERROR; + (listc == 1 ? "" : "s"))); + goto error; } else { int len; - char *str = Tcl_GetStringFromObj(resObj, &len); + const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - Tcl_DStringAppend(dsPtr, " ", 1); + TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - return TCL_OK; + goto ok; } + + ok: + result = TCL_OK; + stop: + if (optionObj) { + Tcl_DecrRefCount(optionObj); + } + Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + Tcl_Release(rcPtr); + return result; + error: + result = TCL_ERROR; + goto stop; } /* @@ -1676,9 +1962,9 @@ ReflectGetOption( * 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 + * equivalent internal bitmask. The list must contain at least one + * element. Elements are "read", "write", or any unique abbreviation of + * them. Note that the bitmask is not changed if problems are * encountered. * * Results: @@ -1695,7 +1981,7 @@ ReflectGetOption( static int EncodeEventMask( Tcl_Interp *interp, - CONST char *objName, + const char *objName, Tcl_Obj *obj, int *mask) { @@ -1710,7 +1996,8 @@ EncodeEventMask( } if (listc < 1) { - Tcl_AppendResult(interp, "bad ", objName, " list: is empty", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad %s list: is empty", objName)); return TCL_ERROR; } @@ -1743,7 +2030,7 @@ EncodeEventMask( * This function takes an internal bitmask of events and constructs the * equivalent list of event items. * - * Results: + * Results, Contract: * A Tcl_Obj reference. The object will have a refCount of one. The user * has to decrement it to release the object. * @@ -1757,7 +2044,7 @@ static Tcl_Obj * DecodeEventMask( int mask) { - register CONST char *eventStr; + register const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { @@ -1777,6 +2064,7 @@ DecodeEventMask( evObj = Tcl_NewStringObj(eventStr, -1); Tcl_IncrRefCount(evObj); + /* assert evObj.refCount == 1 */ return evObj; } @@ -1805,67 +2093,32 @@ NewReflectedChannel( Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; - int listc; - Tcl_Obj **listv; - int i; + MethodName mn = METH_BLOCKING; - rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel)); + rcPtr = ckalloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ - /* rcPtr->methods: Assigned by caller. Dummy data here. */ rcPtr->chan = NULL; - rcPtr->methods = 0; rcPtr->interp = interp; + rcPtr->dead = 0; #ifdef TCL_THREADS rcPtr->thread = Tcl_GetCurrentThread(); #endif rcPtr->mode = mode; rcPtr->interest = 0; /* Initially no interest registered */ - /* - * 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 - */ - - rcPtr->argc = listc + 2; - rcPtr->argv = (Tcl_Obj**) ckalloc(sizeof(Tcl_Obj*) * (listc+4)); - - /* - * Duplicate object references. - */ - - for (i=0; i<listc ; i++) { - Tcl_Obj *word = rcPtr->argv[i] = listv[i]; - Tcl_IncrRefCount(word); - } - - i++; /* Skip placeholder for method */ - - rcPtr->argv[i] = handleObj; - Tcl_IncrRefCount(handleObj); - - /* - * The next two objects are kept empty, varying arguments. - */ - - /* - * Initialization complete. - */ - + rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj); + Tcl_IncrRefCount(rcPtr->cmd); + rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL); + while (mn <= METH_WRITE) { + Tcl_ListObjAppendElement(NULL, rcPtr->methods, + Tcl_NewStringObj(methodNames[mn++], -1)); + } + Tcl_IncrRefCount(rcPtr->methods); + rcPtr->name = handleObj; + Tcl_IncrRefCount(rcPtr->name); return rcPtr; } @@ -1903,9 +2156,8 @@ NextHandle(void) static unsigned long rcCounter = 0; Tcl_Obj *resObj; - TclNewObj(resObj); Tcl_MutexLock(&rcCounterMutex); - TclObjPrintf(NULL, resObj, "rc%lu", rcCounter); + resObj = Tcl_ObjPrintf("rc%lu", rcCounter); rcCounter++; Tcl_MutexUnlock(&rcCounterMutex); @@ -1913,27 +2165,24 @@ NextHandle(void) } static void -FreeReflectedChannel(rcPtr) - ReflectedChannel *rcPtr; +FreeReflectedChannel( + ReflectedChannel *rcPtr) { Channel *chanPtr = (Channel *) rcPtr->chan; - int i, n; if (chanPtr->typePtr != &tclRChannelType) { /* * Delete a cloned ChannelType structure. */ - ckfree((char*) chanPtr->typePtr); - } - - n = rcPtr->argc - 2; - for (i=0; i<n; i++) { - Tcl_DecrRefCount(rcPtr->argv[i]); + ckfree(chanPtr->typePtr); + chanPtr->typePtr = NULL; } - - ckfree((char*) rcPtr->argv); - ckfree((char*) rcPtr); + Tcl_Release(chanPtr); + Tcl_DecrRefCount(rcPtr->name); + Tcl_DecrRefCount(rcPtr->methods); + Tcl_DecrRefCount(rcPtr->cmd); + ckfree(rcPtr); } /* @@ -1952,53 +2201,71 @@ FreeReflectedChannel(rcPtr) * Side effects: * Arbitrary, as it calls upon a Tcl script. * + * Contract: + * argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL + * argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL + * resObj.refCount in {0, 1, ...} + * *---------------------------------------------------------------------- */ static int InvokeTclMethod( ReflectedChannel *rcPtr, - CONST char *method, + MethodName method, Tcl_Obj *argOneObj, /* NULL'able */ Tcl_Obj *argTwoObj, /* NULL'able */ - Tcl_Obj **resultObjPtr, /* NULL'able */ - int flags) + 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. */ + Tcl_Obj *cmd; - /* - * NOTE (5): Decide impl. issue: Cache objects with method names? - * Requires TSD data as reflections can be created in many different - * threads. - */ + if (rcPtr->dead) { + /* + * The channel is marked as dead. Bail out immediately, with an + * appropriate error. + */ + + if (resultObjPtr != NULL) { + resObj = Tcl_NewStringObj(msg_dstlost,-1); + *resultObjPtr = resObj; + Tcl_IncrRefCount(resObj); + } + + /* + * Not touching argOneObj, argTwoObj, they have not been used. + * See the contract as well. + */ + + return TCL_ERROR; + } /* - * Insert method into the pre-allocated area, after the command prefix, + * Insert method into the callback command, after the command prefix, * before the channel id. */ - methObj = Tcl_NewStringObj(method, -1); - Tcl_IncrRefCount(methObj); - rcPtr->argv[rcPtr->argc - 2] = methObj; + cmd = TclListObjCopy(NULL, rcPtr->cmd); + + Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj); + Tcl_ListObjAppendElement(NULL, cmd, methObj); + Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name); /* * Append the additional argument containing method specific details * behind the channel id. If specified. + * + * Because of the contract there is no need to increment the refcounts. + * The objects will survive the Tcl_EvalObjv without change. */ - cmdc = rcPtr->argc; if (argOneObj) { - Tcl_IncrRefCount(argOneObj); - rcPtr->argv[cmdc] = argOneObj; - cmdc++; + Tcl_ListObjAppendElement(NULL, cmd, argOneObj); if (argTwoObj) { - Tcl_IncrRefCount(argTwoObj); - rcPtr->argv[cmdc] = argTwoObj; - cmdc++; + Tcl_ListObjAppendElement(NULL, cmd, argTwoObj); } } @@ -2007,9 +2274,10 @@ InvokeTclMethod( * existing state intact. */ + Tcl_IncrRefCount(cmd); sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */); Tcl_Preserve(rcPtr->interp); - result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL); + result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL); /* * We do not try to extract the result information if the caller has no @@ -2018,7 +2286,7 @@ InvokeTclMethod( */ if (resultObjPtr) { - if ((result == TCL_OK) || (flags & INVOKE_NO_CAPTURE)) { + if (result == TCL_OK) { /* * Ok result taken as is, also if the caller requests that there * is no capture. @@ -2029,29 +2297,36 @@ InvokeTclMethod( /* * 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. */ - result = TCL_ERROR; + if (result != TCL_ERROR) { + int cmdLen; + const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); + + Tcl_IncrRefCount(cmd); + Tcl_ResetResult(rcPtr->interp); + Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf( + "chan handler returned bad code: %d", result)); + Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, + cmdLen); + Tcl_DecrRefCount(cmd); + result = TCL_ERROR; + } + Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf( + "\n (chan handler subcommand \"%s\")", + methodNames[method])); resObj = MarshallError(rcPtr->interp); } Tcl_IncrRefCount(resObj); } + Tcl_DecrRefCount(cmd); Tcl_RestoreInterpState(rcPtr->interp, sr); Tcl_Release(rcPtr->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). @@ -2069,24 +2344,402 @@ InvokeTclMethod( return result; } +/* + *---------------------------------------------------------------------- + * + * ErrnoReturn -- + * + * Checks a method error result if it returned an 'errno'. + * + * Results: + * The negative errno found in the error result, or 0. + * + * Side effects: + * None. + * + * Users: + * ReflectInput/Output(), to enable the signaling of EAGAIN + * on 0-sized short reads/writes. + * + *---------------------------------------------------------------------- + */ + +static int +ErrnoReturn( + ReflectedChannel *rcPtr, + Tcl_Obj *resObj) +{ + int code; + Tcl_InterpState sr; /* State of handler interp */ + + if (rcPtr->dead) { + return 0; + } + + sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */); + UnmarshallErrorResult(rcPtr->interp, resObj); + + resObj = Tcl_GetObjResult(rcPtr->interp); + + if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK) + || (code >= 0))) { + if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) { + code = -EAGAIN; + } else { + code = 0; + } + } + + Tcl_RestoreInterpState(rcPtr->interp, sr); + return code; +} + +/* + *---------------------------------------------------------------------- + * + * GetReflectedChannelMap -- + * + * Gets and potentially initializes the reflected channel map for an + * interpreter. + * + * Results: + * A pointer to the map created, for use by the caller. + * + * Side effects: + * Initializes the reflected channel map for an interpreter. + * + *---------------------------------------------------------------------- + */ + +static ReflectedChannelMap * +GetReflectedChannelMap( + Tcl_Interp *interp) +{ + ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL); + + if (rcmPtr == NULL) { + rcmPtr = ckalloc(sizeof(ReflectedChannelMap)); + Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS); + Tcl_SetAssocData(interp, RCMKEY, + (Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr); + } + return rcmPtr; +} + +/* + *---------------------------------------------------------------------- + * + * DeleteReflectedChannelMap -- + * + * Deletes the channel table for an interpreter, closing any open + * channels whose refcount reaches zero. This procedure is invoked when + * an interpreter is deleted, via the AssocData cleanup mechanism. + * + * Results: + * None. + * + * Side effects: + * Deletes the hash table of channels. May close channels. May flush + * output on closed channels. Removes any channeEvent handlers that were + * registered in this interpreter. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteReflectedChannelMap( + ClientData clientData, /* The per-interpreter data structure. */ + Tcl_Interp *interp) /* The interpreter being deleted. */ +{ + ReflectedChannelMap *rcmPtr = clientData; + /* The map */ + Tcl_HashSearch hSearch; /* Search variable. */ + Tcl_HashEntry *hPtr; /* Search variable. */ + ReflectedChannel *rcPtr; + Tcl_Channel chan; +#ifdef TCL_THREADS + ForwardingResult *resultPtr; + ForwardingEvent *evPtr; + ForwardParam *paramPtr; +#endif + + /* + * Delete all entries. The channels may have been closed already, or will + * be closed later, by the standard IO finalization of an interpreter + * under destruction. Except for the channels which were moved to a + * different interpreter and/or thread. They do not exist from the IO + * systems point of view and will not get closed. Therefore mark all as + * dead so that any future access will cause a proper error. For channels + * in a different thread we actually do the same as + * DeleteThreadReflectedChannelMap(), just restricted to the channels of + * this interp. + */ + + for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); + hPtr != NULL; + hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { + chan = Tcl_GetHashValue(hPtr); + rcPtr = Tcl_GetChannelInstanceData(chan); + + rcPtr->dead = 1; + Tcl_DeleteHashEntry(hPtr); + } + Tcl_DeleteHashTable(&rcmPtr->map); + ckfree(&rcmPtr->map); + +#ifdef TCL_THREADS + /* + * The origin interpreter for one or more reflected channels is gone. + */ + + /* + * Go through the list of pending results and cancel all whose events were + * destined for this interpreter. While this is in progress we block any + * other access to the list of pending results. + */ + + Tcl_MutexLock(&rcForwardMutex); + + for (resultPtr = forwardList; + resultPtr != NULL; + resultPtr = resultPtr->nextPtr) { + if (resultPtr->dsti != interp) { + /* + * Ignore results/events for other interpreters. + */ + + continue; + } + + /* + * The receiver for the event exited, before processing the event. We + * detach the result now, wake the originator up and signal failure. + */ + + evPtr = resultPtr->evPtr; + + /* Basic crash safety until this routine can get revised [3411310] */ + if (evPtr == NULL) { + continue; + } + paramPtr = evPtr->param; + + evPtr->resultPtr = NULL; + resultPtr->evPtr = NULL; + resultPtr->result = TCL_ERROR; + + ForwardSetStaticError(paramPtr, msg_send_dstlost); + + Tcl_ConditionNotify(&resultPtr->done); + } + Tcl_MutexUnlock(&rcForwardMutex); + + /* + * Get the map of all channels handled by the current thread. This is a + * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go + * through the channels and remove all which were handled by this + * interpreter. They have already been marked as dead. + */ + + rcmPtr = GetThreadReflectedChannelMap(); + for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&hSearch)) { + chan = Tcl_GetHashValue(hPtr); + rcPtr = Tcl_GetChannelInstanceData(chan); + + if (rcPtr->interp != interp) { + /* + * Ignore entries for other interpreters. + */ + + continue; + } + + rcPtr->dead = 1; + Tcl_DeleteHashEntry(hPtr); + } +#endif +} + #ifdef TCL_THREADS +/* + *---------------------------------------------------------------------- + * + * GetThreadReflectedChannelMap -- + * + * Gets and potentially initializes the reflected channel map for a + * thread. + * + * Results: + * A pointer to the map created, for use by the caller. + * + * Side effects: + * Initializes the reflected channel map for a thread. + * + *---------------------------------------------------------------------- + */ + +static ReflectedChannelMap * +GetThreadReflectedChannelMap(void) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (!tsdPtr->rcmPtr) { + tsdPtr->rcmPtr = ckalloc(sizeof(ReflectedChannelMap)); + Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS); + Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL); + } + + return tsdPtr->rcmPtr; +} + +/* + *---------------------------------------------------------------------- + * + * DeleteThreadReflectedChannelMap -- + * + * Deletes the channel table for a thread. This procedure is invoked when + * a thread is deleted. The channels have already been marked as dead, in + * DeleteReflectedChannelMap(). + * + * Results: + * None. + * + * Side effects: + * Deletes the hash table of channels. + * + *---------------------------------------------------------------------- + */ + static void -ForwardOpToOwnerThread( +DeleteThreadReflectedChannelMap( + ClientData clientData) /* The per-thread data structure. */ +{ + Tcl_HashSearch hSearch; /* Search variable. */ + Tcl_HashEntry *hPtr; /* Search variable. */ + Tcl_ThreadId self = Tcl_GetCurrentThread(); + ReflectedChannelMap *rcmPtr; /* The map */ + ForwardingResult *resultPtr; + + /* + * The origin thread for one or more reflected channels is gone. + * NOTE: If this function is called due to a thread getting killed the + * per-interp DeleteReflectedChannelMap is apparently not called. + */ + + /* + * Go through the list of pending results and cancel all whose events were + * destined for this thread. While this is in progress we block any + * other access to the list of pending results. + */ + + Tcl_MutexLock(&rcForwardMutex); + + for (resultPtr = forwardList; + resultPtr != NULL; + resultPtr = resultPtr->nextPtr) { + ForwardingEvent *evPtr; + ForwardParam *paramPtr; + + if (resultPtr->dst != self) { + /* + * Ignore results/events for other threads. + */ + + continue; + } + + /* + * The receiver for the event exited, before processing the event. We + * detach the result now, wake the originator up and signal failure. + */ + + evPtr = resultPtr->evPtr; + + /* Basic crash safety until this routine can get revised [3411310] */ + if (evPtr == NULL ) { + continue; + } + paramPtr = evPtr->param; + + evPtr->resultPtr = NULL; + resultPtr->evPtr = NULL; + resultPtr->result = TCL_ERROR; + + ForwardSetStaticError(paramPtr, msg_send_dstlost); + + Tcl_ConditionNotify(&resultPtr->done); + } + Tcl_MutexUnlock(&rcForwardMutex); + + /* + * Run over the event queue of this thread and remove all ReflectEvent's + * still pending. These are inbound events for reflected channels this + * thread owns but doesn't handle. The inverse of the channel map + * actually. + */ + + Tcl_DeleteEvents(ReflectEventDelete, NULL); + + /* + * Get the map of all channels handled by the current thread. This is a + * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go + * through the channels, remove all, mark them as dead. + */ + + rcmPtr = GetThreadReflectedChannelMap(); + for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); + hPtr != NULL; + hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { + Tcl_Channel chan = Tcl_GetHashValue(hPtr); + ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan); + + rcPtr->dead = 1; + Tcl_DeleteHashEntry(hPtr); + } + ckfree(rcmPtr); +} + +static void +ForwardOpToHandlerThread( ReflectedChannel *rcPtr, /* Channel instance */ ForwardedOperation op, /* Forwarded driver operation */ - CONST VOID *param) /* Arguments */ + const void *param) /* Arguments */ { + /* + * Core of the communication from OWNER to HANDLER thread. + * The receiver is ForwardProc() below. + */ + Tcl_ThreadId dst = rcPtr->thread; ForwardingEvent *evPtr; ForwardingResult *resultPtr; - int result; + + /* + * We gather the lock early. This allows us to check the liveness of the + * channel without interference from DeleteThreadReflectedChannelMap(). + */ + + Tcl_MutexLock(&rcForwardMutex); + + if (rcPtr->dead) { + /* + * The channel is marked as dead. Bail out immediately, with an + * appropriate error. Do not forget to unlock the mutex on this path. + */ + + ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost); + Tcl_MutexUnlock(&rcForwardMutex); + return; + } /* * Create and initialize the event and data structures. */ - evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent)); - resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult)); + evPtr = ckalloc(sizeof(ForwardingEvent)); + resultPtr = ckalloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; @@ -2096,6 +2749,7 @@ ForwardOpToOwnerThread( resultPtr->src = Tcl_GetCurrentThread(); resultPtr->dst = dst; + resultPtr->dsti = rcPtr->interp; resultPtr->done = NULL; resultPtr->result = -1; resultPtr->evPtr = evPtr; @@ -2104,41 +2758,47 @@ ForwardOpToOwnerThread( * Now execute the forward. */ - Tcl_MutexLock(&rcForwardMutex); TclSpliceIn(resultPtr, forwardList); + /* Do not unlock here. That is done by the ConditionWait */ /* - * Ensure cleanup of the event if any of the two involved threads exits - * while this event is pending or in progress. + * Ensure cleanup of the event if the origin thread exits while this event + * is pending or in progress. Exit of the destination thread is handled by + * DeleteThreadReflectedChannelMap(), this is set up by + * GetThreadReflectedChannelMap(). This is what we use the 'forwardList' + * (see above) for. */ - Tcl_CreateThreadExitHandler(SrcExitProc, (ClientData) evPtr); - Tcl_CreateThreadExitHandler(DstExitProc, (ClientData) evPtr); + Tcl_CreateThreadExitHandler(SrcExitProc, evPtr); /* * Queue the event and poke the other thread's notifier. */ - Tcl_ThreadQueueEvent(dst, (Tcl_Event *)evPtr, TCL_QUEUE_TAIL); + Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL); Tcl_ThreadAlert(dst); /* - * (*) Block until the other thread has either processed the transfer or + * (*) Block until the handler 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" + * waiting here? IOW Is it possible that "SrcExitProc" is called while + * we are here? See complementary note (2) in "SrcExitProc" + * + * The ConditionWait unlocks the mutex during the wait and relocks it + * immediately after. */ Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL); } /* - * Unlink result from the forwarder list. + * Unlink result from the forwarder list. No need to lock. Either still + * locked, or locked by the ConditionWait */ TclSpliceOut(resultPtr, forwardList); @@ -2150,17 +2810,15 @@ ForwardOpToOwnerThread( Tcl_ConditionFinalize(&resultPtr->done); /* - * Kill the cleanup handlers now, and the result structure as well, before + * Kill the cleanup handler 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); + Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); - result = resultPtr->result; - ckfree((char*) resultPtr); + ckfree(resultPtr); } static int @@ -2169,6 +2827,11 @@ ForwardProc( int mask) { /* + * HANDLER thread. + + * The receiver part for the operations coming from the OWNER thread. + * See ForwardOpToHandlerThread() for the transmitter. + * * Notes regarding access to the referenced data. * * In principle the data belongs to the originating thread (see @@ -2187,6 +2850,9 @@ ForwardProc( Tcl_Interp *interp = rcPtr->interp; ForwardParam *paramPtr = evPtr->param; Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */ + ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in + * this interp. */ + Tcl_HashEntry *hPtr; /* Entry in the above map */ /* * Ignore the event if no one is waiting for its result anymore. @@ -2212,34 +2878,54 @@ ForwardProc( * No parameters/results. */ - if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj, - 0) != TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } /* - * Freeing is done here, in the origin thread, because the argv[] + * Freeing is done here, in the origin thread, callback command * objects belong to this thread. Deallocating them in a different * thread is not allowed + * + * We remove the channel from both interpreter and thread maps before + * releasing the memory, to prevent future accesses (like by + * 'postevent') from finding and dereferencing a dangling pointer. */ - FreeReflectedChannel(rcPtr); + rcmPtr = GetReflectedChannelMap(interp); + hPtr = Tcl_FindHashEntry(&rcmPtr->map, + Tcl_GetChannelName(rcPtr->chan)); + Tcl_DeleteHashEntry(hPtr); + + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_FindHashEntry(&rcmPtr->map, + Tcl_GetChannelName(rcPtr->chan)); + Tcl_DeleteHashEntry(hPtr); + + Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); break; case ForwardedInput: { Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); + Tcl_IncrRefCount(toReadObj); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj, - 0) != TCL_OK) { - ForwardSetObjError(paramPtr, resObj); + Tcl_Preserve(rcPtr); + if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){ + int code = ErrnoReturn(rcPtr, resObj); + + if (code < 0) { + paramPtr->base.code = code; + } else { + ForwardSetObjError(paramPtr, resObj); + } paramPtr->input.toRead = -1; } else { /* * Process a regular result. */ - int bytec; /* Number of returned bytes */ - unsigned char *bytev; /* Array of returned bytes */ + int bytec; /* Number of returned bytes */ + unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); @@ -2248,21 +2934,30 @@ ForwardProc( paramPtr->input.toRead = -1; } else { if (bytec > 0) { - memcpy(paramPtr->input.buf, bytev, (size_t)bytec); + memcpy(paramPtr->input.buf, bytev, (size_t) bytec); } paramPtr->input.toRead = bytec; } } + Tcl_Release(rcPtr); + Tcl_DecrRefCount(toReadObj); break; } case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) - paramPtr->output.buf, paramPtr->output.toWrite); + paramPtr->output.buf, paramPtr->output.toWrite); + Tcl_IncrRefCount(bufObj); - if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj, - 0) != TCL_OK) { - ForwardSetObjError(paramPtr, resObj); + Tcl_Preserve(rcPtr); + if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { + int code = ErrnoReturn(rcPtr, resObj); + + if (code < 0) { + paramPtr->base.code = code; + } else { + ForwardSetObjError(paramPtr, resObj); + } paramPtr->output.toWrite = -1; } else { /* @@ -2272,7 +2967,9 @@ ForwardProc( int written; if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) { - ForwardSetObjError(paramPtr, MarshallError(interp)); + Tcl_DecrRefCount(resObj); + resObj = MarshallError(interp); + ForwardSetObjError(paramPtr, resObj); paramPtr->output.toWrite = -1; } else if (written==0 || paramPtr->output.toWrite<written) { ForwardSetStaticError(paramPtr, msg_write_toomuch); @@ -2281,17 +2978,22 @@ ForwardProc( paramPtr->output.toWrite = written; } } + Tcl_Release(rcPtr); + Tcl_DecrRefCount(bufObj); break; } case ForwardedSeek: { Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset); Tcl_Obj *baseObj = Tcl_NewStringObj( - (paramPtr->seek.seekMode==SEEK_SET) ? "start" : - (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1); + (paramPtr->seek.seekMode==SEEK_SET) ? "start" : + (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1); - if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj, - 0) != TCL_OK) { + Tcl_IncrRefCount(offObj); + Tcl_IncrRefCount(baseObj); + + Tcl_Preserve(rcPtr); + if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } else { @@ -2310,40 +3012,57 @@ ForwardProc( paramPtr->seek.offset = newLoc; } } else { - ForwardSetObjError(paramPtr, MarshallError(interp)); + Tcl_DecrRefCount(resObj); + resObj = MarshallError(interp); + ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } } + Tcl_Release(rcPtr); + Tcl_DecrRefCount(offObj); + Tcl_DecrRefCount(baseObj); break; } case ForwardedWatch: { Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask); + /* assert maskObj.refCount == 1 */ - (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL, - INVOKE_NO_CAPTURE); + Tcl_Preserve(rcPtr); + (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); + Tcl_Release(rcPtr); break; } case ForwardedBlock: { Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking); - if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj, - 0) != TCL_OK) { + Tcl_IncrRefCount(blockObj); + Tcl_Preserve(rcPtr); + if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } + Tcl_Release(rcPtr); + Tcl_DecrRefCount(blockObj); break; } case ForwardedSetOpt: { Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1); - Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); + Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); - if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj, &resObj, - 0) != TCL_OK) { + Tcl_IncrRefCount(optionObj); + Tcl_IncrRefCount(valueObj); + Tcl_Preserve(rcPtr); + if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } + Tcl_Release(rcPtr); + Tcl_DecrRefCount(optionObj); + Tcl_DecrRefCount(valueObj); break; } @@ -2354,12 +3073,15 @@ ForwardProc( Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); - if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj, - 0) != TCL_OK) { + Tcl_IncrRefCount(optionObj); + Tcl_Preserve(rcPtr); + if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { - Tcl_DStringAppend(paramPtr->getOpt.value, TclGetString(resObj),-1); + TclDStringAppendObj(paramPtr->getOpt.value, resObj); } + Tcl_Release(rcPtr); + Tcl_DecrRefCount(optionObj); break; } @@ -2368,8 +3090,8 @@ ForwardProc( * Retrieve all options. */ - if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj, - 0) != TCL_OK) { + Tcl_Preserve(rcPtr); + if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { /* @@ -2378,11 +3100,13 @@ ForwardProc( */ int listc; - Tcl_Obj** listv; + Tcl_Obj **listv; if (Tcl_ListObjGetElements(interp, resObj, &listc, - &listv) != TCL_OK) { - ForwardSetObjError(paramPtr, MarshallError(interp)); + &listv) != TCL_OK) { + Tcl_DecrRefCount(resObj); + resObj = MarshallError(interp); + ForwardSetObjError(paramPtr, resObj); } else if ((listc % 2) == 1) { /* * Odd number of elements is wrong. [x]. @@ -2396,20 +3120,22 @@ ForwardProc( ForwardSetDynamicError(paramPtr, buf); } else { int len; - CONST char *str = Tcl_GetStringFromObj(resObj, &len); + const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1); + TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } } + Tcl_Release(rcPtr); break; default: /* * Bad operation code. */ + Tcl_Panic("Bad operation code in ForwardProc"); break; } @@ -2443,7 +3169,7 @@ static void SrcExitProc( ClientData clientData) { - ForwardingEvent *evPtr = (ForwardingEvent *) clientData; + ForwardingEvent *evPtr = clientData; ForwardingResult *resultPtr; ForwardParam *paramPtr; @@ -2488,42 +3214,15 @@ SrcExitProc( } 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); + const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len)); + ForwardSetDynamicError(paramPtr, ckalloc(len)); memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len); } #endif @@ -2533,5 +3232,7 @@ ForwardSetObjError( * mode: c * c-basic-offset: 4 * fill-column: 78 + * tab-width: 8 + * indent-tabs-mode: nil * End: */ |