diff options
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 131 |
1 files changed, 72 insertions, 59 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c1032f9..d35af46 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -147,7 +147,8 @@ static int TEOV_NotFound(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr); static int TEOV_RunEnterTraces(Tcl_Interp *interp, Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, - Tcl_Obj *const objv[], Namespace *lookupNsPtr); + Tcl_Obj *const objv[], Namespace *lookupNsPtr, + int weLookUp); static Tcl_NRPostProc RewindCoroutineCallback; static Tcl_NRPostProc TailcallCleanup; static Tcl_NRPostProc TEOEx_ByteCodeCallback; @@ -160,6 +161,7 @@ static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc Dispatch; static Tcl_ObjCmdProc NRCoroInjectObjCmd; +static Tcl_NRPostProc NRPostInvoke; MODULE_SCOPE const TclStubs tclStubs; @@ -4097,6 +4099,7 @@ TclNREvalObjv( Namespace *lookupNsPtr = iPtr->lookupNsPtr; Command **cmdPtrPtr; NRE_callback *callbackPtr; + int weLookUp = (cmdPtr == NULL); iPtr->lookupNsPtr = NULL; @@ -4126,10 +4129,6 @@ TclNREvalObjv( return result; } - if (cmdPtr) { - goto commandFound; - } - /* * Push records for task to be done on return, in INVERSE order. First, if * needed, the exception handlers (as they should happen last). @@ -4139,6 +4138,10 @@ TclNREvalObjv( TEOV_PushExceptionHandlers(interp, objc, objv, flags); } + if (!weLookUp) { + goto commandFound; + } + /* * Configure evaluation context to match the requested flags. */ @@ -4187,12 +4190,16 @@ TclNREvalObjv( result = TEOV_RunEnterTraces(interp, &cmdPtr, TclGetSourceFromFrame( flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, - objc, objv), objc, objv, lookupNsPtr); + objc, objv), objc, objv, lookupNsPtr, weLookUp); if (result != TCL_OK) { return result; } - if (!cmdPtr) { - return TEOV_NotFound(interp, objc, objv, lookupNsPtr); + if (cmdPtr == NULL) { + if (weLookUp) { + return TEOV_NotFound(interp, objc, objv, lookupNsPtr); + } + /* Is this right??? */ + return TCL_OK; } } @@ -4595,7 +4602,8 @@ TEOV_RunEnterTraces( Tcl_Obj *commandPtr, int objc, Tcl_Obj *const objv[], - Namespace *lookupNsPtr) + Namespace *lookupNsPtr, + int weLookUp) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; @@ -4603,7 +4611,7 @@ TEOV_RunEnterTraces( int cmdEpoch = cmdPtr->cmdEpoch; int newEpoch; const char *command; - int length; + int length, deleted; Tcl_IncrRefCount(commandPtr); command = Tcl_GetStringFromObj(commandPtr, &length); @@ -4625,16 +4633,32 @@ TEOV_RunEnterTraces( cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv); } newEpoch = cmdPtr->cmdEpoch; + deleted = cmdPtr->flags & CMD_IS_DELETED; TclCleanupCommandMacro(cmdPtr); - /* - * If the traces modified/deleted the command or any existing traces, they - * will update the command's epoch. We need to lookup again, but do not - * run enter traces on the newly found cmdPtr. - */ - if (cmdEpoch != newEpoch) { - cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr); + + /* + * The traces did something to the traced command. How should + * we respond? + * + * If we got the trace command by looking up a command name, we + * should just look it up again. + */ + if (weLookUp) { + cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr); + } else { + + /* + * If we did not look up a command name, we got the cmdPtr + * from a caller. If that cmdPtr has been deleted, we need + * to avoid a crash. Otherwise, press on. We don't have + * any foundation to claim a better answer. + */ + if (deleted) { + cmdPtr = NULL; + } + } *cmdPtrPtr = cmdPtr; } @@ -6462,30 +6486,32 @@ TclObjInvoke( * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN, * or TCL_INVOKE_NO_TRACEBACK. */ { - register Interp *iPtr = (Interp *) interp; - Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ - const char *cmdName; /* Name of the command from objv[0]. */ - Tcl_HashEntry *hPtr = NULL; - Command *cmdPtr; - int result; - if (interp == NULL) { return TCL_ERROR; } - if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal argument vector", -1)); return TCL_ERROR; } - if ((flags & TCL_INVOKE_HIDDEN) == 0) { Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN"); } + return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv); +} - if (TclInterpReady(interp) == TCL_ERROR) { - return TCL_ERROR; - } +int +TclNRInvoke( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + register Interp *iPtr = (Interp *) interp; + Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ + const char *cmdName; /* Name of the command from objv[0]. */ + Tcl_HashEntry *hPtr = NULL; + Command *cmdPtr; cmdName = TclGetString(objv[0]); hTblPtr = iPtr->hiddenCmdTablePtr; @@ -6501,36 +6527,22 @@ TclObjInvoke( } cmdPtr = Tcl_GetHashValue(hPtr); - /* - * Invoke the command function. - */ - - iPtr->cmdCount++; - if (cmdPtr->objProc != NULL) { - result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); - } else { - result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc, - cmdPtr->objClientData, objc, objv); - } - - /* - * If an error occurred, record information about what was being executed - * when the error occurred. - */ - - if ((result == TCL_ERROR) - && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0) - && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) { - int length; - Tcl_Obj *command = Tcl_NewListObj(objc, objv); - const char *cmdString; + /* Avoid the exception-handling brain damage when numLevels == 0 . */ + iPtr->numLevels++; + Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL); + + /* TODO: how to get re-resolution right */ + return TclNREvalObjv(interp, objc, objv, 0, cmdPtr); +} - Tcl_IncrRefCount(command); - cmdString = Tcl_GetStringFromObj(command, &length); - Tcl_LogCommandInfo(interp, cmdString, cmdString, length); - Tcl_DecrRefCount(command); - iPtr->flags &= ~ERR_ALREADY_LOGGED; - } +static int +NRPostInvoke( + ClientData clientData[], + Tcl_Interp *interp, + int result) +{ + Interp *iPtr = (Interp *)interp; + iPtr->numLevels--; return result; } @@ -8106,7 +8118,8 @@ Tcl_NRCmdSwap( Tcl_Obj *const objv[], int flags) { - return TclNREvalObjv(interp, objc, objv, flags, (Command *) cmd); + return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR, + (Command *) cmd); } /***************************************************************************** |