summaryrefslogtreecommitdiffstats
path: root/generic/tclInterp.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclInterp.c')
-rw-r--r--generic/tclInterp.c63
1 files changed, 60 insertions, 3 deletions
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index f6f53f2..4521b50 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.54 2004/12/02 15:31:28 dkf Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.55 2004/12/16 19:36:34 dkf Exp $
*/
#include "tclInt.h"
@@ -246,6 +246,7 @@ static void DeleteScriptLimitCallback _ANSI_ARGS_((
ClientData clientData));
static void RunLimitHandlers _ANSI_ARGS_((LimitHandler *handlerPtr,
Tcl_Interp *interp));
+static void TimeLimitCallback _ANSI_ARGS_((ClientData clientData));
/*
@@ -2946,7 +2947,7 @@ Tcl_MakeSafe(interp)
*
* Tcl_LimitExceeded --
*
- * Tests whether any limit has been exceededin the given
+ * Tests whether any limit has been exceeded in the given
* interpreter (i.e. whether the interpreter is currently unable
* to process further scripts).
*
@@ -3073,7 +3074,7 @@ Tcl_LimitCheck(interp)
iPtr->limit.exceeded |= TCL_LIMIT_TIME;
Tcl_Preserve(interp);
RunLimitHandlers(iPtr->limit.timeHandlers, interp);
- if (iPtr->limit.time.sec >= now.sec ||
+ if (iPtr->limit.time.sec > now.sec ||
(iPtr->limit.time.sec == now.sec &&
iPtr->limit.time.usec >= now.usec)) {
iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
@@ -3415,6 +3416,16 @@ TclLimitRemoveAllHandlers(interp)
ckfree((char *) handlerPtr);
}
}
+
+ /*
+ * Delete the timer callback that is used to trap limits that
+ * occur in [vwait]s...
+ */
+
+ if (iPtr->limit.timeEvent != NULL) {
+ Tcl_DeleteTimerHandler(iPtr->limit.timeEvent);
+ iPtr->limit.timeEvent = NULL;
+ }
}
/*
@@ -3611,14 +3622,59 @@ Tcl_LimitSetTime(interp, timeLimitPtr)
Tcl_Time *timeLimitPtr;
{
Interp *iPtr = (Interp *) interp;
+ Tcl_Time nextMoment;
memcpy(&iPtr->limit.time, timeLimitPtr, sizeof(Tcl_Time));
+ if (iPtr->limit.timeEvent != NULL) {
+ Tcl_DeleteTimerHandler(iPtr->limit.timeEvent);
+ }
+ nextMoment.sec = timeLimitPtr->sec;
+ nextMoment.usec = timeLimitPtr->usec+10;
+ if (nextMoment.usec >= 1000000) {
+ nextMoment.sec++;
+ nextMoment.usec -= 1000000;
+ }
+ iPtr->limit.timeEvent = TclCreateAbsoluteTimerHandler(&nextMoment,
+ TimeLimitCallback, (ClientData) interp);
iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
}
/*
*----------------------------------------------------------------------
*
+ * TimeLimitCallback --
+ *
+ * Callback that allows time limits to be enforced even when
+ * doing a blocking wait for events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May put the interpreter into a state where it can no longer
+ * execute commands. May make callbacks into other interpreters.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TimeLimitCallback(clientData)
+ ClientData clientData;
+{
+ Tcl_Interp *interp = (Tcl_Interp *) clientData;
+
+ Tcl_Preserve((ClientData) interp);
+ ((Interp *)interp)->limit.timeEvent = NULL;
+ if (Tcl_LimitCheck(interp) != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (while waiting for event)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_LimitGetTime --
*
* Get the current time limit.
@@ -3928,6 +3984,7 @@ TclInitLimitSupport(interp)
iPtr->limit.cmdGranularity = 1;
memset(&iPtr->limit.time, 0, sizeof(Tcl_Time));
iPtr->limit.timeHandlers = NULL;
+ iPtr->limit.timeEvent = NULL;
iPtr->limit.timeGranularity = 10;
Tcl_InitHashTable(&iPtr->limit.callbacks,
sizeof(struct ScriptLimitCallbackKey)/sizeof(int));