summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c131
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);
}
/*****************************************************************************