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