Attachment "teovi-08July06.patch" to
ticket [1290457fff]
added by
tallniel
2006-07-08 21:42:37.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.194
diff -u -r1.194 tclBasic.c
--- generic/tclBasic.c 4 May 2006 12:55:49 -0000 1.194
+++ generic/tclBasic.c 8 Jul 2006 14:22:39 -0000
@@ -35,6 +35,24 @@
} OldMathFuncData;
/*
+ * The following structure is used to pass information between then
+ * TclEvalObjvInternal group of functions. It should be considered private to
+ * those functions.
+ */
+typedef struct TclEvalObjvInternalData {
+ CONST char *command; /* Command invocation string */
+ int length; /* Length of command string */
+ Command *cmdPtr; /* Corresponding Command structure */
+ int objc; /* Number of objects in command invocation */
+ Tcl_Obj * CONST *objv; /* Actual objects of command invocation */
+ int code; /* Return code from invoking command */
+ int traceCode; /* Return code from execution traces */
+ int flags; /* TCL_EVAL_GLOBAL etc */
+ CallFrame *savedVarFramePtr; /* Saved call frame and namespace context.*/
+ Namespace *savedNsPtr;
+} TclEvalObjvInternalData;
+
+/*
* Static functions in this file:
*/
@@ -1884,7 +1902,7 @@
* Invoke the command's object-based Tcl_ObjCmdProc.
*/
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
+ result = TclInvokeCommand(interp, argc, objv, cmdPtr, 0);
/*
* Move the interpreter's object result to the string result, then reset
@@ -3195,213 +3213,321 @@
/*
*----------------------------------------------------------------------
*
- * TclEvalObjvInternal --
+ * TclEvalObjvInternalUnknownHandler --
*
- * This function evaluates a Tcl command that has already been parsed
- * into words, with one Tcl_Obj holding each word. The caller is
- * responsible for managing the iPtr->numLevels.
+ * Called to handle an unknown command being invoked. This calls the
+ * unknown handler command for the current namespace. If there is no
+ * handler for the current namespace, then it calls the handler for the
+ * global namespace (default: "::unknown") if it exists. Otherwise an
+ * error message is generated.
*
* Results:
- * The return value is a standard Tcl completion code such as TCL_OK or
- * TCL_ERROR. A result or error message is left in interp's result. If an
- * error occurs, this function does NOT add any information to the
- * errorInfo variable.
+ * The return value is the result of calling the ::unknown procedure,
+ * or TCL_ERROR if no such procedure exists.
*
* Side effects:
- * Depends on the command.
+ * Depends on the ::unknown command. Alters fields in "data".
*
*----------------------------------------------------------------------
*/
-int
-TclEvalObjvInternal(
- Tcl_Interp *interp, /* Interpreter in which to evaluate the
- * command. Also used for error reporting. */
- int objc, /* Number of words in command. */
- Tcl_Obj *CONST objv[], /* An array of pointers to objects that are
- * the words that make up the command. */
- CONST char *command, /* Points to the beginning of the string
- * representation of the command; this is used
- * for traces. If the string representation of
- * the command is unknown, an empty string
- * should be supplied. If it is NULL, no
- * traces will be called. */
- int length, /* Number of bytes in command; if -1, all
- * characters up to the first null byte are
- * used. */
- int flags) /* Collection of OR-ed bits that control the
- * evaluation of the script. Only
- * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
- * currently supported. */
-{
+static int
+TclEvalObjvInternalUnknownHandler(
+ Tcl_Interp *interp,
+ TclEvalObjvInternalData *data)
+{
+ Namespace *currNsPtr = NULL; /* Used to check for and invoke any
+ * registered unknown command handler
+ * for the current namespace (TIP 181). */
+ int newObjc, handlerObjc;
+ Tcl_Obj **handlerObjv, **newObjv;
Command *cmdPtr;
- Interp *iPtr = (Interp *) interp;
- Tcl_Obj **newObjv;
+ Interp *iPtr = (Interp *)interp;
int i;
- CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
- * TCL_EVAL_GLOBAL was set. */
- int code = TCL_OK;
- int traceCode = TCL_OK;
- int checkTraces = 1;
- int cmdEpoch;
- Namespace *savedNsPtr = NULL;
- if (TclInterpReady(interp) == TCL_ERROR) {
- return TCL_ERROR;
+ if (iPtr->varFramePtr != NULL) {
+ currNsPtr = iPtr->varFramePtr->nsPtr;
+ }
+ if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
+ currNsPtr = iPtr->globalNsPtr;
}
+ if (currNsPtr == NULL) {
+ Tcl_Panic(
+ "TclEvalObjvInternalUnknownHandler: NULL global namespace pointer");
+ }
+ if (currNsPtr->unknownHandlerPtr == NULL) {
+ /* Global namespace has lost unknown handler; reset. */
+ currNsPtr->unknownHandlerPtr = Tcl_NewStringObj("::unknown", -1);
+ Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
+ }
+ Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
+ &handlerObjc, &handlerObjv);
+ newObjc = data->objc + handlerObjc;
+ newObjv = (Tcl_Obj **) ckalloc((unsigned) (newObjc * sizeof(Tcl_Obj *)));
- if (objc == 0) {
- return TCL_OK;
+ /* Copy command prefix from unknown handler. */
+ for (i = 0; i < handlerObjc; ++i) {
+ newObjv[i] = handlerObjv[i];
+ Tcl_IncrRefCount(newObjv[i]);
+ }
+ /* Add in command name and arguments. */
+ for (i = data->objc-1; i >= 0; --i) {
+ newObjv[i+handlerObjc] = data->objv[i];
}
- /* Configure evaluation context to match the requested flags */
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
- } else if ((flags & TCL_EVAL_INVOKE) && iPtr->varFramePtr) {
- savedNsPtr = iPtr->varFramePtr->nsPtr;
- iPtr->varFramePtr->nsPtr = iPtr->globalNsPtr;
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
+
+ if (cmdPtr == NULL) {
+ Tcl_AppendResult(interp, "invalid command name \"",
+ Tcl_GetString(data->objv[0]), "\"", NULL);
+ data->code = TCL_ERROR;
+ } else {
+ iPtr->numLevels++;
+ /* TODO: Replace with a TclInvokeCommand call? This would save calling
+ * Tcl_GetCommandFromObj again, but would lose the string 'command'
+ * field, which may be needed? NEM */
+ data->code = TclEvalObjvInternal(interp, newObjc, newObjv,
+ data->command, data->length, 0);
+ iPtr->numLevels--;
+ }
+ for (i = 0; i < handlerObjc; ++i) {
+ Tcl_DecrRefCount(newObjv[i]);
+ }
+ ckfree((char *) newObjv);
+
+ if (data->savedNsPtr) {
+ iPtr->varFramePtr->nsPtr = data->savedNsPtr;
}
+ return data->code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternalTraceEnter --
+ *
+ * Fires execution traces before executing a command.
+ *
+ * Results:
+ * Returns the result of any execution enter traces, or TCL_OK if there
+ * are none.
+ *
+ * Side effects:
+ * Execution traces may cause the command being invoked to be changed
+ * in some way, so it may have to be looked up again if
+ * data->cmdPtr->cmdEpoch has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TclEvalObjvInternalTraceEnter(
+ Tcl_Interp *interp,
+ TclEvalObjvInternalData *data)
+{
+ Interp *iPtr = (Interp *)interp;
+
+ data->cmdPtr->refCount++;
+
+ if (iPtr->tracePtr != NULL && data->traceCode == TCL_OK) {
+ data->traceCode = TclCheckInterpTraces(interp,
+ data->command, data->length,
+ data->cmdPtr, data->code, TCL_TRACE_ENTER_EXEC,
+ data->objc, data->objv);
+ }
+ if ((data->cmdPtr->flags & CMD_HAS_EXEC_TRACES) &&
+ (data->traceCode == TCL_OK)) {
+ data->traceCode = TclCheckExecutionTraces(interp,
+ data->command, data->length,
+ data->cmdPtr, data->code, TCL_TRACE_ENTER_EXEC,
+ data->objc, data->objv);
+ }
+ data->cmdPtr->refCount--;
+
+ return data->traceCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternalCheckEnterTraces --
+ *
+ * Checks whether a command exists, and if so fires any enter traces
+ * associated with that command.
+ *
+ * Results:
+ * None.
+ *
+ * Side-effects:
+ * Invokes any enter traces associated with a command. If any traces
+ * cause the command to be renamed or deleted, then updates data->cmdPtr
+ * with the new command.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TclEvalObjvInternalCheckEnterTraces(
+ Tcl_Interp *interp,
+ TclEvalObjvInternalData *data)
+{
+ Interp *iPtr = (Interp *)interp;
+ int checkTraces;
+ int cmdEpoch;
+
/*
- * Find the function to execute this command. If there isn't one, then see
- * if there is an unknown command handler registered for this namespace.
- * If so, create a new word array with the handler as the first words and
- * the original command words as arguments. Then call ourselves
- * recursively to execute it.
+ * Lookup the command. If it is unknown then invoke an unknown command
+ * handler.
*
* If any execution traces rename or delete the current command, we may
* need (at most) two passes here.
*/
+ for (checkTraces = 1; checkTraces >= 0; --checkTraces) {
- reparseBecauseOfTraces:
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- if (cmdPtr == NULL) {
- Namespace *currNsPtr = NULL; /* Used to check for and invoke any
- * registered unknown command handler
- * for the current namespace
- * (TIP 181). */
- int newObjc, handlerObjc;
- Tcl_Obj **handlerObjv;
-
- if (iPtr->varFramePtr != NULL) {
- currNsPtr = iPtr->varFramePtr->nsPtr;
- }
- if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
- currNsPtr = iPtr->globalNsPtr;
- }
- if (currNsPtr == NULL) {
- Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
- }
- if (currNsPtr->unknownHandlerPtr == NULL) {
- /* Global namespace has lost unknown handler, reset. */
- currNsPtr->unknownHandlerPtr = Tcl_NewStringObj("::unknown", -1);
- Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
- }
- Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
- &handlerObjc, &handlerObjv);
- newObjc = objc + handlerObjc;
- newObjv = (Tcl_Obj **) ckalloc((unsigned)
- (newObjc * sizeof(Tcl_Obj *)));
- /* Copy command prefix from unknown handler. */
- for (i = 0; i < handlerObjc; ++i) {
- newObjv[i] = handlerObjv[i];
- Tcl_IncrRefCount(newObjv[i]);
- }
- /* Add in command name and arguments. */
- for (i = objc-1; i >= 0; --i) {
- newObjv[i+handlerObjc] = objv[i];
- }
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
- if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[0]), "\"", NULL);
- code = TCL_ERROR;
- } else {
- iPtr->numLevels++;
- code = TclEvalObjvInternal(interp, newObjc, newObjv, command,
- length, 0);
- iPtr->numLevels--;
- }
- for (i = 0; i < handlerObjc; ++i) {
- Tcl_DecrRefCount(newObjv[i]);
- }
- ckfree((char *) newObjv);
- if (savedNsPtr) {
- iPtr->varFramePtr->nsPtr = savedNsPtr;
+ if (data->cmdPtr == NULL) {
+ /*
+ * Unknown command.
+ */
+ break;
+
+ } else if (checkTraces) {
+
+ if (data->savedNsPtr) {
+ iPtr->varFramePtr->nsPtr = data->savedNsPtr;
+ }
+
+ /*
+ * Call trace functions if needed.
+ */
+
+ cmdEpoch = data->cmdPtr->cmdEpoch;
+
+ TclEvalObjvInternalTraceEnter(interp, data);
+
+ if (cmdEpoch == data->cmdPtr->cmdEpoch) {
+ /* Trace didn't alter command, so avoid re-lookup */
+ break;
+ }
}
- goto done;
+
+ /*
+ * Re-lookup command in case any traces renamed or deleted it.
+ */
+ data->cmdPtr = (Command *)
+ Tcl_GetCommandFromObj(interp, data->objv[0]);
}
- if (savedNsPtr) {
- iPtr->varFramePtr->nsPtr = savedNsPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternalTraceLeave --
+ *
+ * Fires execution leave traces for a command.
+ *
+ * Results:
+ * Returns result of executing traces, or TCL_OK if there were none.
+ *
+ * Side effects:
+ * Depends of execution traces.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TclEvalObjvInternalTraceLeave(
+ Tcl_Interp *interp,
+ TclEvalObjvInternalData *data)
+{
+ Interp *iPtr = (Interp *)interp;
+
+ if (!(data->cmdPtr->flags & CMD_IS_DELETED)) {
+ if ((data->cmdPtr->flags & CMD_HAS_EXEC_TRACES) &&
+ (data->traceCode == TCL_OK)) {
+ data->traceCode = TclCheckExecutionTraces(interp,
+ data->command, data->length,
+ data->cmdPtr, data->code, TCL_TRACE_LEAVE_EXEC,
+ data->objc, data->objv);
+ }
+ if (iPtr->tracePtr != NULL && data->traceCode == TCL_OK) {
+ data->traceCode = TclCheckInterpTraces(interp,
+ data->command, data->length,
+ data->cmdPtr, data->code, TCL_TRACE_LEAVE_EXEC,
+ data->objc, data->objv);
+ }
}
- /*
- * Call trace functions if needed.
- */
+ return data->traceCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternalInvokeCommand --
+ *
+ * Takes care of actually invoking a command, invoking any enter and
+ * leave traces and handling unknown commands.
+ *
+ * Results:
+ * Sets data->code to result of command invocation, and also returns
+ * this result.
+ *
+ * Side effects:
+ * Depends on command.
+ *
+ *----------------------------------------------------------------------
+ */
- cmdEpoch = cmdPtr->cmdEpoch;
- if ((checkTraces) && (command != NULL)) {
- cmdPtr->refCount++;
+static int
+TclEvalObjvInternalInvokeCommand(
+ Tcl_Interp *interp,
+ TclEvalObjvInternalData *data)
+{
+ Interp *iPtr = (Interp *)interp;
- /*
- * If the first set of traces modifies/deletes the command or any
- * existing traces, then the set checkTraces to 0 and go through this
- * while loop one more time.
- */
+ /*
+ * Fire any execution enter traces for the command.
+ */
+ TclEvalObjvInternalCheckEnterTraces(interp, data);
- if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
- traceCode = TclCheckInterpTraces(interp, command, length,
- cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
- }
- if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
- traceCode = TclCheckExecutionTraces(interp, command, length,
- cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
- }
- cmdPtr->refCount--;
- }
- if (cmdEpoch != cmdPtr->cmdEpoch) {
- /* The command has been modified in some way. */
- checkTraces = 0;
- goto reparseBecauseOfTraces;
+ if (data->cmdPtr == NULL) {
+ /*
+ * Unknown command.
+ */
+ return TclEvalObjvInternalUnknownHandler(interp, data);
}
/*
- * Finally, invoke the command's Tcl_ObjCmdProc.
+ * Invoke the command.
*/
- cmdPtr->refCount++;
+ data->cmdPtr->refCount++;
iPtr->cmdCount++;
- if (code == TCL_OK && traceCode == TCL_OK && !Tcl_LimitExceeded(interp)) {
- if (!(flags & TCL_EVAL_INVOKE) &&
+
+ if (data->code == TCL_OK && data->traceCode == TCL_OK &&
+ !Tcl_LimitExceeded(interp)) {
+
+ if (!(data->flags & TCL_EVAL_INVOKE) &&
(iPtr->ensembleRewrite.sourceObjs != NULL) &&
- !Tcl_IsEnsemble((Tcl_Command) cmdPtr)) {
+ !Tcl_IsEnsemble((Tcl_Command) data->cmdPtr)) {
iPtr->ensembleRewrite.sourceObjs = NULL;
}
- code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ data->code = (*data->cmdPtr->objProc)
+ (data->cmdPtr->objClientData, interp, data->objc, data->objv);
}
if (Tcl_AsyncReady()) {
- code = Tcl_AsyncInvoke(interp, code);
+ data->code = Tcl_AsyncInvoke(interp, data->code);
}
- if (code == TCL_OK && Tcl_LimitReady(interp)) {
- code = Tcl_LimitCheck(interp);
+ if (data->code == TCL_OK && Tcl_LimitReady(interp)) {
+ data->code = Tcl_LimitCheck(interp);
}
/*
- * Call 'leave' command traces
+ * Call any execution leave command traces.
*/
- if (!(cmdPtr->flags & CMD_IS_DELETED)) {
- if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
- traceCode = TclCheckExecutionTraces(interp, command, length,
- cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
- }
- if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
- traceCode = TclCheckInterpTraces(interp, command, length,
- cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
- }
- }
- TclCleanupCommand(cmdPtr);
+ TclEvalObjvInternalTraceLeave(interp, data);
+ TclCleanupCommand(data->cmdPtr);
/*
* If one of the trace invocation resulted in error, then change the
@@ -3409,8 +3535,8 @@
* be set correctly by the call to TraceExecutionProc.
*/
- if (traceCode != TCL_OK) {
- code = traceCode;
+ if (data->traceCode != TCL_OK) {
+ data->code = data->traceCode;
}
/*
@@ -3424,9 +3550,217 @@
(void) Tcl_GetObjResult(interp);
}
- done:
- iPtr->varFramePtr = savedVarFramePtr;
- return code;
+ return data->code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternalSetContext --
+ *
+ * Sets up the interpreter evaluation context (varFramePtr and nsPtr) to
+ * match that requested in data->flags, and saves the previous context in
+ * the data structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side-effects:
+ * Sets the current evaluation context. Alters the data structure to
+ * contain the previous evaluation context.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TclEvalObjvInternalSetContext(
+ Tcl_Interp *interp, /* Interpreter to set up the context for. */
+ TclEvalObjvInternalData *data) /* Data structure describing context. */
+{
+ Interp *iPtr = (Interp *)interp;
+
+ /*
+ * Save current varFramePtr.
+ */
+ data->savedVarFramePtr = iPtr->varFramePtr;
+
+ /*
+ * Set up new evaluation context.
+ */
+ if (data->flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
+ } else if ((data->flags & TCL_EVAL_INVOKE) && iPtr->varFramePtr) {
+ data->savedNsPtr = iPtr->varFramePtr->nsPtr;
+ iPtr->varFramePtr->nsPtr = iPtr->globalNsPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternalRestoreContext --
+ *
+ * Restore the interpreter evaluation context to the previous state
+ * stored in the data structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side-effects:
+ * Sets the interpreter evaluation context to its previous state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TclEvalObjvInternalRestoreContext(
+ Tcl_Interp *interp, /* Interpreter to restore the context for. */
+ TclEvalObjvInternalData *data) /* Data structure describing context. */
+{
+ Interp *iPtr = (Interp *)interp;
+
+ iPtr->varFramePtr = data->savedVarFramePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInvokeCommand --
+ *
+ * This function evaluates a Tcl command that has already been
+ * looked up. It takes care of setting the correct evaluation context,
+ * invoking any enter or exit execution traces and invoking an unknown
+ * command handler if the command is NULL.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code such as TCL_OK or
+ * TCL_ERROR. A result or error message is left in interp's result. If an
+ * error occurs, this function does NOT add any information to the
+ * errorInfo variable.
+ *
+ * Side-effects:
+ * Depends on the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclInvokeCommand(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate the
+ * command. Also used for error reporting. */
+ int objc, /* Number of words in command. */
+ Tcl_Obj *CONST objv[], /* An array of pointers to objects that are
+ * the words that make up the command. */
+ Command *cmdPtr, /* The actual command structure. */
+ int flags) /* Collection of OR-ed bits that control the
+ * evaluation of the script. Only
+ * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
+ * currently supported. */
+{
+ TclEvalObjvInternalData data; /* State to pass to helper functions */
+
+ data.command = "";
+ data.length = 0;
+ data.cmdPtr = cmdPtr;
+ data.objc = objc;
+ data.objv = objv;
+ data.code = TCL_OK;
+ data.traceCode = TCL_OK;
+ data.flags = flags;
+ data.savedVarFramePtr = NULL;
+ data.savedNsPtr = NULL;
+
+ if (TclInterpReady(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 0) {
+ return TCL_OK;
+ }
+
+ TclEvalObjvInternalSetContext(interp, &data);
+ TclEvalObjvInternalInvokeCommand(interp, &data);
+ TclEvalObjvInternalRestoreContext(interp, &data);
+
+ return data.code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternal --
+ *
+ * This function evaluates a Tcl command that has already been parsed
+ * into words, with one Tcl_Obj holding each word. The caller is
+ * responsible for managing the iPtr->numLevels. Assumes that the
+ * interpreter evaluation context (varFramePtr and nsPtr) have been
+ * configured appropriately by the caller.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code such as TCL_OK or
+ * TCL_ERROR. A result or error message is left in interp's result. If an
+ * error occurs, this function does NOT add any information to the
+ * errorInfo variable.
+ *
+ * Side effects:
+ * Depends on the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclEvalObjvInternal(
+ Tcl_Interp *interp, /* Interpreter in which to evaluate the
+ * command. Also used for error reporting. */
+ int objc, /* Number of words in command. */
+ Tcl_Obj *CONST objv[], /* An array of pointers to objects that are
+ * the words that make up the command. */
+ CONST char *command, /* Points to the beginning of the string
+ * representation of the command; this is used
+ * for traces. If the string representation of
+ * the command is unknown, an empty string
+ * should be supplied. If it is NULL, no
+ * traces will be called. */
+ int length, /* Number of bytes in command; if -1, all
+ * characters up to the first null byte are
+ * used. */
+ int flags) /* Collection of OR-ed bits that control the
+ * evaluation of the script. Only
+ * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
+ * currently supported. */
+{
+ TclEvalObjvInternalData data; /* State to pass to helper functions */
+
+ data.command = command;
+ data.length = length;
+ data.cmdPtr = NULL;
+ data.objc = objc;
+ data.objv = objv;
+ data.code = TCL_OK;
+ data.traceCode = TCL_OK;
+ data.flags = flags;
+ data.savedVarFramePtr = NULL;
+ data.savedNsPtr = NULL;
+
+ if (TclInterpReady(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 0) {
+ return TCL_OK;
+ }
+
+ TclEvalObjvInternalSetContext(interp, &data);
+
+ /*
+ * Lookup the command in the new execution context.
+ */
+ data.cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
+
+ TclEvalObjvInternalInvokeCommand(interp, &data);
+ TclEvalObjvInternalRestoreContext(interp, &data);
+
+ return data.code;
}
/*
@@ -4475,8 +4809,7 @@
* Invoke the command function.
*/
- iPtr->cmdCount++;
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ result = TclInvokeCommand(interp, objc, objv, cmdPtr, flags);
/*
* If an error occurred, record information about what was being executed
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.272
diff -u -r1.272 tclInt.h
--- generic/tclInt.h 5 Jul 2006 05:34:44 -0000 1.272
+++ generic/tclInt.h 8 Jul 2006 14:22:42 -0000
@@ -1223,6 +1223,14 @@
#define CMD_HAS_EXEC_TRACES 0x4
/*
+ * Internal function used for invoking commands (used in tclBasic.c and
+ * tclNamesp.c).
+ */
+
+MODULE_SCOPE int TclInvokeCommand(Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[], Command *cmdPtr, int flags);
+
+/*
*----------------------------------------------------------------
* Data structures related to name resolution procedures.
*----------------------------------------------------------------
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.95
diff -u -r1.95 tclNamesp.c
--- generic/tclNamesp.c 13 Mar 2006 17:02:27 -0000 1.95
+++ generic/tclNamesp.c 8 Jul 2006 14:22:46 -0000
@@ -1864,8 +1864,7 @@
register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
register Command *realCmdPtr = dataPtr->realCmdPtr;
- return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
- objc, objv);
+ return TclInvokeCommand(interp, objc, objv, realCmdPtr, 0);
}
/*
