summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c81
1 files changed, 59 insertions, 22 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6182a51..dd527fb 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.125 2004/05/12 17:43:55 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.126 2004/05/13 12:59:22 dkf Exp $
*/
#include "tclInt.h"
@@ -1011,26 +1011,39 @@ TclCompEvalObj(interp, objPtr)
}
iPtr->numLevels--;
-
/*
* If no commands at all were executed, check for asynchronous
- * handlers so that they at least get one change to execute.
- * This is needed to handle event loops written in Tcl with
- * empty bodies.
+ * handlers and resource limits so that they at least get one
+ * change to execute. This is needed to handle event loops
+ * written in Tcl with empty bodies.
*/
- if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
- result = Tcl_AsyncInvoke(interp, result);
-
+ if (oldCount == iPtr->cmdCount) {
+ if (Tcl_AsyncReady()) {
+ result = Tcl_AsyncInvoke(interp, result);
- /*
- * If an error occurred, record information about what was being
- * executed when the error occurred.
- */
-
- if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
+ /*
+ * If an error occurred, record information about what was
+ * being executed when the error occurred.
+ */
+
+ if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
+ }
+ }
+ if (result==TCL_OK && Tcl_LimitReady(interp)) {
+ result = Tcl_LimitCheck(interp);
+
+ /*
+ * If an error occurred, record information about what was
+ * being executed when the error occurred.
+ */
+
+ if (result==TCL_ERROR && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
+ }
}
}
@@ -1229,12 +1242,22 @@ TclExecuteByteCode(interp, codePtr)
* of the form (2**n-1).
*/
- if (!(instructionCount++ & ASYNC_CHECK_COUNT_MASK) && Tcl_AsyncReady()) {
- DECACHE_STACK_INFO();
- result = Tcl_AsyncInvoke(interp, result);
- CACHE_STACK_INFO();
- if (result == TCL_ERROR) {
- goto checkForCatch;
+ if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
+ if (Tcl_AsyncReady()) {
+ DECACHE_STACK_INFO();
+ result = Tcl_AsyncInvoke(interp, result);
+ CACHE_STACK_INFO();
+ if (result == TCL_ERROR) {
+ goto checkForCatch;
+ }
+ }
+ if (Tcl_LimitReady(interp)) {
+ DECACHE_STACK_INFO();
+ result = Tcl_LimitCheck(interp);
+ CACHE_STACK_INFO();
+ if (result == TCL_ERROR) {
+ goto checkForCatch;
+ }
}
}
@@ -4558,6 +4581,20 @@ TclExecuteByteCode(interp, codePtr)
iPtr->flags |= ERR_ALREADY_LOGGED;
}
}
+ /*
+ * We must not catch an exceeded limit. Instead, it blows
+ * outwards until we either hit another interpreter (presumably
+ * where the limit is not exceeded) or we get to the top-level.
+ */
+ if (Tcl_LimitExceeded(interp)) {
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, " ... limit exceeded, returning %s\n",
+ StringForResultCode(result));
+ }
+#endif
+ goto abnormalReturn;
+ }
if (catchTop == initCatchTop) {
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {