summaryrefslogtreecommitdiffstats
path: root/generic/tclPreserve.c
blob: 624675e8ce3ca0509a809f79c998e3c65110dceb (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
/* 
 * 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.5 2003/12/24 04:18:20 davygrvy 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) {
		    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.
     */

    Tcl_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) {
	    Tcl_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) {
	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) {
	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
    }
    if (handlePtr->ptr2 != handlePtr->ptr) {
	Tcl_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) {
	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
    }
    if ((handlePtr->ptr != NULL)
	    && (handlePtr->ptr != handlePtr->ptr2)) {
	Tcl_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) {
	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
    }
    if ((handlePtr->ptr != NULL)
	    && (handlePtr->ptr != handlePtr->ptr2)) {
	Tcl_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);
    }
}