[25] | 1 | /* |
---|
| 2 | * tclTimer.c -- |
---|
| 3 | * |
---|
| 4 | * This file provides timer event management facilities for Tcl, |
---|
| 5 | * including the "after" command. |
---|
| 6 | * |
---|
| 7 | * Copyright (c) 1997 by Sun Microsystems, Inc. |
---|
| 8 | * |
---|
| 9 | * See the file "license.terms" for information on usage and redistribution of |
---|
| 10 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 11 | * |
---|
| 12 | * RCS: @(#) $Id: tclTimer.c,v 1.31 2008/01/22 20:52:10 dgp Exp $ |
---|
| 13 | */ |
---|
| 14 | |
---|
| 15 | #include "tclInt.h" |
---|
| 16 | |
---|
| 17 | /* |
---|
| 18 | * For each timer callback that's pending there is one record of the following |
---|
| 19 | * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained |
---|
| 20 | * together in a list sorted by time (earliest event first). |
---|
| 21 | */ |
---|
| 22 | |
---|
| 23 | typedef struct TimerHandler { |
---|
| 24 | Tcl_Time time; /* When timer is to fire. */ |
---|
| 25 | Tcl_TimerProc *proc; /* Function to call. */ |
---|
| 26 | ClientData clientData; /* Argument to pass to proc. */ |
---|
| 27 | Tcl_TimerToken token; /* Identifies handler so it can be deleted. */ |
---|
| 28 | struct TimerHandler *nextPtr; |
---|
| 29 | /* Next event in queue, or NULL for end of |
---|
| 30 | * queue. */ |
---|
| 31 | } TimerHandler; |
---|
| 32 | |
---|
| 33 | /* |
---|
| 34 | * The data structure below is used by the "after" command to remember the |
---|
| 35 | * command to be executed later. All of the pending "after" commands for an |
---|
| 36 | * interpreter are linked together in a list. |
---|
| 37 | */ |
---|
| 38 | |
---|
| 39 | typedef struct AfterInfo { |
---|
| 40 | struct AfterAssocData *assocPtr; |
---|
| 41 | /* Pointer to the "tclAfter" assocData for the |
---|
| 42 | * interp in which command will be |
---|
| 43 | * executed. */ |
---|
| 44 | Tcl_Obj *commandPtr; /* Command to execute. */ |
---|
| 45 | int id; /* Integer identifier for command; used to |
---|
| 46 | * cancel it. */ |
---|
| 47 | Tcl_TimerToken token; /* Used to cancel the "after" command. NULL |
---|
| 48 | * means that the command is run as an idle |
---|
| 49 | * handler rather than as a timer handler. |
---|
| 50 | * NULL means this is an "after idle" handler |
---|
| 51 | * rather than a timer handler. */ |
---|
| 52 | struct AfterInfo *nextPtr; /* Next in list of all "after" commands for |
---|
| 53 | * this interpreter. */ |
---|
| 54 | } AfterInfo; |
---|
| 55 | |
---|
| 56 | /* |
---|
| 57 | * One of the following structures is associated with each interpreter for |
---|
| 58 | * which an "after" command has ever been invoked. A pointer to this structure |
---|
| 59 | * is stored in the AssocData for the "tclAfter" key. |
---|
| 60 | */ |
---|
| 61 | |
---|
| 62 | typedef struct AfterAssocData { |
---|
| 63 | Tcl_Interp *interp; /* The interpreter for which this data is |
---|
| 64 | * registered. */ |
---|
| 65 | AfterInfo *firstAfterPtr; /* First in list of all "after" commands still |
---|
| 66 | * pending for this interpreter, or NULL if |
---|
| 67 | * none. */ |
---|
| 68 | } AfterAssocData; |
---|
| 69 | |
---|
| 70 | /* |
---|
| 71 | * There is one of the following structures for each of the handlers declared |
---|
| 72 | * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are |
---|
| 73 | * linked together into a list. |
---|
| 74 | */ |
---|
| 75 | |
---|
| 76 | typedef struct IdleHandler { |
---|
| 77 | Tcl_IdleProc (*proc); /* Function to call. */ |
---|
| 78 | ClientData clientData; /* Value to pass to proc. */ |
---|
| 79 | int generation; /* Used to distinguish older handlers from |
---|
| 80 | * recently-created ones. */ |
---|
| 81 | struct IdleHandler *nextPtr;/* Next in list of active handlers. */ |
---|
| 82 | } IdleHandler; |
---|
| 83 | |
---|
| 84 | /* |
---|
| 85 | * The timer and idle queues are per-thread because they are associated with |
---|
| 86 | * the notifier, which is also per-thread. |
---|
| 87 | * |
---|
| 88 | * All static variables used in this file are collected into a single instance |
---|
| 89 | * of the following structure. For multi-threaded implementations, there is |
---|
| 90 | * one instance of this structure for each thread. |
---|
| 91 | * |
---|
| 92 | * Notice that different structures with the same name appear in other files. |
---|
| 93 | * The structure defined below is used in this file only. |
---|
| 94 | */ |
---|
| 95 | |
---|
| 96 | typedef struct ThreadSpecificData { |
---|
| 97 | TimerHandler *firstTimerHandlerPtr; /* First event in queue. */ |
---|
| 98 | int lastTimerId; /* Timer identifier of most recently created |
---|
| 99 | * timer. */ |
---|
| 100 | int timerPending; /* 1 if a timer event is in the queue. */ |
---|
| 101 | IdleHandler *idleList; /* First in list of all idle handlers. */ |
---|
| 102 | IdleHandler *lastIdlePtr; /* Last in list (or NULL for empty list). */ |
---|
| 103 | int idleGeneration; /* Used to fill in the "generation" fields of |
---|
| 104 | * IdleHandler structures. Increments each |
---|
| 105 | * time Tcl_DoOneEvent starts calling idle |
---|
| 106 | * handlers, so that all old handlers can be |
---|
| 107 | * called without calling any of the new ones |
---|
| 108 | * created by old ones. */ |
---|
| 109 | int afterId; /* For unique identifiers of after events. */ |
---|
| 110 | } ThreadSpecificData; |
---|
| 111 | |
---|
| 112 | static Tcl_ThreadDataKey dataKey; |
---|
| 113 | |
---|
| 114 | /* |
---|
| 115 | * Helper macros for working with times. TCL_TIME_BEFORE encodes how to write |
---|
| 116 | * the ordering relation on (normalized) times, and TCL_TIME_DIFF_MS computes |
---|
| 117 | * the number of milliseconds difference between two times. Both macros use |
---|
| 118 | * both of their arguments multiple times, so make sure they are cheap and |
---|
| 119 | * side-effect free. The "prototypes" for these macros are: |
---|
| 120 | * |
---|
| 121 | * static int TCL_TIME_BEFORE(Tcl_Time t1, Tcl_Time t2); |
---|
| 122 | * static long TCL_TIME_DIFF_MS(Tcl_Time t1, Tcl_Time t2); |
---|
| 123 | */ |
---|
| 124 | |
---|
| 125 | #define TCL_TIME_BEFORE(t1, t2) \ |
---|
| 126 | (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec)) |
---|
| 127 | |
---|
| 128 | #define TCL_TIME_DIFF_MS(t1, t2) \ |
---|
| 129 | (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \ |
---|
| 130 | ((long)(t1).usec - (long)(t2).usec)/1000) |
---|
| 131 | |
---|
| 132 | /* |
---|
| 133 | * Prototypes for functions referenced only in this file: |
---|
| 134 | */ |
---|
| 135 | |
---|
| 136 | static void AfterCleanupProc(ClientData clientData, |
---|
| 137 | Tcl_Interp *interp); |
---|
| 138 | static int AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms); |
---|
| 139 | static void AfterProc(ClientData clientData); |
---|
| 140 | static void FreeAfterPtr(AfterInfo *afterPtr); |
---|
| 141 | static AfterInfo * GetAfterEvent(AfterAssocData *assocPtr, |
---|
| 142 | Tcl_Obj *commandPtr); |
---|
| 143 | static ThreadSpecificData *InitTimer(void); |
---|
| 144 | static void TimerExitProc(ClientData clientData); |
---|
| 145 | static int TimerHandlerEventProc(Tcl_Event *evPtr, int flags); |
---|
| 146 | static void TimerCheckProc(ClientData clientData, int flags); |
---|
| 147 | static void TimerSetupProc(ClientData clientData, int flags); |
---|
| 148 | |
---|
| 149 | /* |
---|
| 150 | *---------------------------------------------------------------------- |
---|
| 151 | * |
---|
| 152 | * InitTimer -- |
---|
| 153 | * |
---|
| 154 | * This function initializes the timer module. |
---|
| 155 | * |
---|
| 156 | * Results: |
---|
| 157 | * A pointer to the thread specific data. |
---|
| 158 | * |
---|
| 159 | * Side effects: |
---|
| 160 | * Registers the idle and timer event sources. |
---|
| 161 | * |
---|
| 162 | *---------------------------------------------------------------------- |
---|
| 163 | */ |
---|
| 164 | |
---|
| 165 | static ThreadSpecificData * |
---|
| 166 | InitTimer(void) |
---|
| 167 | { |
---|
| 168 | ThreadSpecificData *tsdPtr = (ThreadSpecificData *) |
---|
| 169 | TclThreadDataKeyGet(&dataKey); |
---|
| 170 | |
---|
| 171 | if (tsdPtr == NULL) { |
---|
| 172 | tsdPtr = TCL_TSD_INIT(&dataKey); |
---|
| 173 | Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL); |
---|
| 174 | Tcl_CreateThreadExitHandler(TimerExitProc, NULL); |
---|
| 175 | } |
---|
| 176 | return tsdPtr; |
---|
| 177 | } |
---|
| 178 | |
---|
| 179 | /* |
---|
| 180 | *---------------------------------------------------------------------- |
---|
| 181 | * |
---|
| 182 | * TimerExitProc -- |
---|
| 183 | * |
---|
| 184 | * This function is call at exit or unload time to remove the timer and |
---|
| 185 | * idle event sources. |
---|
| 186 | * |
---|
| 187 | * Results: |
---|
| 188 | * None. |
---|
| 189 | * |
---|
| 190 | * Side effects: |
---|
| 191 | * Removes the timer and idle event sources and remaining events. |
---|
| 192 | * |
---|
| 193 | *---------------------------------------------------------------------- |
---|
| 194 | */ |
---|
| 195 | |
---|
| 196 | static void |
---|
| 197 | TimerExitProc( |
---|
| 198 | ClientData clientData) /* Not used. */ |
---|
| 199 | { |
---|
| 200 | ThreadSpecificData *tsdPtr = (ThreadSpecificData *) |
---|
| 201 | TclThreadDataKeyGet(&dataKey); |
---|
| 202 | |
---|
| 203 | Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); |
---|
| 204 | if (tsdPtr != NULL) { |
---|
| 205 | register TimerHandler *timerHandlerPtr; |
---|
| 206 | |
---|
| 207 | timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; |
---|
| 208 | while (timerHandlerPtr != NULL) { |
---|
| 209 | tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; |
---|
| 210 | ckfree((char *) timerHandlerPtr); |
---|
| 211 | timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; |
---|
| 212 | } |
---|
| 213 | } |
---|
| 214 | } |
---|
| 215 | |
---|
| 216 | /* |
---|
| 217 | *-------------------------------------------------------------- |
---|
| 218 | * |
---|
| 219 | * Tcl_CreateTimerHandler -- |
---|
| 220 | * |
---|
| 221 | * Arrange for a given function to be invoked at a particular time in the |
---|
| 222 | * future. |
---|
| 223 | * |
---|
| 224 | * Results: |
---|
| 225 | * The return value is a token for the timer event, which may be used to |
---|
| 226 | * delete the event before it fires. |
---|
| 227 | * |
---|
| 228 | * Side effects: |
---|
| 229 | * When milliseconds have elapsed, proc will be invoked exactly once. |
---|
| 230 | * |
---|
| 231 | *-------------------------------------------------------------- |
---|
| 232 | */ |
---|
| 233 | |
---|
| 234 | Tcl_TimerToken |
---|
| 235 | Tcl_CreateTimerHandler( |
---|
| 236 | int milliseconds, /* How many milliseconds to wait before |
---|
| 237 | * invoking proc. */ |
---|
| 238 | Tcl_TimerProc *proc, /* Function to invoke. */ |
---|
| 239 | ClientData clientData) /* Arbitrary data to pass to proc. */ |
---|
| 240 | { |
---|
| 241 | Tcl_Time time; |
---|
| 242 | |
---|
| 243 | /* |
---|
| 244 | * Compute when the event should fire. |
---|
| 245 | */ |
---|
| 246 | |
---|
| 247 | Tcl_GetTime(&time); |
---|
| 248 | time.sec += milliseconds/1000; |
---|
| 249 | time.usec += (milliseconds%1000)*1000; |
---|
| 250 | if (time.usec >= 1000000) { |
---|
| 251 | time.usec -= 1000000; |
---|
| 252 | time.sec += 1; |
---|
| 253 | } |
---|
| 254 | return TclCreateAbsoluteTimerHandler(&time, proc, clientData); |
---|
| 255 | } |
---|
| 256 | |
---|
| 257 | /* |
---|
| 258 | *-------------------------------------------------------------- |
---|
| 259 | * |
---|
| 260 | * TclCreateAbsoluteTimerHandler -- |
---|
| 261 | * |
---|
| 262 | * Arrange for a given function to be invoked at a particular time in the |
---|
| 263 | * future. |
---|
| 264 | * |
---|
| 265 | * Results: |
---|
| 266 | * The return value is a token for the timer event, which may be used to |
---|
| 267 | * delete the event before it fires. |
---|
| 268 | * |
---|
| 269 | * Side effects: |
---|
| 270 | * When the time in timePtr has been reached, proc will be invoked |
---|
| 271 | * exactly once. |
---|
| 272 | * |
---|
| 273 | *-------------------------------------------------------------- |
---|
| 274 | */ |
---|
| 275 | |
---|
| 276 | Tcl_TimerToken |
---|
| 277 | TclCreateAbsoluteTimerHandler( |
---|
| 278 | Tcl_Time *timePtr, |
---|
| 279 | Tcl_TimerProc *proc, |
---|
| 280 | ClientData clientData) |
---|
| 281 | { |
---|
| 282 | register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; |
---|
| 283 | ThreadSpecificData *tsdPtr; |
---|
| 284 | |
---|
| 285 | tsdPtr = InitTimer(); |
---|
| 286 | timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler)); |
---|
| 287 | |
---|
| 288 | /* |
---|
| 289 | * Fill in fields for the event. |
---|
| 290 | */ |
---|
| 291 | |
---|
| 292 | memcpy((void *)&timerHandlerPtr->time, (void *)timePtr, sizeof(Tcl_Time)); |
---|
| 293 | timerHandlerPtr->proc = proc; |
---|
| 294 | timerHandlerPtr->clientData = clientData; |
---|
| 295 | tsdPtr->lastTimerId++; |
---|
| 296 | timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId); |
---|
| 297 | |
---|
| 298 | /* |
---|
| 299 | * Add the event to the queue in the correct position |
---|
| 300 | * (ordered by event firing time). |
---|
| 301 | */ |
---|
| 302 | |
---|
| 303 | for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL; |
---|
| 304 | prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) { |
---|
| 305 | if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) { |
---|
| 306 | break; |
---|
| 307 | } |
---|
| 308 | } |
---|
| 309 | timerHandlerPtr->nextPtr = tPtr2; |
---|
| 310 | if (prevPtr == NULL) { |
---|
| 311 | tsdPtr->firstTimerHandlerPtr = timerHandlerPtr; |
---|
| 312 | } else { |
---|
| 313 | prevPtr->nextPtr = timerHandlerPtr; |
---|
| 314 | } |
---|
| 315 | |
---|
| 316 | TimerSetupProc(NULL, TCL_ALL_EVENTS); |
---|
| 317 | |
---|
| 318 | return timerHandlerPtr->token; |
---|
| 319 | } |
---|
| 320 | |
---|
| 321 | /* |
---|
| 322 | *-------------------------------------------------------------- |
---|
| 323 | * |
---|
| 324 | * Tcl_DeleteTimerHandler -- |
---|
| 325 | * |
---|
| 326 | * Delete a previously-registered timer handler. |
---|
| 327 | * |
---|
| 328 | * Results: |
---|
| 329 | * None. |
---|
| 330 | * |
---|
| 331 | * Side effects: |
---|
| 332 | * Destroy the timer callback identified by TimerToken, so that its |
---|
| 333 | * associated function will not be called. If the callback has already |
---|
| 334 | * fired, or if the given token doesn't exist, then nothing happens. |
---|
| 335 | * |
---|
| 336 | *-------------------------------------------------------------- |
---|
| 337 | */ |
---|
| 338 | |
---|
| 339 | void |
---|
| 340 | Tcl_DeleteTimerHandler( |
---|
| 341 | Tcl_TimerToken token) /* Result previously returned by |
---|
| 342 | * Tcl_DeleteTimerHandler. */ |
---|
| 343 | { |
---|
| 344 | register TimerHandler *timerHandlerPtr, *prevPtr; |
---|
| 345 | ThreadSpecificData *tsdPtr = InitTimer(); |
---|
| 346 | |
---|
| 347 | if (token == NULL) { |
---|
| 348 | return; |
---|
| 349 | } |
---|
| 350 | |
---|
| 351 | for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; |
---|
| 352 | timerHandlerPtr != NULL; prevPtr = timerHandlerPtr, |
---|
| 353 | timerHandlerPtr = timerHandlerPtr->nextPtr) { |
---|
| 354 | if (timerHandlerPtr->token != token) { |
---|
| 355 | continue; |
---|
| 356 | } |
---|
| 357 | if (prevPtr == NULL) { |
---|
| 358 | tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; |
---|
| 359 | } else { |
---|
| 360 | prevPtr->nextPtr = timerHandlerPtr->nextPtr; |
---|
| 361 | } |
---|
| 362 | ckfree((char *) timerHandlerPtr); |
---|
| 363 | return; |
---|
| 364 | } |
---|
| 365 | } |
---|
| 366 | |
---|
| 367 | /* |
---|
| 368 | *---------------------------------------------------------------------- |
---|
| 369 | * |
---|
| 370 | * TimerSetupProc -- |
---|
| 371 | * |
---|
| 372 | * This function is called by Tcl_DoOneEvent to setup the timer event |
---|
| 373 | * source for before blocking. This routine checks both the idle and |
---|
| 374 | * after timer lists. |
---|
| 375 | * |
---|
| 376 | * Results: |
---|
| 377 | * None. |
---|
| 378 | * |
---|
| 379 | * Side effects: |
---|
| 380 | * May update the maximum notifier block time. |
---|
| 381 | * |
---|
| 382 | *---------------------------------------------------------------------- |
---|
| 383 | */ |
---|
| 384 | |
---|
| 385 | static void |
---|
| 386 | TimerSetupProc( |
---|
| 387 | ClientData data, /* Not used. */ |
---|
| 388 | int flags) /* Event flags as passed to Tcl_DoOneEvent. */ |
---|
| 389 | { |
---|
| 390 | Tcl_Time blockTime; |
---|
| 391 | ThreadSpecificData *tsdPtr = InitTimer(); |
---|
| 392 | |
---|
| 393 | if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList) |
---|
| 394 | || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) { |
---|
| 395 | /* |
---|
| 396 | * There is an idle handler or a pending timer event, so just poll. |
---|
| 397 | */ |
---|
| 398 | |
---|
| 399 | blockTime.sec = 0; |
---|
| 400 | blockTime.usec = 0; |
---|
| 401 | |
---|
| 402 | } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { |
---|
| 403 | /* |
---|
| 404 | * Compute the timeout for the next timer on the list. |
---|
| 405 | */ |
---|
| 406 | |
---|
| 407 | Tcl_GetTime(&blockTime); |
---|
| 408 | blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; |
---|
| 409 | blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - |
---|
| 410 | blockTime.usec; |
---|
| 411 | if (blockTime.usec < 0) { |
---|
| 412 | blockTime.sec -= 1; |
---|
| 413 | blockTime.usec += 1000000; |
---|
| 414 | } |
---|
| 415 | if (blockTime.sec < 0) { |
---|
| 416 | blockTime.sec = 0; |
---|
| 417 | blockTime.usec = 0; |
---|
| 418 | } |
---|
| 419 | } else { |
---|
| 420 | return; |
---|
| 421 | } |
---|
| 422 | |
---|
| 423 | Tcl_SetMaxBlockTime(&blockTime); |
---|
| 424 | } |
---|
| 425 | |
---|
| 426 | /* |
---|
| 427 | *---------------------------------------------------------------------- |
---|
| 428 | * |
---|
| 429 | * TimerCheckProc -- |
---|
| 430 | * |
---|
| 431 | * This function is called by Tcl_DoOneEvent to check the timer event |
---|
| 432 | * source for events. This routine checks both the idle and after timer |
---|
| 433 | * lists. |
---|
| 434 | * |
---|
| 435 | * Results: |
---|
| 436 | * None. |
---|
| 437 | * |
---|
| 438 | * Side effects: |
---|
| 439 | * May queue an event and update the maximum notifier block time. |
---|
| 440 | * |
---|
| 441 | *---------------------------------------------------------------------- |
---|
| 442 | */ |
---|
| 443 | |
---|
| 444 | static void |
---|
| 445 | TimerCheckProc( |
---|
| 446 | ClientData data, /* Not used. */ |
---|
| 447 | int flags) /* Event flags as passed to Tcl_DoOneEvent. */ |
---|
| 448 | { |
---|
| 449 | Tcl_Event *timerEvPtr; |
---|
| 450 | Tcl_Time blockTime; |
---|
| 451 | ThreadSpecificData *tsdPtr = InitTimer(); |
---|
| 452 | |
---|
| 453 | if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) { |
---|
| 454 | /* |
---|
| 455 | * Compute the timeout for the next timer on the list. |
---|
| 456 | */ |
---|
| 457 | |
---|
| 458 | Tcl_GetTime(&blockTime); |
---|
| 459 | blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec; |
---|
| 460 | blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec - |
---|
| 461 | blockTime.usec; |
---|
| 462 | if (blockTime.usec < 0) { |
---|
| 463 | blockTime.sec -= 1; |
---|
| 464 | blockTime.usec += 1000000; |
---|
| 465 | } |
---|
| 466 | if (blockTime.sec < 0) { |
---|
| 467 | blockTime.sec = 0; |
---|
| 468 | blockTime.usec = 0; |
---|
| 469 | } |
---|
| 470 | |
---|
| 471 | /* |
---|
| 472 | * If the first timer has expired, stick an event on the queue. |
---|
| 473 | */ |
---|
| 474 | |
---|
| 475 | if (blockTime.sec == 0 && blockTime.usec == 0 && |
---|
| 476 | !tsdPtr->timerPending) { |
---|
| 477 | tsdPtr->timerPending = 1; |
---|
| 478 | timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event)); |
---|
| 479 | timerEvPtr->proc = TimerHandlerEventProc; |
---|
| 480 | Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL); |
---|
| 481 | } |
---|
| 482 | } |
---|
| 483 | } |
---|
| 484 | |
---|
| 485 | /* |
---|
| 486 | *---------------------------------------------------------------------- |
---|
| 487 | * |
---|
| 488 | * TimerHandlerEventProc -- |
---|
| 489 | * |
---|
| 490 | * This function is called by Tcl_ServiceEvent when a timer event reaches |
---|
| 491 | * the front of the event queue. This function handles the event by |
---|
| 492 | * invoking the callbacks for all timers that are ready. |
---|
| 493 | * |
---|
| 494 | * Results: |
---|
| 495 | * Returns 1 if the event was handled, meaning it should be removed from |
---|
| 496 | * the queue. Returns 0 if the event was not handled, meaning it should |
---|
| 497 | * stay on the queue. The only time the event isn't handled is if the |
---|
| 498 | * TCL_TIMER_EVENTS flag bit isn't set. |
---|
| 499 | * |
---|
| 500 | * Side effects: |
---|
| 501 | * Whatever the timer handler callback functions do. |
---|
| 502 | * |
---|
| 503 | *---------------------------------------------------------------------- |
---|
| 504 | */ |
---|
| 505 | |
---|
| 506 | static int |
---|
| 507 | TimerHandlerEventProc( |
---|
| 508 | Tcl_Event *evPtr, /* Event to service. */ |
---|
| 509 | int flags) /* Flags that indicate what events to handle, |
---|
| 510 | * such as TCL_FILE_EVENTS. */ |
---|
| 511 | { |
---|
| 512 | TimerHandler *timerHandlerPtr, **nextPtrPtr; |
---|
| 513 | Tcl_Time time; |
---|
| 514 | int currentTimerId; |
---|
| 515 | ThreadSpecificData *tsdPtr = InitTimer(); |
---|
| 516 | |
---|
| 517 | /* |
---|
| 518 | * Do nothing if timers aren't enabled. This leaves the event on the |
---|
| 519 | * queue, so we will get to it as soon as ServiceEvents() is called with |
---|
| 520 | * timers enabled. |
---|
| 521 | */ |
---|
| 522 | |
---|
| 523 | if (!(flags & TCL_TIMER_EVENTS)) { |
---|
| 524 | return 0; |
---|
| 525 | } |
---|
| 526 | |
---|
| 527 | /* |
---|
| 528 | * The code below is trickier than it may look, for the following reasons: |
---|
| 529 | * |
---|
| 530 | * 1. New handlers can get added to the list while the current one is |
---|
| 531 | * being processed. If new ones get added, we don't want to process |
---|
| 532 | * them during this pass through the list to avoid starving other event |
---|
| 533 | * sources. This is implemented using the token number in the handler: |
---|
| 534 | * new handlers will have a newer token than any of the ones currently |
---|
| 535 | * on the list. |
---|
| 536 | * 2. The handler can call Tcl_DoOneEvent, so we have to remove the |
---|
| 537 | * handler from the list before calling it. Otherwise an infinite loop |
---|
| 538 | * could result. |
---|
| 539 | * 3. Tcl_DeleteTimerHandler can be called to remove an element from the |
---|
| 540 | * list while a handler is executing, so the list could change |
---|
| 541 | * structure during the call. |
---|
| 542 | * 4. Because we only fetch the current time before entering the loop, the |
---|
| 543 | * only way a new timer will even be considered runnable is if its |
---|
| 544 | * expiration time is within the same millisecond as the current time. |
---|
| 545 | * This is fairly likely on Windows, since it has a course granularity |
---|
| 546 | * clock. Since timers are placed on the queue in time order with the |
---|
| 547 | * most recently created handler appearing after earlier ones with the |
---|
| 548 | * same expiration time, we don't have to worry about newer generation |
---|
| 549 | * timers appearing before later ones. |
---|
| 550 | */ |
---|
| 551 | |
---|
| 552 | tsdPtr->timerPending = 0; |
---|
| 553 | currentTimerId = tsdPtr->lastTimerId; |
---|
| 554 | Tcl_GetTime(&time); |
---|
| 555 | while (1) { |
---|
| 556 | nextPtrPtr = &tsdPtr->firstTimerHandlerPtr; |
---|
| 557 | timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; |
---|
| 558 | if (timerHandlerPtr == NULL) { |
---|
| 559 | break; |
---|
| 560 | } |
---|
| 561 | |
---|
| 562 | if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) { |
---|
| 563 | break; |
---|
| 564 | } |
---|
| 565 | |
---|
| 566 | /* |
---|
| 567 | * Bail out if the next timer is of a newer generation. |
---|
| 568 | */ |
---|
| 569 | |
---|
| 570 | if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) { |
---|
| 571 | break; |
---|
| 572 | } |
---|
| 573 | |
---|
| 574 | /* |
---|
| 575 | * Remove the handler from the queue before invoking it, to avoid |
---|
| 576 | * potential reentrancy problems. |
---|
| 577 | */ |
---|
| 578 | |
---|
| 579 | (*nextPtrPtr) = timerHandlerPtr->nextPtr; |
---|
| 580 | (*timerHandlerPtr->proc)(timerHandlerPtr->clientData); |
---|
| 581 | ckfree((char *) timerHandlerPtr); |
---|
| 582 | } |
---|
| 583 | TimerSetupProc(NULL, TCL_TIMER_EVENTS); |
---|
| 584 | return 1; |
---|
| 585 | } |
---|
| 586 | |
---|
| 587 | /* |
---|
| 588 | *-------------------------------------------------------------- |
---|
| 589 | * |
---|
| 590 | * Tcl_DoWhenIdle -- |
---|
| 591 | * |
---|
| 592 | * Arrange for proc to be invoked the next time the system is idle (i.e., |
---|
| 593 | * just before the next time that Tcl_DoOneEvent would have to wait for |
---|
| 594 | * something to happen). |
---|
| 595 | * |
---|
| 596 | * Results: |
---|
| 597 | * None. |
---|
| 598 | * |
---|
| 599 | * Side effects: |
---|
| 600 | * Proc will eventually be called, with clientData as argument. See the |
---|
| 601 | * manual entry for details. |
---|
| 602 | * |
---|
| 603 | *-------------------------------------------------------------- |
---|
| 604 | */ |
---|
| 605 | |
---|
| 606 | void |
---|
| 607 | Tcl_DoWhenIdle( |
---|
| 608 | Tcl_IdleProc *proc, /* Function to invoke. */ |
---|
| 609 | ClientData clientData) /* Arbitrary value to pass to proc. */ |
---|
| 610 | { |
---|
| 611 | register IdleHandler *idlePtr; |
---|
| 612 | Tcl_Time blockTime; |
---|
| 613 | ThreadSpecificData *tsdPtr = InitTimer(); |
---|
| 614 | |
---|
| 615 | idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler)); |
---|
| 616 | idlePtr->proc = proc; |
---|
| 617 | idlePtr->clientData = clientData; |
---|
| 618 | idlePtr->generation = tsdPtr->idleGeneration; |
---|
| 619 | idlePtr->nextPtr = NULL; |
---|
| 620 | if (tsdPtr->lastIdlePtr == NULL) { |
---|
| 621 | tsdPtr->idleList = idlePtr; |
---|
| 622 | } else { |
---|
| 623 | tsdPtr->lastIdlePtr->nextPtr = idlePtr; |
---|
| 624 | } |
---|
| 625 | tsdPtr->lastIdlePtr = idlePtr; |
---|
| 626 | |
---|
| 627 | blockTime.sec = 0; |
---|
| 628 | blockTime.usec = 0; |
---|
| 629 | Tcl_SetMaxBlockTime(&blockTime); |
---|
| 630 | } |
---|
| 631 | |
---|
| 632 | /* |
---|
| 633 | *---------------------------------------------------------------------- |
---|
| 634 | * |
---|
| 635 | * Tcl_CancelIdleCall -- |
---|
| 636 | * |
---|
| 637 | * If there are any when-idle calls requested to a given function with |
---|
| 638 | * given clientData, cancel all of them. |
---|
| 639 | * |
---|
| 640 | * Results: |
---|
| 641 | * None. |
---|
| 642 | * |
---|
| 643 | * Side effects: |
---|
| 644 | * If the proc/clientData combination were on the when-idle list, they |
---|
| 645 | * are removed so that they will never be called. |
---|
| 646 | * |
---|
| 647 | *---------------------------------------------------------------------- |
---|
| 648 | */ |
---|
| 649 | |
---|
| 650 | void |
---|
| 651 | Tcl_CancelIdleCall( |
---|
| 652 | Tcl_IdleProc *proc, /* Function that was previously registered. */ |
---|
| 653 | ClientData clientData) /* Arbitrary value to pass to proc. */ |
---|
| 654 | { |
---|
| 655 | register IdleHandler *idlePtr, *prevPtr; |
---|
| 656 | IdleHandler *nextPtr; |
---|
| 657 | ThreadSpecificData *tsdPtr = InitTimer(); |
---|
| 658 | |
---|
| 659 | for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL; |
---|
| 660 | prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { |
---|
| 661 | while ((idlePtr->proc == proc) |
---|
| 662 | && (idlePtr->clientData == clientData)) { |
---|
| 663 | nextPtr = idlePtr->nextPtr; |
---|
| 664 | ckfree((char *) idlePtr); |
---|
| 665 | idlePtr = nextPtr; |
---|
| 666 | if (prevPtr == NULL) { |
---|
| 667 | tsdPtr->idleList = idlePtr; |
---|
| 668 | } else { |
---|
| 669 | prevPtr->nextPtr = idlePtr; |
---|
| 670 | } |
---|
| 671 | if (idlePtr == NULL) { |
---|
| 672 | tsdPtr->lastIdlePtr = prevPtr; |
---|
| 673 | return; |
---|
| 674 | } |
---|
| 675 | } |
---|
| 676 | } |
---|
| 677 | } |
---|
| 678 | |
---|
| 679 | /* |
---|
| 680 | *---------------------------------------------------------------------- |
---|
| 681 | * |
---|
| 682 | * TclServiceIdle -- |
---|
| 683 | * |
---|
| 684 | * This function is invoked by the notifier when it becomes idle. It will |
---|
| 685 | * invoke all idle handlers that are present at the time the call is |
---|
| 686 | * invoked, but not those added during idle processing. |
---|
| 687 | * |
---|
| 688 | * Results: |
---|
| 689 | * The return value is 1 if TclServiceIdle found something to do, |
---|
| 690 | * otherwise return value is 0. |
---|
| 691 | * |
---|
| 692 | * Side effects: |
---|
| 693 | * Invokes all pending idle handlers. |
---|
| 694 | * |
---|
| 695 | *---------------------------------------------------------------------- |
---|
| 696 | */ |
---|
| 697 | |
---|
| 698 | int |
---|
| 699 | TclServiceIdle(void) |
---|
| 700 | { |
---|
| 701 | IdleHandler *idlePtr; |
---|
| 702 | int oldGeneration; |
---|
| 703 | Tcl_Time blockTime; |
---|
| 704 | ThreadSpecificData *tsdPtr = InitTimer(); |
---|
| 705 | |
---|
| 706 | if (tsdPtr->idleList == NULL) { |
---|
| 707 | return 0; |
---|
| 708 | } |
---|
| 709 | |
---|
| 710 | oldGeneration = tsdPtr->idleGeneration; |
---|
| 711 | tsdPtr->idleGeneration++; |
---|
| 712 | |
---|
| 713 | /* |
---|
| 714 | * The code below is trickier than it may look, for the following reasons: |
---|
| 715 | * |
---|
| 716 | * 1. New handlers can get added to the list while the current one is |
---|
| 717 | * being processed. If new ones get added, we don't want to process |
---|
| 718 | * them during this pass through the list (want to check for other work |
---|
| 719 | * to do first). This is implemented using the generation number in the |
---|
| 720 | * handler: new handlers will have a different generation than any of |
---|
| 721 | * the ones currently on the list. |
---|
| 722 | * 2. The handler can call Tcl_DoOneEvent, so we have to remove the |
---|
| 723 | * handler from the list before calling it. Otherwise an infinite loop |
---|
| 724 | * could result. |
---|
| 725 | * 3. Tcl_CancelIdleCall can be called to remove an element from the list |
---|
| 726 | * while a handler is executing, so the list could change structure |
---|
| 727 | * during the call. |
---|
| 728 | */ |
---|
| 729 | |
---|
| 730 | for (idlePtr = tsdPtr->idleList; |
---|
| 731 | ((idlePtr != NULL) |
---|
| 732 | && ((oldGeneration - idlePtr->generation) >= 0)); |
---|
| 733 | idlePtr = tsdPtr->idleList) { |
---|
| 734 | tsdPtr->idleList = idlePtr->nextPtr; |
---|
| 735 | if (tsdPtr->idleList == NULL) { |
---|
| 736 | tsdPtr->lastIdlePtr = NULL; |
---|
| 737 | } |
---|
| 738 | (*idlePtr->proc)(idlePtr->clientData); |
---|
| 739 | ckfree((char *) idlePtr); |
---|
| 740 | } |
---|
| 741 | if (tsdPtr->idleList) { |
---|
| 742 | blockTime.sec = 0; |
---|
| 743 | blockTime.usec = 0; |
---|
| 744 | Tcl_SetMaxBlockTime(&blockTime); |
---|
| 745 | } |
---|
| 746 | return 1; |
---|
| 747 | } |
---|
| 748 | |
---|
| 749 | /* |
---|
| 750 | *---------------------------------------------------------------------- |
---|
| 751 | * |
---|
| 752 | * Tcl_AfterObjCmd -- |
---|
| 753 | * |
---|
| 754 | * This function is invoked to process the "after" Tcl command. See the |
---|
| 755 | * user documentation for details on what it does. |
---|
| 756 | * |
---|
| 757 | * Results: |
---|
| 758 | * A standard Tcl result. |
---|
| 759 | * |
---|
| 760 | * Side effects: |
---|
| 761 | * See the user documentation. |
---|
| 762 | * |
---|
| 763 | *---------------------------------------------------------------------- |
---|
| 764 | */ |
---|
| 765 | |
---|
| 766 | /* ARGSUSED */ |
---|
| 767 | int |
---|
| 768 | Tcl_AfterObjCmd( |
---|
| 769 | ClientData clientData, /* Unused */ |
---|
| 770 | Tcl_Interp *interp, /* Current interpreter. */ |
---|
| 771 | int objc, /* Number of arguments. */ |
---|
| 772 | Tcl_Obj *CONST objv[]) /* Argument objects. */ |
---|
| 773 | { |
---|
| 774 | Tcl_WideInt ms; /* Number of milliseconds to wait */ |
---|
| 775 | Tcl_Time wakeup; |
---|
| 776 | AfterInfo *afterPtr; |
---|
| 777 | AfterAssocData *assocPtr; |
---|
| 778 | int length; |
---|
| 779 | int index; |
---|
| 780 | char buf[16 + TCL_INTEGER_SPACE]; |
---|
| 781 | static CONST char *afterSubCmds[] = { |
---|
| 782 | "cancel", "idle", "info", NULL |
---|
| 783 | }; |
---|
| 784 | enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO}; |
---|
| 785 | ThreadSpecificData *tsdPtr = InitTimer(); |
---|
| 786 | |
---|
| 787 | if (objc < 2) { |
---|
| 788 | Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); |
---|
| 789 | return TCL_ERROR; |
---|
| 790 | } |
---|
| 791 | |
---|
| 792 | /* |
---|
| 793 | * Create the "after" information associated for this interpreter, if it |
---|
| 794 | * doesn't already exist. |
---|
| 795 | */ |
---|
| 796 | |
---|
| 797 | assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL); |
---|
| 798 | if (assocPtr == NULL) { |
---|
| 799 | assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData)); |
---|
| 800 | assocPtr->interp = interp; |
---|
| 801 | assocPtr->firstAfterPtr = NULL; |
---|
| 802 | Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, |
---|
| 803 | (ClientData) assocPtr); |
---|
| 804 | } |
---|
| 805 | |
---|
| 806 | /* |
---|
| 807 | * First lets see if the command was passed a number as the first argument. |
---|
| 808 | */ |
---|
| 809 | |
---|
| 810 | if (objv[1]->typePtr == &tclIntType |
---|
| 811 | #ifndef NO_WIDE_TYPE |
---|
| 812 | || objv[1]->typePtr == &tclWideIntType |
---|
| 813 | #endif |
---|
| 814 | || objv[1]->typePtr == &tclBignumType |
---|
| 815 | || ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, |
---|
| 816 | &index) != TCL_OK )) { |
---|
| 817 | index = -1; |
---|
| 818 | if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { |
---|
| 819 | Tcl_AppendResult(interp, "bad argument \"", |
---|
| 820 | Tcl_GetString(objv[1]), |
---|
| 821 | "\": must be cancel, idle, info, or an integer", |
---|
| 822 | NULL); |
---|
| 823 | return TCL_ERROR; |
---|
| 824 | } |
---|
| 825 | } |
---|
| 826 | |
---|
| 827 | /* |
---|
| 828 | * At this point, either index = -1 and ms contains the number of ms |
---|
| 829 | * to wait, or else index is the index of a subcommand. |
---|
| 830 | */ |
---|
| 831 | |
---|
| 832 | switch (index) { |
---|
| 833 | case -1: { |
---|
| 834 | if (ms < 0) { |
---|
| 835 | ms = 0; |
---|
| 836 | } |
---|
| 837 | if (objc == 2) { |
---|
| 838 | return AfterDelay(interp, ms); |
---|
| 839 | } |
---|
| 840 | afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); |
---|
| 841 | afterPtr->assocPtr = assocPtr; |
---|
| 842 | if (objc == 3) { |
---|
| 843 | afterPtr->commandPtr = objv[2]; |
---|
| 844 | } else { |
---|
| 845 | afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); |
---|
| 846 | } |
---|
| 847 | Tcl_IncrRefCount(afterPtr->commandPtr); |
---|
| 848 | |
---|
| 849 | /* |
---|
| 850 | * The variable below is used to generate unique identifiers for after |
---|
| 851 | * commands. This id can wrap around, which can potentially cause |
---|
| 852 | * problems. However, there are not likely to be problems in practice, |
---|
| 853 | * because after commands can only be requested to about a month in |
---|
| 854 | * the future, and wrap-around is unlikely to occur in less than about |
---|
| 855 | * 1-10 years. Thus it's unlikely that any old ids will still be |
---|
| 856 | * around when wrap-around occurs. |
---|
| 857 | */ |
---|
| 858 | |
---|
| 859 | afterPtr->id = tsdPtr->afterId; |
---|
| 860 | tsdPtr->afterId += 1; |
---|
| 861 | Tcl_GetTime(&wakeup); |
---|
| 862 | wakeup.sec += (long)(ms / 1000); |
---|
| 863 | wakeup.usec += ((long)(ms % 1000)) * 1000; |
---|
| 864 | if (wakeup.usec > 1000000) { |
---|
| 865 | wakeup.sec++; |
---|
| 866 | wakeup.usec -= 1000000; |
---|
| 867 | } |
---|
| 868 | afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, AfterProc, |
---|
| 869 | (ClientData) afterPtr); |
---|
| 870 | afterPtr->nextPtr = assocPtr->firstAfterPtr; |
---|
| 871 | assocPtr->firstAfterPtr = afterPtr; |
---|
| 872 | Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); |
---|
| 873 | return TCL_OK; |
---|
| 874 | } |
---|
| 875 | case AFTER_CANCEL: { |
---|
| 876 | Tcl_Obj *commandPtr; |
---|
| 877 | char *command, *tempCommand; |
---|
| 878 | int tempLength; |
---|
| 879 | |
---|
| 880 | if (objc < 3) { |
---|
| 881 | Tcl_WrongNumArgs(interp, 2, objv, "id|command"); |
---|
| 882 | return TCL_ERROR; |
---|
| 883 | } |
---|
| 884 | if (objc == 3) { |
---|
| 885 | commandPtr = objv[2]; |
---|
| 886 | } else { |
---|
| 887 | commandPtr = Tcl_ConcatObj(objc-2, objv+2);; |
---|
| 888 | } |
---|
| 889 | command = Tcl_GetStringFromObj(commandPtr, &length); |
---|
| 890 | for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; |
---|
| 891 | afterPtr = afterPtr->nextPtr) { |
---|
| 892 | tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr, |
---|
| 893 | &tempLength); |
---|
| 894 | if ((length == tempLength) |
---|
| 895 | && (memcmp((void*) command, (void*) tempCommand, |
---|
| 896 | (unsigned) length) == 0)) { |
---|
| 897 | break; |
---|
| 898 | } |
---|
| 899 | } |
---|
| 900 | if (afterPtr == NULL) { |
---|
| 901 | afterPtr = GetAfterEvent(assocPtr, commandPtr); |
---|
| 902 | } |
---|
| 903 | if (objc != 3) { |
---|
| 904 | Tcl_DecrRefCount(commandPtr); |
---|
| 905 | } |
---|
| 906 | if (afterPtr != NULL) { |
---|
| 907 | if (afterPtr->token != NULL) { |
---|
| 908 | Tcl_DeleteTimerHandler(afterPtr->token); |
---|
| 909 | } else { |
---|
| 910 | Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr); |
---|
| 911 | } |
---|
| 912 | FreeAfterPtr(afterPtr); |
---|
| 913 | } |
---|
| 914 | break; |
---|
| 915 | } |
---|
| 916 | case AFTER_IDLE: |
---|
| 917 | if (objc < 3) { |
---|
| 918 | Tcl_WrongNumArgs(interp, 2, objv, "script script ..."); |
---|
| 919 | return TCL_ERROR; |
---|
| 920 | } |
---|
| 921 | afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo))); |
---|
| 922 | afterPtr->assocPtr = assocPtr; |
---|
| 923 | if (objc == 3) { |
---|
| 924 | afterPtr->commandPtr = objv[2]; |
---|
| 925 | } else { |
---|
| 926 | afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); |
---|
| 927 | } |
---|
| 928 | Tcl_IncrRefCount(afterPtr->commandPtr); |
---|
| 929 | afterPtr->id = tsdPtr->afterId; |
---|
| 930 | tsdPtr->afterId += 1; |
---|
| 931 | afterPtr->token = NULL; |
---|
| 932 | afterPtr->nextPtr = assocPtr->firstAfterPtr; |
---|
| 933 | assocPtr->firstAfterPtr = afterPtr; |
---|
| 934 | Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr); |
---|
| 935 | Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); |
---|
| 936 | break; |
---|
| 937 | case AFTER_INFO: { |
---|
| 938 | Tcl_Obj *resultListPtr; |
---|
| 939 | |
---|
| 940 | if (objc == 2) { |
---|
| 941 | for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; |
---|
| 942 | afterPtr = afterPtr->nextPtr) { |
---|
| 943 | if (assocPtr->interp == interp) { |
---|
| 944 | sprintf(buf, "after#%d", afterPtr->id); |
---|
| 945 | Tcl_AppendElement(interp, buf); |
---|
| 946 | } |
---|
| 947 | } |
---|
| 948 | return TCL_OK; |
---|
| 949 | } |
---|
| 950 | if (objc != 3) { |
---|
| 951 | Tcl_WrongNumArgs(interp, 2, objv, "?id?"); |
---|
| 952 | return TCL_ERROR; |
---|
| 953 | } |
---|
| 954 | afterPtr = GetAfterEvent(assocPtr, objv[2]); |
---|
| 955 | if (afterPtr == NULL) { |
---|
| 956 | Tcl_AppendResult(interp, "event \"", TclGetString(objv[2]), |
---|
| 957 | "\" doesn't exist", NULL); |
---|
| 958 | return TCL_ERROR; |
---|
| 959 | } |
---|
| 960 | resultListPtr = Tcl_NewObj(); |
---|
| 961 | Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr); |
---|
| 962 | Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( |
---|
| 963 | (afterPtr->token == NULL) ? "idle" : "timer", -1)); |
---|
| 964 | Tcl_SetObjResult(interp, resultListPtr); |
---|
| 965 | break; |
---|
| 966 | } |
---|
| 967 | default: |
---|
| 968 | Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds"); |
---|
| 969 | } |
---|
| 970 | return TCL_OK; |
---|
| 971 | } |
---|
| 972 | |
---|
| 973 | /* |
---|
| 974 | *---------------------------------------------------------------------- |
---|
| 975 | * |
---|
| 976 | * AfterDelay -- |
---|
| 977 | * |
---|
| 978 | * Implements the blocking delay behaviour of [after $time]. Tricky |
---|
| 979 | * because it has to take into account any time limit that has been set. |
---|
| 980 | * |
---|
| 981 | * Results: |
---|
| 982 | * Standard Tcl result code (with error set if an error occurred due to a |
---|
| 983 | * time limit being exceeded). |
---|
| 984 | * |
---|
| 985 | * Side effects: |
---|
| 986 | * May adjust the time limit granularity marker. |
---|
| 987 | * |
---|
| 988 | *---------------------------------------------------------------------- |
---|
| 989 | */ |
---|
| 990 | |
---|
| 991 | static int |
---|
| 992 | AfterDelay( |
---|
| 993 | Tcl_Interp *interp, |
---|
| 994 | Tcl_WideInt ms) |
---|
| 995 | { |
---|
| 996 | Interp *iPtr = (Interp *) interp; |
---|
| 997 | |
---|
| 998 | Tcl_Time endTime, now; |
---|
| 999 | Tcl_WideInt diff; |
---|
| 1000 | |
---|
| 1001 | Tcl_GetTime(&endTime); |
---|
| 1002 | endTime.sec += (long)(ms/1000); |
---|
| 1003 | endTime.usec += ((int)(ms%1000))*1000; |
---|
| 1004 | if (endTime.usec >= 1000000) { |
---|
| 1005 | endTime.sec++; |
---|
| 1006 | endTime.usec -= 1000000; |
---|
| 1007 | } |
---|
| 1008 | |
---|
| 1009 | do { |
---|
| 1010 | Tcl_GetTime(&now); |
---|
| 1011 | if (iPtr->limit.timeEvent != NULL |
---|
| 1012 | && TCL_TIME_BEFORE(iPtr->limit.time, now)) { |
---|
| 1013 | iPtr->limit.granularityTicker = 0; |
---|
| 1014 | if (Tcl_LimitCheck(interp) != TCL_OK) { |
---|
| 1015 | return TCL_ERROR; |
---|
| 1016 | } |
---|
| 1017 | } |
---|
| 1018 | if (iPtr->limit.timeEvent == NULL |
---|
| 1019 | || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) { |
---|
| 1020 | diff = TCL_TIME_DIFF_MS(endTime, now); |
---|
| 1021 | #ifndef TCL_WIDE_INT_IS_LONG |
---|
| 1022 | if (diff > LONG_MAX) { |
---|
| 1023 | diff = LONG_MAX; |
---|
| 1024 | } |
---|
| 1025 | #endif |
---|
| 1026 | if (diff > 0) { |
---|
| 1027 | Tcl_Sleep((long)diff); |
---|
| 1028 | } |
---|
| 1029 | } else { |
---|
| 1030 | diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); |
---|
| 1031 | #ifndef TCL_WIDE_INT_IS_LONG |
---|
| 1032 | if (diff > LONG_MAX) { |
---|
| 1033 | diff = LONG_MAX; |
---|
| 1034 | } |
---|
| 1035 | #endif |
---|
| 1036 | if (diff > 0) { |
---|
| 1037 | Tcl_Sleep((long)diff); |
---|
| 1038 | } |
---|
| 1039 | if (Tcl_LimitCheck(interp) != TCL_OK) { |
---|
| 1040 | return TCL_ERROR; |
---|
| 1041 | } |
---|
| 1042 | } |
---|
| 1043 | } while (TCL_TIME_BEFORE(now, endTime)); |
---|
| 1044 | return TCL_OK; |
---|
| 1045 | } |
---|
| 1046 | |
---|
| 1047 | /* |
---|
| 1048 | *---------------------------------------------------------------------- |
---|
| 1049 | * |
---|
| 1050 | * GetAfterEvent -- |
---|
| 1051 | * |
---|
| 1052 | * This function parses an "after" id such as "after#4" and returns a |
---|
| 1053 | * pointer to the AfterInfo structure. |
---|
| 1054 | * |
---|
| 1055 | * Results: |
---|
| 1056 | * The return value is either a pointer to an AfterInfo structure, if one |
---|
| 1057 | * is found that corresponds to "cmdString" and is for interp, or NULL if |
---|
| 1058 | * no corresponding after event can be found. |
---|
| 1059 | * |
---|
| 1060 | * Side effects: |
---|
| 1061 | * None. |
---|
| 1062 | * |
---|
| 1063 | *---------------------------------------------------------------------- |
---|
| 1064 | */ |
---|
| 1065 | |
---|
| 1066 | static AfterInfo * |
---|
| 1067 | GetAfterEvent( |
---|
| 1068 | AfterAssocData *assocPtr, /* Points to "after"-related information for |
---|
| 1069 | * this interpreter. */ |
---|
| 1070 | Tcl_Obj *commandPtr) |
---|
| 1071 | { |
---|
| 1072 | char *cmdString; /* Textual identifier for after event, such as |
---|
| 1073 | * "after#6". */ |
---|
| 1074 | AfterInfo *afterPtr; |
---|
| 1075 | int id; |
---|
| 1076 | char *end; |
---|
| 1077 | |
---|
| 1078 | cmdString = TclGetString(commandPtr); |
---|
| 1079 | if (strncmp(cmdString, "after#", 6) != 0) { |
---|
| 1080 | return NULL; |
---|
| 1081 | } |
---|
| 1082 | cmdString += 6; |
---|
| 1083 | id = strtoul(cmdString, &end, 10); |
---|
| 1084 | if ((end == cmdString) || (*end != 0)) { |
---|
| 1085 | return NULL; |
---|
| 1086 | } |
---|
| 1087 | for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; |
---|
| 1088 | afterPtr = afterPtr->nextPtr) { |
---|
| 1089 | if (afterPtr->id == id) { |
---|
| 1090 | return afterPtr; |
---|
| 1091 | } |
---|
| 1092 | } |
---|
| 1093 | return NULL; |
---|
| 1094 | } |
---|
| 1095 | |
---|
| 1096 | /* |
---|
| 1097 | *---------------------------------------------------------------------- |
---|
| 1098 | * |
---|
| 1099 | * AfterProc -- |
---|
| 1100 | * |
---|
| 1101 | * Timer callback to execute commands registered with the "after" |
---|
| 1102 | * command. |
---|
| 1103 | * |
---|
| 1104 | * Results: |
---|
| 1105 | * None. |
---|
| 1106 | * |
---|
| 1107 | * Side effects: |
---|
| 1108 | * Executes whatever command was specified. If the command returns an |
---|
| 1109 | * error, then the command "bgerror" is invoked to process the error; if |
---|
| 1110 | * bgerror fails then information about the error is output on stderr. |
---|
| 1111 | * |
---|
| 1112 | *---------------------------------------------------------------------- |
---|
| 1113 | */ |
---|
| 1114 | |
---|
| 1115 | static void |
---|
| 1116 | AfterProc( |
---|
| 1117 | ClientData clientData) /* Describes command to execute. */ |
---|
| 1118 | { |
---|
| 1119 | AfterInfo *afterPtr = (AfterInfo *) clientData; |
---|
| 1120 | AfterAssocData *assocPtr = afterPtr->assocPtr; |
---|
| 1121 | AfterInfo *prevPtr; |
---|
| 1122 | int result; |
---|
| 1123 | Tcl_Interp *interp; |
---|
| 1124 | |
---|
| 1125 | /* |
---|
| 1126 | * First remove the callback from our list of callbacks; otherwise someone |
---|
| 1127 | * could delete the callback while it's being executed, which could cause |
---|
| 1128 | * a core dump. |
---|
| 1129 | */ |
---|
| 1130 | |
---|
| 1131 | if (assocPtr->firstAfterPtr == afterPtr) { |
---|
| 1132 | assocPtr->firstAfterPtr = afterPtr->nextPtr; |
---|
| 1133 | } else { |
---|
| 1134 | for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr; |
---|
| 1135 | prevPtr = prevPtr->nextPtr) { |
---|
| 1136 | /* Empty loop body. */ |
---|
| 1137 | } |
---|
| 1138 | prevPtr->nextPtr = afterPtr->nextPtr; |
---|
| 1139 | } |
---|
| 1140 | |
---|
| 1141 | /* |
---|
| 1142 | * Execute the callback. |
---|
| 1143 | */ |
---|
| 1144 | |
---|
| 1145 | interp = assocPtr->interp; |
---|
| 1146 | Tcl_Preserve((ClientData) interp); |
---|
| 1147 | result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL); |
---|
| 1148 | if (result != TCL_OK) { |
---|
| 1149 | Tcl_AddErrorInfo(interp, "\n (\"after\" script)"); |
---|
| 1150 | TclBackgroundException(interp, result); |
---|
| 1151 | } |
---|
| 1152 | Tcl_Release((ClientData) interp); |
---|
| 1153 | |
---|
| 1154 | /* |
---|
| 1155 | * Free the memory for the callback. |
---|
| 1156 | */ |
---|
| 1157 | |
---|
| 1158 | Tcl_DecrRefCount(afterPtr->commandPtr); |
---|
| 1159 | ckfree((char *) afterPtr); |
---|
| 1160 | } |
---|
| 1161 | |
---|
| 1162 | /* |
---|
| 1163 | *---------------------------------------------------------------------- |
---|
| 1164 | * |
---|
| 1165 | * FreeAfterPtr -- |
---|
| 1166 | * |
---|
| 1167 | * This function removes an "after" command from the list of those that |
---|
| 1168 | * are pending and frees its resources. This function does *not* cancel |
---|
| 1169 | * the timer handler; if that's needed, the caller must do it. |
---|
| 1170 | * |
---|
| 1171 | * Results: |
---|
| 1172 | * None. |
---|
| 1173 | * |
---|
| 1174 | * Side effects: |
---|
| 1175 | * The memory associated with afterPtr is released. |
---|
| 1176 | * |
---|
| 1177 | *---------------------------------------------------------------------- |
---|
| 1178 | */ |
---|
| 1179 | |
---|
| 1180 | static void |
---|
| 1181 | FreeAfterPtr( |
---|
| 1182 | AfterInfo *afterPtr) /* Command to be deleted. */ |
---|
| 1183 | { |
---|
| 1184 | AfterInfo *prevPtr; |
---|
| 1185 | AfterAssocData *assocPtr = afterPtr->assocPtr; |
---|
| 1186 | |
---|
| 1187 | if (assocPtr->firstAfterPtr == afterPtr) { |
---|
| 1188 | assocPtr->firstAfterPtr = afterPtr->nextPtr; |
---|
| 1189 | } else { |
---|
| 1190 | for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr; |
---|
| 1191 | prevPtr = prevPtr->nextPtr) { |
---|
| 1192 | /* Empty loop body. */ |
---|
| 1193 | } |
---|
| 1194 | prevPtr->nextPtr = afterPtr->nextPtr; |
---|
| 1195 | } |
---|
| 1196 | Tcl_DecrRefCount(afterPtr->commandPtr); |
---|
| 1197 | ckfree((char *) afterPtr); |
---|
| 1198 | } |
---|
| 1199 | |
---|
| 1200 | /* |
---|
| 1201 | *---------------------------------------------------------------------- |
---|
| 1202 | * |
---|
| 1203 | * AfterCleanupProc -- |
---|
| 1204 | * |
---|
| 1205 | * This function is invoked whenever an interpreter is deleted |
---|
| 1206 | * to cleanup the AssocData for "tclAfter". |
---|
| 1207 | * |
---|
| 1208 | * Results: |
---|
| 1209 | * None. |
---|
| 1210 | * |
---|
| 1211 | * Side effects: |
---|
| 1212 | * After commands are removed. |
---|
| 1213 | * |
---|
| 1214 | *---------------------------------------------------------------------- |
---|
| 1215 | */ |
---|
| 1216 | |
---|
| 1217 | /* ARGSUSED */ |
---|
| 1218 | static void |
---|
| 1219 | AfterCleanupProc( |
---|
| 1220 | ClientData clientData, /* Points to AfterAssocData for the |
---|
| 1221 | * interpreter. */ |
---|
| 1222 | Tcl_Interp *interp) /* Interpreter that is being deleted. */ |
---|
| 1223 | { |
---|
| 1224 | AfterAssocData *assocPtr = (AfterAssocData *) clientData; |
---|
| 1225 | AfterInfo *afterPtr; |
---|
| 1226 | |
---|
| 1227 | while (assocPtr->firstAfterPtr != NULL) { |
---|
| 1228 | afterPtr = assocPtr->firstAfterPtr; |
---|
| 1229 | assocPtr->firstAfterPtr = afterPtr->nextPtr; |
---|
| 1230 | if (afterPtr->token != NULL) { |
---|
| 1231 | Tcl_DeleteTimerHandler(afterPtr->token); |
---|
| 1232 | } else { |
---|
| 1233 | Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr); |
---|
| 1234 | } |
---|
| 1235 | Tcl_DecrRefCount(afterPtr->commandPtr); |
---|
| 1236 | ckfree((char *) afterPtr); |
---|
| 1237 | } |
---|
| 1238 | ckfree((char *) assocPtr); |
---|
| 1239 | } |
---|
| 1240 | |
---|
| 1241 | /* |
---|
| 1242 | * Local Variables: |
---|
| 1243 | * mode: c |
---|
| 1244 | * c-basic-offset: 4 |
---|
| 1245 | * fill-column: 78 |
---|
| 1246 | * End: |
---|
| 1247 | */ |
---|