shared_source/c_tcl_base_7_5_w_mods/tclasync.c

/* $Header$ */
/* 
 * tclAsync.c --
 *
 *      This file provides low-level support needed to invoke signal
 *      handlers in a safe way.  The code here doesn't actually handle
 *      signals, though.  This code is based on proposals made by
 *      Mark Diekhans and Don Libes.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclasync.c,v 1.1.1.1 2001/06/13 04:33:03 dtashley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * One of the following structures exists for each asynchronous
 * handler:
 */

typedef struct AsyncHandler {
    int ready;                          /* Non-zero means this handler should
                                         * be invoked in the next call to
                                         * Tcl_AsyncInvoke. */
    struct AsyncHandler *nextPtr;       /* Next in list of all handlers for
                                         * the process. */
    Tcl_AsyncProc *proc;                /* Procedure to call when handler
                                         * is invoked. */
    ClientData clientData;              /* Value to pass to handler when it
                                         * is invoked. */
} AsyncHandler;

/*
 * The variables below maintain a list of all existing handlers.
 */

static AsyncHandler *firstHandler;      /* First handler defined for process,
                                         * or NULL if none. */
static AsyncHandler *lastHandler;       /* Last handler or NULL. */

TCL_DECLARE_MUTEX(asyncMutex)           /* Process-wide async handler lock */

/*
 * The variable below is set to 1 whenever a handler becomes ready and
 * it is cleared to zero whenever Tcl_AsyncInvoke is called.  It can be
 * checked elsewhere in the application by calling Tcl_AsyncReady to see
 * if Tcl_AsyncInvoke should be invoked.
 */

static int asyncReady = 0;

/*
 * The variable below indicates whether Tcl_AsyncInvoke is currently
 * working.  If so then we won't set asyncReady again until
 * Tcl_AsyncInvoke returns.
 */

static int asyncActive = 0;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncCreate --
 *
 *      This procedure creates the data structures for an asynchronous
 *      handler, so that no memory has to be allocated when the handler
 *      is activated.
 *
 * Results:
 *      The return value is a token for the handler, which can be used
 *      to activate it later on.
 *
 * Side effects:
 *      Information about the handler is recorded.
 *
 *----------------------------------------------------------------------
 */

