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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25