shared_source/tcl_base/tclpreserve.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclpreserve.c,v 1.1.1.1 2001/06/13 04:45:15 dtashley Exp $ */

/* 
 * tclPreserve.c --
 *
 *      This file contains a collection of procedures that are used
 *      to make sure that widget records and other data structures
 *      aren't reallocated when there are nested procedures that
 *      depend on their existence.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 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: tclpreserve.c,v 1.1.1.1 2001/06/13 04:45:15 dtashley Exp $
 */

#include "tclInt.h"

/*
 * The following data structure is used to keep track of all the
 * Tcl_Preserve calls that are still in effect.  It grows as needed
 * to accommodate any number of calls in effect.
 */

typedef struct {
    ClientData clientData;      /* Address of preserved block. */
    int refCount;               /* Number of Tcl_Preserve calls in effect
                                 * for block. */
    int mustFree;               /* Non-zero means Tcl_EventuallyFree was
                                 * called while a Tcl_Preserve call was in
                                 * effect, so the structure must be freed
                                 * when refCount becomes zero. */
    Tcl_FreeProc *freeProc;     /* Procedure to call to free. */
} Reference;

static Reference *refArray;     /* First in array of references. */
static int spaceAvl = 0;        /* Total number of structures available
                                 * at *firstRefPtr. */
static int inUse = 0;           /* Count of structures currently in use
                                 * in refArray. */
#define INITIAL_SIZE 2
TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */

/*
 * The following data structure is used to keep track of whether an
 * arbitrary block of memory has been deleted.  This is used by the
 * TclHandle code to avoid the more time-expensive algorithm of
 * Tcl_Preserve().  This mechanism is mainly used when we have lots of
 * references to a few big, expensive objects that we don't want to live
 * any longer than necessary.
 */

typedef struct HandleStruct {
    VOID *ptr;                  /* Pointer to the memory block being
                                 * tracked.  This field will become NULL when
                                 * the memory block is deleted.  This field
                                 * must be the first in the structure. */
#ifdef TCL_MEM_DEBUG
    VOID *ptr2;                 /* Backup copy of the abpve pointer used to
                                 * ensure that the contents of the handle are
                                 * not changed by anyone else. */
#endif
    int refCount;               /* Number of TclHandlePreserve() calls in
                                 * effect on this handle. */
} HandleStruct;


/*
 * Static routines in this file:
 */

static void     PreserveExitProc _ANSI_ARGS_((ClientData clientData));


/*
 *----------------------------------------------------------------------
 *
 * PreserveExitProc --
 *
 *      Called during exit processing to clean up the reference array.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees the storage of the reference array.
 *
 *----------------------------------------------------------------------
 */

        /* ARGSUSED */
