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 96d74c4..82aa833 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; @@ -161,6 +162,7 @@ static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; static Tcl_ObjCmdProc NRCoroInjectObjCmd; +static Tcl_NRPostProc NRPostInvoke; MODULE_SCOPE const TclStubs tclStubs; @@ -4125,6 +4127,7 @@ EvalObjvCore( Tcl_Obj **objv = data[3]; Interp *iPtr = (Interp *) interp; Namespace *lookupNsPtr = iPtr->lookupNsPtr; + int weLookUp = (cmdPtr == NULL); if (TCL_OK != TclInterpReady(interp)) { return TCL_ERROR; @@ -4140,10 +4143,6 @@ EvalObjvCore( iPtr->lookupNsPtr = NULL; - 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). @@ -4153,6 +4152,10 @@ EvalObjvCore( TEOV_PushExceptionHandlers(interp, objc, objv, flags); } + if (!weLookUp) { + goto commandFound; + } + /* * Configure evaluation context to match the requested flags. */ @@ -4196,12 +4199,16 @@ EvalObjvCore( 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; } } @@ -4593,7 +4600,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; @@ -4601,7 +4609,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); @@ -4623,16 +4631,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; } @@ -6460,30 +6484,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; @@ -6499,36 +6525,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; } @@ -8076,7 +8088,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); } /***************************************************************************** |