/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tcltimer.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tcltimer.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25