diff options
Diffstat (limited to 'generic/tclIORChan.c')
-rw-r--r-- | generic/tclIORChan.c | 277 |
1 files changed, 66 insertions, 211 deletions
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 4b61538..9c311fc 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -99,31 +99,9 @@ typedef struct { Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif - - /* See [==] as well. - * Storage for the command prefix and the additional words required for - * the invocation of methods in the command handler. - * - * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2] - * cmd ... pfx | method chan | detail1 detail2 - * ~~~~ CT ~~~ ~~ CT ~~ - * - * CT = Belongs to the 'Command handler Thread'. - */ - - int argc; /* Number of preallocated words - 2 */ - Tcl_Obj **argv; /* Preallocated array for calling the handler. - * args[0] is placeholder for cmd word. - * Followed by the arguments in the prefix, - * plus 4 placeholders for method, channel, - * and at most two varying (method specific) - * words. */ - int methods; /* Bitmask of supported methods */ - - /* - * NOTE (9): Should we have predefined shared literals for the method - * names? - */ + Tcl_Obj *cmd; /* Callback command prefix */ + Tcl_Obj *methods; /* Methods to append to command prefix */ + Tcl_Obj *name; /* Name of the channel as created */ int mode; /* Mask of R/W mode */ int interest; /* Mask of events the channel is interested @@ -450,9 +428,8 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp, Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj); static Tcl_Obj * NextHandle(void); static void FreeReflectedChannel(ReflectedChannel *rcPtr); -static void FreeReflectedChannelArgs(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); @@ -467,9 +444,7 @@ 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}"; @@ -583,10 +558,6 @@ TclChanCreateObjCmd( rcId = NextHandle(); rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId); - chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, - mode); - rcPtr->chan = chan; - chanPtr = (Channel *) chan; /* * Invoke 'initialize' and validate that the handler is present and ok. @@ -600,7 +571,7 @@ 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) { @@ -683,7 +654,11 @@ TclChanCreateObjCmd( * Everything is fine now. */ - rcPtr->methods = methods; + chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr, + mode); + rcPtr->chan = chan; + Tcl_Preserve(chan); + chanPtr = (Channel *) chan; if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) { /* @@ -744,12 +719,10 @@ TclChanCreateObjCmd( return TCL_OK; error: - /* - * Signal to ReflectClose to not call 'finalize'. - */ - - rcPtr->methods = 0; - Tcl_Close(interp, chan); + Tcl_DecrRefCount(rcPtr->name); + Tcl_DecrRefCount(rcPtr->methods); + Tcl_DecrRefCount(rcPtr->cmd); + ckfree((char*) rcPtr); return TCL_ERROR; #undef MODE @@ -1172,6 +1145,7 @@ ReflectClose( if (result != TCL_OK) { FreeReceivedError(&p); } + return EOK; } #endif @@ -1180,18 +1154,6 @@ ReflectClose( } /* - * -- 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) { - Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); - return EOK; - } - - /* * Are we in the correct thread? */ @@ -1208,14 +1170,12 @@ ReflectClose( Tcl_DeleteEvents(ReflectEventDelete, rcPtr); - Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); - if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); } } 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); } @@ -1290,18 +1250,6 @@ ReflectInput( 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? */ @@ -1339,7 +1287,7 @@ ReflectInput( toReadObj = Tcl_NewIntObj(toRead); Tcl_IncrRefCount(toReadObj); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { @@ -1405,18 +1353,6 @@ ReflectOutput( 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? */ @@ -1454,7 +1390,7 @@ ReflectOutput( 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) { @@ -1568,7 +1504,7 @@ ReflectSeekWide( 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; } @@ -1639,8 +1575,6 @@ ReflectWatch( ReflectedChannel *rcPtr = clientData; Tcl_Obj *maskObj; - /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */ - /* * We restrict the interest to what the channel can support. IOW there * will never be write events for a channel which is not writable. @@ -1683,7 +1617,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); @@ -1742,7 +1676,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 { @@ -1854,7 +1788,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); } @@ -1899,7 +1833,7 @@ ReflectGetOption( 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? @@ -1938,14 +1872,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); } @@ -2159,16 +2093,13 @@ NewReflectedChannel( Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; - int i, listc; - Tcl_Obj **listv; + MethodName mn = METH_BLOCKING; rcPtr = ckalloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ - /* rcPtr->methods: Assigned by caller. Dummy data here. */ rcPtr->chan = NULL; - rcPtr->methods = 0; rcPtr->interp = interp; rcPtr->dead = 0; #ifdef TCL_THREADS @@ -2177,54 +2108,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; } @@ -2271,28 +2165,6 @@ NextHandle(void) } static void -FreeReflectedChannelArgs( - ReflectedChannel *rcPtr) -{ - int i, n = rcPtr->argc - 2; - - if (n < 0) { - return; - } - 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]); - - rcPtr->argc = 1; -} - -static void FreeReflectedChannel( ReflectedChannel *rcPtr) { @@ -2306,10 +2178,10 @@ FreeReflectedChannel( ckfree(chanPtr->typePtr); chanPtr->typePtr = NULL; } - - FreeReflectedChannelArgs(rcPtr); - - ckfree(rcPtr->argv); + Tcl_Release(chanPtr); + Tcl_DecrRefCount(rcPtr->name); + Tcl_DecrRefCount(rcPtr->methods); + Tcl_DecrRefCount(rcPtr->cmd); ckfree(rcPtr); } @@ -2340,16 +2212,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->dead) { /* @@ -2372,19 +2244,15 @@ 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 @@ -2394,13 +2262,10 @@ InvokeTclMethod( * 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); } } @@ -2409,9 +2274,10 @@ InvokeTclMethod( * existing state intact. */ + Tcl_IncrRefCount(cmd); sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */); Tcl_Preserve(rcPtr->interp); - result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL); + result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL); /* * We do not try to extract the result information if the caller has no @@ -2437,7 +2303,6 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { - Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv); int cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); @@ -2451,25 +2316,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). @@ -2700,7 +2557,6 @@ DeleteReflectedChannelMap( } rcPtr->dead = 1; - FreeReflectedChannelArgs(rcPtr); Tcl_DeleteHashEntry(hPtr); } #endif @@ -2840,7 +2696,6 @@ DeleteThreadReflectedChannelMap( ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan); rcPtr->dead = 1; - FreeReflectedChannelArgs(rcPtr); Tcl_DeleteHashEntry(hPtr); } ckfree(rcmPtr); @@ -3023,12 +2878,12 @@ ForwardProc( * No parameters/results. */ - if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) { + if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } /* - * Freeing is done here, in the origin thread, because the argv[] + * Freeing is done here, in the origin thread, callback command * objects belong to this thread. Deallocating them in a different * thread is not allowed * @@ -3047,7 +2902,7 @@ ForwardProc( Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); - FreeReflectedChannelArgs(rcPtr); + Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); break; case ForwardedInput: { @@ -3055,7 +2910,7 @@ ForwardProc( Tcl_IncrRefCount(toReadObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){ + if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){ int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { @@ -3095,7 +2950,7 @@ ForwardProc( 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) { @@ -3138,7 +2993,7 @@ ForwardProc( 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 { @@ -3174,7 +3029,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; @@ -3185,7 +3040,7 @@ ForwardProc( Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, + if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } @@ -3201,7 +3056,7 @@ ForwardProc( Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj, + if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } @@ -3220,7 +3075,7 @@ 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 { TclDStringAppendObj(paramPtr->getOpt.value, resObj); @@ -3236,7 +3091,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 { /* |