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