Attachment "teovi.patch" to
ticket [1904111fff]
added by
msofer
2008-02-29 00:12:08.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.250
diff -u -r1.250 tcl.h
--- generic/tcl.h 13 Feb 2008 18:00:33 -0000 1.250
+++ generic/tcl.h 28 Feb 2008 17:05:35 -0000
@@ -981,11 +981,15 @@
* o Cut out of error traces
* o Don't reset the flags controlling ensemble
* error message rewriting.
+ * TCL_EVAL_NOERR absolutely no exception or error reporting
+ * should be done, it is managed by the caller.
*/
+
#define TCL_NO_EVAL 0x10000
#define TCL_EVAL_GLOBAL 0x20000
#define TCL_EVAL_DIRECT 0x40000
#define TCL_EVAL_INVOKE 0x80000
+#define TCL_EVAL_NOERR 0x100000
/*
* Special freeProc values that may be passed to Tcl_SetResult (see the man
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.291
diff -u -r1.291 tclBasic.c
--- generic/tclBasic.c 23 Jan 2008 21:21:26 -0000 1.291
+++ generic/tclBasic.c 28 Feb 2008 17:05:37 -0000
@@ -10,6 +10,7 @@
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
* Copyright (c) 2007 Daniel A. Steffen <[email protected]>
+ * Copyright (c) 2008 Miguel Sofer <[email protected]>
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -55,8 +56,8 @@
static int CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void DeleteInterpProc(Tcl_Interp *interp);
static void DeleteOpCmdClientData(ClientData clientData);
-static Tcl_Obj *GetCommandSource(Interp *iPtr, const char *command,
- int numChars, int objc, Tcl_Obj *const objv[]);
+static Tcl_Obj *GetCommandSource(Interp *iPtr, int objc,
+ Tcl_Obj *const objv[], int lookup);
static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode);
static int OldMathFuncProc(ClientData clientData, Tcl_Interp *interp,
int argc, Tcl_Obj *const *objv);
@@ -100,6 +101,28 @@
extern TclStubs tclStubs;
+
+/*
+ * Block for NRE-related things
+ */
+
+static int TEOVI_Exception(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
+ int result, int flags);
+
+static int TEOVI_NotFound(Tcl_Interp *interp, Tcl_Obj *commandPtr,
+ Namespace *lookupNsPtr);
+
+static int TEOVI_RunEnterTraces(Tcl_Interp *interp, Command **cmdPtrPtr,
+ Tcl_Obj **commandPtrPtr, Namespace *lookupNsPtr);
+
+static int TEOVI_RunLeaveTraces(Tcl_Interp *interp, Command *cmdPtr,
+ Tcl_Obj*commandPtr, int code);
+
+static inline Command *
+ TEOVI_LookupCmdFromObj(Tcl_Interp *interp, Tcl_Obj *namePtr,
+ Namespace *lookupNsPtr);
+
+
/*
* The following structure define the commands in the Tcl core.
*/
@@ -2962,18 +2985,32 @@
static Tcl_Obj *
GetCommandSource(
Interp *iPtr,
- const char *command,
- int numChars,
int objc,
- Tcl_Obj *const objv[])
+ Tcl_Obj *const objv[],
+ int lookup)
{
- if (!command) {
- return Tcl_NewListObj(objc, objv);
- }
- if (command == (char *) -1) {
- command = TclGetSrcInfoForCmd(iPtr, &numChars);
+ Tcl_Obj *objPtr;
+ CmdFrame *cfPtr = iPtr->cmdFramePtr;
+ const char *command = NULL;
+ int numChars;
+
+ objPtr = Tcl_NewListObj(objc, objv);
+ if (lookup) {
+ if (cfPtr && cfPtr->data.tebc.codePtr) {
+ command = TclGetSrcInfoForCmd(iPtr, &numChars);
+ } else if(cfPtr && cfPtr->cmd.str.cmd) {
+ command = cfPtr->cmd.str.cmd;
+ numChars = cfPtr->cmd.str.len;
+ }
+ if (command) {
+ Tcl_Obj *obj2Ptr = Tcl_NewStringObj(command, numChars);
+ objPtr->bytes = obj2Ptr->bytes;
+ objPtr->length = numChars;
+ obj2Ptr->bytes = NULL;
+ Tcl_DecrRefCount(obj2Ptr);
+ }
}
- return Tcl_NewStringObj(command, numChars);
+ return objPtr;
}
/*
@@ -3449,20 +3486,14 @@
/*
*----------------------------------------------------------------------
*
- * TclEvalObjvInternal
+ * Tcl_EvalObjv --
*
* 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.
- *
- * TclEvalObjvInternal is the backend for Tcl_EvalObjv, the bytecode
- * engine also calls it directly.
+ * into words, with one Tcl_Obj holding each word.
*
* 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.
+ * TCL_ERROR. A result or error message is left in interp's result.
*
* Side effects:
* Depends on the command.
@@ -3471,147 +3502,94 @@
*/
int
-TclEvalObjvInternal(
+Tcl_EvalObjv(
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. NULL if the string
- * representation of the command is unknown is
- * to be generated from (objc,objv), -1 if it
- * is to be generated from bytecode
- * source. This is only needed the traces. */
- 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. */
+ * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
+ * TCL_EVAL_NOERR are currently supported. */
{
Command *cmdPtr;
Interp *iPtr = (Interp *) interp;
- Tcl_Obj **newObjv;
- int i;
CallFrame *savedVarFramePtr = NULL;
CallFrame *varFramePtr = iPtr->varFramePtr;
- int code = TCL_OK;
- int traceCode = TCL_OK;
- int checkTraces = 1, traced;
- Namespace *savedNsPtr = NULL;
+ int result = TCL_OK;
Namespace *lookupNsPtr = iPtr->lookupNsPtr;
Tcl_Obj *commandPtr = NULL;
-
+ int traceCode = TCL_OK;
+
+ iPtr->numLevels++;
if (TclInterpReady(interp) == TCL_ERROR) {
+ iPtr->numLevels--;
return TCL_ERROR;
}
if (objc == 0) {
+ iPtr->numLevels--;
return TCL_OK;
}
/*
- * If any execution traces rename or delete the current command, we may
- * need (at most) two passes here.
- */
-
- reparseBecauseOfTraces:
-
- /*
* Configure evaluation context to match the requested flags.
*/
- if (flags) {
- if (flags & TCL_EVAL_INVOKE) {
- savedNsPtr = varFramePtr->nsPtr;
- if (lookupNsPtr) {
- varFramePtr->nsPtr = lookupNsPtr;
- iPtr->lookupNsPtr = NULL;
- } else {
- varFramePtr->nsPtr = iPtr->globalNsPtr;
- }
- } else if ((flags & TCL_EVAL_GLOBAL)
- && (varFramePtr != iPtr->rootFramePtr) && !savedVarFramePtr) {
- varFramePtr = iPtr->rootFramePtr;
- savedVarFramePtr = iPtr->varFramePtr;
- iPtr->varFramePtr = varFramePtr;
- }
- }
-
- /*
- * 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.
- */
-
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- if (!cmdPtr) {
- goto notFound;
+ if ((flags & TCL_EVAL_GLOBAL) && !(flags & TCL_EVAL_INVOKE)) {
+ varFramePtr = iPtr->rootFramePtr;
+ savedVarFramePtr = iPtr->varFramePtr;
+ iPtr->varFramePtr = varFramePtr;
+ lookupNsPtr = iPtr->globalNsPtr;
}
- if (savedNsPtr) {
- varFramePtr->nsPtr = savedNsPtr;
+ if (flags & TCL_EVAL_INVOKE) {
+ if (!lookupNsPtr) {
+ lookupNsPtr = iPtr->globalNsPtr;
+ }
} else if (iPtr->ensembleRewrite.sourceObjs) {
/*
* TCL_EVAL_INVOKE was not set: clear rewrite rules
*/
-
+
iPtr->ensembleRewrite.sourceObjs = NULL;
}
+ iPtr->lookupNsPtr = NULL;
- /*
- * Call trace functions if needed.
- */
-
- traced = (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES));
- if (traced && checkTraces) {
- int cmdEpoch = cmdPtr->cmdEpoch;
- int newEpoch;
-
- /*
- * Insure that we have a correct nul-terminated command string for the
- * trace code.
- */
-
- commandPtr = GetCommandSource(iPtr, command, length, objc, objv);
- command = TclGetStringFromObj(commandPtr, &length);
+ cmdPtr = TEOVI_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+ if (!cmdPtr) {
+ commandPtr = GetCommandSource(iPtr, objc, objv, 0);
+ notFound:
+ result = TEOVI_NotFound(interp, commandPtr, lookupNsPtr);
+ goto cleanup;
+ }
+ if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
/*
- * Execute any command or execution traces. Note that we bump up the
- * command's reference count for the duration of the calling of the
- * traces so that the structure doesn't go away underneath our feet.
+ * Call enter traces; note that this ALWAYS replaces command with a
+ * pointer to a string that we must ckfree ourselves, and MAY replace
+ * cmdPtr.
*/
-
- cmdPtr->refCount++;
- if (iPtr->tracePtr && (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);
+
+ commandPtr = GetCommandSource(iPtr, objc, objv, 1);
+ traceCode = TEOVI_RunEnterTraces(interp, &cmdPtr, &commandPtr, lookupNsPtr);
+ if (!cmdPtr) {
+ TclInvalidateStringRep(commandPtr);
+ goto notFound;
}
- newEpoch = cmdPtr->cmdEpoch;
- TclCleanupCommandMacro(cmdPtr);
-
+
/*
- * If the traces modified/deleted the command or any existing traces,
- * they will update the command's epoch. When that happens, set
- * checkTraces is set to 0 to prevent the re-calling of traces (and
- * any possible infinite loop) and we go back to re-find the command
- * implementation.
+ * From this point on commandPtr is set exactly if the command is
+ * traced, and RunEnterTraces encoded ALL INFO for RunLeaveTrace in
+ * it. We rely on its presence to signal the need for trace
+ * processing.
*/
-
- if (cmdEpoch != newEpoch) {
- checkTraces = 0;
- goto reparseBecauseOfTraces;
- }
}
+
+ /*
+ * Found a command! The real work begins now ...
+ */
if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
char *a[10];
@@ -3638,52 +3616,37 @@
cmdPtr->refCount++;
iPtr->cmdCount++;
- if (code == TCL_OK && traceCode == TCL_OK
- && !TclLimitExceeded(iPtr->limit)) {
+ if (result == TCL_OK && !TclLimitExceeded(iPtr->limit) && traceCode == TCL_OK) {
if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
(Tcl_Obj **)(objv + 1));
}
- code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
- TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
+ TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), result);
}
}
if (TclAsyncReady(iPtr)) {
- code = Tcl_AsyncInvoke(interp, code);
+ result = Tcl_AsyncInvoke(interp, result);
}
- if (code == TCL_OK && TclLimitReady(iPtr->limit)) {
- code = Tcl_LimitCheck(interp);
+ if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
+ result = Tcl_LimitCheck(interp);
}
/*
- * Call 'leave' command traces
+ * Call 'leave' command traces. If one of the trace invocation resulted in
+ * error, then change result code accordingly. Note, that the
+ * interp->result should already be set correctly by the call to
+ * TraceExecutionProc.
*/
-
- if (traced) {
- 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);
- }
- }
-
- /*
- * If one of the trace invocation resulted in error, then change the
- * result code accordingly. Note, that the interp->result should
- * already be set correctly by the call to TraceExecutionProc.
- */
-
+
+ if (commandPtr) {
+ int traceCode;
+
+ traceCode = TEOVI_RunLeaveTraces(interp, cmdPtr, commandPtr, result);
if (traceCode != TCL_OK) {
- code = traceCode;
- }
- if (commandPtr) {
- Tcl_DecrRefCount(commandPtr);
+ result = traceCode;
}
}
@@ -3693,194 +3656,348 @@
*/
TclCleanupCommandMacro(cmdPtr);
-
+
/*
* If the interpreter has a non-empty string result, the result object is
* either empty or stale because some function set interp->result
* directly. If so, move the string result to the result object, then
* reset the string result.
*/
-
+
if (*(iPtr->result) != 0) {
(void) Tcl_GetObjResult(interp);
}
if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
Tcl_Obj *r;
-
+
r = Tcl_GetObjResult(interp);
- TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r),r);
+ TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), result, TclGetString(r),r);
}
-
- done:
+
+ cleanup:
if (savedVarFramePtr) {
iPtr->varFramePtr = savedVarFramePtr;
}
- return code;
-
- notFound:
- {
- 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;
-
- currNsPtr = varFramePtr->nsPtr;
- if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
- currNsPtr = iPtr->globalNsPtr;
- if (currNsPtr == NULL) {
- Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
- }
- }
-
- /*
- * Check to see if the resolution namespace has lost its unknown
- * handler. If so, reset it to "::unknown".
- */
-
- if (currNsPtr->unknownHandlerPtr == NULL) {
- TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
- Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
- }
-
- /*
- * Get the list of words for the unknown handler and allocate enough
- * space to hold both the handler prefix and all words of the command
- * invokation itself.
- */
-
- Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
- &handlerObjc, &handlerObjv);
- newObjc = objc + handlerObjc;
- newObjv = (Tcl_Obj **) TclStackAlloc(interp,
- (int) sizeof(Tcl_Obj *) * newObjc);
-
- /*
- * Copy command prefix from unknown handler and add on the real
- * command's full argument list. Note that we only use memcpy() once
- * because we have to increment the reference count of all the handler
- * arguments anyway.
- */
-
- for (i = 0; i < handlerObjc; ++i) {
- newObjv[i] = handlerObjv[i];
- Tcl_IncrRefCount(newObjv[i]);
- }
- memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
-
- /*
- * Look up and invoke the handler (by recursive call to this
- * function). If there is no handler at all, instead of doing the
- * recursive call we just generate a generic error message; it would
- * be an infinite-recursion nightmare otherwise.
- */
-
- 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--;
- }
-
- /*
- * Release any resources we locked and allocated during the handler
- * call.
- */
+ iPtr->numLevels--;
- for (i = 0; i < handlerObjc; ++i) {
- Tcl_DecrRefCount(newObjv[i]);
- }
- TclStackFree(interp, newObjv);
- if (savedNsPtr) {
- varFramePtr->nsPtr = savedNsPtr;
- }
- goto done;
+ if ((result == TCL_OK) || (flags & TCL_EVAL_NOERR)) {
+ return result;
+ } else {
+ return TEOVI_Exception(interp, objc, objv, result, flags);
}
}
/*
*----------------------------------------------------------------------
*
- * Tcl_EvalObjv --
- *
- * This function evaluates a Tcl command that has already been parsed
- * into words, with one Tcl_Obj holding each word.
+ * TEOVI_Exception -
+ * TEOVI_LookupCmdFromObj -
+ * TEOVI_RunEnterTraces -
+ * TEOVI_RunLeaveTraces -
+ * TEOVI_NotFound -
*
- * 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.
- *
- * Side effects:
- * Depends on the command.
+ * These are helper functions for Tcl_EvalObjv.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_EvalObjv(
- 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. */
- 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
+TEOVI_Exception(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[],
+ int result,
+ int flags)
+{
+ Interp *iPtr = (Interp *) interp;
+ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
+
+ /*
+ * If we are again at the top level, process any unusual return code
+ * returned by the evaluated code.
+ */
+
+ if (iPtr->numLevels == 0) {
+ if (result == TCL_RETURN) {
+ result = TclUpdateReturnInfo(iPtr);
+ }
+ if ((result != TCL_ERROR) && !allowExceptions) {
+ ProcessUnexpectedResult(interp, result);
+ result = TCL_ERROR;
+ }
+ }
+
+ if ((result == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
+ /*
+ * If there was an error, a command string will be needed for the
+ * error log: generate it now. Do not worry too much about doing
+ * it expensively.
+ */
+
+ Tcl_Obj *listPtr;
+ char *cmdString;
+ int cmdLen;
+
+ listPtr = Tcl_NewListObj(objc, objv);
+ cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
+ Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
+ Tcl_DecrRefCount(listPtr);
+ }
+
+ return result;
+}
+
+
+static int
+TEOVI_NotFound(
+ Tcl_Interp *interp,
+ Tcl_Obj*commandPtr,
+ Namespace *lookupNsPtr)
{
+ Command * cmdPtr;
Interp *iPtr = (Interp *) interp;
+ Tcl_Obj **newObjv;
+ int i;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
int code = TCL_OK;
+ 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;
+ Namespace *savedNsPtr = NULL;
+ char *command;
+ int length, objc;
+ Tcl_Obj **objv;
- iPtr->numLevels++;
- code = TclEvalObjvInternal(interp, objc, objv, NULL, 0, flags);
- iPtr->numLevels--;
+ command = Tcl_GetStringFromObj(commandPtr, &length);
+ code = Tcl_ListObjGetElements(interp, commandPtr, &objc, &objv);
+ if (code != TCL_OK) {
+ Tcl_Panic("Who messed with commandPtr?");
+ }
+
+ currNsPtr = varFramePtr->nsPtr;
+ if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
+ currNsPtr = iPtr->globalNsPtr;
+ if (currNsPtr == NULL) {
+ Tcl_Panic("Tcl_EvalObjv: NULL global namespace pointer");
+ }
+ }
- if (code == TCL_OK) {
- return code;
- } else {
- int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
+ /*
+ * Check to see if the resolution namespace has lost its unknown
+ * handler. If so, reset it to "::unknown".
+ */
- /*
- * If we are again at the top level, process any unusual return code
- * returned by the evaluated code.
- */
+ if (currNsPtr->unknownHandlerPtr == NULL) {
+ TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
+ Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
+ }
+
+ /*
+ * Get the list of words for the unknown handler and allocate enough
+ * space to hold both the handler prefix and all words of the command
+ * invokation itself.
+ */
+
+ Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
+ &handlerObjc, &handlerObjv);
+ newObjc = objc + handlerObjc;
+ newObjv = (Tcl_Obj **) TclStackAlloc(interp,
+ (int) sizeof(Tcl_Obj *) * newObjc);
+
+ /*
+ * Copy command prefix from unknown handler and add on the real
+ * command's full argument list. Note that we only use memcpy() once
+ * because we have to increment the reference count of all the handler
+ * arguments anyway.
+ */
+
+ for (i = 0; i < handlerObjc; ++i) {
+ newObjv[i] = handlerObjv[i];
+ Tcl_IncrRefCount(newObjv[i]);
+ }
+ memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
+
+ /*
+ * Look up and invoke the handler (by recursive call to this
+ * function). If there is no handler at all, instead of doing the
+ * recursive call we just generate a generic error message; it would
+ * be an infinite-recursion nightmare otherwise.
+ *
+ * In this case we worry a bit less about recursion for now, and call
+ * the "blocking" interface.
+ */
+
+ cmdPtr = TEOVI_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
+ if (cmdPtr == NULL) {
+ Tcl_AppendResult(interp, "invalid command name \"",
+ TclGetString(objv[0]), "\"", NULL);
+ code = TCL_ERROR;
+ } else {
+ if (lookupNsPtr) {
+ savedNsPtr = varFramePtr->nsPtr;
+ varFramePtr->nsPtr = lookupNsPtr;
+ }
+ code = Tcl_EvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR);
+ if (savedNsPtr) {
+ varFramePtr->nsPtr = savedNsPtr;
+ }
+ }
+
+ /*
+ * Release any resources we locked and allocated during the handler
+ * call.
+ */
+
+ for (i = 0; i < handlerObjc; ++i) {
+ Tcl_DecrRefCount(newObjv[i]);
+ }
+ TclStackFree(interp, newObjv);
+ Tcl_DecrRefCount(commandPtr);
+ return code;
+}
- if (iPtr->numLevels == 0) {
- if (code == TCL_RETURN) {
- code = TclUpdateReturnInfo(iPtr);
+static int
+TEOVI_RunLeaveTraces(
+ Tcl_Interp *interp,
+ Command *cmdPtr,
+ Tcl_Obj*commandPtr,
+ int code)
+{
+ Interp *iPtr = (Interp *) interp;
+ int traceCode;
+ char *command;
+ int length, objc;
+ Tcl_Obj **objv;
+
+ if (commandPtr->bytes) {
+ traceCode = TCL_OK;
+ command = Tcl_GetStringFromObj(commandPtr, &length);
+ if (TCL_OK != Tcl_ListObjGetElements(interp, commandPtr, &objc, &objv)) {
+ Tcl_Panic("Who messed with commandPtr?");
+ }
+
+ 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 ((code != TCL_ERROR) && !allowExceptions) {
- ProcessUnexpectedResult(interp, code);
- code = TCL_ERROR;
+ if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
+ traceCode = TclCheckInterpTraces(interp, command, length,
+ cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
}
}
+ } else {
+ traceCode = commandPtr->length;
+ }
+
+ Tcl_DecrRefCount(commandPtr);
+ return traceCode;
+}
+
+static int
+TEOVI_RunEnterTraces(
+ Tcl_Interp *interp,
+ Command **cmdPtrPtr,
+ Tcl_Obj **commandPtrPtr,
+ Namespace *lookupNsPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ Command *cmdPtr = *cmdPtrPtr;
+ int code = TCL_OK, traceCode = TCL_OK;
+ int cmdEpoch = cmdPtr->cmdEpoch;
+ int newEpoch;
+ char *command;
+ int length, objc;
+ Tcl_Obj **objv;
+ Tcl_Obj *commandPtr = *commandPtrPtr;
+
+ /*
+ * We actually should teach the trace code to deal with this
+ * "command, length, objc, objv packed in a Tcl_Obj" thingy - maybe get
+ * their own type for that. Some other time ...
+ */
+
+ command = Tcl_GetStringFromObj(commandPtr, &length);
+ code = Tcl_ListObjGetElements(interp, commandPtr, &objc, &objv);
+ if (code != TCL_OK) {
+ Tcl_Panic("Who messed with commandPtr?");
+ }
+
+ /*
+ * Call trace functions
+ * Execute any command or execution traces. Note that we bump up the
+ * command's reference count for the duration of the calling of the
+ * traces so that the structure doesn't go away underneath our feet.
+ */
+
+ cmdPtr->refCount++;
+ if (iPtr->tracePtr && (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);
+ }
+ newEpoch = cmdPtr->cmdEpoch;
+ 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 = TEOVI_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
+ *cmdPtrPtr = cmdPtr;
+ }
- if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
+ if (cmdPtr) {
+ if (!iPtr->tracePtr && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
/*
- * If there was an error, a command string will be needed for the
- * error log: generate it now. Do not worry too much about doing
- * it expensively.
+ * No more traces: signal by setting cmdPtr to NULL
*/
-
- Tcl_Obj *listPtr;
- char *cmdString;
- int cmdLen;
-
- listPtr = Tcl_NewListObj(objc, objv);
- cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
- Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
- Tcl_DecrRefCount(listPtr);
+
+ Tcl_DecrRefCount(commandPtr);
+ commandPtr = NULL;
+ } else if (traceCode != TCL_OK) {
+ /*
+ * Command was found, but traceCode is not TCL_OK: leave all
+ * necessary info for RunLeaveTraces, which is JUST the
+ * traceCode.
+ */
+
+ Tcl_DecrRefCount(commandPtr);
+ commandPtr = Tcl_NewObj();
+ commandPtr->bytes = NULL;
+ commandPtr->length = traceCode;
}
-
- return code;
}
+ *commandPtrPtr = commandPtr;
+ return traceCode;
+}
+
+static inline Command *
+TEOVI_LookupCmdFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *namePtr,
+ Namespace *lookupNsPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ Command *cmdPtr;
+ Namespace *savedNsPtr = iPtr->varFramePtr->nsPtr;
+
+ if (lookupNsPtr) {
+ iPtr->varFramePtr->nsPtr = lookupNsPtr;
+ }
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr);
+ iPtr->varFramePtr->nsPtr = savedNsPtr;
+ return cmdPtr;
}
/*
@@ -4290,10 +4407,7 @@
eeFramePtr->line = lines;
iPtr->cmdFramePtr = eeFramePtr;
- iPtr->numLevels++;
- code = TclEvalObjvInternal(interp, objectsUsed, objv,
- parsePtr->commandStart, parsePtr->commandSize, 0);
- iPtr->numLevels--;
+ code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR);
iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
eeFramePtr->line = NULL;
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.90
diff -u -r1.90 tclCompile.h
--- generic/tclCompile.h 26 Feb 2008 20:28:59 -0000 1.90
+++ generic/tclCompile.h 28 Feb 2008 17:05:37 -0000
@@ -827,15 +827,6 @@
/*
*----------------------------------------------------------------
- * Procedures exported by tclBasic.c to be used within the engine.
- *----------------------------------------------------------------
- */
-
-MODULE_SCOPE int TclEvalObjvInternal(Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[],
- CONST char *command, int length, int flags);
-/*
- *----------------------------------------------------------------
* Procedures exported by the engine to be used by tclBasic.c
*----------------------------------------------------------------
*/
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.363
diff -u -r1.363 tclExecute.c
--- generic/tclExecute.c 4 Feb 2008 20:24:55 -0000 1.363
+++ generic/tclExecute.c 28 Feb 2008 17:05:40 -0000
@@ -1337,7 +1337,6 @@
* performance is noticeable.
*/
- iPtr->numLevels++;
if (TclInterpReady(interp) == TCL_ERROR) {
result = TCL_ERROR;
goto done;
@@ -1425,7 +1424,6 @@
goto runCompiledObj;
done:
- iPtr->numLevels--;
return result;
}
@@ -2237,13 +2235,13 @@
/*
* Reset the instructionCount variable, since we're about to check
- * for async stuff anyway while processing TclEvalObjvInternal.
+ * for async stuff anyway while processing Tcl_EvalObjv.
*/
instructionCount = 1;
/*
- * Finally, let TclEvalObjvInternal handle the command.
+ * Finally, let Tcl_EvalObjv handle the command.
*
* TIP #280: Record the last piece of info needed by
* 'TclGetSrcInfoForPc', and push the frame.
@@ -2252,8 +2250,7 @@
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
DECACHE_STACK_INFO();
- result = TclEvalObjvInternal(interp, objc, objv,
- /* call from TEBC */(char *) -1, -1, 0);
+ result = Tcl_EvalObjv(interp, objc, objv, TCL_EVAL_NOERR);
CACHE_STACK_INFO();
iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.139
diff -u -r1.139 tclProc.c
--- generic/tclProc.c 13 Dec 2007 15:23:20 -0000 1.139
+++ generic/tclProc.c 28 Feb 2008 17:05:41 -0000
@@ -1701,7 +1701,6 @@
*/
procPtr->refCount++;
- iPtr->numLevels++;
if (TclInterpReady(interp) == TCL_ERROR) {
result = TCL_ERROR;
@@ -1728,7 +1727,6 @@
}
}
- iPtr->numLevels--;
procPtr->refCount--;
if (procPtr->refCount <= 0) {
TclProcCleanupProc(procPtr);
Index: generic/tclTrace.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTrace.c,v
retrieving revision 1.47
diff -u -r1.47 tclTrace.c
--- generic/tclTrace.c 13 Dec 2007 15:23:20 -0000 1.47
+++ generic/tclTrace.c 28 Feb 2008 17:05:41 -0000
@@ -1378,7 +1378,7 @@
* For instance extensions like [incr Tcl] which use their own execution
* technique can make use of Tcl's tracing.
*
- * This function is called by 'TclEvalObjvInternal'
+ * This function is called by 'TclEvalObjv'
*
* Results:
* The return value is a standard Tcl completion code such as TCL_OK or
@@ -1481,7 +1481,7 @@
* [incr Tcl] which use their own execution technique can make use of
* Tcl's tracing.
*
- * This function is called by 'TclEvalObjvInternal'
+ * This function is called by 'TclEvalObjv'
*
* Results:
* The return value is a standard Tcl completion code such as TCL_OK or
Index: unix/tclUnixInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixInit.c,v
retrieving revision 1.82
diff -u -r1.82 tclUnixInit.c
--- unix/tclUnixInit.c 13 Dec 2007 15:28:42 -0000 1.82
+++ unix/tclUnixInit.c 28 Feb 2008 17:05:42 -0000
@@ -1143,6 +1143,8 @@
{
size_t rawStackSize;
struct rlimit rLimit; /* The result from getrlimit(). */
+ int safety;
+
#ifdef TCL_THREADS
rawStackSize = TclpThreadGetStackSize();
@@ -1189,18 +1191,21 @@
#ifdef TCL_THREADS /* Stop warning... */
finalSanityCheck:
#endif
- if (rawStackSize <= 0) {
- STACK_DEBUG(("skipping stack checks with success\n"));
- return TCL_CONTINUE;
- }
/*
* Calculate a stack size with a safety margin.
*/
- *stackSizePtr = (rawStackSize / TCL_MAGIC_STACK_DIVISOR)
- - (getpagesize() * TCL_RESERVED_STACK_PAGES);
+ safety = (getpagesize() * TCL_RESERVED_STACK_PAGES);
+ rawStackSize = (rawStackSize / TCL_MAGIC_STACK_DIVISOR);
+
+
+ if (rawStackSize <= 2*safety) {
+ STACK_DEBUG(("skipping stack checks with success: raw size too small\n"));
+ return TCL_CONTINUE;
+ }
+ *stackSizePtr = rawStackSize - safety;
return TCL_OK;
}
#endif /* TCL_NO_STACK_CHECK */
