diff options
Diffstat (limited to 'generic/tclIORChan.c')
| -rw-r--r-- | generic/tclIORChan.c | 1245 |
1 files changed, 428 insertions, 817 deletions
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 31ead91..c9939d6 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -10,14 +10,14 @@ * * See TIP #219 for the specification of this functionality. * - * Copyright © 2004-2005 ActiveState, a division of Sophos + * Copyright (c) 2004-2005 ActiveState, a divison of Sophos * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tclInt.h" -#include "tclIO.h" +#include <tclInt.h> +#include <tclIO.h> #include <assert.h> #ifndef EINVAL @@ -31,66 +31,48 @@ * Signatures of all functions used in the C layer of the reflection. */ -static int ReflectClose(void *clientData, - Tcl_Interp *interp, int flags); -static int ReflectInput(void *clientData, char *buf, +static int ReflectClose(ClientData clientData, + Tcl_Interp *interp); +static int ReflectInput(ClientData clientData, char *buf, int toRead, int *errorCodePtr); -static int ReflectOutput(void *clientData, const char *buf, +static int ReflectOutput(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr); -static void ReflectWatch(void *clientData, int mask); -static int ReflectBlock(void *clientData, int mode); -#if TCL_THREADS -static void ReflectThread(void *clientData, int action); -static int ReflectEventRun(Tcl_Event *ev, int flags); -static int ReflectEventDelete(Tcl_Event *ev, void *cd); -#endif -static long long ReflectSeekWide(void *clientData, - long long offset, int mode, int *errorCodePtr); -#ifndef TCL_NO_DEPRECATED -static int ReflectSeek(void *clientData, long offset, +static void ReflectWatch(ClientData clientData, int mask); +static int ReflectBlock(ClientData clientData, int mode); +static Tcl_WideInt ReflectSeekWide(ClientData clientData, + Tcl_WideInt offset, int mode, int *errorCodePtr); +static int ReflectSeek(ClientData clientData, long offset, int mode, int *errorCodePtr); -#endif -static int ReflectGetOption(void *clientData, +static int ReflectGetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -static int ReflectSetOption(void *clientData, +static int ReflectSetOption(ClientData clientData, Tcl_Interp *interp, const char *optionName, const char *newValue); -static int ReflectTruncate(void *clientData, - long long length); -static void TimerRunRead(void *clientData); -static void TimerRunWrite(void *clientData); /* - * The C layer channel type/driver definition used by the reflection. + * The C layer channel type/driver definition used by the reflection. This is + * 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 */ - TCL_CLOSE2PROC, /* Close channel, clean instance data */ - ReflectInput, /* Handle read request */ - ReflectOutput, /* Handle write request */ -#ifndef TCL_NO_DEPRECATED - ReflectSeek, /* Move location of access point. NULL'able */ -#else - NULL, -#endif - ReflectSetOption, /* Set options. NULL'able */ - ReflectGetOption, /* Get options. NULL'able */ - ReflectWatch, /* Initialize notifier */ - NULL, /* Get OS handle from the channel. NULL'able */ - ReflectClose, /* 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 */ -#if TCL_THREADS - ReflectThread, /* thread action, tracking owner */ -#else - NULL, /* thread action */ -#endif - ReflectTruncate /* Truncate. NULL'able */ + 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 */ }; /* @@ -106,9 +88,8 @@ typedef struct { * interpreter/thread containing its Tcl * command is gone. */ -#if TCL_THREADS - Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ - Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ +#ifdef TCL_THREADS + Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */ #endif Tcl_Obj *cmd; /* Callback command prefix */ Tcl_Obj *methods; /* Methods to append to command prefix */ @@ -118,20 +99,6 @@ typedef struct { int interest; /* Mask of events the channel is interested * in. */ - int dead; /* Boolean signal that some operations - * should no longer be attempted. */ - - Tcl_TimerToken readTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is readable - */ - Tcl_TimerToken writeTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is writable - */ - /* * Note regarding the usage of timers. * @@ -139,16 +106,18 @@ typedef struct { * data in buffers is flushed out through the generation of fake file * events. * - * See 'refchan', 'memchan', etc. + * See 'rechan', 'memchan', etc. * - * A timer is used here as well in order to ensure at least on pass through - * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and - * ef28eb1f1516. + * Here this is _not_ required. Interest in events is posted to the Tcl + * level via 'watch'. And posting of events is possible from the Tcl level + * as well, via 'chan postevent'. This means that the generation of all + * events, fake or not, timer based or not, is completely in the hands of + * the Tcl level. Therefore no timer here. */ } ReflectedChannel; /* - * Structure of the table mapping from channel handles to reflected + * 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 @@ -168,7 +137,7 @@ typedef struct { * Event literals. ================================================== */ -static const char *const eventOptions[] = { +static const char *eventOptions[] = { "read", "write", NULL }; typedef enum { @@ -179,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 */ @@ -188,7 +157,6 @@ static const char *const methodNames[] = { "initialize", /* */ "read", /* OPT */ "seek", /* OPT */ - "truncate", /* OPT */ "watch", /* */ "write", /* OPT */ NULL @@ -202,7 +170,6 @@ typedef enum { METH_INIT, METH_READ, METH_SEEK, - METH_TRUNCATE, METH_WATCH, METH_WRITE } MethodName; @@ -212,17 +179,16 @@ typedef enum { (FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH)) #define NULLABLE_METHODS \ (FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \ - FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \ - FLAG(METH_CGETALL) | FLAG(METH_TRUNCATE)) + FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL)) #define RANDW \ (TCL_READABLE | TCL_WRITABLE) #define IMPLIES(a,b) ((!(a)) || (b)) #define NEGIMPL(a,b) -#define HAS(x,f) ((x) & FLAG(f)) +#define HAS(x,f) (x & FLAG(f)) -#if TCL_THREADS +#ifdef TCL_THREADS /* * Thread specific types and structures. * @@ -243,8 +209,7 @@ typedef enum { ForwardedBlock, ForwardedSetOpt, ForwardedGetOpt, - ForwardedGetOptAll, - ForwardedTruncate + ForwardedGetOptAll } ForwardedOperation; /* @@ -258,7 +223,7 @@ typedef enum { * sharing problems. */ -typedef struct { +typedef struct ForwardParamBase { int code; /* O: Ok/Fail of the cmd handler */ char *msgStr; /* O: Error message for handler failure */ int mustFree; /* O: True if msgStr is allocated, false if @@ -274,13 +239,13 @@ typedef struct { struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - Tcl_Size toRead; /* I: #bytes to read, + int toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ const char *buf; /* I: Where the bytes to write come from */ - Tcl_Size toWrite; /* I: #bytes to write, + int toWrite; /* I: #bytes to write, * O: #bytes actually written */ }; struct ForwardParamSeek { @@ -307,10 +272,6 @@ struct ForwardParamGetOpt { const char *name; /* Name of option to get, maybe NULL */ Tcl_DString *value; /* Result */ }; -struct ForwardParamTruncate { - ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ - Tcl_WideInt length; /* I: Length of file. */ -}; /* * Now join all these together in a single union for convenience. @@ -325,7 +286,6 @@ typedef union ForwardParam { struct ForwardParamBlock block; struct ForwardParamSetOpt setOpt; struct ForwardParamGetOpt getOpt; - struct ForwardParamTruncate truncate; } ForwardParam; /* @@ -338,7 +298,7 @@ typedef struct ForwardingResult ForwardingResult; * General event structure, with reference to operation specific data. */ -typedef struct { +typedef struct ForwardingEvent { Tcl_Event event; /* Basic event data, has to be first item */ ForwardingResult *resultPtr; ForwardedOperation op; /* Forwarded driver operation */ @@ -358,8 +318,7 @@ typedef struct { 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 @@ -375,13 +334,13 @@ struct ForwardingResult { * results. */ }; -typedef struct { +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; + ReflectedChannelMap* rcmPtr; } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -405,37 +364,37 @@ TCL_DECLARE_MUTEX(rcForwardMutex) * leak resources when threads go away. */ -static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr, - ForwardedOperation op, const void *param); +static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr, + ForwardedOperation op, const VOID *param); static int ForwardProc(Tcl_Event *evPtr, int mask); -static void SrcExitProc(void *clientData); +static void SrcExitProc(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 ReflectedChannelMap * GetThreadReflectedChannelMap(void); -static Tcl_ExitProc DeleteThreadReflectedChannelMap; +static void DeleteThreadReflectedChannelMap(ClientData clientData); #endif /* TCL_THREADS */ @@ -456,15 +415,15 @@ 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 Tcl_FreeProc FreeReflectedChannel; +static void FreeReflectedChannel(ReflectedChannel *rcPtr); static int InvokeTclMethod(ReflectedChannel *rcPtr, MethodName method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); -static Tcl_InterpDeleteProc DeleteReflectedChannelMap; -static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj); -static void MarkDead(ReflectedChannel *rcPtr); +static void DeleteReflectedChannelMap(ClientData clientData, + Tcl_Interp *interp); +static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj); /* * Global constant strings (messages). ================== @@ -477,7 +436,7 @@ 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}"; -#if TCL_THREADS +#ifdef TCL_THREADS static const char *msg_send_originlost = "{Channel thread lost}"; #endif /* TCL_THREADS */ static const char *msg_send_dstlost = "{Owner lost}"; @@ -507,7 +466,7 @@ static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo int TclChanCreateObjCmd( - TCL_UNUSED(void *), + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) @@ -520,7 +479,7 @@ TclChanCreateObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Channel chan; /* Token for the new channel */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + int listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ @@ -528,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 @@ -556,10 +513,9 @@ TclChanCreateObjCmd( /* * First argument is a list of modes. Allowed entries are "read", "write". - * Empty list is uncommon, but allowed. Abbreviations are ok. + * Expect at least one list element. Abbreviations are ok. */ - modeObj = objv[MODE]; if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) { return TCL_ERROR; } @@ -587,9 +543,6 @@ TclChanCreateObjCmd( rcId = NextHandle(); rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId); - if (!rcPtr) { - return TCL_ERROR; - } /* * Invoke 'initialize' and validate that the handler is present and ok. @@ -605,7 +558,6 @@ TclChanCreateObjCmd( /* assert modeObj.refCount == 1 */ 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 */ @@ -619,10 +571,12 @@ TclChanCreateObjCmd( * Compare open mode against optional r/w. */ - if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s initialize\" returned non-list: %s", - TclGetString(cmdObj), TclGetString(resObj))); + if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { + TclNewLiteralStringObj(err, "chan handler \""); + Tcl_AppendObjToObj(err, cmdObj); + Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1); + Tcl_AppendObjToObj(err, resObj); + Tcl_SetObjResult(interp, err); Tcl_DecrRefCount(resObj); goto error; } @@ -646,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", - TclGetString(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", - TclGetString(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", - TclGetString(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\"", - TclGetString(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\"", - TclGetString(cmdObj))); + TclNewLiteralStringObj(err, "chan handler \""); + Tcl_AppendObjToObj(err, cmdObj); + Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1); + Tcl_SetObjResult(interp, err); goto error; } @@ -699,7 +658,8 @@ TclChanCreateObjCmd( * as the actual channel type. */ - Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)ckalloc(sizeof(Tcl_ChannelType)); + Tcl_ChannelType *clonePtr = (Tcl_ChannelType *) + ckalloc(sizeof(Tcl_ChannelType)); memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType)); @@ -714,14 +674,9 @@ TclChanCreateObjCmd( clonePtr->blockModeProc = NULL; } if (!(methods & FLAG(METH_SEEK))) { -#ifndef TCL_NO_DEPRECATED clonePtr->seekProc = NULL; -#endif clonePtr->wideSeekProc = NULL; } - if (!(methods & FLAG(METH_TRUNCATE))) { - clonePtr->truncateProc = NULL; - } chanPtr->typePtr = clonePtr; } @@ -733,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); -#if TCL_THREADS +#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 @@ -751,15 +708,14 @@ TclChanCreateObjCmd( * Return handle as result of command. */ - Tcl_SetObjResult(interp, - Tcl_NewStringObj(chanPtr->state->channelName, -1)); + Tcl_SetObjResult(interp, rcId); return TCL_OK; - error: + error: Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); - ckfree(rcPtr); + ckfree((char*) rcPtr); return TCL_ERROR; #undef MODE @@ -784,62 +740,14 @@ TclChanCreateObjCmd( *---------------------------------------------------------------------- */ -#if TCL_THREADS -typedef struct { - Tcl_Event header; - ReflectedChannel *rcPtr; - int events; -} ReflectEvent; - -static int -ReflectEventRun( - Tcl_Event *ev, - TCL_UNUSED(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, - void *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; -} -#endif - int TclChanPostEventObjCmd( - TCL_UNUSED(void *), + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { /* - * Ensure -> HANDLER thread - * * Syntax: chan postevent CHANNEL EVENTSPEC * [0] [1] [2] [3] * @@ -858,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... @@ -878,34 +785,33 @@ 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_SetObjResult(interp, Tcl_ObjPrintf( - "can not find reflected channel named \"%s\"", chanId)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, (void *)NULL); + Tcl_AppendResult(interp, "can not find reflected channel named \"", chanId, + "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL); return TCL_ERROR; } /* - * Note that the search above subsumes several of the older checks, - * namely: + * Note that the search above subsumes several of the older checks, namely: * - * (1) Does the channel handle refer to a reflected channel? + * (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? + * 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 paranoia, but abort now instead of - * throwing errors, as failure now means that our internal data structures + * 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_Channel)Tcl_GetHashValue(hPtr); + chan = Tcl_GetHashValue(hPtr); chanTypePtr = Tcl_GetChannelType(chan); /* @@ -918,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 = (ReflectedChannel *)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"); } /* @@ -935,20 +841,14 @@ TclChanPostEventObjCmd( if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) { return TCL_ERROR; } - if (events == 0) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("bad event list: is empty", -1)); - return TCL_ERROR; - } /* * Check that the channel is actually interested in the provided events. */ if (events & ~rcPtr->interest) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "tried to post events channel \"%s\" is not interested in", - chanId)); + Tcl_AppendResult(interp, "tried to post events channel \"", chanId, + "\" is not interested in", NULL); return TCL_ERROR; } @@ -956,56 +856,7 @@ TclChanPostEventObjCmd( * We have the channel and the events to post. */ -#if TCL_THREADS - if (rcPtr->owner == rcPtr->thread) { -#endif - if (events & TCL_READABLE) { - if (rcPtr->readTimer == NULL) { - rcPtr->readTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - TimerRunRead, rcPtr); - } - } - if (events & TCL_WRITABLE) { - if (rcPtr->writeTimer == NULL) { - rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - TimerRunWrite, rcPtr); - } - } -#if TCL_THREADS - } else { - ReflectEvent *ev = (ReflectEvent *)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_QUEUE_ALERT_IF_EMPTY); - } -#endif + Tcl_NotifyChannel(chan, events); /* * Squash interp results left by the event script. @@ -1018,29 +869,11 @@ TclChanPostEventObjCmd( #undef EVENT } -static void -TimerRunRead( - void *clientData) -{ - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; - rcPtr->readTimer = NULL; - Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE); -} - -static void -TimerRunWrite( - void *clientData) -{ - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; - rcPtr->writeTimer = NULL; - Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE); -} - /* * Channel error message marshalling utilities. */ -static Tcl_Obj * +static Tcl_Obj* MarshallError( Tcl_Interp *interp) { @@ -1065,10 +898,10 @@ UnmarshallErrorResult( Tcl_Interp *interp, Tcl_Obj *msgObj) { - Tcl_Size lc; + int lc; Tcl_Obj **lv; int explicitResult; - Tcl_Size numOptions; + int numOptions; /* * Process the caught message. @@ -1076,11 +909,11 @@ UnmarshallErrorResult( * Syntax = (option value)... ?message? * * Bad syntax causes a panic. This is OK because the other side uses - * Tcl_GetReturnOptions and list construction functions to marshal the + * Tcl_GetReturnOptions and list construction functions to marshall the * information; if we panic here, something has gone badly wrong already. */ - if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) { Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result"); } if (interp == NULL) { @@ -1095,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 @@ -1164,10 +997,10 @@ TclChanCaughtErrorBypass( * ReflectClose -- * * This function is invoked when the channel is closed, to delete the - * driver-specific instance data. + * driver specific instance data. * * Results: - * A Posix error. + * A posix error. * * Side effects: * Releases memory. Arbitrary, as it calls upon a script. @@ -1177,70 +1010,57 @@ TclChanCaughtErrorBypass( static int ReflectClose( - void *clientData, - Tcl_Interp *interp, - int flags) + ClientData clientData, + Tcl_Interp *interp) { - ReflectedChannel *rcPtr = (ReflectedChannel *)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 */ - const Tcl_ChannelType *tctPtr; - - if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) { - return EINVAL; - } + ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */ + Tcl_HashEntry* hPtr; /* Entry in the above map */ + Tcl_ChannelType *tctPtr; if (TclInThreadExit()) { /* * This call comes from TclFinalizeIOSystem. There are no * interpreters, and therefore we cannot call upon the handler command - * anymore. Threading is irrelevant as well. Simply clean up all - * the C level data structures and leave the Tcl level to the other + * anymore. Threading is irrelevant as well. We simply clean up all + * our C level data structures and leave the Tcl level to the other * finalization functions. */ /* * THREADED => Forward this to the origin thread * - * Note: 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? */ -#if TCL_THREADS +#ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); + ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p); result = p.base.code; - /* - * Now squash the pending reflection events for this channel. - */ - - Tcl_DeleteEvents(ReflectEventDelete, rcPtr); + /* + * FreeReflectedChannel is done in the forwarded operation!, in + * the other thread. rcPtr here is gone! + */ if (result != TCL_OK) { FreeReceivedError(&p); } + return EOK; } #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { - ckfree(tctPtr); + ckfree((char *)tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } - if (rcPtr->readTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->readTimer); - } - if (rcPtr->writeTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->writeTimer); - } - Tcl_EventuallyFree(rcPtr, FreeReflectedChannel); + Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); return EOK; } @@ -1248,18 +1068,17 @@ ReflectClose( * Are we in the correct thread? */ -#if TCL_THREADS +#ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); + ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p); result = p.base.code; - /* - * Now squash the pending reflection events for this channel. - */ - - Tcl_DeleteEvents(ReflectEventDelete, rcPtr); + /* + * FreeReflectedChannel is done in the forwarded operation!, in the + * other thread. rcPtr here is gone! + */ if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); @@ -1287,35 +1106,32 @@ ReflectClose( * the per-interp DeleteReflectedChannelMap exit-handler. */ - if (!rcPtr->dead) { - rcmPtr = GetReflectedChannelMap(rcPtr->interp); - hPtr = Tcl_FindHashEntry(&rcmPtr->map, - Tcl_GetChannelName(rcPtr->chan)); + if (rcPtr->interp) { + rcmPtr = GetReflectedChannelMap (rcPtr->interp); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); if (hPtr) { - Tcl_DeleteHashEntry(hPtr); + Tcl_DeleteHashEntry (hPtr); } } -#if TCL_THREADS - rcmPtr = GetThreadReflectedChannelMap(); - hPtr = Tcl_FindHashEntry(&rcmPtr->map, - Tcl_GetChannelName(rcPtr->chan)); +#ifdef TCL_THREADS + 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(tctPtr); - ((Channel *)rcPtr->chan)->typePtr = NULL; - } - if (rcPtr->readTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->readTimer); - } - if (rcPtr->writeTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->writeTimer); + + 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 } - Tcl_EventuallyFree(rcPtr, FreeReflectedChannel); +#endif return (result == TCL_OK) ? EOK : EINVAL; } @@ -1337,14 +1153,14 @@ ReflectClose( static int ReflectInput( - void *clientData, + ClientData clientData, char *buf, int toRead, int *errorCodePtr) { - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *toReadObj; - Tcl_Size bytec; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ @@ -1352,27 +1168,24 @@ ReflectInput( * Are we in the correct thread? */ -#if TCL_THREADS +#ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.input.buf = buf; p.input.toRead = toRead; - ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p); + ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { - /* - * No error message, this is an errno signal. - */ - + /* No error message, this is an errno signal. */ *errorCodePtr = -p.base.code; } else { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; } - p.input.toRead = TCL_INDEX_NONE; + p.input.toRead = -1; } else { *errorCodePtr = EOK; } @@ -1386,11 +1199,11 @@ ReflectInput( Tcl_Preserve(rcPtr); - TclNewIntObj(toReadObj, toRead); + toReadObj = Tcl_NewIntObj(toRead); Tcl_IncrRefCount(toReadObj); if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { - int code = ErrnoReturn(rcPtr, resObj); + int code = ErrnoReturn (rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; @@ -1405,13 +1218,13 @@ ReflectInput( if (toRead < bytec) { SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); - goto invalid; + goto invalid; } *errorCodePtr = EOK; if (bytec > 0) { - memcpy(buf, bytev, bytec); + memcpy(buf, bytev, (size_t)bytec); } stop: @@ -1444,12 +1257,12 @@ ReflectInput( static int ReflectOutput( - void *clientData, + ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) { - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *bufObj; Tcl_Obj *resObj; /* Result data for 'write' */ int written; @@ -1458,21 +1271,18 @@ ReflectOutput( * Are we in the correct thread? */ -#if TCL_THREADS +#ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.output.buf = buf; p.output.toWrite = toWrite; - ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p); + ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { - /* - * No error message, this is an errno signal. - */ - + /* No error message, this is an errno signal. */ *errorCodePtr = -p.base.code; } else { PassReceivedError(rcPtr->chan, &p); @@ -1523,8 +1333,8 @@ ReflectOutput( if ((written == 0) && (toWrite > 0)) { /* - * The handler claims to have written nothing of what it was given. - * That is bad. + * The handler claims to have written nothing of what it was + * given. That is bad. */ SetChannelErrorStr(rcPtr->chan, msg_write_nothing); @@ -1571,14 +1381,14 @@ ReflectOutput( *---------------------------------------------------------------------- */ -static long long +static Tcl_WideInt ReflectSeekWide( - void *clientData, - long long offset, + ClientData clientData, + Tcl_WideInt offset, int seekMode, int *errorCodePtr) { - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *offObj, *baseObj; Tcl_Obj *resObj; /* Result for 'seek' */ Tcl_WideInt newLoc; @@ -1587,14 +1397,14 @@ ReflectSeekWide( * Are we in the correct thread? */ -#if TCL_THREADS +#ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.seek.seekMode = seekMode; p.seek.offset = offset; - ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p); + ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); @@ -1612,10 +1422,9 @@ ReflectSeekWide( Tcl_Preserve(rcPtr); - TclNewIntObj(offObj, offset); - baseObj = Tcl_NewStringObj( - (seekMode == SEEK_SET) ? "start" : - (seekMode == SEEK_CUR) ? "current" : "end", -1); + offObj = Tcl_NewWideIntObj(offset); + baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" : + ((seekMode == SEEK_CUR) ? "current" : "end"), -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); @@ -1629,7 +1438,7 @@ ReflectSeekWide( goto invalid; } - if (newLoc < 0) { + if (newLoc < Tcl_LongAsWide(0)) { SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart); goto invalid; } @@ -1647,10 +1456,9 @@ ReflectSeekWide( goto stop; } -#ifndef TCL_NO_DEPRECATED static int ReflectSeek( - void *clientData, + ClientData clientData, long offset, int seekMode, int *errorCodePtr) @@ -1662,10 +1470,9 @@ ReflectSeek( * routine. */ - return ReflectSeekWide(clientData, offset, seekMode, + return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode, errorCodePtr); } -#endif /* *---------------------------------------------------------------------- @@ -1686,10 +1493,10 @@ ReflectSeek( static void ReflectWatch( - void *clientData, + ClientData clientData, int mask) { - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *maskObj; /* @@ -1708,16 +1515,18 @@ ReflectWatch( return; } + rcPtr->interest = mask; + /* * Are we in the correct thread? */ -#if TCL_THREADS +#ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.watch.mask = mask; - ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p); + ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p); /* * Any failure from the forward is ignored. We have no place to put @@ -1730,7 +1539,6 @@ ReflectWatch( Tcl_Preserve(rcPtr); - rcPtr->interest = mask; maskObj = DecodeEventMask(mask); /* assert maskObj.refCount == 1 */ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); @@ -1748,7 +1556,7 @@ ReflectWatch( * is required of it. * * Results: - * A Posix error number. + * A posix error number. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. @@ -1758,10 +1566,10 @@ ReflectWatch( static int ReflectBlock( - void *clientData, + ClientData clientData, int nonblocking) { - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *blockObj; int errorNum; /* EINVAL or EOK (success). */ Tcl_Obj *resObj; /* Result data for 'blocking' */ @@ -1770,13 +1578,13 @@ ReflectBlock( * Are we in the correct thread? */ -#if TCL_THREADS +#ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.block.nonblocking = nonblocking; - ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p); + ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); @@ -1792,7 +1600,7 @@ ReflectBlock( Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); errorNum = EINVAL; } else { @@ -1806,44 +1614,6 @@ ReflectBlock( return errorNum; } -#if 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( - void *clientData, - int action) -{ - ReflectedChannel *rcPtr = (ReflectedChannel *)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 /* *---------------------------------------------------------------------- * @@ -1862,12 +1632,12 @@ ReflectThread( static int ReflectSetOption( - void *clientData, /* Channel to query */ + 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 */ { - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; + ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *optionObj, *valueObj; int result; /* Result code for 'configure' */ Tcl_Obj *resObj; /* Result data for 'configure' */ @@ -1876,14 +1646,14 @@ ReflectSetOption( * Are we in the correct thread? */ -#if TCL_THREADS +#ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; p.setOpt.name = optionName; p.setOpt.value = newValue; - ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p); + ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); @@ -1934,7 +1704,7 @@ ReflectSetOption( static int ReflectGetOption( - void *clientData, /* Channel to query */ + ClientData clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of reuqested option */ Tcl_DString *dsPtr) /* String to place the result into */ @@ -1944,11 +1714,10 @@ ReflectGetOption( * The bypass functions are not required. */ - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; + ReflectedChannel *rcPtr = (ReflectedChannel*) clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ - Tcl_Size listc; - int result = TCL_OK; + int listc, result = TCL_OK; Tcl_Obj **listv; MethodName method; @@ -1956,9 +1725,9 @@ ReflectGetOption( * Are we in the correct thread? */ -#if TCL_THREADS +#ifdef TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { - ForwardedOperation opcode; + int opcode; ForwardParam p; p.getOpt.name = optionName; @@ -1970,7 +1739,7 @@ ReflectGetOption( opcode = ForwardedGetOpt; } - ForwardOpToHandlerThread(rcPtr, opcode, &p); + ForwardOpToOwnerThread(rcPtr, opcode, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); @@ -2014,7 +1783,7 @@ ReflectGetOption( */ if (optionObj != NULL) { - TclDStringAppendObj(dsPtr, resObj); + Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1); goto ok; } @@ -2029,7 +1798,7 @@ ReflectGetOption( * result is a valid list. Nor that the list has an even number elements. */ - if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { goto error; } @@ -2041,15 +1810,15 @@ ReflectGetOption( Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Expected list with even number of " - "elements, got %" TCL_SIZE_MODIFIER "d element%s instead", listc, + "elements, got %d element%s instead", listc, (listc == 1 ? "" : "s"))); goto error; } else { - Tcl_Size len; - const char *str = TclGetStringFromObj(resObj, &len); + int len; + char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - TclDStringAppendLiteral(dsPtr, " "); + Tcl_DStringAppend(dsPtr, " ", 1); Tcl_DStringAppend(dsPtr, str, len); } goto ok; @@ -2070,73 +1839,6 @@ ReflectGetOption( } /* - *---------------------------------------------------------------------- - * - * ReflectTruncate -- - * - * This function is invoked to truncate a channel's file size. - * - * Results: - * A standard Tcl result code. - * - * Side effects: - * Arbitrary, as it calls upon a Tcl script. - * - *---------------------------------------------------------------------- - */ - -static int -ReflectTruncate( - void *clientData, /* Channel to query */ - long long length) /* Length to truncate to. */ -{ - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; - Tcl_Obj *lenObj; - int errorNum; /* EINVAL or EOK (success). */ - Tcl_Obj *resObj; /* Result for 'truncate' */ - - /* - * Are we in the correct thread? - */ - -#if TCL_THREADS - if (rcPtr->thread != Tcl_GetCurrentThread()) { - ForwardParam p; - - p.truncate.length = length; - - ForwardOpToHandlerThread(rcPtr, ForwardedTruncate, &p); - - if (p.base.code != TCL_OK) { - PassReceivedError(rcPtr->chan, &p); - return EINVAL; - } - - return EOK; - } -#endif - - /* ASSERT: rcPtr->method & FLAG(METH_TRUNCATE) */ - - Tcl_Preserve(rcPtr); - - lenObj = Tcl_NewWideIntObj(length); - Tcl_IncrRefCount(lenObj); - - if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) { - Tcl_SetChannelError(rcPtr->chan, resObj); - errorNum = EINVAL; - } else { - errorNum = EOK; - } - - Tcl_DecrRefCount(lenObj); - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - Tcl_Release(rcPtr); - return errorNum; -} - -/* * Helpers. ========================================================= */ @@ -2146,10 +1848,10 @@ ReflectTruncate( * EncodeEventMask -- * * This function takes a list of event items and constructs the - * equivalent internal bitmask. The list may be empty but will usually - * contain at least one element. Valid elements are "read", "write", or - * any unique abbreviation of them. Note that the bitmask is not changed - * if problems are encountered. + * 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: * A standard Tcl error code. A bitmask where TCL_READABLE and/or @@ -2170,12 +1872,17 @@ EncodeEventMask( int *mask) { int events; /* Mask of events to post */ - Tcl_Size listc; /* #elements in eventspec list */ + int listc; /* #elements in eventspec list */ Tcl_Obj **listv; /* Elements of eventspec list */ int evIndex; /* Id of event for an element of the eventspec * list. */ - if (TclListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) { + return TCL_ERROR; + } + + if (listc < 1) { + Tcl_AppendResult(interp, "bad ", objName, " list: is empty", NULL); return TCL_ERROR; } @@ -2208,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. * @@ -2222,7 +1929,7 @@ static Tcl_Obj * DecodeEventMask( int mask) { - const char *eventStr; + register const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { @@ -2242,7 +1949,6 @@ DecodeEventMask( evObj = Tcl_NewStringObj(eventStr, -1); Tcl_IncrRefCount(evObj); - /* assert evObj.refCount == 1 */ return evObj; } @@ -2271,27 +1977,25 @@ NewReflectedChannel( Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; - int mn = 0; + MethodName mn = METH_BLOCKING; - rcPtr = (ReflectedChannel *)ckalloc(sizeof(ReflectedChannel)); + rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ rcPtr->chan = NULL; rcPtr->interp = interp; - rcPtr->dead = 0; - rcPtr->readTimer = 0; - rcPtr->writeTimer = 0; -#if TCL_THREADS +#ifdef TCL_THREADS rcPtr->thread = Tcl_GetCurrentThread(); #endif rcPtr->mode = mode; rcPtr->interest = 0; /* Initially no interest registered */ + /* ASSERT: cmdpfxObj is a Tcl List */ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj); Tcl_IncrRefCount(rcPtr->cmd); rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL); - while (mn <= (int)METH_WRITE) { + while (mn <= METH_WRITE) { Tcl_ListObjAppendElement(NULL, rcPtr->methods, Tcl_NewStringObj(methodNames[mn++], -1)); } @@ -2314,7 +2018,7 @@ NewReflectedChannel( * refcount of the returned object is -- zero --. * * Side effects: - * May allocate memory. Mutex-protected critical section locks out other + * May allocate memory. Mutex protected critical section locks out other * threads for a short time. * *---------------------------------------------------------------------- @@ -2345,22 +2049,15 @@ NextHandle(void) static void FreeReflectedChannel( - char *blockPtr) + ReflectedChannel *rcPtr) { - ReflectedChannel *rcPtr = (ReflectedChannel *) blockPtr; Channel *chanPtr = (Channel *) rcPtr->chan; TclChannelRelease((Tcl_Channel)chanPtr); - if (rcPtr->name) { - Tcl_DecrRefCount(rcPtr->name); - } - if (rcPtr->methods) { - Tcl_DecrRefCount(rcPtr->methods); - } - if (rcPtr->cmd) { - Tcl_DecrRefCount(rcPtr->cmd); - } - ckfree(rcPtr); + Tcl_DecrRefCount(rcPtr->name); + Tcl_DecrRefCount(rcPtr->methods); + Tcl_DecrRefCount(rcPtr->cmd); + ckfree((char*) rcPtr); } /* @@ -2369,7 +2066,7 @@ FreeReflectedChannel( * InvokeTclMethod -- * * This function is used to invoke the Tcl level of a reflected channel. - * It handles all the command assembly, invocation, and generic state and + * It handles all the command assembly, invokation, and generic state and * result mgmt. It does *not* handle thread redirection; that is the * responsibility of clients of this function. * @@ -2397,11 +2094,11 @@ InvokeTclMethod( { Tcl_Obj *methObj = NULL; /* Method name in object form */ Tcl_InterpState sr; /* State of handler interp */ - int result; /* Result code of method invocation */ - Tcl_Obj *resObj = NULL; /* Result of method invocation. */ + int result; /* Result code of method invokation */ + Tcl_Obj *resObj = NULL; /* Result of method invokation. */ Tcl_Obj *cmd; - if (rcPtr->dead) { + if (!rcPtr->interp) { /* * The channel is marked as dead. Bail out immediately, with an * appropriate error. @@ -2427,6 +2124,7 @@ InvokeTclMethod( */ cmd = TclListObjCopy(NULL, rcPtr->cmd); + Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj); Tcl_ListObjAppendElement(NULL, cmd, methObj); Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name); @@ -2434,9 +2132,6 @@ InvokeTclMethod( /* * 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. */ if (argOneObj) { @@ -2454,7 +2149,7 @@ InvokeTclMethod( Tcl_IncrRefCount(cmd); sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */); Tcl_Preserve(rcPtr->interp); - result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL); + result = Tcl_GlobalEvalObj(rcPtr->interp, cmd); /* * We do not try to extract the result information if the caller has no @@ -2480,8 +2175,8 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { - Tcl_Size cmdLen; - const char *cmdString = TclGetStringFromObj(cmd, &cmdLen); + int cmdLen; + const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rcPtr->interp); @@ -2535,21 +2230,19 @@ InvokeTclMethod( * None. * * Users: - * ReflectInput/Output(), to enable the signaling of EAGAIN on 0-sized - * short reads/writes. + * ReflectInput/Output(), to enable the signaling of EAGAIN + * on 0-sized short reads/writes. * *---------------------------------------------------------------------- */ static int -ErrnoReturn( - ReflectedChannel *rcPtr, - Tcl_Obj *resObj) +ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj) { int code; Tcl_InterpState sr; /* State of handler interp */ - if (rcPtr->dead) { + if (!rcPtr->interp) { return 0; } @@ -2558,10 +2251,9 @@ ErrnoReturn( resObj = Tcl_GetObjResult(rcPtr->interp); - if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK) - || (code >= 0))) { - if (strcmp("EAGAIN", TclGetString(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; } @@ -2592,12 +2284,13 @@ static ReflectedChannelMap * GetReflectedChannelMap( Tcl_Interp *interp) { - ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL); + ReflectedChannelMap* rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL); if (rcmPtr == NULL) { - rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap)); + rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS); - Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr); + Tcl_SetAssocData(interp, RCMKEY, + (Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr); } return rcmPtr; } @@ -2616,46 +2309,24 @@ GetReflectedChannelMap( * * Side effects: * Deletes the hash table of channels. May close channels. May flush - * output on closed channels. Removes any channelEvent handlers that were + * output on closed channels. Removes any channeEvent handlers that were * registered in this interpreter. * *---------------------------------------------------------------------- */ static void -MarkDead( - ReflectedChannel *rcPtr) -{ - if (rcPtr->dead) { - return; - } - if (rcPtr->name) { - Tcl_DecrRefCount(rcPtr->name); - rcPtr->name = NULL; - } - if (rcPtr->methods) { - Tcl_DecrRefCount(rcPtr->methods); - rcPtr->methods = NULL; - } - if (rcPtr->cmd) { - Tcl_DecrRefCount(rcPtr->cmd); - rcPtr->cmd = NULL; - } - rcPtr->dead = 1; -} - -static void DeleteReflectedChannelMap( - void *clientData, /* The per-interpreter data structure. */ + ClientData clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { - ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData; - /* The map */ + ReflectedChannelMap* rcmPtr; /* The map */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ - ReflectedChannel *rcPtr; + ReflectedChannel* rcPtr; Tcl_Channel chan; -#if TCL_THREADS + +#ifdef TCL_THREADS ForwardingResult *resultPtr; ForwardingEvent *evPtr; ForwardParam *paramPtr; @@ -2664,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 @@ -2673,19 +2344,22 @@ DeleteReflectedChannelMap( * this interp. */ + rcmPtr = clientData; for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); - hPtr != NULL; - hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { - chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); - rcPtr = (ReflectedChannel *)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; - MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); - ckfree(&rcmPtr->map); + ckfree((char *) &rcmPtr->map); -#if TCL_THREADS +#ifdef TCL_THREADS /* * The origin interpreter for one or more reflected channels is gone. */ @@ -2699,13 +2373,10 @@ 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; } @@ -2720,14 +2391,6 @@ DeleteReflectedChannelMap( */ evPtr = resultPtr->evPtr; - - /* - * Basic crash safety until this routine can get revised [3411310] - */ - - if (evPtr == NULL) { - continue; - } paramPtr = evPtr->param; if (!evPtr) { continue; @@ -2741,7 +2404,6 @@ DeleteReflectedChannelMap( Tcl_ConditionNotify(&resultPtr->done); } - Tcl_MutexUnlock(&rcForwardMutex); /* * Get the map of all channels handled by the current thread. This is a @@ -2752,28 +2414,25 @@ DeleteReflectedChannelMap( rcmPtr = GetThreadReflectedChannelMap(); for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&hSearch)) { - chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); - rcPtr = (ReflectedChannel *)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; } - MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } -#else - (void)interp; + + Tcl_MutexUnlock(&rcForwardMutex); #endif } -#if TCL_THREADS +#ifdef TCL_THREADS /* *---------------------------------------------------------------------- * @@ -2792,12 +2451,12 @@ DeleteReflectedChannelMap( */ static ReflectedChannelMap * -GetThreadReflectedChannelMap(void) +GetThreadReflectedChannelMap() { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rcmPtr) { - tsdPtr->rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap)); + tsdPtr->rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap)); Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL); } @@ -2812,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. @@ -2825,14 +2484,18 @@ GetThreadReflectedChannelMap(void) static void DeleteThreadReflectedChannelMap( - TCL_UNUSED(void *)) + 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 */ + + ReflectedChannelMap* rcmPtr; /* The map */ + Tcl_Channel chan; + ReflectedChannel* rcPtr; ForwardingResult *resultPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ForwardingEvent *evPtr; + ForwardParam *paramPtr; /* * The origin thread for one or more reflected channels is gone. @@ -2842,23 +2505,17 @@ DeleteThreadReflectedChannelMap( /* * 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. + * 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; - + resultPtr != NULL; + resultPtr = resultPtr->nextPtr) { if (resultPtr->dst != self) { - /* - * Ignore results/events for other threads. - */ - + /* Ignore results/events for other threads. */ continue; } @@ -2873,14 +2530,6 @@ DeleteThreadReflectedChannelMap( */ evPtr = resultPtr->evPtr; - - /* - * Basic crash safety until this routine can get revised [3411310] - */ - - if (evPtr == NULL ) { - continue; - } paramPtr = evPtr->param; if (!evPtr) { continue; @@ -2894,16 +2543,6 @@ DeleteThreadReflectedChannelMap( 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 @@ -2912,30 +2551,27 @@ DeleteThreadReflectedChannelMap( */ rcmPtr = GetThreadReflectedChannelMap(); - tsdPtr->rcmPtr = NULL; for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); - hPtr != NULL; - hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { - Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr); - ReflectedChannel *rcPtr = (ReflectedChannel *)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; - MarkDead(rcPtr); Tcl_DeleteHashEntry(hPtr); } - ckfree(rcmPtr); + + Tcl_MutexUnlock(&rcForwardMutex); } static void -ForwardOpToHandlerThread( +ForwardOpToOwnerThread( 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; @@ -2947,13 +2583,13 @@ ForwardOpToHandlerThread( Tcl_MutexLock(&rcForwardMutex); - if (rcPtr->dead) { + if (rcPtr->interp == NULL) { /* * 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); + ForwardSetStaticError((ForwardParam *)param, msg_send_dstlost); Tcl_MutexUnlock(&rcForwardMutex); return; } @@ -2962,8 +2598,8 @@ ForwardOpToHandlerThread( * Create and initialize the event and data structures. */ - evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent)); - resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult)); + evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent)); + resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult)); evPtr->event.proc = ForwardProc; evPtr->resultPtr = resultPtr; @@ -2971,8 +2607,8 @@ ForwardOpToHandlerThread( 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; @@ -2983,30 +2619,27 @@ ForwardOpToHandlerThread( */ TclSpliceIn(resultPtr, forwardList); - - /* - * Do not unlock here. That is done by the ConditionWait. - */ + /* Do not unlock here. That is done by the ConditionWait */ /* * 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' + * 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_QUEUE_ALERT_IF_EMPTY); + Tcl_ThreadQueueEvent(dst, (Tcl_Event *)evPtr, TCL_QUEUE_TAIL); + Tcl_ThreadAlert(dst); /* - * (*) Block until the handler thread has either processed the transfer or + * (*) Block until the other thread has either processed the transfer or * rejected it. */ @@ -3024,8 +2657,8 @@ ForwardOpToHandlerThread( } /* - * 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); @@ -3043,26 +2676,21 @@ ForwardOpToHandlerThread( * Note: The event structure has already been deleted. */ - Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr); + Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr); - ckfree(resultPtr); + ckfree((char*) resultPtr); } static int ForwardProc( Tcl_Event *evGPtr, - TCL_UNUSED(int) /* mask */) + 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 - * evPtr->src), however this thread is currently blocked at (*), i.e., + * evPtr->src), however this thread is currently blocked at (*), i.e. * quiescent. Because of this we can treat the data as belonging to us, * without fear of race conditions. I.e. we can read and write as we like. * @@ -3077,9 +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. @@ -3105,6 +2732,8 @@ ForwardProc( * No parameters/results. */ + Tcl_ChannelType *tctPtr; + if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } @@ -3119,51 +2748,55 @@ 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); - MarkDead(rcPtr); + 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; - - TclNewIntObj(toReadObj, paramPtr->input.toRead); - Tcl_IncrRefCount(toReadObj); + Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); + Tcl_IncrRefCount(toReadObj); - Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){ - int code = ErrnoReturn(rcPtr, resObj); + int code = ErrnoReturn (rcPtr, resObj); if (code < 0) { paramPtr->base.code = code; } else { ForwardSetObjError(paramPtr, resObj); } - paramPtr->input.toRead = TCL_IO_FAILURE; + paramPtr->input.toRead = -1; } else { /* * Process a regular result. */ - Tcl_Size bytec; /* Number of returned bytes */ + int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); if (paramPtr->input.toRead < bytec) { ForwardSetStaticError(paramPtr, msg_read_toomuch); - paramPtr->input.toRead = TCL_IO_FAILURE; + paramPtr->input.toRead = -1; } else { if (bytec > 0) { - memcpy(paramPtr->input.buf, bytev, bytec); + memcpy(paramPtr->input.buf, bytev, (size_t)bytec); } paramPtr->input.toRead = bytec; } @@ -3175,7 +2808,7 @@ 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); @@ -3196,9 +2829,7 @@ ForwardProc( int written; if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) { - Tcl_DecrRefCount(resObj); - resObj = MarshallError(interp); - ForwardSetObjError(paramPtr, resObj); + ForwardSetObjError(paramPtr, MarshallError(interp)); paramPtr->output.toWrite = -1; } else if (written==0 || paramPtr->output.toWrite<written) { ForwardSetStaticError(paramPtr, msg_write_toomuch); @@ -3213,18 +2844,15 @@ ForwardProc( } case ForwardedSeek: { - Tcl_Obj *offObj; - Tcl_Obj *baseObj; - - TclNewIntObj(offObj, paramPtr->seek.offset); - baseObj = Tcl_NewStringObj( + 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); - Tcl_IncrRefCount(offObj); - Tcl_IncrRefCount(baseObj); + Tcl_IncrRefCount(offObj); + Tcl_IncrRefCount(baseObj); - Tcl_Preserve(rcPtr); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; @@ -3237,16 +2865,14 @@ ForwardProc( Tcl_WideInt newLoc; if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) { - if (newLoc < 0) { + if (newLoc < Tcl_LongAsWide(0)) { ForwardSetStaticError(paramPtr, msg_seek_beforestart); paramPtr->seek.offset = -1; } else { paramPtr->seek.offset = newLoc; } } else { - Tcl_DecrRefCount(resObj); - resObj = MarshallError(interp); - ForwardSetObjError(paramPtr, resObj); + ForwardSetObjError(paramPtr, MarshallError(interp)); paramPtr->seek.offset = -1; } } @@ -3261,7 +2887,6 @@ ForwardProc( /* assert maskObj.refCount == 1 */ Tcl_Preserve(rcPtr); - rcPtr->interest = paramPtr->watch.mask; (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); @@ -3270,11 +2895,11 @@ ForwardProc( case ForwardedBlock: { Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking); - Tcl_IncrRefCount(blockObj); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, - &resObj) != TCL_OK) { + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); @@ -3284,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, METH_CONFIGURE, optionObj, valueObj, - &resObj) != TCL_OK) { + &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); @@ -3305,13 +2930,14 @@ ForwardProc( */ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); - Tcl_IncrRefCount(optionObj); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { - TclDStringAppendObj(paramPtr->getOpt.value, resObj); + Tcl_DStringAppend(paramPtr->getOpt.value, + TclGetString(resObj), -1); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); @@ -3332,31 +2958,29 @@ ForwardProc( * NOTE (4) as well. */ - Tcl_Size listc; + int listc; Tcl_Obj **listv; - if (TclListObjGetElements(interp, resObj, &listc, - &listv) != TCL_OK) { - Tcl_DecrRefCount(resObj); - resObj = MarshallError(interp); - ForwardSetObjError(paramPtr, resObj); + if (Tcl_ListObjGetElements(interp, resObj, &listc, + &listv) != TCL_OK) { + ForwardSetObjError(paramPtr, MarshallError(interp)); } else if ((listc % 2) == 1) { /* * Odd number of elements is wrong. [x]. */ - char *buf = (char *)ckalloc(200); - snprintf(buf, 200, - "{Expected list with even number of elements, got %" TCL_SIZE_MODIFIER "d %s instead}", + char *buf = ckalloc(200); + sprintf(buf, + "{Expected list with even number of elements, got %d %s instead}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); } else { - Tcl_Size len; - const char *str = TclGetStringFromObj(resObj, &len); + int len; + const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { - TclDStringAppendLiteral(paramPtr->getOpt.value, " "); + Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } @@ -3364,19 +2988,6 @@ ForwardProc( Tcl_Release(rcPtr); break; - case ForwardedTruncate: { - Tcl_Obj *lenObj = Tcl_NewWideIntObj(paramPtr->truncate.length); - - Tcl_IncrRefCount(lenObj); - Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) { - ForwardSetObjError(paramPtr, resObj); - } - Tcl_Release(rcPtr); - Tcl_DecrRefCount(lenObj); - break; - } - default: /* * Bad operation code. @@ -3413,9 +3024,9 @@ ForwardProc( static void SrcExitProc( - void *clientData) + ClientData clientData) { - ForwardingEvent *evPtr = (ForwardingEvent *)clientData; + ForwardingEvent *evPtr = (ForwardingEvent *) clientData; ForwardingResult *resultPtr; ForwardParam *paramPtr; @@ -3464,12 +3075,12 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - Tcl_Size len; - const char *msgStr = TclGetStringFromObj(obj, &len); + int len; + const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; - ForwardSetDynamicError(paramPtr, ckalloc(len)); - memcpy(paramPtr->base.msgStr, msgStr, len); + ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len)); + memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len); } #endif |