Tcl_AsyncHandler
Tcl_AsyncCreate(proc, clientData)
    Tcl_AsyncProc *proc;                /* Procedure to call when handler
                                         * is invoked. */
    ClientData clientData;              /* Argument to pass to handler. */
{
    AsyncHandler *asyncPtr;

    asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
    asyncPtr->ready = 0;
    asyncPtr->nextPtr = NULL;
    asyncPtr->proc = proc;
    asyncPtr->clientData = clientData;
    Tcl_MutexLock(&asyncMutex);
    if (firstHandler == NULL) {
        firstHandler = asyncPtr;
    } else {
        lastHandler->nextPtr = asyncPtr;
    }
    lastHandler = asyncPtr;
    Tcl_MutexUnlock(&asyncMutex);
    return (Tcl_AsyncHandler) asyncPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncMark --
 *
 *      This procedure is called to request that an asynchronous handler
 *      be invoked as soon as possible.  It's typically called from
 *      an interrupt handler, where it isn't safe to do anything that
 *      depends on or modifies application state.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The handler gets marked for invocation later.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AsyncMark(async)
    Tcl_AsyncHandler async;             /* Token for handler. */
{
    Tcl_MutexLock(&asyncMutex);
    ((AsyncHandler *) async)->ready = 1;
    if (!asyncActive) {
        asyncReady = 1;
        TclpAsyncMark(async);
    }
    Tcl_MutexUnlock(&asyncMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncInvoke --
 *
 *      This procedure is called at a "safe" time at background level
 *      to invoke any active asynchronous handlers.
 *
 * Results:
 *      The return value is a normal Tcl result, which is intended to
 *      replace the code argument as the current completion code for
 *      interp.
 *
 * Side effects:
 *      Depends on the handlers that are active.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AsyncInvoke(interp, code)
    Tcl_Interp *interp;                 /* If invoked from Tcl_Eval just after
                                         * completing a command, points to
                                         * interpreter.  Otherwise it is
                                         * NULL. */
    int code;                           /* If interp is non-NULL, this gives
                                         * completion code from command that
                                         * just completed. */
{
    AsyncHandler *asyncPtr;
    Tcl_MutexLock(&asyncMutex);

    if (asyncReady == 0) {
        Tcl_MutexUnlock(&asyncMutex);
        return code;
    }
    asyncReady = 0;
    asyncActive = 1;
    if (interp == NULL) {
        code = 0;
    }

    /*
     * Make one or more passes over the list of handlers, invoking
     * at most one handler in each pass.  After invoking a handler,
     * go back to the start of the list again so that (a) if a new
     * higher-priority handler gets marked while executing a lower
     * priority handler, we execute the higher-priority handler
     * next, and (b) if a handler gets deleted during the execution
     * of a handler, then the list structure may change so it isn't
     * safe to continue down the list anyway.
     */

    while (1) {
        for (asyncPtr = firstHandler; asyncPtr != NULL;
                asyncPtr = asyncPtr->nextPtr) {
            if (asyncPtr->ready) {
                break;
            }
        }
        if (asyncPtr == NULL) {
            break;
        }
        asyncPtr->ready = 0;
        Tcl_MutexUnlock(&asyncMutex);
        code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
        Tcl_MutexLock(&asyncMutex);
    }
    asyncActive = 0;
    Tcl_MutexUnlock(&asyncMutex);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncDelete --
 *
 *      Frees up all the state for an asynchronous handler.  The handler
 *      should never be used again.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The state associated with the handler is deleted.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AsyncDelete(async)
    Tcl_AsyncHandler async;             /* Token for handler to delete. */
{
    AsyncHandler *asyncPtr = (AsyncHandler *) async;
    AsyncHandler *prevPtr;

    Tcl_MutexLock(&asyncMutex);
    if (firstHandler == asyncPtr) {
        firstHandler = asyncPtr->nextPtr;
        if (firstHandler == NULL) {
            lastHandler = NULL;
        }
    } else {
        prevPtr = firstHandler;
        while (prevPtr->nextPtr != asyncPtr) {
            prevPtr = prevPtr->nextPtr;
        }
        prevPtr->nextPtr = asyncPtr->nextPtr;
        if (lastHandler == asyncPtr) {
            lastHandler = prevPtr;
        }
    }
    Tcl_MutexUnlock(&asyncMutex);
    ckfree((char *) asyncPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncReady --
 *
 *      This procedure can be used to tell whether Tcl_AsyncInvoke
 *      needs to be called.  This procedure is the external interface
 *      for checking the internal asyncReady variable.
 *
 * Results:
 *      The return value is 1 whenever a handler is ready and is 0
 *      when no handlers are ready.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AsyncReady()
{
    return asyncReady;
}

/* End of tclasync.c */
1	dashley	64	/* $Header$ */
2	dashley	25	/*
3			* tclAsync.c --
4			*
5			* This file provides low-level support needed to invoke signal
6			* handlers in a safe way. The code here doesn't actually handle
7			* signals, though. This code is based on proposals made by
8			* Mark Diekhans and Don Libes.
9			*
10			* Copyright (c) 1993 The Regents of the University of California.
11			* Copyright (c) 1994 Sun Microsystems, Inc.
12			*
13			* See the file "license.terms" for information on usage and redistribution
14			* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15			*
16			* RCS: @(#) $Id: tclasync.c,v 1.1.1.1 2001/06/13 04:33:03 dtashley Exp $
17			*/
18
19			#include "tclInt.h"
20			#include "tclPort.h"
21
22			/*
23			* One of the following structures exists for each asynchronous
24			* handler:
25			*/
26
27			typedef struct AsyncHandler {
28			int ready; /* Non-zero means this handler should
29			* be invoked in the next call to
30			* Tcl_AsyncInvoke. */
31			struct AsyncHandler nextPtr; / Next in list of all handlers for
32			* the process. */
33			Tcl_AsyncProc proc; / Procedure to call when handler
34			* is invoked. */
35			ClientData clientData; /* Value to pass to handler when it
36			* is invoked. */
37			} AsyncHandler;
38
39			/*
40			* The variables below maintain a list of all existing handlers.
41			*/
42
43			static AsyncHandler firstHandler; / First handler defined for process,
44			* or NULL if none. */
45			static AsyncHandler lastHandler; / Last handler or NULL. */
46
47			TCL_DECLARE_MUTEX(asyncMutex) /* Process-wide async handler lock */
48
49			/*
50			* The variable below is set to 1 whenever a handler becomes ready and
51			* it is cleared to zero whenever Tcl_AsyncInvoke is called. It can be
52			* checked elsewhere in the application by calling Tcl_AsyncReady to see
53			* if Tcl_AsyncInvoke should be invoked.
54			*/
55
56			static int asyncReady = 0;
57
58			/*
59			* The variable below indicates whether Tcl_AsyncInvoke is currently
60			* working. If so then we won't set asyncReady again until
61			* Tcl_AsyncInvoke returns.
62			*/
63
64			static int asyncActive = 0;
65
66			/*
67			*----------------------------------------------------------------------
68			*
69			* Tcl_AsyncCreate --
70			*
71			* This procedure creates the data structures for an asynchronous
72			* handler, so that no memory has to be allocated when the handler
73			* is activated.
74			*
75			* Results:
76			* The return value is a token for the handler, which can be used
77			* to activate it later on.
78			*
79			* Side effects:
80			* Information about the handler is recorded.
81			*
82			*----------------------------------------------------------------------
83			*/
84
85			Tcl_AsyncHandler
86			Tcl_AsyncCreate(proc, clientData)
87			Tcl_AsyncProc proc; / Procedure to call when handler
88			* is invoked. */
89			ClientData clientData; /* Argument to pass to handler. */
90			{
91			AsyncHandler *asyncPtr;
92
93			asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
94			asyncPtr->ready = 0;
95			asyncPtr->nextPtr = NULL;
96			asyncPtr->proc = proc;
97			asyncPtr->clientData = clientData;
98			Tcl_MutexLock(&asyncMutex);
99			if (firstHandler == NULL) {
100			firstHandler = asyncPtr;
101			} else {
102			lastHandler->nextPtr = asyncPtr;
103			}
104			lastHandler = asyncPtr;
105			Tcl_MutexUnlock(&asyncMutex);
106			return (Tcl_AsyncHandler) asyncPtr;
107			}
108
109			/*
110			*----------------------------------------------------------------------
111			*
112			* Tcl_AsyncMark --
113			*
114			* This procedure is called to request that an asynchronous handler
115			* be invoked as soon as possible. It's typically called from
116			* an interrupt handler, where it isn't safe to do anything that
117			* depends on or modifies application state.
118			*
119			* Results:
120			* None.
121			*
122			* Side effects:
123			* The handler gets marked for invocation later.
124			*
125			*----------------------------------------------------------------------
126			*/
127
128			void
129			Tcl_AsyncMark(async)
130			Tcl_AsyncHandler async; /* Token for handler. */
131			{
132			Tcl_MutexLock(&asyncMutex);
133			((AsyncHandler *) async)->ready = 1;
134			if (!asyncActive) {
135			asyncReady = 1;
136			TclpAsyncMark(async);
137			}
138			Tcl_MutexUnlock(&asyncMutex);
139			}
140
141			/*
142			*----------------------------------------------------------------------
143			*
144			* Tcl_AsyncInvoke --
145			*
146			* This procedure is called at a "safe" time at background level
147			* to invoke any active asynchronous handlers.
148			*
149			* Results:
150			* The return value is a normal Tcl result, which is intended to
151			* replace the code argument as the current completion code for
152			* interp.
153			*
154			* Side effects:
155			* Depends on the handlers that are active.
156			*
157			*----------------------------------------------------------------------
158			*/
159
160			int
161			Tcl_AsyncInvoke(interp, code)
162			Tcl_Interp interp; / If invoked from Tcl_Eval just after
163			* completing a command, points to
164			* interpreter. Otherwise it is
165			* NULL. */
166			int code; /* If interp is non-NULL, this gives
167			* completion code from command that
168			* just completed. */
169			{
170			AsyncHandler *asyncPtr;
171			Tcl_MutexLock(&asyncMutex);
172
173			if (asyncReady == 0) {
174			Tcl_MutexUnlock(&asyncMutex);
175			return code;
176			}
177			asyncReady = 0;
178			asyncActive = 1;
179			if (interp == NULL) {
180			code = 0;
181			}
182
183			/*
184			* Make one or more passes over the list of handlers, invoking
185			* at most one handler in each pass. After invoking a handler,
186			* go back to the start of the list again so that (a) if a new
187			* higher-priority handler gets marked while executing a lower
188			* priority handler, we execute the higher-priority handler
189			* next, and (b) if a handler gets deleted during the execution
190			* of a handler, then the list structure may change so it isn't
191			* safe to continue down the list anyway.
192			*/
193
194			while (1) {
195			for (asyncPtr = firstHandler; asyncPtr != NULL;
196			asyncPtr = asyncPtr->nextPtr) {
197			if (asyncPtr->ready) {
198			break;
199			}
200			}
201			if (asyncPtr == NULL) {
202			break;
203			}
204			asyncPtr->ready = 0;
205			Tcl_MutexUnlock(&asyncMutex);
206			code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
207			Tcl_MutexLock(&asyncMutex);
208			}
209			asyncActive = 0;
210			Tcl_MutexUnlock(&asyncMutex);
211			return code;
212			}
213
214			/*
215			*----------------------------------------------------------------------
216			*
217			* Tcl_AsyncDelete --
218			*
219			* Frees up all the state for an asynchronous handler. The handler
220			* should never be used again.
221			*
222			* Results:
223			* None.
224			*
225			* Side effects:
226			* The state associated with the handler is deleted.
227			*
228			*----------------------------------------------------------------------
229			*/
230
231			void
232			Tcl_AsyncDelete(async)
233			Tcl_AsyncHandler async; /* Token for handler to delete. */
234			{
235			AsyncHandler asyncPtr = (AsyncHandler ) async;
236			AsyncHandler *prevPtr;
237
238			Tcl_MutexLock(&asyncMutex);
239			if (firstHandler == asyncPtr) {
240			firstHandler = asyncPtr->nextPtr;
241			if (firstHandler == NULL) {
242			lastHandler = NULL;
243			}
244			} else {
245			prevPtr = firstHandler;
246			while (prevPtr->nextPtr != asyncPtr) {
247			prevPtr = prevPtr->nextPtr;
248			}
249			prevPtr->nextPtr = asyncPtr->nextPtr;
250			if (lastHandler == asyncPtr) {
251			lastHandler = prevPtr;
252			}
253			}
254			Tcl_MutexUnlock(&asyncMutex);
255			ckfree((char *) asyncPtr);
256			}
257
258			/*
259			*----------------------------------------------------------------------
260			*
261			* Tcl_AsyncReady --
262			*
263			* This procedure can be used to tell whether Tcl_AsyncInvoke
264			* needs to be called. This procedure is the external interface
265			* for checking the internal asyncReady variable.
266			*
267			* Results:
268			* The return value is 1 whenever a handler is ready and is 0
269			* when no handlers are ready.
270			*
271			* Side effects:
272			* None.
273			*
274			*----------------------------------------------------------------------
275			*/
276
277			int
278			Tcl_AsyncReady()
279			{
280			return asyncReady;
281			}
282
283	dashley	67	/* End of tclasync.c */