diff options
| -rw-r--r-- | ChangeLog | 72 | ||||
| -rw-r--r-- | generic/tclOO.c | 136 | ||||
| -rw-r--r-- | generic/tclOOBasic.c | 21 | ||||
| -rw-r--r-- | generic/tclOOCall.c | 86 | ||||
| -rw-r--r-- | generic/tclOOInt.h | 11 | ||||
| -rw-r--r-- | generic/tclOOMethod.c | 40 |
6 files changed, 280 insertions, 86 deletions
@@ -1,11 +1,23 @@ +2008-07-16 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclOO.c, generic/tclOOInt.h, generic/tclOOBasic.c: + * generic/tclOOCall.c, generic/tclOOMethod.c: NRE-enable the TclOO + implementation in Tcl. No change to public APIs, except that method + implementations can now be NRE-aware if they choose (which normal + methods and forwards are). On the other hand, callers of + TclOOInvokeObject (which is only in the internal stub table) will need + to deal with the fact that it's only safe to call inside an NRE-aware + context. + ***POTENTIAL INCOMPATIBILITY*** + 2008-07-15 Miguel Sofer <msofer@users.sf.net> - * tests/NRE.test: better constraint for testing the - * tests/stack.test: existence of teststacklimit, to insure that - the testsuite runs under tclsh. - - * generic/tclParse.c: fixing incomplete reversion of "fix" for - [Bug 2017583], missing TclResetCancellation call. + * tests/NRE.test: Better constraint for testing the existence of + * tests/stack.test: teststacklimit, to insure that the test suite + runs under tclsh. + + * generic/tclParse.c: fixing incomplete reversion of "fix" for [Bug + 2017583], missing TclResetCancellation call. 2008-07-15 Donal K. Fellows <dkf@users.sf.net> @@ -20,14 +32,14 @@ 2008-07-14 Miguel Sofer <msofer@users.sf.net> - * generic/tclParse.c: reverting the "fix" for [Bug 2017583], - * tests/parse.test: numLevel management and TclInterpReady check - seems to be necessary after all. - + * generic/tclParse.c: Reverting the "fix" for [Bug 2017583], numLevel + * tests/parse.test: management and TclInterpReady check seems to be + necessary after all. + 2008-07-14 Donal K. Fellows <dkf@users.sf.net> - * generic/tclProc.c (TclNRApplyObjCmd, TclObjInterpProcCore): - * generic/tclBasic.c (TclNR_AddCallback, TclEvalObjv_NR2): + * generic/tclProc.c (TclNRApplyObjCmd, TclObjInterpProcCore): + * generic/tclBasic.c (TclNR_AddCallback, TclEvalObjv_NR2): * generic/tclNRE.h (TEOV_callback): Change the callback storage type to use an array, so guaranteeing correct inter-member spacing and memory layout. @@ -36,35 +48,35 @@ * generic/tclExecute.c: Remove unneeded TclInterpReady calls * generic/tclParse.c: - + * generic/tclBasic.c.: Embedded Tcl_Canceled() calls into * generic/tclExecute.c: TclInterpReady(). - * generic/tclParse.c: - + * generic/tclParse.c: + * generic/tclVar.c: fix error message - - * generic/tclParse.c: remove unnecessary numLevel management + + * generic/tclParse.c: remove unnecessary numLevel management * tests/parse.test: [Bug 2017583] - - * generic/tclBasic.c.: NRE left too many calls to + + * generic/tclBasic.c.: NRE left too many calls to * generic/tclExecute.c: TclResetCancellation lying around: it * generic/tclProc.c: only needs to be called prior to any iPtr->numLevels++. Thanks mistachkin. - + * generic/tclBasic.c: TclResetCancellation() calls were misplaced (merge mishap); stray //. Thanks patthoyts. - + * generic/tclInt.h: the new macros TclSmallAlloc and TclSmallFree were badly defined under mem debugging [Bug 2017240] (thx das) - + 2008-07-13 Miguel Sofer <msofer@users.sf.net> NRE implementation [Patch 2017110] - - * generic/tcl.decls: The NRE infrastructure - * generic/tcl.h: + + * generic/tcl.decls: The NRE infrastructure + * generic/tcl.h: * generic/tclBasic.c: - * generic/tclCmdAH.c: + * generic/tclCmdAH.c: * generic/tclCompile.h: * generic/tclDecls.h: * generic/tclExecute.c: @@ -75,8 +87,8 @@ * generic/tclNRE.h: * generic/tclStubInit.c: * unix/Makefile.in: - - * generic/tclInterp.c: NRE-enabling: procs, lambdas, uplevel, + + * generic/tclInterp.c: NRE-enabling: procs, lambdas, uplevel, * generic/tclNamesp.c: same-interp aliases, ensembles, imports * generic/tclProc.c: and namespace_eval. @@ -85,9 +97,9 @@ tested by the whole testsuite. * tests/interp.test: Fixed numLevel counting. - * tests/parse.test: + * tests/parse.test: * tests/stack.test: - + * unix/configure: Removing support for the hacky nonportable * unix/configure.in: stack check: it is not needed anymore, Tcl * unix/tclConfig.h.in: is very thrifty on the C stack. diff --git a/generic/tclOO.c b/generic/tclOO.c index 2b892af..176e90a 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOO.c,v 1.9 2008/06/19 21:29:03 dkf Exp $ + * RCS: @(#) $Id: tclOO.c,v 1.10 2008/07/16 22:09:00 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -70,6 +70,10 @@ static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, Method **newMPtrPtr); static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr); +static int FinalizeNext(ClientData data[], + Tcl_Interp *interp, int result); +static int FinalizeObjectCall(ClientData data[], + Tcl_Interp *interp, int result); static void InitFoundation(Tcl_Interp *interp); static void KillFoundation(ClientData clientData, Tcl_Interp *interp); @@ -82,9 +86,15 @@ static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr); static int PublicObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); +static int PublicNRObjectCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); static int PrivateObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); +static int PrivateNRObjectCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const *objv); /* * Methods in the oo::object and oo::class classes. First, we define a helper @@ -476,6 +486,7 @@ AllocObject( oPtr->command = Tcl_CreateObjCommand(interp, oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL); } + ((Command *) oPtr->command)->nreProc = PublicNRObjectCmd; /* * Access the namespace command table directly when creating "my" to avoid @@ -494,6 +505,7 @@ AllocObject( cmdPtr->objClientData = oPtr; cmdPtr->proc = TclInvokeObjectCommand; cmdPtr->clientData = cmdPtr; + cmdPtr->nreProc = PrivateNRObjectCmd; Tcl_SetHashValue(cmdPtr->hPtr, cmdPtr); } @@ -558,7 +570,8 @@ ObjectRenamedTrace( contextPtr->callPtr->flags |= DESTRUCTOR; contextPtr->skip = 0; state = Tcl_SaveInterpState(interp, TCL_OK); - result = TclOOInvokeContext(interp, contextPtr, 0, NULL); + result = TclNR_CallObjProc(interp, TclOOInvokeContext, contextPtr, + 0, NULL); if (result != TCL_OK) { Tcl_BackgroundError(interp); } @@ -1243,7 +1256,8 @@ Tcl_NewObjectInstance( state = Tcl_SaveInterpState(interp, TCL_OK); contextPtr->callPtr->flags |= CONSTRUCTOR; contextPtr->skip = skip; - result = TclOOInvokeContext(interp, contextPtr, objc, objv); + result = TclNR_CallObjProc(interp, TclOOInvokeContext, contextPtr, + objc, objv); TclOODeleteContext(contextPtr); DelRef(oPtr); if (result != TCL_OK) { @@ -1779,6 +1793,16 @@ PublicObjectCmd( int objc, Tcl_Obj *const *objv) { + return TclNR_CallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv); +} + +static int +PublicNRObjectCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv) +{ return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD, NULL); } @@ -1790,6 +1814,16 @@ PrivateObjectCmd( int objc, Tcl_Obj *const *objv) { + return TclNR_CallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv); +} + +static int +PrivateNRObjectCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv) +{ return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL); } @@ -1902,8 +1936,8 @@ TclOOObjectCmdCore( result = TCL_ERROR; Tcl_SetResult(interp, "no valid method implementation", TCL_STATIC); - AddRef(oPtr); /* Just to balance. */ - goto disposeChain; + TclOODeleteContext(contextPtr); + return TCL_ERROR; } } @@ -1913,13 +1947,23 @@ TclOOObjectCmdCore( */ AddRef(oPtr); - result = TclOOInvokeContext(interp, contextPtr, objc, objv); + TclNR_AddCallback(interp, FinalizeObjectCall, contextPtr,oPtr, NULL,NULL); + return TclOOInvokeContext(contextPtr, interp, objc, objv); +} + +static int +FinalizeObjectCall( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + register CallContext *contextPtr = data[0]; + register Object *oPtr = data[1]; /* * Dispose of the call chain and drop the lock on the object's structure. */ - disposeChain: TclOODeleteContext(contextPtr); DelRef(oPtr); return result; @@ -1928,11 +1972,12 @@ TclOOObjectCmdCore( /* * ---------------------------------------------------------------------- * - * Tcl_ObjectContextInvokeNext -- + * Tcl_ObjectContextInvokeNext, TclNRObjectContextInvokeNext -- * * Invokes the next stage of the call chain described in an object * context. This is the core of the implementation of the [next] command. - * Does not do management of the call-frame stack. + * Does not do management of the call-frame stack. Available in public + * (standard API) and private (NRE-aware) forms. * * ---------------------------------------------------------------------- */ @@ -1987,7 +2032,8 @@ Tcl_ObjectContextInvokeNext( * Invoke the (advanced) method call context in the caller context. */ - result = TclOOInvokeContext(interp, contextPtr, objc, objv); + result = TclNR_CallObjProc(interp, TclOOInvokeContext, contextPtr, objc, + objv); /* * Restore the call chain context index as we've finished the inner invoke @@ -1999,6 +2045,76 @@ Tcl_ObjectContextInvokeNext( return result; } + +int +TclNRObjectContextInvokeNext( + Tcl_Interp *interp, + Tcl_ObjectContext context, + int objc, + Tcl_Obj *const *objv, + int skip) +{ + register CallContext *contextPtr = (CallContext *) context; + + if (contextPtr->index+1 >= contextPtr->callPtr->numChain) { + /* + * We're at the end of the chain; generate an error message. + */ + + const char *methodType; + + if (contextPtr->callPtr->flags & CONSTRUCTOR) { + methodType = "constructor"; + } else if (contextPtr->callPtr->flags & DESTRUCTOR) { + methodType = "destructor"; + } else { + methodType = "method"; + } + + Tcl_AppendResult(interp, "no next ", methodType, " implementation", + NULL); + return TCL_ERROR; + } + + /* + * Advance to the next method implementation in the chain in the method + * call context while we process the body. However, need to adjust the + * argument-skip control because we're guaranteed to have a single prefix + * arg (i.e., 'next') and not the variable amount that can happen because + * method invokations (i.e., '$obj meth' and 'my meth'), constructors + * (i.e., '$cls new' and '$cls create obj') and destructors (no args at + * all) come through the same code. + */ + + TclNR_AddCallback(interp, FinalizeNext, contextPtr, + INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL); + contextPtr->index++; + contextPtr->skip = skip; + + /* + * Invoke the (advanced) method call context in the caller context. + */ + + return TclOOInvokeContext(contextPtr, interp, objc, objv); +} + +static int +FinalizeNext( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + CallContext *contextPtr = data[0]; + + /* + * Restore the call chain context index as we've finished the inner invoke + * and want to operate in the outer context again. + */ + + contextPtr->index = PTR2INT(data[1]); + contextPtr->skip = PTR2INT(data[2]); + return result; +} /* * ---------------------------------------------------------------------- diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 1cd07df..0af3a0b 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOBasic.c,v 1.1 2008/05/31 11:42:17 dkf Exp $ + * RCS: @(#) $Id: tclOOBasic.c,v 1.2 2008/07/16 22:09:01 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -17,6 +17,9 @@ #endif #include "tclInt.h" #include "tclOOInt.h" + +static int RestoreFrame(ClientData data[], + Tcl_Interp *interp, int result); /* * ---------------------------------------------------------------------- @@ -581,7 +584,6 @@ TclOONextObjCmd( Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->varFramePtr; Tcl_ObjectContext context; - int result; /* * Start with sanity checks on the calling context to make sure that we @@ -601,9 +603,20 @@ TclOONextObjCmd( * that this is like [uplevel 1] and not [eval]. */ + TclNR_AddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL); iPtr->varFramePtr = framePtr->callerVarPtr; - result = Tcl_ObjectContextInvokeNext(interp, context, objc, objv, 1); - iPtr->varFramePtr = framePtr; + return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1); +} + +static int +RestoreFrame( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Interp *iPtr = (Interp *) interp; + + iPtr->varFramePtr = data[0]; return result; } diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index bc90d09..162e7e2 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOCall.c,v 1.7 2008/06/19 20:57:23 dkf Exp $ + * RCS: @(#) $Id: tclOOCall.c,v 1.8 2008/07/16 22:09:02 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -66,9 +66,15 @@ static void AddSimpleClassChainToCallContext(Class *classPtr, Class *const filterDecl); static int CmpStr(const void *ptr1, const void *ptr2); static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr); +static int FinalizeMethodRefs(ClientData data[], + Tcl_Interp *interp, int result); static void FreeMethodNameRep(Tcl_Obj *objPtr); static inline int IsStillValid(CallChain *callPtr, Object *oPtr, int flags, int reuseMask); +static int ResetFilterFlags(ClientData data[], + Tcl_Interp *interp, int result); +static int SetFilterFlags(ClientData data[], + Tcl_Interp *interp, int result); static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr); /* @@ -231,20 +237,18 @@ FreeMethodNameRep( int TclOOInvokeContext( - Tcl_Interp *const interp, /* Interpreter for error reporting, and many + ClientData clientData, /* The method call context. */ + Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method * implementation. */ - CallContext *const contextPtr, - /* The method call context. */ - const int objc, /* The number of arguments. */ - Tcl_Obj *const *const objv) /* The arguments as actually seen. */ + int objc, /* The number of arguments. */ + Tcl_Obj *const objv[]) /* The arguments as actually seen. */ { + register CallContext *const contextPtr = clientData; Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; - const int isFirst = (contextPtr->index == 0); const int isFilter = contextPtr->callPtr->chain[contextPtr->index].isFilter; - int result, wasFilter; /* * If this is the first step along the chain, we preserve the method @@ -252,7 +256,7 @@ TclOOInvokeContext( * feet. */ - if (isFirst) { + if (contextPtr->index == 0) { int i; for (i=0 ; i<contextPtr->callPtr->numChain ; i++) { @@ -267,13 +271,25 @@ TclOOInvokeContext( if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) { contextPtr->skip--; } + + /* + * Add a callback to ensure that method references are dropped once + * this call is finished. + */ + + TclNR_AddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL, + NULL); } /* * Save whether we were in a filter and set up whether we are now. */ - wasFilter = contextPtr->oPtr->flags & FILTER_HANDLING; + if (contextPtr->oPtr->flags & FILTER_HANDLING) { + TclNR_AddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); + } else { + TclNR_AddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); + } if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { contextPtr->oPtr->flags |= FILTER_HANDLING; } else { @@ -284,25 +300,45 @@ TclOOInvokeContext( * Run the method implementation. */ - result = mPtr->typePtr->callProc(mPtr->clientData, interp, + return mPtr->typePtr->callProc(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, objc, objv); +} - /* - * Restore the old filter-ness, release any locks on method - * implementations, and return the result code. - */ +static int +SetFilterFlags( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + CallContext *contextPtr = data[0]; - if (wasFilter) { - contextPtr->oPtr->flags |= FILTER_HANDLING; - } else { - contextPtr->oPtr->flags &= ~FILTER_HANDLING; - } - if (isFirst) { - int i; + contextPtr->oPtr->flags |= FILTER_HANDLING; + return result; +} - for (i=0 ; i<contextPtr->callPtr->numChain ; i++) { - TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr); - } +static int +ResetFilterFlags( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + CallContext *contextPtr = data[0]; + + contextPtr->oPtr->flags &= ~FILTER_HANDLING; + return result; +} + +static int +FinalizeMethodRefs( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + CallContext *contextPtr = data[0]; + int i; + + for (i=0 ; i<contextPtr->callPtr->numChain ; i++) { + TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr); } return result; } diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 580ea13..569ac2f 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOInt.h,v 1.2 2008/05/31 19:56:07 dkf Exp $ + * RCS: @(#) $Id: tclOOInt.h,v 1.3 2008/07/16 22:09:02 dkf Exp $ */ #include <tclInt.h> @@ -493,9 +493,12 @@ MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp); -MODULE_SCOPE int TclOOInvokeContext(Tcl_Interp *const interp, - CallContext *const contextPtr, int const objc, - Tcl_Obj *const *const objv); +MODULE_SCOPE int TclOOInvokeContext(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, + Tcl_ObjectContext context, int objc, + Tcl_Obj *const *objv, int skip); MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr, const DeclaredClassMethod *dcm); MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr); diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 053336e..62585b7 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOMethod.c,v 1.5 2008/06/01 08:11:07 dkf Exp $ + * RCS: @(#) $Id: tclOOMethod.c,v 1.6 2008/07/16 22:09:02 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -55,6 +55,8 @@ static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc, static int InvokeProcedureMethod(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); +static int FinalizePMCall(ClientData data[], Tcl_Interp *interp, + int result); static int PushMethodCallFrame(Tcl_Interp *interp, CallContext *contextPtr, ProcedureMethod *pmPtr, int objc, Tcl_Obj *const *objv, @@ -633,7 +635,6 @@ InvokeProcedureMethod( { ProcedureMethod *pmPtr = clientData; int result; - register int skip; PMFrameData *fdPtr; /* Important data that has to have a lifetime * matched by this function (or rather, by the * call frame's lifetime). */ @@ -643,7 +644,6 @@ InvokeProcedureMethod( */ fdPtr = (PMFrameData *) TclStackAlloc(interp, sizeof(PMFrameData)); - pmPtr->refCount++; /* * Create a call frame for this method. @@ -652,8 +652,10 @@ InvokeProcedureMethod( result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr, objc, objv, fdPtr); if (result != TCL_OK) { - goto done; + TclStackFree(interp, fdPtr); + return result; } + pmPtr->refCount++; /* * Give the pre-call callback a chance to do some setup and, possibly, @@ -668,19 +670,32 @@ InvokeProcedureMethod( if (isFinished || result != TCL_OK) { Tcl_PopCallFrame(interp); TclStackFree(interp, fdPtr->framePtr); - goto done; + if (--pmPtr->refCount < 1) { + DeleteProcedureMethodRecord(pmPtr); + } + TclStackFree(interp, fdPtr); + return result; } } /* - * Now invoke the body of the method. Note that we need to take special - * action when doing unknown processing to ensure that the missing method - * name is passed as an argument. + * Now invoke the body of the method. */ - skip = Tcl_ObjectContextSkippedArgs(context); - result = TclObjInterpProcCore(interp, fdPtr->nameObj, skip, - fdPtr->errProc); + TclNR_AddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL); + return TclNRInterpProcCore(interp, fdPtr->nameObj, + Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc); +} + +static int +FinalizePMCall( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + ProcedureMethod *pmPtr = data[0]; + Tcl_ObjectContext context = data[1]; + PMFrameData *fdPtr = data[2]; /* * Give the post-call callback a chance to do some cleanup. Note that at @@ -699,7 +714,6 @@ InvokeProcedureMethod( * sensitive when it comes to performance! */ - done: if (--pmPtr->refCount < 1) { DeleteProcedureMethodRecord(pmPtr); } @@ -1136,7 +1150,7 @@ InvokeForwardMethod( argObjs = InitEnsembleRewrite(interp, objc, objv, skip, numPrefixes, prefixObjs, &len); - result = Tcl_EvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE); + result = TclNR_EvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE); TclStackFree(interp, argObjs); return result; } |