os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclTimer.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclTimer.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1141 @@
1.4 +/*
1.5 + * tclTimer.c --
1.6 + *
1.7 + * This file provides timer event management facilities for Tcl,
1.8 + * including the "after" command.
1.9 + *
1.10 + * Copyright (c) 1997 by Sun Microsystems, Inc.
1.11 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.12 + *
1.13 + * See the file "license.terms" for information on usage and redistribution
1.14 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 + *
1.16 + * RCS: @(#) $Id: tclTimer.c,v 1.6.2.4 2005/11/09 21:46:20 kennykb Exp $
1.17 + */
1.18 +
1.19 +#include "tclInt.h"
1.20 +#include "tclPort.h"
1.21 +#if defined(__SYMBIAN32__) && defined(__WINSCW__)
1.22 +#include "tclSymbianGlobals.h"
1.23 +#define dataKey getdataKey(7)
1.24 +#endif
1.25 +
1.26 +/*
1.27 + * For each timer callback that's pending there is one record of the following
1.28 + * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
1.29 + * together in a list sorted by time (earliest event first).
1.30 + */
1.31 +
1.32 +typedef struct TimerHandler {
1.33 + Tcl_Time time; /* When timer is to fire. */
1.34 + Tcl_TimerProc *proc; /* Procedure to call. */
1.35 + ClientData clientData; /* Argument to pass to proc. */
1.36 + Tcl_TimerToken token; /* Identifies handler so it can be
1.37 + * deleted. */
1.38 + struct TimerHandler *nextPtr; /* Next event in queue, or NULL for
1.39 + * end of queue. */
1.40 +} TimerHandler;
1.41 +
1.42 +/*
1.43 + * The data structure below is used by the "after" command to remember
1.44 + * the command to be executed later. All of the pending "after" commands
1.45 + * for an interpreter are linked together in a list.
1.46 + */
1.47 +
1.48 +typedef struct AfterInfo {
1.49 + struct AfterAssocData *assocPtr;
1.50 + /* Pointer to the "tclAfter" assocData for
1.51 + * the interp in which command will be
1.52 + * executed. */
1.53 + Tcl_Obj *commandPtr; /* Command to execute. */
1.54 + int id; /* Integer identifier for command; used to
1.55 + * cancel it. */
1.56 + Tcl_TimerToken token; /* Used to cancel the "after" command. NULL
1.57 + * means that the command is run as an
1.58 + * idle handler rather than as a timer
1.59 + * handler. NULL means this is an "after
1.60 + * idle" handler rather than a
1.61 + * timer handler. */
1.62 + struct AfterInfo *nextPtr; /* Next in list of all "after" commands for
1.63 + * this interpreter. */
1.64 +} AfterInfo;
1.65 +
1.66 +/*
1.67 + * One of the following structures is associated with each interpreter
1.68 + * for which an "after" command has ever been invoked. A pointer to
1.69 + * this structure is stored in the AssocData for the "tclAfter" key.
1.70 + */
1.71 +
1.72 +typedef struct AfterAssocData {
1.73 + Tcl_Interp *interp; /* The interpreter for which this data is
1.74 + * registered. */
1.75 + AfterInfo *firstAfterPtr; /* First in list of all "after" commands
1.76 + * still pending for this interpreter, or
1.77 + * NULL if none. */
1.78 +} AfterAssocData;
1.79 +
1.80 +/*
1.81 + * There is one of the following structures for each of the
1.82 + * handlers declared in a call to Tcl_DoWhenIdle. All of the
1.83 + * currently-active handlers are linked together into a list.
1.84 + */
1.85 +
1.86 +typedef struct IdleHandler {
1.87 + Tcl_IdleProc (*proc); /* Procedure to call. */
1.88 + ClientData clientData; /* Value to pass to proc. */
1.89 + int generation; /* Used to distinguish older handlers from
1.90 + * recently-created ones. */
1.91 + struct IdleHandler *nextPtr;/* Next in list of active handlers. */
1.92 +} IdleHandler;
1.93 +
1.94 +/*
1.95 + * The timer and idle queues are per-thread because they are associated
1.96 + * with the notifier, which is also per-thread.
1.97 + *
1.98 + * All static variables used in this file are collected into a single
1.99 + * instance of the following structure. For multi-threaded implementations,
1.100 + * there is one instance of this structure for each thread.
1.101 + *
1.102 + * Notice that different structures with the same name appear in other
1.103 + * files. The structure defined below is used in this file only.
1.104 + */
1.105 +
1.106 +typedef struct ThreadSpecificData {
1.107 + TimerHandler *firstTimerHandlerPtr; /* First event in queue. */
1.108 + int lastTimerId; /* Timer identifier of most recently
1.109 + * created timer. */
1.110 + int timerPending; /* 1 if a timer event is in the queue. */
1.111 + IdleHandler *idleList; /* First in list of all idle handlers. */
1.112 + IdleHandler *lastIdlePtr; /* Last in list (or NULL for empty list). */
1.113 + int idleGeneration; /* Used to fill in the "generation" fields
1.114 + * of IdleHandler structures. Increments
1.115 + * each time Tcl_DoOneEvent starts calling
1.116 + * idle handlers, so that all old handlers
1.117 + * can be called without calling any of the
1.118 + * new ones created by old ones. */
1.119 + int afterId; /* For unique identifiers of after events. */
1.120 +} ThreadSpecificData;
1.121 +
1.122 +#if !defined(__SYMBIAN32__) || !defined(__WINSCW__)
1.123 +static Tcl_ThreadDataKey dataKey;
1.124 +#endif
1.125 +
1.126 +/*
1.127 + * Prototypes for procedures referenced only in this file:
1.128 + */
1.129 +
1.130 +static void AfterCleanupProc _ANSI_ARGS_((ClientData clientData,
1.131 + Tcl_Interp *interp));
1.132 +static void AfterProc _ANSI_ARGS_((ClientData clientData));
1.133 +static void FreeAfterPtr _ANSI_ARGS_((AfterInfo *afterPtr));
1.134 +static AfterInfo * GetAfterEvent _ANSI_ARGS_((AfterAssocData *assocPtr,
1.135 + Tcl_Obj *commandPtr));
1.136 +static ThreadSpecificData *InitTimer _ANSI_ARGS_((void));
1.137 +static void TimerExitProc _ANSI_ARGS_((ClientData clientData));
1.138 +static int TimerHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
1.139 + int flags));
1.140 +static void TimerCheckProc _ANSI_ARGS_((ClientData clientData,
1.141 + int flags));
1.142 +static void TimerSetupProc _ANSI_ARGS_((ClientData clientData,
1.143 + int flags));
1.144 +
1.145 +/*
1.146 + *----------------------------------------------------------------------
1.147 + *
1.148 + * InitTimer --
1.149 + *
1.150 + * This function initializes the timer module.
1.151 + *
1.152 + * Results:
1.153 + * A pointer to the thread specific data.
1.154 + *
1.155 + * Side effects:
1.156 + * Registers the idle and timer event sources.
1.157 + *
1.158 + *----------------------------------------------------------------------
1.159 + */
1.160 +
1.161 +static ThreadSpecificData *
1.162 +InitTimer()
1.163 +{
1.164 + ThreadSpecificData *tsdPtr =
1.165 + (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
1.166 +
1.167 + if (tsdPtr == NULL) {
1.168 + tsdPtr = TCL_TSD_INIT(&dataKey);
1.169 + Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
1.170 + Tcl_CreateThreadExitHandler(TimerExitProc, NULL);
1.171 + }
1.172 + return tsdPtr;
1.173 +}
1.174 +
1.175 +/*
1.176 + *----------------------------------------------------------------------
1.177 + *
1.178 + * TimerExitProc --
1.179 + *
1.180 + * This function is call at exit or unload time to remove the
1.181 + * timer and idle event sources.
1.182 + *
1.183 + * Results:
1.184 + * None.
1.185 + *
1.186 + * Side effects:
1.187 + * Removes the timer and idle event sources and remaining events.
1.188 + *
1.189 + *----------------------------------------------------------------------
1.190 + */
1.191 +
1.192 +static void
1.193 +TimerExitProc(clientData)
1.194 + ClientData clientData; /* Not used. */
1.195 +{
1.196 + ThreadSpecificData *tsdPtr =
1.197 + (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
1.198 +
1.199 + Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
1.200 + if (tsdPtr != NULL) {
1.201 + register TimerHandler *timerHandlerPtr;
1.202 + timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
1.203 + while (timerHandlerPtr != NULL) {
1.204 + tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
1.205 + ckfree((char *) timerHandlerPtr);
1.206 + timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
1.207 + }
1.208 + }
1.209 +}
1.210 +
1.211 +/*
1.212 + *--------------------------------------------------------------
1.213 + *
1.214 + * Tcl_CreateTimerHandler --
1.215 + *
1.216 + * Arrange for a given procedure to be invoked at a particular
1.217 + * time in the future.
1.218 + *
1.219 + * Results:
1.220 + * The return value is a token for the timer event, which
1.221 + * may be used to delete the event before it fires.
1.222 + *
1.223 + * Side effects:
1.224 + * When milliseconds have elapsed, proc will be invoked
1.225 + * exactly once.
1.226 + *
1.227 + *--------------------------------------------------------------
1.228 + */
1.229 +
1.230 +EXPORT_C Tcl_TimerToken
1.231 +Tcl_CreateTimerHandler(milliseconds, proc, clientData)
1.232 + int milliseconds; /* How many milliseconds to wait
1.233 + * before invoking proc. */
1.234 + Tcl_TimerProc *proc; /* Procedure to invoke. */
1.235 + ClientData clientData; /* Arbitrary data to pass to proc. */
1.236 +{
1.237 + register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
1.238 + Tcl_Time time;
1.239 + ThreadSpecificData *tsdPtr;
1.240 +
1.241 + tsdPtr = InitTimer();
1.242 +
1.243 + timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));
1.244 +
1.245 + /*
1.246 + * Compute when the event should fire.
1.247 + */
1.248 +
1.249 + Tcl_GetTime(&time);
1.250 + timerHandlerPtr->time.sec = time.sec + milliseconds/1000;
1.251 + timerHandlerPtr->time.usec = time.usec + (milliseconds%1000)*1000;
1.252 + if (timerHandlerPtr->time.usec >= 1000000) {
1.253 + timerHandlerPtr->time.usec -= 1000000;
1.254 + timerHandlerPtr->time.sec += 1;
1.255 + }
1.256 +
1.257 + /*
1.258 + * Fill in other fields for the event.
1.259 + */
1.260 +
1.261 + timerHandlerPtr->proc = proc;
1.262 + timerHandlerPtr->clientData = clientData;
1.263 + tsdPtr->lastTimerId++;
1.264 + timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId;
1.265 +
1.266 + /*
1.267 + * Add the event to the queue in the correct position
1.268 + * (ordered by event firing time).
1.269 + */
1.270 +
1.271 + for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
1.272 + prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
1.273 + if ((tPtr2->time.sec > timerHandlerPtr->time.sec)
1.274 + || ((tPtr2->time.sec == timerHandlerPtr->time.sec)
1.275 + && (tPtr2->time.usec > timerHandlerPtr->time.usec))) {
1.276 + break;
1.277 + }
1.278 + }
1.279 + timerHandlerPtr->nextPtr = tPtr2;
1.280 + if (prevPtr == NULL) {
1.281 + tsdPtr->firstTimerHandlerPtr = timerHandlerPtr;
1.282 + } else {
1.283 + prevPtr->nextPtr = timerHandlerPtr;
1.284 + }
1.285 +
1.286 + TimerSetupProc(NULL, TCL_ALL_EVENTS);
1.287 +
1.288 + return timerHandlerPtr->token;
1.289 +}
1.290 +
1.291 +/*
1.292 + *--------------------------------------------------------------
1.293 + *
1.294 + * Tcl_DeleteTimerHandler --
1.295 + *
1.296 + * Delete a previously-registered timer handler.
1.297 + *
1.298 + * Results:
1.299 + * None.
1.300 + *
1.301 + * Side effects:
1.302 + * Destroy the timer callback identified by TimerToken,
1.303 + * so that its associated procedure will not be called.
1.304 + * If the callback has already fired, or if the given
1.305 + * token doesn't exist, then nothing happens.
1.306 + *
1.307 + *--------------------------------------------------------------
1.308 + */
1.309 +
1.310 +EXPORT_C void
1.311 +Tcl_DeleteTimerHandler(token)
1.312 + Tcl_TimerToken token; /* Result previously returned by
1.313 + * Tcl_DeleteTimerHandler. */
1.314 +{
1.315 + register TimerHandler *timerHandlerPtr, *prevPtr;
1.316 + ThreadSpecificData *tsdPtr = InitTimer();
1.317 +
1.318 + if (token == NULL) {
1.319 + return;
1.320 + }
1.321 +
1.322 + for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;
1.323 + timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
1.324 + timerHandlerPtr = timerHandlerPtr->nextPtr) {
1.325 + if (timerHandlerPtr->token != token) {
1.326 + continue;
1.327 + }
1.328 + if (prevPtr == NULL) {
1.329 + tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
1.330 + } else {
1.331 + prevPtr->nextPtr = timerHandlerPtr->nextPtr;
1.332 + }
1.333 + ckfree((char *) timerHandlerPtr);
1.334 + return;
1.335 + }
1.336 +}
1.337 +
1.338 +/*
1.339 + *----------------------------------------------------------------------
1.340 + *
1.341 + * TimerSetupProc --
1.342 + *
1.343 + * This function is called by Tcl_DoOneEvent to setup the timer
1.344 + * event source for before blocking. This routine checks both the
1.345 + * idle and after timer lists.
1.346 + *
1.347 + * Results:
1.348 + * None.
1.349 + *
1.350 + * Side effects:
1.351 + * May update the maximum notifier block time.
1.352 + *
1.353 + *----------------------------------------------------------------------
1.354 + */
1.355 +
1.356 +static void
1.357 +TimerSetupProc(data, flags)
1.358 + ClientData data; /* Not used. */
1.359 + int flags; /* Event flags as passed to Tcl_DoOneEvent. */
1.360 +{
1.361 + Tcl_Time blockTime;
1.362 + ThreadSpecificData *tsdPtr = InitTimer();
1.363 +
1.364 + if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)
1.365 + || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {
1.366 + /*
1.367 + * There is an idle handler or a pending timer event, so just poll.
1.368 + */
1.369 +
1.370 + blockTime.sec = 0;
1.371 + blockTime.usec = 0;
1.372 +
1.373 + } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
1.374 + /*
1.375 + * Compute the timeout for the next timer on the list.
1.376 + */
1.377 +
1.378 + Tcl_GetTime(&blockTime);
1.379 + blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
1.380 + blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
1.381 + blockTime.usec;
1.382 + if (blockTime.usec < 0) {
1.383 + blockTime.sec -= 1;
1.384 + blockTime.usec += 1000000;
1.385 + }
1.386 + if (blockTime.sec < 0) {
1.387 + blockTime.sec = 0;
1.388 + blockTime.usec = 0;
1.389 + }
1.390 + } else {
1.391 + return;
1.392 + }
1.393 +
1.394 + Tcl_SetMaxBlockTime(&blockTime);
1.395 +}
1.396 +
1.397 +/*
1.398 + *----------------------------------------------------------------------
1.399 + *
1.400 + * TimerCheckProc --
1.401 + *
1.402 + * This function is called by Tcl_DoOneEvent to check the timer
1.403 + * event source for events. This routine checks both the
1.404 + * idle and after timer lists.
1.405 + *
1.406 + * Results:
1.407 + * None.
1.408 + *
1.409 + * Side effects:
1.410 + * May queue an event and update the maximum notifier block time.
1.411 + *
1.412 + *----------------------------------------------------------------------
1.413 + */
1.414 +
1.415 +static void
1.416 +TimerCheckProc(data, flags)
1.417 + ClientData data; /* Not used. */
1.418 + int flags; /* Event flags as passed to Tcl_DoOneEvent. */
1.419 +{
1.420 + Tcl_Event *timerEvPtr;
1.421 + Tcl_Time blockTime;
1.422 + ThreadSpecificData *tsdPtr = InitTimer();
1.423 +
1.424 + if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
1.425 + /*
1.426 + * Compute the timeout for the next timer on the list.
1.427 + */
1.428 +
1.429 + Tcl_GetTime(&blockTime);
1.430 + blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
1.431 + blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
1.432 + blockTime.usec;
1.433 + if (blockTime.usec < 0) {
1.434 + blockTime.sec -= 1;
1.435 + blockTime.usec += 1000000;
1.436 + }
1.437 + if (blockTime.sec < 0) {
1.438 + blockTime.sec = 0;
1.439 + blockTime.usec = 0;
1.440 + }
1.441 +
1.442 + /*
1.443 + * If the first timer has expired, stick an event on the queue.
1.444 + */
1.445 +
1.446 + if (blockTime.sec == 0 && blockTime.usec == 0 &&
1.447 + !tsdPtr->timerPending) {
1.448 + tsdPtr->timerPending = 1;
1.449 + timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
1.450 + timerEvPtr->proc = TimerHandlerEventProc;
1.451 + Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
1.452 + }
1.453 + }
1.454 +}
1.455 +
1.456 +/*
1.457 + *----------------------------------------------------------------------
1.458 + *
1.459 + * TimerHandlerEventProc --
1.460 + *
1.461 + * This procedure is called by Tcl_ServiceEvent when a timer event
1.462 + * reaches the front of the event queue. This procedure handles
1.463 + * the event by invoking the callbacks for all timers that are
1.464 + * ready.
1.465 + *
1.466 + * Results:
1.467 + * Returns 1 if the event was handled, meaning it should be removed
1.468 + * from the queue. Returns 0 if the event was not handled, meaning
1.469 + * it should stay on the queue. The only time the event isn't
1.470 + * handled is if the TCL_TIMER_EVENTS flag bit isn't set.
1.471 + *
1.472 + * Side effects:
1.473 + * Whatever the timer handler callback procedures do.
1.474 + *
1.475 + *----------------------------------------------------------------------
1.476 + */
1.477 +
1.478 +static int
1.479 +TimerHandlerEventProc(evPtr, flags)
1.480 + Tcl_Event *evPtr; /* Event to service. */
1.481 + int flags; /* Flags that indicate what events to
1.482 + * handle, such as TCL_FILE_EVENTS. */
1.483 +{
1.484 + TimerHandler *timerHandlerPtr, **nextPtrPtr;
1.485 + Tcl_Time time;
1.486 + int currentTimerId;
1.487 + ThreadSpecificData *tsdPtr = InitTimer();
1.488 +
1.489 + /*
1.490 + * Do nothing if timers aren't enabled. This leaves the event on the
1.491 + * queue, so we will get to it as soon as ServiceEvents() is called
1.492 + * with timers enabled.
1.493 + */
1.494 +
1.495 + if (!(flags & TCL_TIMER_EVENTS)) {
1.496 + return 0;
1.497 + }
1.498 +
1.499 + /*
1.500 + * The code below is trickier than it may look, for the following
1.501 + * reasons:
1.502 + *
1.503 + * 1. New handlers can get added to the list while the current
1.504 + * one is being processed. If new ones get added, we don't
1.505 + * want to process them during this pass through the list to avoid
1.506 + * starving other event sources. This is implemented using the
1.507 + * token number in the handler: new handlers will have a
1.508 + * newer token than any of the ones currently on the list.
1.509 + * 2. The handler can call Tcl_DoOneEvent, so we have to remove
1.510 + * the handler from the list before calling it. Otherwise an
1.511 + * infinite loop could result.
1.512 + * 3. Tcl_DeleteTimerHandler can be called to remove an element from
1.513 + * the list while a handler is executing, so the list could
1.514 + * change structure during the call.
1.515 + * 4. Because we only fetch the current time before entering the loop,
1.516 + * the only way a new timer will even be considered runnable is if
1.517 + * its expiration time is within the same millisecond as the
1.518 + * current time. This is fairly likely on Windows, since it has
1.519 + * a course granularity clock. Since timers are placed
1.520 + * on the queue in time order with the most recently created
1.521 + * handler appearing after earlier ones with the same expiration
1.522 + * time, we don't have to worry about newer generation timers
1.523 + * appearing before later ones.
1.524 + */
1.525 +
1.526 + tsdPtr->timerPending = 0;
1.527 + currentTimerId = tsdPtr->lastTimerId;
1.528 + Tcl_GetTime(&time);
1.529 + while (1) {
1.530 + nextPtrPtr = &tsdPtr->firstTimerHandlerPtr;
1.531 + timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
1.532 + if (timerHandlerPtr == NULL) {
1.533 + break;
1.534 + }
1.535 +
1.536 + if ((timerHandlerPtr->time.sec > time.sec)
1.537 + || ((timerHandlerPtr->time.sec == time.sec)
1.538 + && (timerHandlerPtr->time.usec > time.usec))) {
1.539 + break;
1.540 + }
1.541 +
1.542 + /*
1.543 + * Bail out if the next timer is of a newer generation.
1.544 + */
1.545 +
1.546 + if ((currentTimerId - (int)timerHandlerPtr->token) < 0) {
1.547 + break;
1.548 + }
1.549 +
1.550 + /*
1.551 + * Remove the handler from the queue before invoking it,
1.552 + * to avoid potential reentrancy problems.
1.553 + */
1.554 +
1.555 + (*nextPtrPtr) = timerHandlerPtr->nextPtr;
1.556 + (*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
1.557 + ckfree((char *) timerHandlerPtr);
1.558 + }
1.559 + TimerSetupProc(NULL, TCL_TIMER_EVENTS);
1.560 + return 1;
1.561 +}
1.562 +
1.563 +/*
1.564 + *--------------------------------------------------------------
1.565 + *
1.566 + * Tcl_DoWhenIdle --
1.567 + *
1.568 + * Arrange for proc to be invoked the next time the system is
1.569 + * idle (i.e., just before the next time that Tcl_DoOneEvent
1.570 + * would have to wait for something to happen).
1.571 + *
1.572 + * Results:
1.573 + * None.
1.574 + *
1.575 + * Side effects:
1.576 + * Proc will eventually be called, with clientData as argument.
1.577 + * See the manual entry for details.
1.578 + *
1.579 + *--------------------------------------------------------------
1.580 + */
1.581 +
1.582 +EXPORT_C void
1.583 +Tcl_DoWhenIdle(proc, clientData)
1.584 + Tcl_IdleProc *proc; /* Procedure to invoke. */
1.585 + ClientData clientData; /* Arbitrary value to pass to proc. */
1.586 +{
1.587 + register IdleHandler *idlePtr;
1.588 + Tcl_Time blockTime;
1.589 + ThreadSpecificData *tsdPtr = InitTimer();
1.590 +
1.591 + idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
1.592 + idlePtr->proc = proc;
1.593 + idlePtr->clientData = clientData;
1.594 + idlePtr->generation = tsdPtr->idleGeneration;
1.595 + idlePtr->nextPtr = NULL;
1.596 + if (tsdPtr->lastIdlePtr == NULL) {
1.597 + tsdPtr->idleList = idlePtr;
1.598 + } else {
1.599 + tsdPtr->lastIdlePtr->nextPtr = idlePtr;
1.600 + }
1.601 + tsdPtr->lastIdlePtr = idlePtr;
1.602 +
1.603 + blockTime.sec = 0;
1.604 + blockTime.usec = 0;
1.605 + Tcl_SetMaxBlockTime(&blockTime);
1.606 +}
1.607 +
1.608 +/*
1.609 + *----------------------------------------------------------------------
1.610 + *
1.611 + * Tcl_CancelIdleCall --
1.612 + *
1.613 + * If there are any when-idle calls requested to a given procedure
1.614 + * with given clientData, cancel all of them.
1.615 + *
1.616 + * Results:
1.617 + * None.
1.618 + *
1.619 + * Side effects:
1.620 + * If the proc/clientData combination were on the when-idle list,
1.621 + * they are removed so that they will never be called.
1.622 + *
1.623 + *----------------------------------------------------------------------
1.624 + */
1.625 +
1.626 +EXPORT_C void
1.627 +Tcl_CancelIdleCall(proc, clientData)
1.628 + Tcl_IdleProc *proc; /* Procedure that was previously registered. */
1.629 + ClientData clientData; /* Arbitrary value to pass to proc. */
1.630 +{
1.631 + register IdleHandler *idlePtr, *prevPtr;
1.632 + IdleHandler *nextPtr;
1.633 + ThreadSpecificData *tsdPtr = InitTimer();
1.634 +
1.635 + for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
1.636 + prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
1.637 + while ((idlePtr->proc == proc)
1.638 + && (idlePtr->clientData == clientData)) {
1.639 + nextPtr = idlePtr->nextPtr;
1.640 + ckfree((char *) idlePtr);
1.641 + idlePtr = nextPtr;
1.642 + if (prevPtr == NULL) {
1.643 + tsdPtr->idleList = idlePtr;
1.644 + } else {
1.645 + prevPtr->nextPtr = idlePtr;
1.646 + }
1.647 + if (idlePtr == NULL) {
1.648 + tsdPtr->lastIdlePtr = prevPtr;
1.649 + return;
1.650 + }
1.651 + }
1.652 + }
1.653 +}
1.654 +
1.655 +/*
1.656 + *----------------------------------------------------------------------
1.657 + *
1.658 + * TclServiceIdle --
1.659 + *
1.660 + * This procedure is invoked by the notifier when it becomes
1.661 + * idle. It will invoke all idle handlers that are present at
1.662 + * the time the call is invoked, but not those added during idle
1.663 + * processing.
1.664 + *
1.665 + * Results:
1.666 + * The return value is 1 if TclServiceIdle found something to
1.667 + * do, otherwise return value is 0.
1.668 + *
1.669 + * Side effects:
1.670 + * Invokes all pending idle handlers.
1.671 + *
1.672 + *----------------------------------------------------------------------
1.673 + */
1.674 +
1.675 +int
1.676 +TclServiceIdle()
1.677 +{
1.678 + IdleHandler *idlePtr;
1.679 + int oldGeneration;
1.680 + Tcl_Time blockTime;
1.681 + ThreadSpecificData *tsdPtr = InitTimer();
1.682 +
1.683 + if (tsdPtr->idleList == NULL) {
1.684 + return 0;
1.685 + }
1.686 +
1.687 + oldGeneration = tsdPtr->idleGeneration;
1.688 + tsdPtr->idleGeneration++;
1.689 +
1.690 + /*
1.691 + * The code below is trickier than it may look, for the following
1.692 + * reasons:
1.693 + *
1.694 + * 1. New handlers can get added to the list while the current
1.695 + * one is being processed. If new ones get added, we don't
1.696 + * want to process them during this pass through the list (want
1.697 + * to check for other work to do first). This is implemented
1.698 + * using the generation number in the handler: new handlers
1.699 + * will have a different generation than any of the ones currently
1.700 + * on the list.
1.701 + * 2. The handler can call Tcl_DoOneEvent, so we have to remove
1.702 + * the handler from the list before calling it. Otherwise an
1.703 + * infinite loop could result.
1.704 + * 3. Tcl_CancelIdleCall can be called to remove an element from
1.705 + * the list while a handler is executing, so the list could
1.706 + * change structure during the call.
1.707 + */
1.708 +
1.709 + for (idlePtr = tsdPtr->idleList;
1.710 + ((idlePtr != NULL)
1.711 + && ((oldGeneration - idlePtr->generation) >= 0));
1.712 + idlePtr = tsdPtr->idleList) {
1.713 + tsdPtr->idleList = idlePtr->nextPtr;
1.714 + if (tsdPtr->idleList == NULL) {
1.715 + tsdPtr->lastIdlePtr = NULL;
1.716 + }
1.717 + (*idlePtr->proc)(idlePtr->clientData);
1.718 + ckfree((char *) idlePtr);
1.719 + }
1.720 + if (tsdPtr->idleList) {
1.721 + blockTime.sec = 0;
1.722 + blockTime.usec = 0;
1.723 + Tcl_SetMaxBlockTime(&blockTime);
1.724 + }
1.725 + return 1;
1.726 +}
1.727 +
1.728 +/*
1.729 + *----------------------------------------------------------------------
1.730 + *
1.731 + * Tcl_AfterObjCmd --
1.732 + *
1.733 + * This procedure is invoked to process the "after" Tcl command.
1.734 + * See the user documentation for details on what it does.
1.735 + *
1.736 + * Results:
1.737 + * A standard Tcl result.
1.738 + *
1.739 + * Side effects:
1.740 + * See the user documentation.
1.741 + *
1.742 + *----------------------------------------------------------------------
1.743 + */
1.744 +
1.745 + /* ARGSUSED */
1.746 +int
1.747 +Tcl_AfterObjCmd(clientData, interp, objc, objv)
1.748 + ClientData clientData; /* Unused */
1.749 + Tcl_Interp *interp; /* Current interpreter. */
1.750 + int objc; /* Number of arguments. */
1.751 + Tcl_Obj *CONST objv[]; /* Argument objects. */
1.752 +{
1.753 + int ms;
1.754 + AfterInfo *afterPtr;
1.755 + AfterAssocData *assocPtr;
1.756 + int length;
1.757 + char *argString;
1.758 + int index;
1.759 + char buf[16 + TCL_INTEGER_SPACE];
1.760 + static CONST char *afterSubCmds[] = {
1.761 + "cancel", "idle", "info", (char *) NULL
1.762 + };
1.763 + enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
1.764 + ThreadSpecificData *tsdPtr = InitTimer();
1.765 +
1.766 + if (objc < 2) {
1.767 + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
1.768 + return TCL_ERROR;
1.769 + }
1.770 +
1.771 + /*
1.772 + * Create the "after" information associated for this interpreter,
1.773 + * if it doesn't already exist.
1.774 + */
1.775 +
1.776 + assocPtr = Tcl_GetAssocData( interp, "tclAfter", NULL );
1.777 + if (assocPtr == NULL) {
1.778 + assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
1.779 + assocPtr->interp = interp;
1.780 + assocPtr->firstAfterPtr = NULL;
1.781 + Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
1.782 + (ClientData) assocPtr);
1.783 + }
1.784 +
1.785 + /*
1.786 + * First lets see if the command was passed a number as the first argument.
1.787 + */
1.788 +
1.789 + if (objv[1]->typePtr == &tclIntType) {
1.790 + ms = (int) objv[1]->internalRep.longValue;
1.791 + goto processInteger;
1.792 + }
1.793 + argString = Tcl_GetStringFromObj(objv[1], &length);
1.794 + if (argString[0] == '+' || argString[0] == '-'
1.795 + || isdigit(UCHAR(argString[0]))) { /* INTL: digit */
1.796 + if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
1.797 + return TCL_ERROR;
1.798 + }
1.799 +processInteger:
1.800 + if (ms < 0) {
1.801 + ms = 0;
1.802 + }
1.803 + if (objc == 2) {
1.804 + Tcl_Sleep(ms);
1.805 + return TCL_OK;
1.806 + }
1.807 + afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
1.808 + afterPtr->assocPtr = assocPtr;
1.809 + if (objc == 3) {
1.810 + afterPtr->commandPtr = objv[2];
1.811 + } else {
1.812 + afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
1.813 + }
1.814 + Tcl_IncrRefCount(afterPtr->commandPtr);
1.815 + /*
1.816 + * The variable below is used to generate unique identifiers for
1.817 + * after commands. This id can wrap around, which can potentially
1.818 + * cause problems. However, there are not likely to be problems
1.819 + * in practice, because after commands can only be requested to
1.820 + * about a month in the future, and wrap-around is unlikely to
1.821 + * occur in less than about 1-10 years. Thus it's unlikely that
1.822 + * any old ids will still be around when wrap-around occurs.
1.823 + */
1.824 + afterPtr->id = tsdPtr->afterId;
1.825 + tsdPtr->afterId += 1;
1.826 + afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
1.827 + (ClientData) afterPtr);
1.828 + afterPtr->nextPtr = assocPtr->firstAfterPtr;
1.829 + assocPtr->firstAfterPtr = afterPtr;
1.830 + sprintf(buf, "after#%d", afterPtr->id);
1.831 + Tcl_AppendResult(interp, buf, (char *) NULL);
1.832 + return TCL_OK;
1.833 + }
1.834 +
1.835 + /*
1.836 + * If it's not a number it must be a subcommand.
1.837 + */
1.838 +
1.839 + if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "argument",
1.840 + 0, &index) != TCL_OK) {
1.841 + Tcl_AppendResult(interp, "bad argument \"", argString,
1.842 + "\": must be cancel, idle, info, or a number",
1.843 + (char *) NULL);
1.844 + return TCL_ERROR;
1.845 + }
1.846 + switch ((enum afterSubCmds) index) {
1.847 + case AFTER_CANCEL: {
1.848 + Tcl_Obj *commandPtr;
1.849 + char *command, *tempCommand;
1.850 + int tempLength;
1.851 +
1.852 + if (objc < 3) {
1.853 + Tcl_WrongNumArgs(interp, 2, objv, "id|command");
1.854 + return TCL_ERROR;
1.855 + }
1.856 + if (objc == 3) {
1.857 + commandPtr = objv[2];
1.858 + } else {
1.859 + commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
1.860 + }
1.861 + command = Tcl_GetStringFromObj(commandPtr, &length);
1.862 + for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
1.863 + afterPtr = afterPtr->nextPtr) {
1.864 + tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
1.865 + &tempLength);
1.866 + if ((length == tempLength)
1.867 + && (memcmp((void*) command, (void*) tempCommand,
1.868 + (unsigned) length) == 0)) {
1.869 + break;
1.870 + }
1.871 + }
1.872 + if (afterPtr == NULL) {
1.873 + afterPtr = GetAfterEvent(assocPtr, commandPtr);
1.874 + }
1.875 + if (objc != 3) {
1.876 + Tcl_DecrRefCount(commandPtr);
1.877 + }
1.878 + if (afterPtr != NULL) {
1.879 + if (afterPtr->token != NULL) {
1.880 + Tcl_DeleteTimerHandler(afterPtr->token);
1.881 + } else {
1.882 + Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
1.883 + }
1.884 + FreeAfterPtr(afterPtr);
1.885 + }
1.886 + break;
1.887 + }
1.888 + case AFTER_IDLE:
1.889 + if (objc < 3) {
1.890 + Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
1.891 + return TCL_ERROR;
1.892 + }
1.893 + afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
1.894 + afterPtr->assocPtr = assocPtr;
1.895 + if (objc == 3) {
1.896 + afterPtr->commandPtr = objv[2];
1.897 + } else {
1.898 + afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
1.899 + }
1.900 + Tcl_IncrRefCount(afterPtr->commandPtr);
1.901 + afterPtr->id = tsdPtr->afterId;
1.902 + tsdPtr->afterId += 1;
1.903 + afterPtr->token = NULL;
1.904 + afterPtr->nextPtr = assocPtr->firstAfterPtr;
1.905 + assocPtr->firstAfterPtr = afterPtr;
1.906 + Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
1.907 + sprintf(buf, "after#%d", afterPtr->id);
1.908 + Tcl_AppendResult(interp, buf, (char *) NULL);
1.909 + break;
1.910 + case AFTER_INFO: {
1.911 + Tcl_Obj *resultListPtr;
1.912 +
1.913 + if (objc == 2) {
1.914 + for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
1.915 + afterPtr = afterPtr->nextPtr) {
1.916 + if (assocPtr->interp == interp) {
1.917 + sprintf(buf, "after#%d", afterPtr->id);
1.918 + Tcl_AppendElement(interp, buf);
1.919 + }
1.920 + }
1.921 + return TCL_OK;
1.922 + }
1.923 + if (objc != 3) {
1.924 + Tcl_WrongNumArgs(interp, 2, objv, "?id?");
1.925 + return TCL_ERROR;
1.926 + }
1.927 + afterPtr = GetAfterEvent(assocPtr, objv[2]);
1.928 + if (afterPtr == NULL) {
1.929 + Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]),
1.930 + "\" doesn't exist", (char *) NULL);
1.931 + return TCL_ERROR;
1.932 + }
1.933 + resultListPtr = Tcl_GetObjResult(interp);
1.934 + Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
1.935 + Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
1.936 + (afterPtr->token == NULL) ? "idle" : "timer", -1));
1.937 + Tcl_SetObjResult(interp, resultListPtr);
1.938 + break;
1.939 + }
1.940 + default: {
1.941 + panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
1.942 + }
1.943 + }
1.944 + return TCL_OK;
1.945 +}
1.946 +
1.947 +/*
1.948 + *----------------------------------------------------------------------
1.949 + *
1.950 + * GetAfterEvent --
1.951 + *
1.952 + * This procedure parses an "after" id such as "after#4" and
1.953 + * returns a pointer to the AfterInfo structure.
1.954 + *
1.955 + * Results:
1.956 + * The return value is either a pointer to an AfterInfo structure,
1.957 + * if one is found that corresponds to "cmdString" and is for interp,
1.958 + * or NULL if no corresponding after event can be found.
1.959 + *
1.960 + * Side effects:
1.961 + * None.
1.962 + *
1.963 + *----------------------------------------------------------------------
1.964 + */
1.965 +
1.966 +static AfterInfo *
1.967 +GetAfterEvent(assocPtr, commandPtr)
1.968 + AfterAssocData *assocPtr; /* Points to "after"-related information for
1.969 + * this interpreter. */
1.970 + Tcl_Obj *commandPtr;
1.971 +{
1.972 + char *cmdString; /* Textual identifier for after event, such
1.973 + * as "after#6". */
1.974 + AfterInfo *afterPtr;
1.975 + int id;
1.976 + char *end;
1.977 +
1.978 + cmdString = Tcl_GetString(commandPtr);
1.979 + if (strncmp(cmdString, "after#", 6) != 0) {
1.980 + return NULL;
1.981 + }
1.982 + cmdString += 6;
1.983 + id = strtoul(cmdString, &end, 10);
1.984 + if ((end == cmdString) || (*end != 0)) {
1.985 + return NULL;
1.986 + }
1.987 + for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
1.988 + afterPtr = afterPtr->nextPtr) {
1.989 + if (afterPtr->id == id) {
1.990 + return afterPtr;
1.991 + }
1.992 + }
1.993 + return NULL;
1.994 +}
1.995 +
1.996 +/*
1.997 + *----------------------------------------------------------------------
1.998 + *
1.999 + * AfterProc --
1.1000 + *
1.1001 + * Timer callback to execute commands registered with the
1.1002 + * "after" command.
1.1003 + *
1.1004 + * Results:
1.1005 + * None.
1.1006 + *
1.1007 + * Side effects:
1.1008 + * Executes whatever command was specified. If the command
1.1009 + * returns an error, then the command "bgerror" is invoked
1.1010 + * to process the error; if bgerror fails then information
1.1011 + * about the error is output on stderr.
1.1012 + *
1.1013 + *----------------------------------------------------------------------
1.1014 + */
1.1015 +
1.1016 +static void
1.1017 +AfterProc(clientData)
1.1018 + ClientData clientData; /* Describes command to execute. */
1.1019 +{
1.1020 + AfterInfo *afterPtr = (AfterInfo *) clientData;
1.1021 + AfterAssocData *assocPtr = afterPtr->assocPtr;
1.1022 + AfterInfo *prevPtr;
1.1023 + int result;
1.1024 + Tcl_Interp *interp;
1.1025 + char *script;
1.1026 + int numBytes;
1.1027 +
1.1028 + /*
1.1029 + * First remove the callback from our list of callbacks; otherwise
1.1030 + * someone could delete the callback while it's being executed, which
1.1031 + * could cause a core dump.
1.1032 + */
1.1033 +
1.1034 + if (assocPtr->firstAfterPtr == afterPtr) {
1.1035 + assocPtr->firstAfterPtr = afterPtr->nextPtr;
1.1036 + } else {
1.1037 + for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
1.1038 + prevPtr = prevPtr->nextPtr) {
1.1039 + /* Empty loop body. */
1.1040 + }
1.1041 + prevPtr->nextPtr = afterPtr->nextPtr;
1.1042 + }
1.1043 +
1.1044 + /*
1.1045 + * Execute the callback.
1.1046 + */
1.1047 +
1.1048 + interp = assocPtr->interp;
1.1049 + Tcl_Preserve((ClientData) interp);
1.1050 + script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);
1.1051 + result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);
1.1052 + if (result != TCL_OK) {
1.1053 + Tcl_AddErrorInfo(interp, "\n (\"after\" script)");
1.1054 + Tcl_BackgroundError(interp);
1.1055 + }
1.1056 + Tcl_Release((ClientData) interp);
1.1057 +
1.1058 + /*
1.1059 + * Free the memory for the callback.
1.1060 + */
1.1061 +
1.1062 + Tcl_DecrRefCount(afterPtr->commandPtr);
1.1063 + ckfree((char *) afterPtr);
1.1064 +}
1.1065 +
1.1066 +/*
1.1067 + *----------------------------------------------------------------------
1.1068 + *
1.1069 + * FreeAfterPtr --
1.1070 + *
1.1071 + * This procedure removes an "after" command from the list of
1.1072 + * those that are pending and frees its resources. This procedure
1.1073 + * does *not* cancel the timer handler; if that's needed, the
1.1074 + * caller must do it.
1.1075 + *
1.1076 + * Results:
1.1077 + * None.
1.1078 + *
1.1079 + * Side effects:
1.1080 + * The memory associated with afterPtr is released.
1.1081 + *
1.1082 + *----------------------------------------------------------------------
1.1083 + */
1.1084 +
1.1085 +static void
1.1086 +FreeAfterPtr(afterPtr)
1.1087 + AfterInfo *afterPtr; /* Command to be deleted. */
1.1088 +{
1.1089 + AfterInfo *prevPtr;
1.1090 + AfterAssocData *assocPtr = afterPtr->assocPtr;
1.1091 +
1.1092 + if (assocPtr->firstAfterPtr == afterPtr) {
1.1093 + assocPtr->firstAfterPtr = afterPtr->nextPtr;
1.1094 + } else {
1.1095 + for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
1.1096 + prevPtr = prevPtr->nextPtr) {
1.1097 + /* Empty loop body. */
1.1098 + }
1.1099 + prevPtr->nextPtr = afterPtr->nextPtr;
1.1100 + }
1.1101 + Tcl_DecrRefCount(afterPtr->commandPtr);
1.1102 + ckfree((char *) afterPtr);
1.1103 +}
1.1104 +
1.1105 +/*
1.1106 + *----------------------------------------------------------------------
1.1107 + *
1.1108 + * AfterCleanupProc --
1.1109 + *
1.1110 + * This procedure is invoked whenever an interpreter is deleted
1.1111 + * to cleanup the AssocData for "tclAfter".
1.1112 + *
1.1113 + * Results:
1.1114 + * None.
1.1115 + *
1.1116 + * Side effects:
1.1117 + * After commands are removed.
1.1118 + *
1.1119 + *----------------------------------------------------------------------
1.1120 + */
1.1121 +
1.1122 + /* ARGSUSED */
1.1123 +static void
1.1124 +AfterCleanupProc(clientData, interp)
1.1125 + ClientData clientData; /* Points to AfterAssocData for the
1.1126 + * interpreter. */
1.1127 + Tcl_Interp *interp; /* Interpreter that is being deleted. */
1.1128 +{
1.1129 + AfterAssocData *assocPtr = (AfterAssocData *) clientData;
1.1130 + AfterInfo *afterPtr;
1.1131 +
1.1132 + while (assocPtr->firstAfterPtr != NULL) {
1.1133 + afterPtr = assocPtr->firstAfterPtr;
1.1134 + assocPtr->firstAfterPtr = afterPtr->nextPtr;
1.1135 + if (afterPtr->token != NULL) {
1.1136 + Tcl_DeleteTimerHandler(afterPtr->token);
1.1137 + } else {
1.1138 + Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
1.1139 + }
1.1140 + Tcl_DecrRefCount(afterPtr->commandPtr);
1.1141 + ckfree((char *) afterPtr);
1.1142 + }
1.1143 + ckfree((char *) assocPtr);
1.1144 +}