diff options
Diffstat (limited to 'generic/tclIORChan.c')
| -rw-r--r-- | generic/tclIORChan.c | 285 |
1 files changed, 84 insertions, 201 deletions
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index ca3ab4b..7630473 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -91,31 +91,9 @@ typedef struct { #ifdef TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */ #endif - - /* See [==] as well. - * Storage for the command prefix and the additional words required for - * the invocation of methods in the command handler. - * - * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2] - * cmd ... pfx | method chan | detail1 detail2 - * ~~~~ CT ~~~ ~~ CT ~~ - * - * CT = Belongs to the 'Command handler Thread'. - */ - - int argc; /* Number of preallocated words - 2 */ - Tcl_Obj **argv; /* Preallocated array for calling the handler. - * args[0] is placeholder for cmd word. - * Followed by the arguments in the prefix, - * plus 4 placeholders for method, channel, - * and at most two varying (method specific) - * words. */ - int methods; /* Bitmask of supported methods */ - - /* - * NOTE (9): Should we have predefined shared literals for the method - * names? - */ + Tcl_Obj *cmd; /* Callback command prefix */ + Tcl_Obj *methods; /* Methods to append to command prefix */ + Tcl_Obj *name; /* Name of the channel as created */ int mode; /* Mask of R/W mode */ int interest; /* Mask of events the channel is interested @@ -439,7 +417,7 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp, static Tcl_Obj * NextHandle(void); static void FreeReflectedChannel(ReflectedChannel *rcPtr); static int InvokeTclMethod(ReflectedChannel *rcPtr, - const char *method, Tcl_Obj *argOneObj, + MethodName method, Tcl_Obj *argOneObj, Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr); static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp); @@ -454,9 +432,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}"; @@ -568,10 +544,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. @@ -585,7 +557,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) { UnmarshallErrorResult(interp, resObj); @@ -674,7 +646,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) { /* @@ -737,12 +713,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 @@ -1045,6 +1019,7 @@ ReflectClose( 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 */ + Tcl_ChannelType *tctPtr; if (TclInThreadExit()) { /* @@ -1081,18 +1056,11 @@ ReflectClose( } #endif - Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); - return EOK; - } - - /* - * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL) - * - * A cleaned method mask here implies that the channel creation was - * aborted, and "finalize" must not be called. - */ - - if (rcPtr->methods == 0) { + tctPtr = ((Channel *)rcPtr->chan)->typePtr; + if (tctPtr && tctPtr != &tclRChannelType) { + ckfree((char *)tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; + } Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); return EOK; } @@ -1118,7 +1086,7 @@ ReflectClose( } } else { #endif - result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj); + result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj); if ((result != TCL_OK) && (interp != NULL)) { Tcl_SetChannelErrorInterp(interp, resObj); } @@ -1156,6 +1124,11 @@ ReflectClose( } #endif + tctPtr = ((Channel *)rcPtr->chan)->typePtr; + if (tctPtr && tctPtr != &tclRChannelType) { + ckfree((char *)tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; + } Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); #ifdef TCL_THREADS } @@ -1193,18 +1166,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? */ @@ -1242,7 +1203,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) { @@ -1308,18 +1269,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? */ @@ -1357,7 +1306,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) { @@ -1470,7 +1419,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; } @@ -1541,8 +1490,6 @@ ReflectWatch( ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; Tcl_Obj *maskObj; - /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */ - /* * We restrict the interest to what the channel can support. IOW there * will never be write events for a channel which is not writable. @@ -1585,7 +1532,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); @@ -1644,7 +1591,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 { @@ -1718,7 +1665,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); } @@ -1763,7 +1710,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? @@ -1802,14 +1749,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); } @@ -2021,16 +1968,13 @@ NewReflectedChannel( Tcl_Obj *handleObj) { ReflectedChannel *rcPtr; - int i, listc; - Tcl_Obj **listv; + MethodName mn = METH_BLOCKING; rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel)); /* rcPtr->chan: Assigned by caller. Dummy data here. */ - /* rcPtr->methods: Assigned by caller. Dummy data here. */ rcPtr->chan = NULL; - rcPtr->methods = 0; rcPtr->interp = interp; #ifdef TCL_THREADS rcPtr->thread = Tcl_GetCurrentThread(); @@ -2038,54 +1982,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 = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4)); - - /* - * Duplicate object references. - */ - - for (i=0; i<listc ; i++) { - Tcl_Obj *word = rcPtr->argv[i] = listv[i]; - - Tcl_IncrRefCount(word); - } - - i++; /* Skip placeholder for method */ - - /* - * [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; } @@ -2136,28 +2043,11 @@ FreeReflectedChannel( ReflectedChannel *rcPtr) { Channel *chanPtr = (Channel *) rcPtr->chan; - int i, n; - if (chanPtr->typePtr != &tclRChannelType) { - /* - * Delete a cloned ChannelType structure. - */ - - ckfree((char*) chanPtr->typePtr); - } - - n = rcPtr->argc - 2; - for (i=0; i<n; i++) { - Tcl_DecrRefCount(rcPtr->argv[i]); - } - - /* - * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1. - */ - - Tcl_DecrRefCount(rcPtr->argv[n+1]); - - ckfree((char*) rcPtr->argv); + Tcl_Release(chanPtr); + Tcl_DecrRefCount(rcPtr->name); + Tcl_DecrRefCount(rcPtr->methods); + Tcl_DecrRefCount(rcPtr->cmd); ckfree((char*) rcPtr); } @@ -2188,16 +2078,16 @@ FreeReflectedChannel( static int InvokeTclMethod( ReflectedChannel *rcPtr, - const char *method, + MethodName method, Tcl_Obj *argOneObj, /* NULL'able */ Tcl_Obj *argTwoObj, /* NULL'able */ Tcl_Obj **resultObjPtr) /* NULL'able */ { - int cmdc; /* #words in constructed command */ Tcl_Obj *methObj = NULL; /* Method name in object form */ Tcl_InterpState sr; /* State of handler interp */ int result; /* Result code of method invokation */ Tcl_Obj *resObj = NULL; /* Result of method invokation. */ + Tcl_Obj *cmd; if (!rcPtr->interp) { /* @@ -2220,32 +2110,25 @@ InvokeTclMethod( } /* - * NOTE (5): Decide impl. issue: Cache objects with method names? Needs - * TSD data as reflections can be created in many different threads. - * NO: Caching of command resolutions means storage per channel. - */ - - /* - * Insert method into the pre-allocated area, after the command prefix, + * Insert method into the callback command, after the command prefix, * before the channel id. */ - methObj = Tcl_NewStringObj(method, -1); - Tcl_IncrRefCount(methObj); - rcPtr->argv[rcPtr->argc - 2] = methObj; + cmd = TclListObjCopy(NULL, rcPtr->cmd); + + Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj); + Tcl_ListObjAppendElement(NULL, cmd, methObj); + Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name); /* * Append the additional argument containing method specific details * behind the channel id. If specified. */ - 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); } } @@ -2254,9 +2137,10 @@ InvokeTclMethod( * existing state intact. */ + Tcl_IncrRefCount(cmd); sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */); Tcl_Preserve(rcPtr->interp); - result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL); + result = Tcl_GlobalEvalObj(rcPtr->interp, cmd); /* * We do not try to extract the result information if the caller has no @@ -2282,7 +2166,6 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { - Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv); int cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); @@ -2296,25 +2179,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). @@ -2827,17 +2702,19 @@ ForwardProc( * call upon for the driver. */ - case ForwardedClose: + case ForwardedClose: { /* * No parameters/results. */ - if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) { + Tcl_ChannelType *tctPtr; + + if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); } /* - * Freeing is done here, in the origin thread, because the argv[] + * Freeing is done here, in the origin thread, callback command * objects belong to this thread. Deallocating them in a different * thread is not allowed * @@ -2856,15 +2733,21 @@ ForwardProc( Tcl_GetChannelName (rcPtr->chan)); Tcl_DeleteHashEntry (hPtr); + tctPtr = ((Channel *)rcPtr->chan)->typePtr; + if (tctPtr && tctPtr != &tclRChannelType) { + ckfree((char *)tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; + } Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); break; + } case ForwardedInput: { Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); Tcl_IncrRefCount(toReadObj); Tcl_Preserve(rcPtr); - if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){ + if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){ int code = ErrnoReturn (rcPtr, resObj); if (code < 0) { @@ -2904,7 +2787,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) { @@ -2945,7 +2828,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 { @@ -2979,7 +2862,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; @@ -2990,7 +2873,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); } @@ -3006,7 +2889,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); } @@ -3025,7 +2908,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 { Tcl_DStringAppend(paramPtr->getOpt.value, @@ -3042,7 +2925,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 { /* |