diff options
author | sebres <sebres@users.sourceforge.net> | 2017-07-03 13:24:53 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2017-07-03 13:24:53 (GMT) |
commit | d2d76748809298daff2f10a63b2999d559d129dd (patch) | |
tree | bd910745ad1a3953ca52f6367923bfd879d7abea /generic | |
parent | 0e11ffaa99da39ffd0a3eac314a1f9f848641b83 (diff) | |
download | tcl-d2d76748809298daff2f10a63b2999d559d129dd.zip tcl-d2d76748809298daff2f10a63b2999d559d129dd.tar.gz tcl-d2d76748809298daff2f10a63b2999d559d129dd.tar.bz2 |
[enhancement] extend "vwait" with same options as "update", new syntax "vwait ?options? ?timeout? varname".
some small improvements and fixing:
- Tcl_DoOneEvent can wait for block time that was set with Tcl_SetMaxBlockTime outside an event source traversal,
and stop waiting if Tcl_SetMaxBlockTime was called outside an event source (another event occurs and interrupt waiting loop), etc;
- safer more precise pre-lookup by options (use TclObjIsIndexOfTable instead of simply comparison of type with tclIndexType);
test cases extended to cover conditional "vwait" usage;
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclEvent.c | 90 | ||||
-rw-r--r-- | generic/tclIndexObj.c | 37 | ||||
-rw-r--r-- | generic/tclInt.h | 6 | ||||
-rw-r--r-- | generic/tclNotify.c | 54 | ||||
-rw-r--r-- | generic/tclTimer.c | 2 |
5 files changed, 115 insertions, 74 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 6413d10..84e4637 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1300,6 +1300,17 @@ TclInThreadExit(void) } +static CONST char *updateEventOptions[] = { + "-idle", "-noidle", /* new options */ + "-timer", "-notimer", + "-file", "-nofile", + "-window", "-nowindow", + "-async", "-noasync", + "-nowait", "-wait", + "idletasks", /* backwards compat. */ + NULL +}; + static int GetEventFlagsFromOpts( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ @@ -1309,15 +1320,6 @@ GetEventFlagsFromOpts( { int i, optionIndex, result = TCL_ERROR; int flags = *flagsPtr; /* default flags */ - static CONST char *updateOptions[] = { - "-idle", "-noidle", /* new options */ - "-timer", "-notimer", - "-file", "-nofile", - "-window", "-nowindow", - "-async", "-noasync", - "-nowait", "-wait", - "idletasks", /* backwards compat. */ - NULL}; static CONST struct { int mask; int flags; @@ -1334,7 +1336,7 @@ GetEventFlagsFromOpts( }; for (i = 0; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], updateOptions, + if (Tcl_GetIndexFromObj(interp, objv[i], updateEventOptions, "option", 0, &optionIndex) != TCL_OK) { goto done; } @@ -1354,14 +1356,6 @@ GetEventFlagsFromOpts( return result; } -static void -VwaitTimeOutProc( - ClientData clientData) -{ - int *donePtr = (int *) clientData; - - *donePtr = -1; -} /* *---------------------------------------------------------------------- * @@ -1387,27 +1381,26 @@ Tcl_VwaitObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *CONST objv[]) /* Argument objects. */ { - int done = 0, foundEvent; + int done = 0, foundEvent = 1; int flags = TCL_ALL_EVENTS; /* default flags */ char *nameString; int opti = 1, /* start option index (and index of varname later) */ optc = objc - 2; /* options count without cmd and varname */ - TimerEntry *timerEvent = NULL; Tcl_WideInt ms = -1; + Tcl_Time wakeup; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?options? name ?timeout?"); + Tcl_WrongNumArgs(interp, 1, objv, "?options? ?timeout? name"); return TCL_ERROR; } /* if arguments available - wrap options to flags */ if (objc >= 3) { /* first try to recognize options up to the possible end, thereby - * we assume that varname is not integer, try to get numeric timeout, - * (just assume precidence of option fewer as timeout) + * we assume that option is not an integer, try to get numeric timeout */ - if (Tcl_GetWideIntFromObj(NULL, objv[objc-1], &ms) == TCL_OK) { - objc--; + if (!TclObjIsIndexOfTable(objv[optc], updateEventOptions) + && Tcl_GetWideIntFromObj(NULL, objv[optc], &ms) == TCL_OK) { optc--; } @@ -1417,16 +1410,12 @@ Tcl_VwaitObjCmd( ) { return TCL_ERROR; } - /* opti points to varname */ - opti += optc; } done = 0; /* if timeout specified - create timer event or no-wait by 0ms */ if (ms != -1) { - Tcl_Time wakeup; - if (ms > 0) { Tcl_GetTime(&wakeup); wakeup.sec += (long)(ms / 1000); @@ -1435,26 +1424,38 @@ Tcl_VwaitObjCmd( wakeup.sec++; wakeup.usec -= 1000000; } - timerEvent = TclCreateAbsoluteTimerHandlerEx(&wakeup, VwaitTimeOutProc, NULL, 0); - timerEvent->clientData = &done; } else if (ms == 0) { flags |= TCL_DONT_WAIT; } } - nameString = Tcl_GetString(objv[opti]); + nameString = Tcl_GetString(objv[objc-1]); if (Tcl_TraceVar(interp, nameString, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done) != TCL_OK) { - - /* if timeout-timer and no timeout fired, cancel timer event */ - if (timerEvent && done != -1) { - TclDeleteTimerEntry(timerEvent); - } return TCL_ERROR; }; do { + /* if wait - set blocking time */ + if (ms > 0) { + Tcl_Time blockTime; + Tcl_GetTime(&blockTime); + blockTime.sec = wakeup.sec - blockTime.sec; + blockTime.usec = wakeup.usec - blockTime.usec; + if (blockTime.usec < 0) { + blockTime.sec -= 1; + blockTime.usec += 1000000; + } + if ( blockTime.sec < 0 + || (blockTime.sec == 0 && blockTime.usec <= 0) + ) { + /* timeout occurs */ + done = -1; + break; + } + Tcl_SetMaxBlockTime(&blockTime); + } if ((foundEvent = Tcl_DoOneEvent(flags)) == 0) { /* * If don't wait flag set - no error, and two cases: @@ -1463,14 +1464,16 @@ Tcl_VwaitObjCmd( */ if (flags & TCL_DONT_WAIT) { foundEvent = 1; - if (ms != 0) { - goto checkLimit; /* continue waiting */ - } done = -2; } + if (ms > 0) { + foundEvent = 1; + goto checkWait; /* continue waiting */ + } break; } - checkLimit: + checkWait: + /* check interpreter limit exceeded */ if (Tcl_LimitExceeded(interp)) { foundEvent = -1; break; @@ -1481,11 +1484,6 @@ Tcl_VwaitObjCmd( TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &done); - /* if timeout-timer and no timeout fired, cancel timer event */ - if (timerEvent && done != -1) { - TclDeleteTimerEntry(timerEvent); - } - /* if timeout specified (and no errors) */ if (ms != -1 && foundEvent > 0) { Tcl_Obj *objPtr; diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index ced7bd9..4caba7a 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -63,6 +63,43 @@ typedef struct { /* *---------------------------------------------------------------------- * + * TclObjIsIndexOfStruct -- + * + * This function looks up an object's is a index of given table. + * + * Used for fast lookup by dynamic options count to check for other + * object types. + * + * Results: + * 1 if object is an option of table, otherwise 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +TclObjIsIndexOfStruct( + Tcl_Obj *objPtr, /* Object containing the string to lookup. */ + const void *tablePtr) /* Array of strings to compare against the + * value of objPtr; last entry must be NULL + * and there must not be duplicate entries. */ +{ + IndexRep *indexRep; + if (objPtr->typePtr != &tclIndexType) { + return 0; + } + indexRep = objPtr->internalRep.twoPtrValue.ptr1; + + if (indexRep->tablePtr != (void *) tablePtr) { + return 0; + } + return 1; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GetIndexFromObj -- * * This function looks up an object's value in a table of strings and diff --git a/generic/tclInt.h b/generic/tclInt.h index dd73eac..42223e4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2561,6 +2561,12 @@ MODULE_SCOPE char tclEmptyString; *---------------------------------------------------------------- */ +MODULE_SCOPE int TclObjIsIndexOfStruct(Tcl_Obj *objPtr, + const void *tablePtr); +#define TclObjIsIndexOfTable(objPtr, tablePtr) \ + ((objPtr->typePtr == &tclIndexType) \ + && TclObjIsIndexOfStruct(objPtr, tablePtr)) + MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, int len); MODULE_SCOPE void TclAdvanceContinuations(int* line, int** next, int loc); diff --git a/generic/tclNotify.c b/generic/tclNotify.c index f13fca3..fb251b7 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -989,14 +989,18 @@ Tcl_SetMaxBlockTime( * Results: * The return value is 1 if the function actually found an event to * process. If no processing occurred, then 0 is returned (this can - * happen if the TCL_DONT_WAIT flag is set or if there are no event - * handlers to wait for in the set specified by flags). + * happen if the TCL_DONT_WAIT flag is set or block time was set using + * Tcl_SetMaxBlockTime before or if there are no event handlers to wait + * for in the set specified by flags). * * Side effects: * May delay execution of process while waiting for an event, unless * TCL_DONT_WAIT is set in the flags argument. Event sources are invoked * to check for and queue events. Event handlers may produce arbitrary * side effects. + * If block time was set (Tcl_SetMaxBlockTime) but another event occurs + * and interrupt wait, the function can return early, thereby it resets + * the block time (caller should use Tcl_SetMaxBlockTime again). * *---------------------------------------------------------------------- */ @@ -1013,6 +1017,7 @@ Tcl_DoOneEvent( EventSource *sourcePtr; Tcl_Time *timePtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int stopWait; /* * No event flags is equivalent to TCL_ALL_EVENTS. @@ -1022,20 +1027,26 @@ Tcl_DoOneEvent( flags |= TCL_ALL_EVENTS; } + /* Block time was set outside an event source traversal or no wait */ + stopWait = tsdPtr->blockTimeSet || (flags & TCL_DONT_WAIT); + /* * Asynchronous event handlers are considered to be the highest priority * events, and so must be invoked before we process events on the event * queue. */ - if ((flags & TCL_ASYNC_EVENTS) && Tcl_AsyncReady()) { - (void) Tcl_AsyncInvoke(NULL, 0); - return 1; - } + if (flags & TCL_ASYNC_EVENTS) { + if (Tcl_AsyncReady()) { + (void) Tcl_AsyncInvoke(NULL, 0); + return 1; + } - /* Async only */ - if ((flags & TCL_ALL_EVENTS) == TCL_ASYNC_EVENTS) { - return 0; + /* Async only and don't wait - return */ + if ( (flags & (TCL_ALL_EVENTS|TCL_DONT_WAIT)) + == (TCL_ASYNC_EVENTS|TCL_DONT_WAIT) ) { + return 0; + } } /* @@ -1047,12 +1058,10 @@ Tcl_DoOneEvent( tsdPtr->serviceMode = TCL_SERVICE_NONE; /* - * The core of this function is an infinite loop, even though we only - * service one event. The reason for this is that we may be processing - * events that don't do anything inside of Tcl. + * Main loop until servicing exact one event or block time resp. + * TCL_DONT_WAIT specified (infinite loop if stopWait = 0). */ - - while (1) { + do { /* * If idle events are the only things to service, skip the main part * of the loop and go directly to handle idle events (i.e. don't wait @@ -1060,7 +1069,6 @@ Tcl_DoOneEvent( */ if ((flags & TCL_ALL_EVENTS) == TCL_IDLE_EVENTS) { - flags |= TCL_DONT_WAIT; goto idleEvents; } @@ -1096,8 +1104,6 @@ Tcl_DoOneEvent( tsdPtr->blockTimeSet = 1; timePtr = &tsdPtr->blockTime; goto wait; /* for notifier resp. system events */ - } else { - tsdPtr->blockTimeSet = 0; } /* @@ -1164,9 +1170,6 @@ Tcl_DoOneEvent( break; } } - if (flags & TCL_DONT_WAIT) { - break; - } /* * If Tcl_WaitForEvent has returned 1, indicating that one system @@ -1176,16 +1179,13 @@ Tcl_DoOneEvent( * had the side effect of changing the variable (so the vwait can * return and unwind properly). * - * NB: We will process idle events if any first, because otherwise we - * might never do the idle events if the notifier always gets - * system events. + * We can stop also if block time was set outside an event source, + * that means timeout was set (so exit loop also without event/result). */ - if (result) { - break; - } - } + } while (!stopWait); + tsdPtr->blockTimeSet = 0; tsdPtr->serviceMode = oldMode; return result; } diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 52a3073..63346a1 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -1139,7 +1139,7 @@ Tcl_AfterObjCmd( */ index = -1; - if ( ( objv[1]->typePtr == &tclIndexType + if ( ( TclObjIsIndexOfTable(objv[1], afterSubCmds) || Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK ) && Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, |