static void
PreserveExitProc(clientData)
    ClientData clientData;              /* NULL -Unused. */
{
    Tcl_MutexLock(&preserveMutex);
    if (spaceAvl != 0) {
        ckfree((char *) refArray);
        refArray = (Reference *) NULL;
        inUse = 0;
        spaceAvl = 0;
    }
    Tcl_MutexUnlock(&preserveMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Preserve --
 *
 *      This procedure is used by a procedure to declare its interest
 *      in a particular block of memory, so that the block will not be
 *      reallocated until a matching call to Tcl_Release has been made.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Information is retained so that the block of memory will
 *      not be freed until at least the matching call to Tcl_Release.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Preserve(clientData)
    ClientData clientData;      /* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    int i;

    /*
     * See if there is already a reference for this pointer.  If so,
     * just increment its reference count.
     */

    Tcl_MutexLock(&preserveMutex);
    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
        if (refPtr->clientData == clientData) {
            refPtr->refCount++;
            Tcl_MutexUnlock(&preserveMutex);
            return;
        }
    }

    /*
     * Make a reference array if it doesn't already exist, or make it
     * bigger if it is full.
     */

    if (inUse == spaceAvl) {
        if (spaceAvl == 0) {
            Tcl_CreateExitHandler((Tcl_ExitProc *) PreserveExitProc,
                    (ClientData) NULL);
            refArray = (Reference *) ckalloc((unsigned)
                    (INITIAL_SIZE*sizeof(Reference)));
            spaceAvl = INITIAL_SIZE;
        } else {
            Reference *new;

            new = (Reference *) ckalloc((unsigned)
                    (2*spaceAvl*sizeof(Reference)));
            memcpy((VOID *) new, (VOID *) refArray,
                    spaceAvl*sizeof(Reference));
            ckfree((char *) refArray);
            refArray = new;
            spaceAvl *= 2;
        }
    }

    /*
     * Make a new entry for the new reference.
     */

    refPtr = &refArray[inUse];
    refPtr->clientData = clientData;
    refPtr->refCount = 1;
    refPtr->mustFree = 0;
    refPtr->freeProc = TCL_STATIC;
    inUse += 1;
    Tcl_MutexUnlock(&preserveMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Release --
 *
 *      This procedure is called to cancel a previous call to
 *      Tcl_Preserve, thereby allowing a block of memory to be
 *      freed (if no one else cares about it).
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      If Tcl_EventuallyFree has been called for clientData, and if
 *      no other call to Tcl_Preserve is still in effect, the block of
 *      memory is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Release(clientData)
    ClientData clientData;      /* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    int mustFree;
    Tcl_FreeProc *freeProc;
    int i;

    Tcl_MutexLock(&preserveMutex);
    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
        if (refPtr->clientData != clientData) {
            continue;
        }
        refPtr->refCount--;
        if (refPtr->refCount == 0) {

            /*
             * Must remove information from the slot before calling freeProc
             * to avoid reentrancy problems if the freeProc calls Tcl_Preserve
             * on the same clientData. Copy down the last reference in the
             * array to overwrite the current slot.
             */

            freeProc = refPtr->freeProc;
            mustFree = refPtr->mustFree;
            inUse--;
            if (i < inUse) {
                refArray[i] = refArray[inUse];
            }
            if (mustFree) {
                if ((freeProc == TCL_DYNAMIC) ||
                        (freeProc == (Tcl_FreeProc *) free)) {
                    ckfree((char *) clientData);
                } else {
                    Tcl_MutexUnlock(&preserveMutex);
                    (*freeProc)((char *) clientData);
                    return;
                }
            }
        }
        Tcl_MutexUnlock(&preserveMutex);
        return;
    }
    Tcl_MutexUnlock(&preserveMutex);

    /*
     * Reference not found.  This is a bug in the caller.
     */

    panic("Tcl_Release couldn't find reference for 0x%x", clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EventuallyFree --
 *
 *      Free up a block of memory, unless a call to Tcl_Preserve is in
 *      effect for that block.  In this case, defer the free until all
 *      calls to Tcl_Preserve have been undone by matching calls to
 *      Tcl_Release.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Ptr may be released by calling free().
 *
 *----------------------------------------------------------------------
 */

void
Tcl_EventuallyFree(clientData, freeProc)
    ClientData clientData;      /* Pointer to malloc'ed block of memory. */
    Tcl_FreeProc *freeProc;     /* Procedure to actually do free. */
{
    Reference *refPtr;
    int i;

    /*
     * See if there is a reference for this pointer.  If so, set its
     * "mustFree" flag (the flag had better not be set already!).
     */

    Tcl_MutexLock(&preserveMutex);
    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
        if (refPtr->clientData != clientData) {
            continue;
        }
        if (refPtr->mustFree) {
            panic("Tcl_EventuallyFree called twice for 0x%x\n", clientData);
        }
        refPtr->mustFree = 1;
        refPtr->freeProc = freeProc;
        Tcl_MutexUnlock(&preserveMutex);
        return;
    }
    Tcl_MutexUnlock(&preserveMutex);

    /*
     * No reference for this block.  Free it now.
     */

    if ((freeProc == TCL_DYNAMIC)
            || (freeProc == (Tcl_FreeProc *) free)) {
        ckfree((char *) clientData);
    } else {
        (*freeProc)((char *)clientData);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandleCreate --
 *
 *      Allocate a handle that contains enough information to determine
 *      if an arbitrary malloc'd block has been deleted.  This is 
 *      used to avoid the more time-expensive algorithm of Tcl_Preserve().
 *
 * Results:
 *      The return value is a TclHandle that refers to the given malloc'd
 *      block.  Doubly dereferencing the returned handle will give
 *      back the pointer to the block, or will give NULL if the block has
 *      been deleted.
 *
 * Side effects:
 *      The caller must keep track of this handle (generally by storing
 *      it in a field in the malloc'd block) and call TclHandleFree()
 *      on this handle when the block is deleted.  Everything else that
 *      wishes to keep track of whether the malloc'd block has been deleted
 *      should use calls to TclHandlePreserve() and TclHandleRelease()
 *      on the associated handle.
 *
 *---------------------------------------------------------------------------
 */

TclHandle
TclHandleCreate(ptr)
    VOID *ptr;                  /* Pointer to an arbitrary block of memory
                                 * to be tracked for deletion.  Must not be
                                 * NULL. */
{
    HandleStruct *handlePtr;

    handlePtr = (HandleStruct *) ckalloc(sizeof(HandleStruct));
    handlePtr->ptr = ptr;
#ifdef TCL_MEM_DEBUG
    handlePtr->ptr2 = ptr;
#endif
    handlePtr->refCount = 0;
    return (TclHandle) handlePtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandleFree --
 *
 *      Called when the arbitrary malloc'd block associated with the
 *      handle is being deleted.  Modifies the handle so that doubly
 *      dereferencing it will give NULL.  This informs any user of the
 *      handle that the block of memory formerly referenced by the
 *      handle has been freed.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      If nothing is referring to the handle, the handle will be reclaimed.
 *
 *---------------------------------------------------------------------------
 */

void
TclHandleFree(handle)
    TclHandle handle;           /* Previously created handle associated
                                 * with a malloc'd block that is being
                                 * deleted.  The handle is modified so that
                                 * doubly dereferencing it will give NULL. */
{
    HandleStruct *handlePtr;

    handlePtr = (HandleStruct *) handle;
#ifdef TCL_MEM_DEBUG
    if (handlePtr->refCount == 0x61616161) {
        panic("using previously disposed TclHandle %x", handlePtr);
    }
    if (handlePtr->ptr2 != handlePtr->ptr) {
        panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
                handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->ptr = NULL;
    if (handlePtr->refCount == 0) {
        ckfree((char *) handlePtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandlePreserve --
 *
 *      Declare an interest in the arbitrary malloc'd block associated
 *      with the handle.  
 *
 * Results:
 *      The return value is the handle argument, with its ref count
 *      incremented.
 *
 * Side effects:
 *      For each call to TclHandlePreserve(), there should be a matching
 *      call to TclHandleRelease() when the caller is no longer interested
 *      in the malloc'd block associated with the handle.
 *
 *---------------------------------------------------------------------------
 */

TclHandle
TclHandlePreserve(handle)
    TclHandle handle;           /* Declare an interest in the block of
                                 * memory referenced by this handle. */
{
    HandleStruct *handlePtr;

    handlePtr = (HandleStruct *) handle;
#ifdef TCL_MEM_DEBUG
    if (handlePtr->refCount == 0x61616161) {
        panic("using previously disposed TclHandle %x", handlePtr);
    }
    if ((handlePtr->ptr != NULL)
            && (handlePtr->ptr != handlePtr->ptr2)) {
        panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
                handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->refCount++;

    return handle;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandleRelease --
 *
 *      This procedure is called to release an interest in the malloc'd
 *      block associated with the handle.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The ref count of the handle is decremented.  If the malloc'd block
 *      has been freed and if no one is using the handle any more, the
 *      handle will be reclaimed.
 *
 *---------------------------------------------------------------------------
 */
 
void
TclHandleRelease(handle)
    TclHandle handle;           /* Unregister interest in the block of
                                 * memory referenced by this handle. */
{
    HandleStruct *handlePtr;

    handlePtr = (HandleStruct *) handle;
#ifdef TCL_MEM_DEBUG
    if (handlePtr->refCount == 0x61616161) {
        panic("using previously disposed TclHandle %x", handlePtr);
    }
    if ((handlePtr->ptr != NULL)
            && (handlePtr->ptr != handlePtr->ptr2)) {
        panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
                handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->refCount--;
    if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
        ckfree((char *) handlePtr);
    }
}
    

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

/* End of TCLPRESERVE.C */
1	/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclpreserve.c,v 1.1.1.1 2001/06/13 04:45:15 dtashley Exp $ */
2
3	/*
4	* tclPreserve.c --
5	*
6	* This file contains a collection of procedures that are used
7	* to make sure that widget records and other data structures
8	* aren't reallocated when there are nested procedures that
9	* depend on their existence.
10	*
11	* Copyright (c) 1991-1994 The Regents of the University of California.
12	* Copyright (c) 1994-1998 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: tclpreserve.c,v 1.1.1.1 2001/06/13 04:45:15 dtashley Exp $
18	*/
19
20	#include "tclInt.h"
21
22	/*
23	* The following data structure is used to keep track of all the
24	* Tcl_Preserve calls that are still in effect. It grows as needed
25	* to accommodate any number of calls in effect.
26	*/
27
28	typedef struct {
29	ClientData clientData; /* Address of preserved block. */
30	int refCount; /* Number of Tcl_Preserve calls in effect
31	* for block. */
32	int mustFree; /* Non-zero means Tcl_EventuallyFree was
33	* called while a Tcl_Preserve call was in
34	* effect, so the structure must be freed
35	* when refCount becomes zero. */
36	Tcl_FreeProc freeProc; / Procedure to call to free. */
37	} Reference;
38
39	static Reference refArray; / First in array of references. */
40	static int spaceAvl = 0; /* Total number of structures available
41	* at firstRefPtr. /
42	static int inUse = 0; /* Count of structures currently in use
43	* in refArray. */
44	#define INITIAL_SIZE 2
45	TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */
46
47	/*
48	* The following data structure is used to keep track of whether an
49	* arbitrary block of memory has been deleted. This is used by the
50	* TclHandle code to avoid the more time-expensive algorithm of
51	* Tcl_Preserve(). This mechanism is mainly used when we have lots of
52	* references to a few big, expensive objects that we don't want to live
53	* any longer than necessary.
54	*/
55
56	typedef struct HandleStruct {
57	VOID ptr; / Pointer to the memory block being
58	* tracked. This field will become NULL when
59	* the memory block is deleted. This field
60	* must be the first in the structure. */
61	#ifdef TCL_MEM_DEBUG
62	VOID ptr2; / Backup copy of the abpve pointer used to
63	* ensure that the contents of the handle are
64	* not changed by anyone else. */
65	#endif
66	int refCount; /* Number of TclHandlePreserve() calls in
67	* effect on this handle. */
68	} HandleStruct;
69
70
71	/*
72	* Static routines in this file:
73	*/
74
75	static void PreserveExitProc _ANSI_ARGS_((ClientData clientData));
76
77
78	/*
79	*----------------------------------------------------------------------
80	*
81	* PreserveExitProc --
82	*
83	* Called during exit processing to clean up the reference array.
84	*
85	* Results:
86	* None.
87	*
88	* Side effects:
89	* Frees the storage of the reference array.
90	*
91	*----------------------------------------------------------------------
92	*/
93
94	/* ARGSUSED */
95	static void
96	PreserveExitProc(clientData)
97	ClientData clientData; /* NULL -Unused. */
98	{
99	Tcl_MutexLock(&preserveMutex);
100	if (spaceAvl != 0) {
101	ckfree((char *) refArray);
102	refArray = (Reference *) NULL;
103	inUse = 0;
104	spaceAvl = 0;
105	}
106	Tcl_MutexUnlock(&preserveMutex);
107	}
108
109	/*
110	*----------------------------------------------------------------------
111	*
112	* Tcl_Preserve --
113	*
114	* This procedure is used by a procedure to declare its interest
115	* in a particular block of memory, so that the block will not be
116	* reallocated until a matching call to Tcl_Release has been made.
117	*
118	* Results:
119	* None.
120	*
121	* Side effects:
122	* Information is retained so that the block of memory will
123	* not be freed until at least the matching call to Tcl_Release.
124	*
125	*----------------------------------------------------------------------
126	*/
127
128	void
129	Tcl_Preserve(clientData)
130	ClientData clientData; /* Pointer to malloc'ed block of memory. */
131	{
132	Reference *refPtr;
133	int i;
134
135	/*
136	* See if there is already a reference for this pointer. If so,
137	* just increment its reference count.
138	*/
139
140	Tcl_MutexLock(&preserveMutex);
141	for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
142	if (refPtr->clientData == clientData) {
143	refPtr->refCount++;
144	Tcl_MutexUnlock(&preserveMutex);
145	return;
146	}
147	}
148
149	/*
150	* Make a reference array if it doesn't already exist, or make it
151	* bigger if it is full.
152	*/
153
154	if (inUse == spaceAvl) {
155	if (spaceAvl == 0) {
156	Tcl_CreateExitHandler((Tcl_ExitProc *) PreserveExitProc,
157	(ClientData) NULL);
158	refArray = (Reference *) ckalloc((unsigned)
159	(INITIAL_SIZE*sizeof(Reference)));
160	spaceAvl = INITIAL_SIZE;
161	} else {
162	Reference *new;
163
164	new = (Reference *) ckalloc((unsigned)
165	(2spaceAvlsizeof(Reference)));
166	memcpy((VOID ) new, (VOID ) refArray,
167	spaceAvl*sizeof(Reference));
168	ckfree((char *) refArray);
169	refArray = new;
170	spaceAvl *= 2;
171	}
172	}
173
174	/*
175	* Make a new entry for the new reference.
176	*/
177
178	refPtr = &refArray[inUse];
179	refPtr->clientData = clientData;
180	refPtr->refCount = 1;
181	refPtr->mustFree = 0;
182	refPtr->freeProc = TCL_STATIC;
183	inUse += 1;
184	Tcl_MutexUnlock(&preserveMutex);
185	}
186
187	/*
188	*----------------------------------------------------------------------
189	*
190	* Tcl_Release --
191	*
192	* This procedure is called to cancel a previous call to
193	* Tcl_Preserve, thereby allowing a block of memory to be
194	* freed (if no one else cares about it).
195	*
196	* Results:
197	* None.
198	*
199	* Side effects:
200	* If Tcl_EventuallyFree has been called for clientData, and if
201	* no other call to Tcl_Preserve is still in effect, the block of
202	* memory is freed.
203	*
204	*----------------------------------------------------------------------
205	*/
206
207	void
208	Tcl_Release(clientData)
209	ClientData clientData; /* Pointer to malloc'ed block of memory. */
210	{
211	Reference *refPtr;
212	int mustFree;
213	Tcl_FreeProc *freeProc;
214	int i;
215
216	Tcl_MutexLock(&preserveMutex);
217	for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
218	if (refPtr->clientData != clientData) {
219	continue;
220	}
221	refPtr->refCount--;
222	if (refPtr->refCount == 0) {
223
224	/*
225	* Must remove information from the slot before calling freeProc
226	* to avoid reentrancy problems if the freeProc calls Tcl_Preserve
227	* on the same clientData. Copy down the last reference in the
228	* array to overwrite the current slot.
229	*/
230
231	freeProc = refPtr->freeProc;
232	mustFree = refPtr->mustFree;
233	inUse--;
234	if (i < inUse) {
235	refArray[i] = refArray[inUse];
236	}
237	if (mustFree) {
238	if ((freeProc == TCL_DYNAMIC) \|\|
239	(freeProc == (Tcl_FreeProc *) free)) {
240	ckfree((char *) clientData);
241	} else {
242	Tcl_MutexUnlock(&preserveMutex);
243	(freeProc)((char ) clientData);
244	return;
245	}
246	}
247	}
248	Tcl_MutexUnlock(&preserveMutex);
249	return;
250	}
251	Tcl_MutexUnlock(&preserveMutex);
252
253	/*
254	* Reference not found. This is a bug in the caller.
255	*/
256
257	panic("Tcl_Release couldn't find reference for 0x%x", clientData);
258	}
259
260	/*
261	*----------------------------------------------------------------------
262	*
263	* Tcl_EventuallyFree --
264	*
265	* Free up a block of memory, unless a call to Tcl_Preserve is in
266	* effect for that block. In this case, defer the free until all
267	* calls to Tcl_Preserve have been undone by matching calls to
268	* Tcl_Release.
269	*
270	* Results:
271	* None.
272	*
273	* Side effects:
274	* Ptr may be released by calling free().
275	*
276	*----------------------------------------------------------------------
277	*/
278
279	void
280	Tcl_EventuallyFree(clientData, freeProc)
281	ClientData clientData; /* Pointer to malloc'ed block of memory. */
282	Tcl_FreeProc freeProc; / Procedure to actually do free. */
283	{
284	Reference *refPtr;
285	int i;
286
287	/*
288	* See if there is a reference for this pointer. If so, set its
289	* "mustFree" flag (the flag had better not be set already!).
290	*/
291
292	Tcl_MutexLock(&preserveMutex);
293	for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
294	if (refPtr->clientData != clientData) {
295	continue;
296	}
297	if (refPtr->mustFree) {
298	panic("Tcl_EventuallyFree called twice for 0x%x\n", clientData);
299	}
300	refPtr->mustFree = 1;
301	refPtr->freeProc = freeProc;
302	Tcl_MutexUnlock(&preserveMutex);
303	return;
304	}
305	Tcl_MutexUnlock(&preserveMutex);
306
307	/*
308	* No reference for this block. Free it now.
309	*/
310
311	if ((freeProc == TCL_DYNAMIC)
312	\|\| (freeProc == (Tcl_FreeProc *) free)) {
313	ckfree((char *) clientData);
314	} else {
315	(freeProc)((char )clientData);
316	}
317	}
318
319	/*
320	*---------------------------------------------------------------------------
321	*
322	* TclHandleCreate --
323	*
324	* Allocate a handle that contains enough information to determine
325	* if an arbitrary malloc'd block has been deleted. This is
326	* used to avoid the more time-expensive algorithm of Tcl_Preserve().
327	*
328	* Results:
329	* The return value is a TclHandle that refers to the given malloc'd
330	* block. Doubly dereferencing the returned handle will give
331	* back the pointer to the block, or will give NULL if the block has
332	* been deleted.
333	*
334	* Side effects:
335	* The caller must keep track of this handle (generally by storing
336	* it in a field in the malloc'd block) and call TclHandleFree()
337	* on this handle when the block is deleted. Everything else that
338	* wishes to keep track of whether the malloc'd block has been deleted
339	* should use calls to TclHandlePreserve() and TclHandleRelease()
340	* on the associated handle.
341	*
342	*---------------------------------------------------------------------------
343	*/
344
345	TclHandle
346	TclHandleCreate(ptr)
347	VOID ptr; / Pointer to an arbitrary block of memory
348	* to be tracked for deletion. Must not be
349	* NULL. */
350	{
351	HandleStruct *handlePtr;
352
353	handlePtr = (HandleStruct *) ckalloc(sizeof(HandleStruct));
354	handlePtr->ptr = ptr;
355	#ifdef TCL_MEM_DEBUG
356	handlePtr->ptr2 = ptr;
357	#endif
358	handlePtr->refCount = 0;
359	return (TclHandle) handlePtr;
360	}
361
362	/*
363	*---------------------------------------------------------------------------
364	*
365	* TclHandleFree --
366	*
367	* Called when the arbitrary malloc'd block associated with the
368	* handle is being deleted. Modifies the handle so that doubly
369	* dereferencing it will give NULL. This informs any user of the
370	* handle that the block of memory formerly referenced by the
371	* handle has been freed.
372	*
373	* Results:
374	* None.
375	*
376	* Side effects:
377	* If nothing is referring to the handle, the handle will be reclaimed.
378	*
379	*---------------------------------------------------------------------------
380	*/
381
382	void
383	TclHandleFree(handle)
384	TclHandle handle; /* Previously created handle associated
385	* with a malloc'd block that is being
386	* deleted. The handle is modified so that
387	* doubly dereferencing it will give NULL. */
388	{
389	HandleStruct *handlePtr;
390
391	handlePtr = (HandleStruct *) handle;
392	#ifdef TCL_MEM_DEBUG
393	if (handlePtr->refCount == 0x61616161) {
394	panic("using previously disposed TclHandle %x", handlePtr);
395	}
396	if (handlePtr->ptr2 != handlePtr->ptr) {
397	panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
398	handlePtr, handlePtr->ptr2, handlePtr->ptr);
399	}
400	#endif
401	handlePtr->ptr = NULL;
402	if (handlePtr->refCount == 0) {
403	ckfree((char *) handlePtr);
404	}
405	}
406
407	/*
408	*---------------------------------------------------------------------------
409	*
410	* TclHandlePreserve --
411	*
412	* Declare an interest in the arbitrary malloc'd block associated
413	* with the handle.
414	*
415	* Results:
416	* The return value is the handle argument, with its ref count
417	* incremented.
418	*
419	* Side effects:
420	* For each call to TclHandlePreserve(), there should be a matching
421	* call to TclHandleRelease() when the caller is no longer interested
422	* in the malloc'd block associated with the handle.
423	*
424	*---------------------------------------------------------------------------
425	*/
426
427	TclHandle
428	TclHandlePreserve(handle)
429	TclHandle handle; /* Declare an interest in the block of
430	* memory referenced by this handle. */
431	{
432	HandleStruct *handlePtr;
433
434	handlePtr = (HandleStruct *) handle;
435	#ifdef TCL_MEM_DEBUG
436	if (handlePtr->refCount == 0x61616161) {
437	panic("using previously disposed TclHandle %x", handlePtr);
438	}
439	if ((handlePtr->ptr != NULL)
440	&& (handlePtr->ptr != handlePtr->ptr2)) {
441	panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
442	handlePtr, handlePtr->ptr2, handlePtr->ptr);
443	}
444	#endif
445	handlePtr->refCount++;
446
447	return handle;
448	}
449
450	/*
451	*---------------------------------------------------------------------------
452	*
453	* TclHandleRelease --
454	*
455	* This procedure is called to release an interest in the malloc'd
456	* block associated with the handle.
457	*
458	* Results:
459	* None.
460	*
461	* Side effects:
462	* The ref count of the handle is decremented. If the malloc'd block
463	* has been freed and if no one is using the handle any more, the
464	* handle will be reclaimed.
465	*
466	*---------------------------------------------------------------------------
467	*/
468
469	void
470	TclHandleRelease(handle)
471	TclHandle handle; /* Unregister interest in the block of
472	* memory referenced by this handle. */
473	{
474	HandleStruct *handlePtr;
475
476	handlePtr = (HandleStruct *) handle;
477	#ifdef TCL_MEM_DEBUG
478	if (handlePtr->refCount == 0x61616161) {
479	panic("using previously disposed TclHandle %x", handlePtr);
480	}
481	if ((handlePtr->ptr != NULL)
482	&& (handlePtr->ptr != handlePtr->ptr2)) {
483	panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
484	handlePtr, handlePtr->ptr2, handlePtr->ptr);
485	}
486	#endif
487	handlePtr->refCount--;
488	if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
489	ckfree((char *) handlePtr);
490	}
491	}
492
493
494	/* $History: tclpreserve.c $
495	*
496	* *************** Version 1 ***************
497	* User: Dtashley Date: 1/02/01 Time: 1:36a
498	* Created in $/IjuScripter, IjuConsole/Source/Tcl Base
499	* Initial check-in.
500	*/
501
502	/* End of TCLPRESERVE.C */