shared_source/c_tcl_base_7_5_w_mods/tclasync.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclasync.c,v 1.1.1.1 2001/06/13 04:33:03 dtashley Exp $ */

/* 
 * 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;
}


/* $History: tclasync.c $
 * 
 * *****************  Version 1  *****************
 * User: Dtashley     Date: 1/02/01    Time: 1:34a
 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
 * Initial check-in.
 */ 

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