diff options
Diffstat (limited to 'generic/tclIORChan.c')
| -rw-r--r-- | generic/tclIORChan.c | 693 |
1 files changed, 297 insertions, 396 deletions
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 9ba42ef..c9939d6 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -16,8 +16,8 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tclInt.h" -#include "tclIO.h" +#include <tclInt.h> +#include <tclIO.h> #include <assert.h> #ifndef EINVAL @@ -55,24 +55,24 @@ static int ReflectSetOption(ClientData clientData, * a version 3 structure. */ -static const Tcl_ChannelType tclRChannelType = { - "tclrchannel", /* Type name. */ +static 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 */ - NULL, /* thread action */ - NULL /* truncate */ + 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 */ + NULL, /* thread action */ + NULL, /* truncate */ }; /* @@ -91,31 +91,9 @@ typedef struct { #ifdef TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */ #endif - - /* See [==] as well. - * Storage for the command prefix and the additional words required for - * the invocation of methods in the command handler. - * - * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2] - * cmd ... pfx | method chan | detail1 detail2 - * ~~~~ CT ~~~ ~~ CT ~~ - * - * CT = Belongs to the 'Command handler Thread'. - */ - - int argc; /* Number of preallocated words - 2 */ - Tcl_Obj **argv; /* Preallocated array for calling the handler. - * args[0] is placeholder for cmd word. - * Followed by the arguments in the prefix, - * plus 4 placeholders for method, channel, - * and at most two varying (method specific) - * words. */ - int methods; /* Bitmask of supported methods */ - - /* - * NOTE (9): Should we have predefined shared literals 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 @@ -159,7 +137,7 @@ typedef struct { * Event literals. ================================================== */ -static const char *const eventOptions[] = { +static const char *eventOptions[] = { "read", "write", NULL }; typedef enum { @@ -170,7 +148,7 @@ typedef enum { * Method literals. ================================================== */ -static const char *const methodNames[] = { +static const char *methodNames[] = { "blocking", /* OPT */ "cget", /* OPT \/ Together or none */ "cgetall", /* OPT /\ of these two */ @@ -340,8 +318,7 @@ 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. */ + 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 @@ -363,7 +340,7 @@ typedef struct ThreadSpecificData { * per-thread version of the per-interpreter map. */ - ReflectedChannelMap *rcmPtr; + ReflectedChannelMap* rcmPtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -388,7 +365,7 @@ TCL_DECLARE_MUTEX(rcForwardMutex) */ static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr, - ForwardedOperation op, const void *param); + ForwardedOperation op, const VOID *param); static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(ClientData clientData); @@ -440,13 +417,13 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp, static Tcl_Obj * NextHandle(void); static void FreeReflectedChannel(ReflectedChannel *rcPtr); static int InvokeTclMethod(ReflectedChannel *rcPtr, - const char *method, Tcl_Obj *argOneObj, + MethodName method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); static void DeleteReflectedChannelMap(ClientData clientData, Tcl_Interp *interp); -static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); +static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj); /* * Global constant strings (messages). ================== @@ -455,16 +432,14 @@ static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); * 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_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 = "{Channel thread lost}"; -static const char *msg_send_dstlost = "{Owner lost}"; #endif /* TCL_THREADS */ +static const char *msg_send_dstlost = "{Owner lost}"; static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}"; /* @@ -512,11 +487,9 @@ TclChanCreateObjCmd( 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. */ + 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 @@ -543,7 +516,6 @@ TclChanCreateObjCmd( * Expect at least one list element. Abbreviations are ok. */ - modeObj = objv[MODE]; if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) { return TCL_ERROR; } @@ -571,10 +543,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. @@ -588,9 +556,8 @@ TclChanCreateObjCmd( modeObj = DecodeEventMask(mode); /* assert modeObj.refCount == 1 */ - result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj); + result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj); Tcl_DecrRefCount(modeObj); - if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ @@ -605,9 +572,11 @@ TclChanCreateObjCmd( */ 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))); + 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; } @@ -631,37 +600,42 @@ TclChanCreateObjCmd( Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" does not support all required methods", - Tcl_GetString(cmdObj))); + TclNewLiteralStringObj(err, "chan handler \""); + Tcl_AppendObjToObj(err, cmdObj); + Tcl_AppendToObj(err, "\" does not support all required methods", -1); + Tcl_SetObjResult(interp, err); goto error; } if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" lacks a \"read\" method", - Tcl_GetString(cmdObj))); + TclNewLiteralStringObj(err, "chan handler \""); + Tcl_AppendObjToObj(err, cmdObj); + Tcl_AppendToObj(err, "\" lacks a \"read\" method", -1); + Tcl_SetObjResult(interp, err); goto error; } if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" lacks a \"write\" method", - Tcl_GetString(cmdObj))); + TclNewLiteralStringObj(err, "chan handler \""); + Tcl_AppendObjToObj(err, cmdObj); + Tcl_AppendToObj(err, "\" lacks a \"write\" method", -1); + Tcl_SetObjResult(interp, err); goto error; } if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", - Tcl_GetString(cmdObj))); + TclNewLiteralStringObj(err, "chan handler \""); + Tcl_AppendObjToObj(err, cmdObj); + Tcl_AppendToObj(err, "\" supports \"cget\" but not \"cgetall\"", -1); + Tcl_SetObjResult(interp, err); goto error; } if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", - Tcl_GetString(cmdObj))); + TclNewLiteralStringObj(err, "chan handler \""); + Tcl_AppendObjToObj(err, cmdObj); + Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1); + Tcl_SetObjResult(interp, err); goto error; } @@ -671,7 +645,11 @@ TclChanCreateObjCmd( * Everything is fine now. */ - rcPtr->methods = methods; + chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, + mode); + rcPtr->chan = chan; + TclChannelPreserve(chan); + chanPtr = (Channel *) chan; if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) { /* @@ -680,7 +658,8 @@ TclChanCreateObjCmd( * as the actual channel type. */ - Tcl_ChannelType *clonePtr = ckalloc(sizeof(Tcl_ChannelType)); + Tcl_ChannelType *clonePtr = (Tcl_ChannelType *) + ckalloc(sizeof(Tcl_ChannelType)); memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType)); @@ -709,17 +688,19 @@ TclChanCreateObjCmd( 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"); + rcmPtr = GetReflectedChannelMap (interp); + hPtr = Tcl_CreateHashEntry(&rcmPtr->map, + chanPtr->state->channelName, &isNew); + if (!isNew) { + if (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); + hPtr = Tcl_CreateHashEntry(&rcmPtr->map, + chanPtr->state->channelName, &isNew); Tcl_SetHashValue(hPtr, chan); #endif @@ -727,16 +708,14 @@ TclChanCreateObjCmd( * Return handle as result of command. */ - Tcl_SetResult(interp, (char *)chanPtr->state->channelName, TCL_VOLATILE); + Tcl_SetObjResult(interp, rcId); 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 @@ -787,9 +766,8 @@ TclChanPostEventObjCmd( /* Its associated driver structure */ ReflectedChannel *rcPtr; /* Associated instance data */ 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 */ + ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */ + Tcl_HashEntry* hPtr; /* Entry in the above map */ /* * Number of arguments... @@ -807,12 +785,12 @@ TclChanPostEventObjCmd( chanId = TclGetString(objv[CHAN]); - rcmPtr = GetReflectedChannelMap(interp); - hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId); + rcmPtr = GetReflectedChannelMap (interp); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, chanId); if (hPtr == NULL) { - Tcl_AppendResult(interp, "can not find reflected channel named \"", - chanId, "\"", NULL); + Tcl_AppendResult(interp, "can not find reflected channel named \"", chanId, + "\"", NULL); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL); return TCL_ERROR; } @@ -833,7 +811,7 @@ TclChanPostEventObjCmd( * have gone seriously haywire. */ - chan = Tcl_GetHashValue(hPtr); + chan = Tcl_GetHashValue(hPtr); chanTypePtr = Tcl_GetChannelType(chan); /* @@ -846,13 +824,13 @@ TclChanPostEventObjCmd( */ if (chanTypePtr->watchProc != &ReflectWatch) { - Tcl_Panic("TclChanPostEventObjCmd: channel is not a reflected channel"); + Tcl_Panic ("TclChanPostEventObjCmd: channel is not a reflected channel"); } - rcPtr = Tcl_GetChannelInstanceData(chan); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); if (rcPtr->interp != interp) { - Tcl_Panic("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter"); + Tcl_Panic ("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter"); } /* @@ -895,7 +873,7 @@ TclChanPostEventObjCmd( * Channel error message marshalling utilities. */ -static Tcl_Obj * +static Tcl_Obj* MarshallError( Tcl_Interp *interp) { @@ -950,7 +928,7 @@ UnmarshallErrorResult( } (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv)); - ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED; + ((Interp *)interp)->flags &= ~ERR_ALREADY_LOGGED; } int @@ -1035,12 +1013,12 @@ ReflectClose( ClientData clientData, Tcl_Interp *interp) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) 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 */ + ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */ + Tcl_HashEntry* hPtr; /* Entry in the above map */ + Tcl_ChannelType *tctPtr; if (TclInThreadExit()) { /* @@ -1054,9 +1032,8 @@ ReflectClose( /* * THREADED => Forward this to the origin thread * - * Note: DeleteThreadReflectedChannelMap() is the thread exit handler - * for the origin thread. Use this to clean up the structure? Except - * if lost? + * Note: DeleteThreadReflectedChannelMap() is the thread exit handler for the origin + * thread. Use this to clean up the structure? Except if lost? */ #ifdef TCL_THREADS @@ -1078,18 +1055,11 @@ ReflectClose( } #endif - Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); - 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) { + tctPtr = ((Channel *)rcPtr->chan)->typePtr; + if (tctPtr && tctPtr != &tclRChannelType) { + ckfree((char *)tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; + } Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); return EOK; } @@ -1115,7 +1085,7 @@ ReflectClose( } } else { #endif - result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj); + result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj); if ((result != TCL_OK) && (interp != NULL)) { Tcl_SetChannelErrorInterp(interp, resObj); } @@ -1137,22 +1107,27 @@ ReflectClose( */ if (rcPtr->interp) { - rcmPtr = GetReflectedChannelMap(rcPtr->interp); - hPtr = Tcl_FindHashEntry(&rcmPtr->map, - Tcl_GetChannelName(rcPtr->chan)); + rcmPtr = GetReflectedChannelMap (rcPtr->interp); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); if (hPtr) { - Tcl_DeleteHashEntry(hPtr); + Tcl_DeleteHashEntry (hPtr); } } #ifdef TCL_THREADS - rcmPtr = GetThreadReflectedChannelMap(); - hPtr = Tcl_FindHashEntry(&rcmPtr->map, - Tcl_GetChannelName(rcPtr->chan)); + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); if (hPtr) { - Tcl_DeleteHashEntry(hPtr); + Tcl_DeleteHashEntry (hPtr); } #endif + tctPtr = ((Channel *)rcPtr->chan)->typePtr; + if (tctPtr && tctPtr != &tclRChannelType) { + ckfree((char *)tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; + } Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); #ifdef TCL_THREADS } @@ -1183,25 +1158,13 @@ ReflectInput( int toRead, int *errorCodePtr) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *toReadObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ /* - * The following check can be done before thread redirection, because we - * are reading from an item which is readonly, i.e. will never change - * during the lifetime of the channel. - */ - - if (!(rcPtr->methods & FLAG(METH_READ))) { - SetChannelErrorStr(rcPtr->chan, msg_read_unsup); - *errorCodePtr = EINVAL; - return -1; - } - - /* * Are we in the correct thread? */ @@ -1239,8 +1202,8 @@ ReflectInput( toReadObj = Tcl_NewIntObj(toRead); Tcl_IncrRefCount(toReadObj); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) { - int code = ErrnoReturn(rcPtr, resObj); + if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { + int code = ErrnoReturn (rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; @@ -1299,24 +1262,12 @@ ReflectOutput( int toWrite, int *errorCodePtr) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *bufObj; Tcl_Obj *resObj; /* Result data for 'write' */ int written; /* - * The following check can be done before thread redirection, because we - * are reading from an item which is readonly, i.e. will never change - * during the lifetime of the channel. - */ - - if (!(rcPtr->methods & FLAG(METH_WRITE))) { - SetChannelErrorStr(rcPtr->chan, msg_write_unsup); - *errorCodePtr = EINVAL; - return -1; - } - - /* * Are we in the correct thread? */ @@ -1350,11 +1301,12 @@ ReflectOutput( /* ASSERT: rcPtr->mode & TCL_WRITABLE */ Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr->interp); bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite); Tcl_IncrRefCount(bufObj); - if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { @@ -1366,6 +1318,14 @@ ReflectOutput( goto invalid; } + if (Tcl_InterpDeleted(rcPtr->interp)) { + /* + * The interp was destroyed during InvokeTclMethod(). + */ + + SetChannelErrorStr(rcPtr->chan, msg_send_dstlost); + goto invalid; + } if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); goto invalid; @@ -1395,6 +1355,7 @@ ReflectOutput( stop: Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ + Tcl_Release(rcPtr->interp); Tcl_Release(rcPtr); return written; invalid: @@ -1427,7 +1388,7 @@ ReflectSeekWide( int seekMode, int *errorCodePtr) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *offObj, *baseObj; Tcl_Obj *resObj; /* Result for 'seek' */ Tcl_WideInt newLoc; @@ -1461,13 +1422,13 @@ ReflectSeekWide( Tcl_Preserve(rcPtr); - offObj = Tcl_NewWideIntObj(offset); + offObj = Tcl_NewWideIntObj(offset); baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" : - ((seekMode == SEEK_CUR) ? "current" : "end"), -1); + ((seekMode == SEEK_CUR) ? "current" : "end"), -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); - if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } @@ -1535,11 +1496,9 @@ ReflectWatch( ClientData clientData, int mask) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) 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. @@ -1582,7 +1541,7 @@ ReflectWatch( maskObj = DecodeEventMask(mask); /* assert maskObj.refCount == 1 */ - (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL); + (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); @@ -1610,7 +1569,7 @@ ReflectBlock( ClientData clientData, int nonblocking) { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *blockObj; int errorNum; /* EINVAL or EOK (success). */ Tcl_Obj *resObj; /* Result data for 'blocking' */ @@ -1641,7 +1600,7 @@ ReflectBlock( Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { @@ -1678,7 +1637,7 @@ ReflectSetOption( const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ { - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *optionObj, *valueObj; int result; /* Result code for 'configure' */ Tcl_Obj *resObj; /* Result data for 'configure' */ @@ -1715,7 +1674,7 @@ ReflectSetOption( Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); - result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj); + result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); } @@ -1755,12 +1714,12 @@ ReflectGetOption( * The bypass functions are not required. */ - ReflectedChannel *rcPtr = clientData; + ReflectedChannel *rcPtr = (ReflectedChannel*) clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ int listc, result = TCL_OK; Tcl_Obj **listv; - const char *method; + MethodName method; /* * Are we in the correct thread? @@ -1799,14 +1758,14 @@ 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); } @@ -1856,7 +1815,7 @@ ReflectGetOption( goto error; } else { int len; - const char *str = Tcl_GetStringFromObj(resObj, &len); + char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { Tcl_DStringAppend(dsPtr, " ", 1); @@ -1956,7 +1915,7 @@ EncodeEventMask( * This function takes an internal bitmask of events and constructs the * equivalent list of event items. * - * Results, Contract: + * Results: * A Tcl_Obj reference. The object will have a refCount of one. The user * has to decrement it to release the object. * @@ -1990,7 +1949,6 @@ DecodeEventMask( evObj = Tcl_NewStringObj(eventStr, -1); Tcl_IncrRefCount(evObj); - /* assert evObj.refCount == 1 */ return evObj; } @@ -2019,16 +1977,13 @@ NewReflectedChannel( Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; - int i, listc; - Tcl_Obj **listv; + MethodName mn = METH_BLOCKING; - rcPtr = ckalloc(sizeof(ReflectedChannel)); + rcPtr = (ReflectedChannel *) 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; #ifdef TCL_THREADS rcPtr->thread = Tcl_GetCurrentThread(); @@ -2036,54 +1991,17 @@ NewReflectedChannel( 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 = 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 */ - - /* - * [Bug 1667990]: See [x] in FreeReflectedChannel for release - */ - - 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; } @@ -2134,29 +2052,12 @@ FreeReflectedChannel( ReflectedChannel *rcPtr) { Channel *chanPtr = (Channel *) rcPtr->chan; - int i, n; - - if (chanPtr->typePtr != &tclRChannelType) { - /* - * Delete a cloned ChannelType structure. - */ - - ckfree(chanPtr->typePtr); - } - - n = rcPtr->argc - 2; - for (i=0; i<n; i++) { - Tcl_DecrRefCount(rcPtr->argv[i]); - } - - /* - * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1. - */ - - Tcl_DecrRefCount(rcPtr->argv[n+1]); - ckfree(rcPtr->argv); - ckfree(rcPtr); + TclChannelRelease((Tcl_Channel)chanPtr); + Tcl_DecrRefCount(rcPtr->name); + Tcl_DecrRefCount(rcPtr->methods); + Tcl_DecrRefCount(rcPtr->cmd); + ckfree((char*) rcPtr); } /* @@ -2186,16 +2087,16 @@ FreeReflectedChannel( 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 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; if (!rcPtr->interp) { /* @@ -2218,35 +2119,25 @@ InvokeTclMethod( } /* - * NOTE (5): Decide impl. issue: Cache objects with method names? Needs - * TSD data as reflections can be created in many different threads. - * NO: Caching of command resolutions means storage per channel. - */ - - /* - * Insert method into the pre-allocated area, after the command prefix, + * 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) { - rcPtr->argv[cmdc] = argOneObj; - cmdc++; + Tcl_ListObjAppendElement(NULL, cmd, argOneObj); if (argTwoObj) { - rcPtr->argv[cmdc] = argTwoObj; - cmdc++; + Tcl_ListObjAppendElement(NULL, cmd, argTwoObj); } } @@ -2255,9 +2146,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_GlobalEvalObj(rcPtr->interp, cmd); /* * We do not try to extract the result information if the caller has no @@ -2283,7 +2175,6 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { - Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv); int cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); @@ -2297,25 +2188,17 @@ InvokeTclMethod( result = TCL_ERROR; } Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf( - "\n (chan handler subcommand \"%s\")", method)); + "\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. - * - * The detail objects survived the Tcl_EvalObjv without change because of - * the contract. Therefore there is no need to decrement the refcounts. Only - * the internal method object has to be disposed of. - */ - - Tcl_DecrRefCount(methObj); - - /* * The resObj has a ref count of 1 at this location. This means that the * caller of InvokeTclMethod has to dispose of it (but only if it was * returned to it). @@ -2354,9 +2237,7 @@ InvokeTclMethod( */ static int -ErrnoReturn( - ReflectedChannel *rcPtr, - Tcl_Obj *resObj) +ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj) { int code; Tcl_InterpState sr; /* State of handler interp */ @@ -2370,10 +2251,9 @@ ErrnoReturn( 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; + if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK) || (code >= 0))) { + if (strcmp ("EAGAIN",Tcl_GetString(resObj)) == 0) { + code = - EAGAIN; } else { code = 0; } @@ -2404,10 +2284,10 @@ static ReflectedChannelMap * GetReflectedChannelMap( Tcl_Interp *interp) { - ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL); + ReflectedChannelMap* rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL); if (rcmPtr == NULL) { - rcmPtr = ckalloc(sizeof(ReflectedChannelMap)); + rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS); Tcl_SetAssocData(interp, RCMKEY, (Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr); @@ -2440,12 +2320,12 @@ DeleteReflectedChannelMap( ClientData clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { - ReflectedChannelMap *rcmPtr = clientData; - /* The map */ + ReflectedChannelMap* rcmPtr; /* The map */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ - ReflectedChannel *rcPtr; + ReflectedChannel* rcPtr; Tcl_Channel chan; + #ifdef TCL_THREADS ForwardingResult *resultPtr; ForwardingEvent *evPtr; @@ -2455,7 +2335,7 @@ DeleteReflectedChannelMap( /* * 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 + * 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 @@ -2464,17 +2344,20 @@ DeleteReflectedChannelMap( * this interp. */ + rcmPtr = clientData; for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); - hPtr != NULL; - hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { - chan = Tcl_GetHashValue(hPtr); - rcPtr = Tcl_GetChannelInstanceData(chan); + hPtr != NULL; + hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { + + chan = (Tcl_Channel) Tcl_GetHashValue (hPtr); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); rcPtr->interp = NULL; + Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); - ckfree(&rcmPtr->map); + ckfree((char *) &rcmPtr->map); #ifdef TCL_THREADS /* @@ -2490,23 +2373,28 @@ DeleteReflectedChannelMap( Tcl_MutexLock(&rcForwardMutex); for (resultPtr = forwardList; - resultPtr != NULL; - resultPtr = resultPtr->nextPtr) { + resultPtr != NULL; + resultPtr = resultPtr->nextPtr) { if (resultPtr->dsti != interp) { - /* - * Ignore results/events for other interpreters. - */ - + /* 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. + * + * Attention: Results may have been detached already, by either the + * receiver, or this thread, as part of other parts in the thread + * teardown. Such results are ignored. See ticket [b47b176adf] for the + * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; paramPtr = evPtr->param; + if (!evPtr) { + continue; + } evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; @@ -2526,16 +2414,14 @@ DeleteReflectedChannelMap( rcmPtr = GetThreadReflectedChannelMap(); for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&hSearch)) { - chan = Tcl_GetHashValue(hPtr); - rcPtr = Tcl_GetChannelInstanceData(chan); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&hSearch)) { - if (rcPtr->interp != interp) { - /* - * Ignore entries for other interpreters. - */ + chan = (Tcl_Channel) Tcl_GetHashValue (hPtr); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); + if (rcPtr->interp != interp) { + /* Ignore entries for other interpreters */ continue; } @@ -2565,12 +2451,12 @@ DeleteReflectedChannelMap( */ static ReflectedChannelMap * -GetThreadReflectedChannelMap(void) +GetThreadReflectedChannelMap() { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rcmPtr) { - tsdPtr->rcmPtr = ckalloc(sizeof(ReflectedChannelMap)); + tsdPtr->rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL); } @@ -2585,7 +2471,7 @@ GetThreadReflectedChannelMap(void) * * 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(). + * DeleteReflectedChannelMap(). * * Results: * None. @@ -2603,8 +2489,13 @@ DeleteThreadReflectedChannelMap( Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ Tcl_ThreadId self = Tcl_GetCurrentThread(); - ReflectedChannelMap *rcmPtr; /* The map */ + + ReflectedChannelMap* rcmPtr; /* The map */ + Tcl_Channel chan; + ReflectedChannel* rcPtr; ForwardingResult *resultPtr; + ForwardingEvent *evPtr; + ForwardParam *paramPtr; /* * The origin thread for one or more reflected channels is gone. @@ -2621,26 +2512,28 @@ DeleteThreadReflectedChannelMap( Tcl_MutexLock(&rcForwardMutex); for (resultPtr = forwardList; - resultPtr != NULL; - resultPtr = resultPtr->nextPtr) { - ForwardingEvent *evPtr; - ForwardParam *paramPtr; - + resultPtr != NULL; + resultPtr = resultPtr->nextPtr) { if (resultPtr->dst != self) { - /* - * Ignore results/events for other threads. - */ - + /* 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. + * + * Attention: Results may have been detached already, by either the + * receiver, or this thread, as part of other parts in the thread + * teardown. Such results are ignored. See ticket [b47b176adf] for the + * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; paramPtr = evPtr->param; + if (!evPtr) { + continue; + } evPtr->resultPtr = NULL; resultPtr->evPtr = NULL; @@ -2659,12 +2552,14 @@ DeleteThreadReflectedChannelMap( 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); + hPtr != NULL; + hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { + + chan = (Tcl_Channel) Tcl_GetHashValue (hPtr); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); rcPtr->interp = NULL; + Tcl_DeleteHashEntry(hPtr); } @@ -2675,7 +2570,7 @@ static void ForwardOpToOwnerThread( ReflectedChannel *rcPtr, /* Channel instance */ ForwardedOperation op, /* Forwarded driver operation */ - const void *param) /* Arguments */ + const VOID *param) /* Arguments */ { Tcl_ThreadId dst = rcPtr->thread; ForwardingEvent *evPtr; @@ -2694,7 +2589,7 @@ ForwardOpToOwnerThread( * appropriate error. Do not forget to unlock the mutex on this path. */ - ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost); + ForwardSetStaticError((ForwardParam *)param, msg_send_dstlost); Tcl_MutexUnlock(&rcForwardMutex); return; } @@ -2703,8 +2598,8 @@ ForwardOpToOwnerThread( * Create and initialize the event and data structures. */ - evPtr = ckalloc(sizeof(ForwardingEvent)); - resultPtr = ckalloc(sizeof(ForwardingResult)); + evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent)); + resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; @@ -2712,8 +2607,8 @@ ForwardOpToOwnerThread( evPtr->rcPtr = rcPtr; evPtr->param = (ForwardParam *) param; - resultPtr->src = Tcl_GetCurrentThread(); - resultPtr->dst = dst; + resultPtr->src = Tcl_GetCurrentThread(); + resultPtr->dst = dst; resultPtr->dsti = rcPtr->interp; resultPtr->done = NULL; resultPtr->result = -1; @@ -2728,19 +2623,19 @@ ForwardOpToOwnerThread( /* * Ensure cleanup of the event if the origin thread exits while this event - * is pending or in progress. Exit of the destination thread is handled by - * DeleteThreadReflectionChannelMap(), this is set up by - * GetThreadReflectedChannelMap(). This is what we use the 'forwardList' + * is pending or in progress. Exitus of the destination thread is handled + * by DeleteThreadReflectionChannelMap(), this is set up by + * GetThreadReflectedChannelMap(). This is what we use the 'forwardList' * (see above) for. */ - Tcl_CreateThreadExitHandler(SrcExitProc, evPtr); + Tcl_CreateThreadExitHandler(SrcExitProc, (ClientData) evPtr); /* * Queue the event and poke the other thread's notifier. */ - Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL); + Tcl_ThreadQueueEvent(dst, (Tcl_Event *)evPtr, TCL_QUEUE_TAIL); Tcl_ThreadAlert(dst); /* @@ -2762,8 +2657,8 @@ ForwardOpToOwnerThread( } /* - * Unlink result from the forwarder list. No need to lock. Either still - * locked, or locked by the ConditionWait + * Unlink result from the forwarder list. + * No need to lock. Either still locked, or locked by the ConditionWait */ TclSpliceOut(resultPtr, forwardList); @@ -2781,9 +2676,9 @@ ForwardOpToOwnerThread( * Note: The event structure has already been deleted. */ - Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); + Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr); - ckfree(resultPtr); + ckfree((char*) resultPtr); } static int @@ -2810,10 +2705,8 @@ 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 */ + 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. @@ -2834,17 +2727,19 @@ ForwardProc( * call upon for the driver. */ - case ForwardedClose: + case ForwardedClose: { /* * No parameters/results. */ - if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) { + Tcl_ChannelType *tctPtr; + + 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 * @@ -2853,26 +2748,32 @@ ForwardProc( * 'postevent') from finding and dereferencing a dangling pointer. */ - rcmPtr = GetReflectedChannelMap(interp); - hPtr = Tcl_FindHashEntry(&rcmPtr->map, - Tcl_GetChannelName(rcPtr->chan)); - Tcl_DeleteHashEntry(hPtr); + 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); + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); + Tcl_DeleteHashEntry (hPtr); + tctPtr = ((Channel *)rcPtr->chan)->typePtr; + if (tctPtr && tctPtr != &tclRChannelType) { + ckfree((char *)tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; + } Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); break; + } case ForwardedInput: { Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); Tcl_IncrRefCount(toReadObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){ - int code = ErrnoReturn(rcPtr, resObj); + if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){ + int code = ErrnoReturn (rcPtr, resObj); if (code < 0) { paramPtr->base.code = code; @@ -2907,11 +2808,11 @@ ForwardProc( case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) - paramPtr->output.buf, paramPtr->output.toWrite); + paramPtr->output.buf, paramPtr->output.toWrite); Tcl_IncrRefCount(bufObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { @@ -2945,14 +2846,14 @@ ForwardProc( 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); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){ + if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } else { @@ -2986,7 +2887,7 @@ ForwardProc( /* assert maskObj.refCount == 1 */ Tcl_Preserve(rcPtr); - (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL); + (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); break; @@ -2997,8 +2898,8 @@ ForwardProc( Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, - &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); @@ -3008,13 +2909,13 @@ ForwardProc( 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); Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj, - &resObj) != TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); @@ -3032,11 +2933,11 @@ ForwardProc( Tcl_IncrRefCount(optionObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){ + if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { Tcl_DStringAppend(paramPtr->getOpt.value, - TclGetString(resObj), -1); + TclGetString(resObj), -1); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); @@ -3049,7 +2950,7 @@ ForwardProc( */ Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){ + if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { /* @@ -3061,7 +2962,7 @@ ForwardProc( Tcl_Obj **listv; if (Tcl_ListObjGetElements(interp, resObj, &listc, - &listv) != TCL_OK) { + &listv) != TCL_OK) { ForwardSetObjError(paramPtr, MarshallError(interp)); } else if ((listc % 2) == 1) { /* @@ -3125,7 +3026,7 @@ static void SrcExitProc( ClientData clientData) { - ForwardingEvent *evPtr = clientData; + ForwardingEvent *evPtr = (ForwardingEvent *) clientData; ForwardingResult *resultPtr; ForwardParam *paramPtr; @@ -3178,7 +3079,7 @@ ForwardSetObjError( const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, ckalloc(len)); + ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len)); memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len); } #endif |