1/*
2 * tclThreadAlloc.c --
3 *
4 *	This is a very fast storage allocator for used with threads (designed
5 *	avoid lock contention). The basic strategy is to allocate memory in
6 *	fixed size blocks from block caches.
7 *
8 * The Initial Developer of the Original Code is America Online, Inc.
9 * Portions created by AOL are Copyright (C) 1999 America Online, Inc.
10 *
11 * See the file "license.terms" for information on usage and redistribution of
12 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * RCS: @(#) $Id: tclThreadAlloc.c,v 1.27.2.1 2009/09/29 04:43:59 dgp Exp $
15 */
16
17#include "tclInt.h"
18#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
19
20/*
21 * If range checking is enabled, an additional byte will be allocated to store
22 * the magic number at the end of the requested memory.
23 */
24
25#ifndef RCHECK
26#ifdef  NDEBUG
27#define RCHECK		0
28#else
29#define RCHECK		1
30#endif
31#endif
32
33/*
34 * The following define the number of Tcl_Obj's to allocate/move at a time and
35 * the high water mark to prune a per-thread cache. On a 32 bit system,
36 * sizeof(Tcl_Obj) = 24 so 800 * 24 = ~16k.
37 */
38
39#define NOBJALLOC	800
40#define NOBJHIGH	1200
41
42/*
43 * The following union stores accounting information for each block including
44 * two small magic numbers and a bucket number when in use or a next pointer
45 * when free. The original requested size (not including the Block overhead)
46 * is also maintained.
47 */
48
49typedef union Block {
50    struct {
51	union {
52	    union Block *next;		/* Next in free list. */
53	    struct {
54		unsigned char magic1;	/* First magic number. */
55		unsigned char bucket;	/* Bucket block allocated from. */
56		unsigned char unused;	/* Padding. */
57		unsigned char magic2;	/* Second magic number. */
58	    } s;
59	} u;
60	size_t reqSize;			/* Requested allocation size. */
61    } b;
62    unsigned char padding[TCL_ALLOCALIGN];
63} Block;
64#define nextBlock	b.u.next
65#define sourceBucket	b.u.s.bucket
66#define magicNum1	b.u.s.magic1
67#define magicNum2	b.u.s.magic2
68#define MAGIC		0xEF
69#define blockReqSize	b.reqSize
70
71/*
72 * The following defines the minimum and and maximum block sizes and the number
73 * of buckets in the bucket cache.
74 */
75
76#define MINALLOC	((sizeof(Block) + 8 + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
77#define NBUCKETS	(11 - (MINALLOC >> 5))
78#define MAXALLOC	(MINALLOC << (NBUCKETS - 1))
79
80/*
81 * The following structure defines a bucket of blocks with various accounting
82 * and statistics information.
83 */
84
85typedef struct Bucket {
86    Block *firstPtr;		/* First block available */
87    long numFree;		/* Number of blocks available */
88
89    /* All fields below for accounting only */
90
91    long numRemoves;		/* Number of removes from bucket */
92    long numInserts;		/* Number of inserts into bucket */
93    long numWaits;		/* Number of waits to acquire a lock */
94    long numLocks;		/* Number of locks acquired */
95    long totalAssigned;		/* Total space assigned to bucket */
96} Bucket;
97
98/*
99 * The following structure defines a cache of buckets and objs, of which there
100 * will be (at most) one per thread.
101 */
102
103typedef struct Cache {
104    struct Cache *nextPtr;	/* Linked list of cache entries */
105    Tcl_ThreadId owner;		/* Which thread's cache is this? */
106    Tcl_Obj *firstObjPtr;	/* List of free objects for thread */
107    int numObjects;		/* Number of objects for thread */
108    int totalAssigned;		/* Total space assigned to thread */
109    Bucket buckets[NBUCKETS];	/* The buckets for this thread */
110} Cache;
111
112/*
113 * The following array specifies various per-bucket limits and locks. The
114 * values are statically initialized to avoid calculating them repeatedly.
115 */
116
117static struct {
118    size_t blockSize;		/* Bucket blocksize. */
119    int maxBlocks;		/* Max blocks before move to share. */
120    int numMove;		/* Num blocks to move to share. */
121    Tcl_Mutex *lockPtr;		/* Share bucket lock. */
122} bucketInfo[NBUCKETS];
123
124/*
125 * Static functions defined in this file.
126 */
127
128static Cache *	GetCache(void);
129static void	LockBucket(Cache *cachePtr, int bucket);
130static void	UnlockBucket(Cache *cachePtr, int bucket);
131static void	PutBlocks(Cache *cachePtr, int bucket, int numMove);
132static int	GetBlocks(Cache *cachePtr, int bucket);
133static Block *	Ptr2Block(char *ptr);
134static char *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
135static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
136
137/*
138 * Local variables defined in this file and initialized at startup.
139 */
140
141static Tcl_Mutex *listLockPtr;
142static Tcl_Mutex *objLockPtr;
143static Cache sharedCache;
144static Cache *sharedPtr = &sharedCache;
145static Cache *firstCachePtr = &sharedCache;
146
147/*
148 *----------------------------------------------------------------------
149 *
150 * GetCache ---
151 *
152 *	Gets per-thread memory cache, allocating it if necessary.
153 *
154 * Results:
155 *	Pointer to cache.
156 *
157 * Side effects:
158 *	None.
159 *
160 *----------------------------------------------------------------------
161 */
162
163static Cache *
164GetCache(void)
165{
166    Cache *cachePtr;
167
168    /*
169     * Check for first-time initialization.
170     */
171
172    if (listLockPtr == NULL) {
173	Tcl_Mutex *initLockPtr;
174	unsigned int i;
175
176	initLockPtr = Tcl_GetAllocMutex();
177	Tcl_MutexLock(initLockPtr);
178	if (listLockPtr == NULL) {
179	    listLockPtr = TclpNewAllocMutex();
180	    objLockPtr = TclpNewAllocMutex();
181	    for (i = 0; i < NBUCKETS; ++i) {
182		bucketInfo[i].blockSize = MINALLOC << i;
183		bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
184		bucketInfo[i].numMove = i < NBUCKETS - 1 ?
185			1 << (NBUCKETS - 2 - i) : 1;
186		bucketInfo[i].lockPtr = TclpNewAllocMutex();
187	    }
188	}
189	Tcl_MutexUnlock(initLockPtr);
190    }
191
192    /*
193     * Get this thread's cache, allocating if necessary.
194     */
195
196    cachePtr = TclpGetAllocCache();
197    if (cachePtr == NULL) {
198	cachePtr = calloc(1, sizeof(Cache));
199	if (cachePtr == NULL) {
200	    Tcl_Panic("alloc: could not allocate new cache");
201	}
202	Tcl_MutexLock(listLockPtr);
203	cachePtr->nextPtr = firstCachePtr;
204	firstCachePtr = cachePtr;
205	Tcl_MutexUnlock(listLockPtr);
206	cachePtr->owner = Tcl_GetCurrentThread();
207	TclpSetAllocCache(cachePtr);
208    }
209    return cachePtr;
210}
211
212/*
213 *----------------------------------------------------------------------
214 *
215 * TclFreeAllocCache --
216 *
217 *	Flush and delete a cache, removing from list of caches.
218 *
219 * Results:
220 *	None.
221 *
222 * Side effects:
223 *	None.
224 *
225 *----------------------------------------------------------------------
226 */
227
228void
229TclFreeAllocCache(
230    void *arg)
231{
232    Cache *cachePtr = arg;
233    Cache **nextPtrPtr;
234    register unsigned int bucket;
235
236    /*
237     * Flush blocks.
238     */
239
240    for (bucket = 0; bucket < NBUCKETS; ++bucket) {
241	if (cachePtr->buckets[bucket].numFree > 0) {
242	    PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].numFree);
243	}
244    }
245
246    /*
247     * Flush objs.
248     */
249
250    if (cachePtr->numObjects > 0) {
251	Tcl_MutexLock(objLockPtr);
252	MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
253	Tcl_MutexUnlock(objLockPtr);
254    }
255
256    /*
257     * Remove from pool list.
258     */
259
260    Tcl_MutexLock(listLockPtr);
261    nextPtrPtr = &firstCachePtr;
262    while (*nextPtrPtr != cachePtr) {
263	nextPtrPtr = &(*nextPtrPtr)->nextPtr;
264    }
265    *nextPtrPtr = cachePtr->nextPtr;
266    cachePtr->nextPtr = NULL;
267    Tcl_MutexUnlock(listLockPtr);
268    free(cachePtr);
269}
270
271/*
272 *----------------------------------------------------------------------
273 *
274 * TclpAlloc --
275 *
276 *	Allocate memory.
277 *
278 * Results:
279 *	Pointer to memory just beyond Block pointer.
280 *
281 * Side effects:
282 *	May allocate more blocks for a bucket.
283 *
284 *----------------------------------------------------------------------
285 */
286
287char *
288TclpAlloc(
289    unsigned int reqSize)
290{
291    Cache *cachePtr;
292    Block *blockPtr;
293    register int bucket;
294    size_t size;
295
296    if (sizeof(int) >= sizeof(size_t)) {
297	/* An unsigned int overflow can also be a size_t overflow */
298	const size_t zero = 0;
299	const size_t max = ~zero;
300
301	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
302	    /* Requested allocation exceeds memory */
303	    return NULL;
304	}
305    }
306
307    cachePtr = TclpGetAllocCache();
308    if (cachePtr == NULL) {
309	cachePtr = GetCache();
310    }
311
312    /*
313     * Increment the requested size to include room for the Block structure.
314     * Call malloc() directly if the required amount is greater than the
315     * largest block, otherwise pop the smallest block large enough,
316     * allocating more blocks if necessary.
317     */
318
319    blockPtr = NULL;
320    size = reqSize + sizeof(Block);
321#if RCHECK
322    ++size;
323#endif
324    if (size > MAXALLOC) {
325	bucket = NBUCKETS;
326	blockPtr = malloc(size);
327	if (blockPtr != NULL) {
328	    cachePtr->totalAssigned += reqSize;
329	}
330    } else {
331	bucket = 0;
332	while (bucketInfo[bucket].blockSize < size) {
333	    ++bucket;
334	}
335	if (cachePtr->buckets[bucket].numFree || GetBlocks(cachePtr, bucket)) {
336	    blockPtr = cachePtr->buckets[bucket].firstPtr;
337	    cachePtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
338	    --cachePtr->buckets[bucket].numFree;
339	    ++cachePtr->buckets[bucket].numRemoves;
340	    cachePtr->buckets[bucket].totalAssigned += reqSize;
341	}
342    }
343    if (blockPtr == NULL) {
344	return NULL;
345    }
346    return Block2Ptr(blockPtr, bucket, reqSize);
347}
348
349/*
350 *----------------------------------------------------------------------
351 *
352 * TclpFree --
353 *
354 *	Return blocks to the thread block cache.
355 *
356 * Results:
357 *	None.
358 *
359 * Side effects:
360 *	May move blocks to shared cache.
361 *
362 *----------------------------------------------------------------------
363 */
364
365void
366TclpFree(
367    char *ptr)
368{
369    Cache *cachePtr;
370    Block *blockPtr;
371    int bucket;
372
373    if (ptr == NULL) {
374	return;
375    }
376
377    cachePtr = TclpGetAllocCache();
378    if (cachePtr == NULL) {
379	cachePtr = GetCache();
380    }
381
382    /*
383     * Get the block back from the user pointer and call system free directly
384     * for large blocks. Otherwise, push the block back on the bucket and move
385     * blocks to the shared cache if there are now too many free.
386     */
387
388    blockPtr = Ptr2Block(ptr);
389    bucket = blockPtr->sourceBucket;
390    if (bucket == NBUCKETS) {
391	cachePtr->totalAssigned -= blockPtr->blockReqSize;
392	free(blockPtr);
393	return;
394    }
395
396    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
397    blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
398    cachePtr->buckets[bucket].firstPtr = blockPtr;
399    ++cachePtr->buckets[bucket].numFree;
400    ++cachePtr->buckets[bucket].numInserts;
401
402    if (cachePtr != sharedPtr &&
403	    cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
404	PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove);
405    }
406}
407
408/*
409 *----------------------------------------------------------------------
410 *
411 * TclpRealloc --
412 *
413 *	Re-allocate memory to a larger or smaller size.
414 *
415 * Results:
416 *	Pointer to memory just beyond Block pointer.
417 *
418 * Side effects:
419 *	Previous memory, if any, may be freed.
420 *
421 *----------------------------------------------------------------------
422 */
423
424char *
425TclpRealloc(
426    char *ptr,
427    unsigned int reqSize)
428{
429    Cache *cachePtr;
430    Block *blockPtr;
431    void *newPtr;
432    size_t size, min;
433    int bucket;
434
435    if (ptr == NULL) {
436	return TclpAlloc(reqSize);
437    }
438
439    if (sizeof(int) >= sizeof(size_t)) {
440	/* An unsigned int overflow can also be a size_t overflow */
441	const size_t zero = 0;
442	const size_t max = ~zero;
443
444	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
445	    /* Requested allocation exceeds memory */
446	    return NULL;
447	}
448    }
449
450    cachePtr = TclpGetAllocCache();
451    if (cachePtr == NULL) {
452	cachePtr = GetCache();
453    }
454
455    /*
456     * If the block is not a system block and fits in place, simply return the
457     * existing pointer. Otherwise, if the block is a system block and the new
458     * size would also require a system block, call realloc() directly.
459     */
460
461    blockPtr = Ptr2Block(ptr);
462    size = reqSize + sizeof(Block);
463#if RCHECK
464    ++size;
465#endif
466    bucket = blockPtr->sourceBucket;
467    if (bucket != NBUCKETS) {
468	if (bucket > 0) {
469	    min = bucketInfo[bucket-1].blockSize;
470	} else {
471	    min = 0;
472	}
473	if (size > min && size <= bucketInfo[bucket].blockSize) {
474	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
475	    cachePtr->buckets[bucket].totalAssigned += reqSize;
476	    return Block2Ptr(blockPtr, bucket, reqSize);
477	}
478    } else if (size > MAXALLOC) {
479	cachePtr->totalAssigned -= blockPtr->blockReqSize;
480	cachePtr->totalAssigned += reqSize;
481	blockPtr = realloc(blockPtr, size);
482	if (blockPtr == NULL) {
483	    return NULL;
484	}
485	return Block2Ptr(blockPtr, NBUCKETS, reqSize);
486    }
487
488    /*
489     * Finally, perform an expensive malloc/copy/free.
490     */
491
492    newPtr = TclpAlloc(reqSize);
493    if (newPtr != NULL) {
494	if (reqSize > blockPtr->blockReqSize) {
495	    reqSize = blockPtr->blockReqSize;
496	}
497	memcpy(newPtr, ptr, reqSize);
498	TclpFree(ptr);
499    }
500    return newPtr;
501}
502
503/*
504 *----------------------------------------------------------------------
505 *
506 * TclThreadAllocObj --
507 *
508 *	Allocate a Tcl_Obj from the per-thread cache.
509 *
510 * Results:
511 *	Pointer to uninitialized Tcl_Obj.
512 *
513 * Side effects:
514 *	May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's if
515 *	list is empty.
516 *
517 *----------------------------------------------------------------------
518 */
519
520Tcl_Obj *
521TclThreadAllocObj(void)
522{
523    register Cache *cachePtr = TclpGetAllocCache();
524    register Tcl_Obj *objPtr;
525
526    if (cachePtr == NULL) {
527	cachePtr = GetCache();
528    }
529
530    /*
531     * Get this thread's obj list structure and move or allocate new objs if
532     * necessary.
533     */
534
535    if (cachePtr->numObjects == 0) {
536	register int numMove;
537
538	Tcl_MutexLock(objLockPtr);
539	numMove = sharedPtr->numObjects;
540	if (numMove > 0) {
541	    if (numMove > NOBJALLOC) {
542		numMove = NOBJALLOC;
543	    }
544	    MoveObjs(sharedPtr, cachePtr, numMove);
545	}
546	Tcl_MutexUnlock(objLockPtr);
547	if (cachePtr->numObjects == 0) {
548	    Tcl_Obj *newObjsPtr;
549
550	    cachePtr->numObjects = numMove = NOBJALLOC;
551	    newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
552	    if (newObjsPtr == NULL) {
553		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
554	    }
555	    while (--numMove >= 0) {
556		objPtr = &newObjsPtr[numMove];
557		objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
558		cachePtr->firstObjPtr = objPtr;
559	    }
560	}
561    }
562
563    /*
564     * Pop the first object.
565     */
566
567    objPtr = cachePtr->firstObjPtr;
568    cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
569    --cachePtr->numObjects;
570    return objPtr;
571}
572
573/*
574 *----------------------------------------------------------------------
575 *
576 * TclThreadFreeObj --
577 *
578 *	Return a free Tcl_Obj to the per-thread cache.
579 *
580 * Results:
581 *	None.
582 *
583 * Side effects:
584 *	May move free Tcl_Obj's to shared list upon hitting high water mark.
585 *
586 *----------------------------------------------------------------------
587 */
588
589void
590TclThreadFreeObj(
591    Tcl_Obj *objPtr)
592{
593    Cache *cachePtr = TclpGetAllocCache();
594
595    if (cachePtr == NULL) {
596	cachePtr = GetCache();
597    }
598
599    /*
600     * Get this thread's list and push on the free Tcl_Obj.
601     */
602
603    objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
604    cachePtr->firstObjPtr = objPtr;
605    ++cachePtr->numObjects;
606
607    /*
608     * If the number of free objects has exceeded the high water mark, move
609     * some blocks to the shared list.
610     */
611
612    if (cachePtr->numObjects > NOBJHIGH) {
613	Tcl_MutexLock(objLockPtr);
614	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
615	Tcl_MutexUnlock(objLockPtr);
616    }
617}
618
619/*
620 *----------------------------------------------------------------------
621 *
622 * Tcl_GetMemoryInfo --
623 *
624 *	Return a list-of-lists of memory stats.
625 *
626 * Results:
627 *	None.
628 *
629 * Side effects:
630 *	List appended to given dstring.
631 *
632 *----------------------------------------------------------------------
633 */
634
635void
636Tcl_GetMemoryInfo(
637    Tcl_DString *dsPtr)
638{
639    Cache *cachePtr;
640    char buf[200];
641    unsigned int n;
642
643    Tcl_MutexLock(listLockPtr);
644    cachePtr = firstCachePtr;
645    while (cachePtr != NULL) {
646	Tcl_DStringStartSublist(dsPtr);
647	if (cachePtr == sharedPtr) {
648	    Tcl_DStringAppendElement(dsPtr, "shared");
649	} else {
650	    sprintf(buf, "thread%p", cachePtr->owner);
651	    Tcl_DStringAppendElement(dsPtr, buf);
652	}
653	for (n = 0; n < NBUCKETS; ++n) {
654	    sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
655		    (unsigned long) bucketInfo[n].blockSize,
656		    cachePtr->buckets[n].numFree,
657		    cachePtr->buckets[n].numRemoves,
658		    cachePtr->buckets[n].numInserts,
659		    cachePtr->buckets[n].totalAssigned,
660		    cachePtr->buckets[n].numLocks,
661		    cachePtr->buckets[n].numWaits);
662	    Tcl_DStringAppendElement(dsPtr, buf);
663	}
664	Tcl_DStringEndSublist(dsPtr);
665	cachePtr = cachePtr->nextPtr;
666    }
667    Tcl_MutexUnlock(listLockPtr);
668}
669
670/*
671 *----------------------------------------------------------------------
672 *
673 * MoveObjs --
674 *
675 *	Move Tcl_Obj's between caches.
676 *
677 * Results:
678 *	None.
679 *
680 * Side effects:
681 *	None.
682 *
683 *----------------------------------------------------------------------
684 */
685
686static void
687MoveObjs(
688    Cache *fromPtr,
689    Cache *toPtr,
690    int numMove)
691{
692    register Tcl_Obj *objPtr = fromPtr->firstObjPtr;
693    Tcl_Obj *fromFirstObjPtr = objPtr;
694
695    toPtr->numObjects += numMove;
696    fromPtr->numObjects -= numMove;
697
698    /*
699     * Find the last object to be moved; set the next one (the first one not
700     * to be moved) as the first object in the 'from' cache.
701     */
702
703    while (--numMove) {
704	objPtr = objPtr->internalRep.otherValuePtr;
705    }
706    fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
707
708    /*
709     * Move all objects as a block - they are already linked to each other, we
710     * just have to update the first and last.
711     */
712
713    objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr;
714    toPtr->firstObjPtr = fromFirstObjPtr;
715}
716
717/*
718 *----------------------------------------------------------------------
719 *
720 * Block2Ptr, Ptr2Block --
721 *
722 *	Convert between internal blocks and user pointers.
723 *
724 * Results:
725 *	User pointer or internal block.
726 *
727 * Side effects:
728 *	Invalid blocks will abort the server.
729 *
730 *----------------------------------------------------------------------
731 */
732
733static char *
734Block2Ptr(
735    Block *blockPtr,
736    int bucket,
737    unsigned int reqSize)
738{
739    register void *ptr;
740
741    blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
742    blockPtr->sourceBucket = bucket;
743    blockPtr->blockReqSize = reqSize;
744    ptr = ((void *) (blockPtr + 1));
745#if RCHECK
746    ((unsigned char *)(ptr))[reqSize] = MAGIC;
747#endif
748    return (char *) ptr;
749}
750
751static Block *
752Ptr2Block(
753    char *ptr)
754{
755    register Block *blockPtr;
756
757    blockPtr = (((Block *) ptr) - 1);
758    if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) {
759	Tcl_Panic("alloc: invalid block: %p: %x %x",
760		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2);
761    }
762#if RCHECK
763    if (((unsigned char *) ptr)[blockPtr->blockReqSize] != MAGIC) {
764	Tcl_Panic("alloc: invalid block: %p: %x %x %x",
765		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2,
766		((unsigned char *) ptr)[blockPtr->blockReqSize]);
767    }
768#endif
769    return blockPtr;
770}
771
772/*
773 *----------------------------------------------------------------------
774 *
775 * LockBucket, UnlockBucket --
776 *
777 *	Set/unset the lock to access a bucket in the shared cache.
778 *
779 * Results:
780 *	None.
781 *
782 * Side effects:
783 *	Lock activity and contention are monitored globally and on a per-cache
784 *	basis.
785 *
786 *----------------------------------------------------------------------
787 */
788
789static void
790LockBucket(
791    Cache *cachePtr,
792    int bucket)
793{
794#if 0
795    if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) {
796	Tcl_MutexLock(bucketInfo[bucket].lockPtr);
797	++cachePtr->buckets[bucket].numWaits;
798	++sharedPtr->buckets[bucket].numWaits;
799    }
800#else
801    Tcl_MutexLock(bucketInfo[bucket].lockPtr);
802#endif
803    ++cachePtr->buckets[bucket].numLocks;
804    ++sharedPtr->buckets[bucket].numLocks;
805}
806
807static void
808UnlockBucket(
809    Cache *cachePtr,
810    int bucket)
811{
812    Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
813}
814
815/*
816 *----------------------------------------------------------------------
817 *
818 * PutBlocks --
819 *
820 *	Return unused blocks to the shared cache.
821 *
822 * Results:
823 *	None.
824 *
825 * Side effects:
826 *	None.
827 *
828 *----------------------------------------------------------------------
829 */
830
831static void
832PutBlocks(
833    Cache *cachePtr,
834    int bucket,
835    int numMove)
836{
837    register Block *lastPtr, *firstPtr;
838    register int n = numMove;
839
840    /*
841     * Before acquiring the lock, walk the block list to find the last block
842     * to be moved.
843     */
844
845    firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
846    while (--n > 0) {
847	lastPtr = lastPtr->nextBlock;
848    }
849    cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
850    cachePtr->buckets[bucket].numFree -= numMove;
851
852    /*
853     * Aquire the lock and place the list of blocks at the front of the shared
854     * cache bucket.
855     */
856
857    LockBucket(cachePtr, bucket);
858    lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
859    sharedPtr->buckets[bucket].firstPtr = firstPtr;
860    sharedPtr->buckets[bucket].numFree += numMove;
861    UnlockBucket(cachePtr, bucket);
862}
863
864/*
865 *----------------------------------------------------------------------
866 *
867 * GetBlocks --
868 *
869 *	Get more blocks for a bucket.
870 *
871 * Results:
872 *	1 if blocks where allocated, 0 otherwise.
873 *
874 * Side effects:
875 *	Cache may be filled with available blocks.
876 *
877 *----------------------------------------------------------------------
878 */
879
880static int
881GetBlocks(
882    Cache *cachePtr,
883    int bucket)
884{
885    register Block *blockPtr;
886    register int n;
887
888    /*
889     * First, atttempt to move blocks from the shared cache. Note the
890     * potentially dirty read of numFree before acquiring the lock which is a
891     * slight performance enhancement. The value is verified after the lock is
892     * actually acquired.
893     */
894
895    if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].numFree > 0) {
896	LockBucket(cachePtr, bucket);
897	if (sharedPtr->buckets[bucket].numFree > 0) {
898
899	    /*
900	     * Either move the entire list or walk the list to find the last
901	     * block to move.
902	     */
903
904	    n = bucketInfo[bucket].numMove;
905	    if (n >= sharedPtr->buckets[bucket].numFree) {
906		cachePtr->buckets[bucket].firstPtr =
907			sharedPtr->buckets[bucket].firstPtr;
908		cachePtr->buckets[bucket].numFree =
909			sharedPtr->buckets[bucket].numFree;
910		sharedPtr->buckets[bucket].firstPtr = NULL;
911		sharedPtr->buckets[bucket].numFree = 0;
912	    } else {
913		blockPtr = sharedPtr->buckets[bucket].firstPtr;
914		cachePtr->buckets[bucket].firstPtr = blockPtr;
915		sharedPtr->buckets[bucket].numFree -= n;
916		cachePtr->buckets[bucket].numFree = n;
917		while (--n > 0) {
918		    blockPtr = blockPtr->nextBlock;
919		}
920		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
921		blockPtr->nextBlock = NULL;
922	    }
923	}
924	UnlockBucket(cachePtr, bucket);
925    }
926
927    if (cachePtr->buckets[bucket].numFree == 0) {
928	register size_t size;
929
930	/*
931	 * If no blocks could be moved from shared, first look for a larger
932	 * block in this cache to split up.
933	 */
934
935	blockPtr = NULL;
936	n = NBUCKETS;
937	size = 0; /* lint */
938	while (--n > bucket) {
939	    if (cachePtr->buckets[n].numFree > 0) {
940		size = bucketInfo[n].blockSize;
941		blockPtr = cachePtr->buckets[n].firstPtr;
942		cachePtr->buckets[n].firstPtr = blockPtr->nextBlock;
943		--cachePtr->buckets[n].numFree;
944		break;
945	    }
946	}
947
948	/*
949	 * Otherwise, allocate a big new block directly.
950	 */
951
952	if (blockPtr == NULL) {
953	    size = MAXALLOC;
954	    blockPtr = malloc(size);
955	    if (blockPtr == NULL) {
956		return 0;
957	    }
958	}
959
960	/*
961	 * Split the larger block into smaller blocks for this bucket.
962	 */
963
964	n = size / bucketInfo[bucket].blockSize;
965	cachePtr->buckets[bucket].numFree = n;
966	cachePtr->buckets[bucket].firstPtr = blockPtr;
967	while (--n > 0) {
968	    blockPtr->nextBlock = (Block *)
969		((char *) blockPtr + bucketInfo[bucket].blockSize);
970	    blockPtr = blockPtr->nextBlock;
971	}
972	blockPtr->nextBlock = NULL;
973    }
974    return 1;
975}
976
977/*
978 *----------------------------------------------------------------------
979 *
980 * TclFinalizeThreadAlloc --
981 *
982 *	This procedure is used to destroy all private resources used in this
983 *	file.
984 *
985 * Results:
986 *	None.
987 *
988 * Side effects:
989 *	None.
990 *
991 *----------------------------------------------------------------------
992 */
993
994void
995TclFinalizeThreadAlloc(void)
996{
997    unsigned int i;
998
999    for (i = 0; i < NBUCKETS; ++i) {
1000        TclpFreeAllocMutex(bucketInfo[i].lockPtr);
1001        bucketInfo[i].lockPtr = NULL;
1002    }
1003
1004    TclpFreeAllocMutex(objLockPtr);
1005    objLockPtr = NULL;
1006
1007    TclpFreeAllocMutex(listLockPtr);
1008    listLockPtr = NULL;
1009
1010    TclpFreeAllocCache(NULL);
1011}
1012
1013#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
1014/*
1015 *----------------------------------------------------------------------
1016 *
1017 * Tcl_GetMemoryInfo --
1018 *
1019 *	Return a list-of-lists of memory stats.
1020 *
1021 * Results:
1022 *	None.
1023 *
1024 * Side effects:
1025 *	List appended to given dstring.
1026 *
1027 *----------------------------------------------------------------------
1028 */
1029
1030void
1031Tcl_GetMemoryInfo(
1032    Tcl_DString *dsPtr)
1033{
1034    Tcl_Panic("Tcl_GetMemoryInfo called when threaded memory allocator not in use");
1035}
1036
1037/*
1038 *----------------------------------------------------------------------
1039 *
1040 * TclFinalizeThreadAlloc --
1041 *
1042 *	This procedure is used to destroy all private resources used in this
1043 *	file.
1044 *
1045 * Results:
1046 *	None.
1047 *
1048 * Side effects:
1049 *	None.
1050 *
1051 *----------------------------------------------------------------------
1052 */
1053
1054void
1055TclFinalizeThreadAlloc(void)
1056{
1057    Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use");
1058}
1059#endif /* TCL_THREADS && USE_THREAD_ALLOC */
1060
1061/*
1062 * Local Variables:
1063 * mode: c
1064 * c-basic-offset: 4
1065 * fill-column: 78
1066 * End:
1067 */
1068