summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c77
-rw-r--r--generic/tclInt.h1
-rw-r--r--generic/tclInterp.c7
3 files changed, 37 insertions, 48 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 22ec6b0..82ce385 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -162,6 +162,7 @@ static Tcl_NRPostProc TEOV_RestoreVarFrame;
static Tcl_NRPostProc TEOV_RunLeaveTraces;
static Tcl_ObjCmdProc NRCoroInjectObjCmd;
+static Tcl_NRPostProc NRPostInvoke;
MODULE_SCOPE const TclStubs tclStubs;
@@ -6599,32 +6600,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 1
- if (TclInterpReady(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
-#endif
+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;
@@ -6640,41 +6641,23 @@ TclObjInvoke(
}
cmdPtr = Tcl_GetHashValue(hPtr);
-#if 1
- /*
- * 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;
-#else
-
-#endif
}
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1f939c0..70d6d02 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2739,6 +2739,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 1a4297b..ac51d9d 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -3052,7 +3052,12 @@ SlaveInvokeHidden(
Tcl_AllowExceptions(slaveInterp);
if (namespaceName == NULL) {
- result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+ if (interp == slaveInterp) {
+ Tcl_Release(slaveInterp);
+ return TclNRInvoke(NULL, slaveInterp, objc, objv);
+ } else {
+ result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+ }
} else {
Namespace *nsPtr, *dummy1, *dummy2;
const char *tail;