Attachment "teovi.patch" to
ticket [1290457fff]
added by
tallniel
2005-09-14 04:06:37.
? teovi.patch
? generic/.tclBasic.c.swp
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.169
diff -u -r1.169 tclBasic.c
--- generic/tclBasic.c 6 Sep 2005 14:40:10 -0000 1.169
+++ generic/tclBasic.c 13 Sep 2005 20:51:56 -0000
@@ -34,6 +34,24 @@
} OldMathFuncData;
/*
+ * The following structure is used to pass information between the
+ * 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 */
+} TclEvalObjvInternalData;
+
+
+/*
* Static procedures in this file:
*/
@@ -3201,6 +3219,272 @@
/*
*----------------------------------------------------------------------
*
+ * TclEvalObjvInternalUnknownHandler --
+ *
+ * Called to handle an unknown command being invoked. This calls a
+ * procedure called "::unknown" if it exists, or generates a standard
+ * error message.
+ *
+ * Results:
+ * The return value is the result of calling the ::unknown procedure,
+ * or TCL_ERROR if no such procedure exists.
+ *
+ * Side effects:
+ * Depends on the ::unknown command. Alters fields in "data".
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclEvalObjvInternalUnknownHandler(
+ Tcl_Interp *interp,
+ TclEvalObjvInternalData *data)
+{
+ Tcl_Obj **newObjv;
+ Command *cmdPtr;
+ Interp *iPtr = (Interp *)interp;
+ int i;
+
+ newObjv = (Tcl_Obj **)
+ ckalloc((unsigned) ((data->objc + 1) * sizeof(Tcl_Obj *)));
+ for (i = data->objc-1; i >= 0; i--) {
+ newObjv[i+1] = data->objv[i];
+ }
+ newObjv[0] = Tcl_NewStringObj("::unknown", -1);
+ Tcl_IncrRefCount(newObjv[0]);
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
+
+ if (cmdPtr == NULL) {
+ Tcl_AppendResult(interp, "invalid command name \"",
+ Tcl_GetString(data->objv[0]), "\"", (char *) NULL);
+ data->code = TCL_ERROR;
+ } else {
+ iPtr->numLevels++;
+ data->code = TclEvalObjvInternal(interp, data->objc+1, newObjv,
+ data->command, data->length, 0);
+ iPtr->numLevels--;
+ }
+ Tcl_DecrRefCount(newObjv[0]);
+ ckfree((char *) newObjv);
+
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternalLookupCommand --
+ *
+ * Locates the Command structure corresponding to the invocation in
+ * data->objv. Takes care of firing execution enter traces and
+ * adjusting the lookup as a result. If the command cannot be found,
+ * then invokes the UnknownHandler.
+ *
+ * Results:
+ * The Command structure is left in data->cmdPtr.
+ *
+ * Side effects:
+ * Fires any execution enter traces associated with the command, as
+ * these may affect the lookup process.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclEvalObjvInternalLookupCommand(
+ Tcl_Interp *interp,
+ TclEvalObjvInternalData *data)
+{
+ Interp *iPtr = (Interp *)interp;
+ CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
+ * TCL_EVAL_GLOBAL was set. */
+ int checkTraces;
+ int cmdEpoch;
+
+ /*
+ * 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) {
+
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (data->flags & (TCL_EVAL_INVOKE | TCL_EVAL_GLOBAL)) {
+ iPtr->varFramePtr = NULL;
+ }
+ data->cmdPtr = (Command *) Tcl_GetCommandFromObj(interp,
+ data->objv[0]);
+ iPtr->varFramePtr = savedVarFramePtr;
+
+ if (data->cmdPtr == NULL) {
+ /*
+ * Unknown command.
+ */
+ TclEvalObjvInternalUnknownHandler(interp, data);
+ break;
+ } else if (checkTraces) {
+ cmdEpoch = data->cmdPtr->cmdEpoch;
+
+ TclEvalObjvInternalTraceEnter(interp, data);
+
+ if (cmdEpoch == data->cmdPtr->cmdEpoch) {
+ /* Trace didn't alter command, so avoid re-lookup */
+ break;
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclEvalObjvInternalInvokeCommand --
+ *
+ * Takes care of actually invoking a command, found previously by
+ * TclEvalObjvInternalLookupCommand. Assumes data->cmdPtr is non-NULL.
+ *
+ * Results:
+ * Sets data->code to result of command invocation, and also returns
+ * this result.
+ *
+ * Side effects:
+ * Depends on command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclEvalObjvInternalInvokeCommand(
+ Tcl_Interp *interp,
+ TclEvalObjvInternalData *data)
+{
+ Interp *iPtr = (Interp *)interp;
+ CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
+ * TCL_EVAL_GLOBAL was set. */
+
+ data->cmdPtr->refCount++;
+ iPtr->cmdCount++;
+
+ if (data->code == TCL_OK && data->traceCode == TCL_OK &&
+ !Tcl_LimitExceeded(interp)) {
+
+ savedVarFramePtr = iPtr->varFramePtr;
+ if (data->flags & TCL_EVAL_GLOBAL) {
+ iPtr->varFramePtr = NULL;
+ }
+ if (!(data->flags & TCL_EVAL_INVOKE) &&
+ (iPtr->ensembleRewrite.sourceObjs != NULL) &&
+ !Tcl_IsEnsemble((Tcl_Command) data->cmdPtr)) {
+ iPtr->ensembleRewrite.sourceObjs = NULL;
+ }
+ data->code = (*data->cmdPtr->objProc)
+ (data->cmdPtr->objClientData, interp, data->objc, data->objv);
+ iPtr->varFramePtr = savedVarFramePtr;
+ }
+ if (Tcl_AsyncReady()) {
+ data->code = Tcl_AsyncInvoke(interp, data->code);
+ }
+ if (data->code == TCL_OK && Tcl_LimitReady(interp)) {
+ data->code = Tcl_LimitCheck(interp);
+ }
+
+ return data->code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+ }
+
+ return data->traceCode;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclEvalObjvInternal --
*
* This procedure evaluates a Tcl command that has already been parsed
@@ -3241,15 +3525,17 @@
* currently supported. */
{
- Command *cmdPtr;
Interp *iPtr = (Interp *) interp;
- Tcl_Obj **newObjv;
- 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;
+ TclEvalObjvInternalData data;/* Bunch of state to pass to helper funcs */
+
+ 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;
if (TclInterpReady(interp) == TCL_ERROR) {
return TCL_ERROR;
@@ -3260,125 +3546,26 @@
}
/*
- * Find the procedure to execute this command. If there isn't one, then
- * see if there is a command "unknown". If so, create a new word array
- * with "unknown" as the first word and the original command words as
- * arguments. Then call ourselves recursively to execute it.
- *
- * If caller requests, or if we're resolving the target end of an
- * interpeter alias (TCL_EVAL_INVOKE), be sure to do command name
- * resolution in the global namespace.
- *
- * If any execution traces rename or delete the current command, we may
- * need (at most) two passes here.
- */
-
- reparseBecauseOfTraces:
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & (TCL_EVAL_INVOKE | TCL_EVAL_GLOBAL)) {
- iPtr->varFramePtr = NULL;
- }
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- iPtr->varFramePtr = savedVarFramePtr;
-
- if (cmdPtr == NULL) {
- newObjv = (Tcl_Obj **)
- ckalloc((unsigned) ((objc + 1) * sizeof(Tcl_Obj *)));
- for (i = objc-1; i >= 0; i--) {
- newObjv[i+1] = objv[i];
- }
- newObjv[0] = Tcl_NewStringObj("::unknown", -1);
- Tcl_IncrRefCount(newObjv[0]);
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
- if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[0]), "\"", (char *) NULL);
- code = TCL_ERROR;
- } else {
- iPtr->numLevels++;
- code = TclEvalObjvInternal(interp, objc+1, newObjv,
- command, length, 0);
- iPtr->numLevels--;
- }
- Tcl_DecrRefCount(newObjv[0]);
- ckfree((char *) newObjv);
- goto done;
- }
-
- /*
- * Call trace procedures if needed.
+ * Lookup command and fire any execution enter traces.
*/
-
- if ((checkTraces) && (command != NULL)) {
- int cmdEpoch = cmdPtr->cmdEpoch;
- cmdPtr->refCount++;
-
+ TclEvalObjvInternalLookupCommand(interp, &data);
+ if (data.cmdPtr == NULL) {
/*
- * 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.
+ * Invoked unknown command handler.
*/
-
- 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;
- }
+ goto done;
}
/*
* Finally, invoke the command's Tcl_ObjCmdProc.
*/
-
- cmdPtr->refCount++;
- iPtr->cmdCount++;
- if (code == TCL_OK && traceCode == TCL_OK && !Tcl_LimitExceeded(interp)) {
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
- }
- if (!(flags & TCL_EVAL_INVOKE) &&
- (iPtr->ensembleRewrite.sourceObjs != NULL) &&
- !Tcl_IsEnsemble((Tcl_Command) cmdPtr)) {
- iPtr->ensembleRewrite.sourceObjs = NULL;
- }
- code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
- iPtr->varFramePtr = savedVarFramePtr;
- }
- if (Tcl_AsyncReady()) {
- code = Tcl_AsyncInvoke(interp, code);
- }
- if (code == TCL_OK && Tcl_LimitReady(interp)) {
- code = Tcl_LimitCheck(interp);
- }
+ TclEvalObjvInternalInvokeCommand(interp, &data);
/*
* Call '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
@@ -3386,8 +3573,8 @@
* be set correctly by the call to TraceExecutionProc.
*/
- if (traceCode != TCL_OK) {
- code = traceCode;
+ if (data.traceCode != TCL_OK) {
+ data.code = data.traceCode;
}
/*
@@ -3402,7 +3589,7 @@
}
done:
- return code;
+ return data.code;
}
/*
