diff options
Diffstat (limited to 'generic/tclTimer.c')
| -rw-r--r-- | generic/tclTimer.c | 34 |
1 files changed, 32 insertions, 2 deletions
diff --git a/generic/tclTimer.c b/generic/tclTimer.c index f7da3c4..db9f6a8 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTimer.c,v 1.32 2008/04/27 22:21:32 dkf Exp $ + * RCS: @(#) $Id: tclTimer.c,v 1.33 2008/06/13 05:45:14 mistachkin Exp $ */ #include "tclInt.h" @@ -130,6 +130,14 @@ static Tcl_ThreadDataKey dataKey; ((long)(t1).usec - (long)(t2).usec)/1000) /* + * The maximum number of milliseconds for each Tcl_Sleep call in AfterDelay. + * This is used to limit the maximum lag between interp limit and script + * cancellation checks. + */ + +#define TCL_TIME_MAXIMUM_SLICE 500 + +/* * Prototypes for functions referenced only in this file: */ @@ -980,7 +988,7 @@ Tcl_AfterObjCmd( * * Results: * Standard Tcl result code (with error set if an error occurred due to a - * time limit being exceeded). + * time limit being exceeded or being canceled). * * Side effects: * May adjust the time limit granularity marker. @@ -1008,6 +1016,14 @@ AfterDelay( do { Tcl_GetTime(&now); + if (Tcl_AsyncReady()) { + if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) { + return TCL_ERROR; + } + } + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + return TCL_ERROR; + } if (iPtr->limit.timeEvent != NULL && TCL_TIME_BEFORE(iPtr->limit.time, now)) { iPtr->limit.granularityTicker = 0; @@ -1023,6 +1039,9 @@ AfterDelay( diff = LONG_MAX; } #endif + if (diff > TCL_TIME_MAXIMUM_SLICE) { + diff = TCL_TIME_MAXIMUM_SLICE; + } if (diff > 0) { Tcl_Sleep((long)diff); } @@ -1033,9 +1052,20 @@ AfterDelay( diff = LONG_MAX; } #endif + if (diff > TCL_TIME_MAXIMUM_SLICE) { + diff = TCL_TIME_MAXIMUM_SLICE; + } if (diff > 0) { Tcl_Sleep((long)diff); } + if (Tcl_AsyncReady()) { + if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) { + return TCL_ERROR; + } + } + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + return TCL_ERROR; + } if (Tcl_LimitCheck(interp) != TCL_OK) { return TCL_ERROR; } |