Index: generic/tclInt.h =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v retrieving revision 1.55 diff -u -r1.55 tclInt.h --- generic/tclInt.h 2001/05/26 01:25:59 1.55 +++ generic/tclInt.h 2001/05/30 13:56:38 @@ -2188,6 +2188,16 @@ extern Tcl_Mutex tclObjMutex; #endif +#define OBJ_CHUNK_ALLOCATOR 1 +#define CHUNK_KILOBYTES 4 + +#ifdef OBJ_CHUNK_ALLOCATOR + +#define TclNewObj(objPtr) ((objPtr) = Tcl_NewObj()) +#define TclDecrRefCount(objPtr) Tcl_DecrRefCount((objPtr)) + +#else + # define TclNewObj(objPtr) \ Tcl_MutexLock(&tclObjMutex); \ if (tclFreeObjList == NULL) { \ @@ -2219,6 +2229,7 @@ TclIncrObjsFreed(); \ Tcl_MutexUnlock(&tclObjMutex); \ } +#endif /* OBJ_CHUNK_ALLOCATOR */ #endif /* TCL_MEM_DEBUG */ /* Index: generic/tclObj.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v retrieving revision 1.22 diff -u -r1.22 tclObj.c --- generic/tclObj.c 2001/05/26 01:25:59 1.22 +++ generic/tclObj.c 2001/05/30 13:56:38 @@ -424,6 +424,146 @@ #else /* if not TCL_MEM_DEBUG */ +#ifdef OBJ_CHUNK_ALLOCATOR + +#if CHUNK_KILOBYTES == 4 +/* These values are chosen so as to make a chunk be the size of a + * memory page on 32-bit architectures */ +#define OBJS_PER_CHUNK 170 +#define PAGE_MASK 0xfffff000 +#define allocatePageForChunk() (valloc(sizeof(Tcl_ObjAllocChunk))) +#define releasePageForChunk(chunk) free((chunk)) +/* #warning USING 4kB CHUNKS */ + +#else /* CHUNK_KILOBYTES != 4 */ +#if CHUNK_KILOBYTES == 16 + +/* For a 16kB-sized chunk, use these settings instead */ +#define OBJS_PER_CHUNK 682 +#define PAGE_MASK 0xffffc000 +#define allocatePageForChunk() (valloc(sizeof(Tcl_ObjAllocChunk))) +#define releasePageForChunk(chunk) free((chunk)) +/* #warning USING 16kB CHUNKS */ + +#else /* CHUNK_KILOBYTES != 16 */ +#if CHUNK_KILOBYTES == 64 + +#define OBJS_PER_CHUNK 2730 +#define PAGE_MASK 0xffff0000 +#define allocatePageForChunk() (valloc(sizeof(Tcl_ObjAllocChunk))) +#define releasePageForChunk(chunk) free((chunk)) +/* #warning USING 64kB CHUNKS */ + +#else /* CHUNK_KILOBYTES != 64 */ + +#error UNKNOWN OR UNDEFINED CHUNK SIZE + +#endif /* CHUNK_KILOBYTES == 64 */ +#endif /* CHUNK_KILOBYTES == 16 */ +#endif /* CHUNK_KILOBYTES == 4 */ + +#define COUNT_SHIFT 8 +#define STATIC_CHUNK_FLAG 1 + +typedef struct Tcl_ObjAllocChunk { + struct Tcl_ObjAllocChunk *prevChunk, *nextChunk; + struct Tcl_Obj *freeList; + unsigned int countAndFlags; + Tcl_Obj objects[OBJS_PER_CHUNK]; +} Tcl_ObjAllocChunk; +static Tcl_ObjAllocChunk *chunkList = NULL; +static Tcl_ObjAllocChunk *freedChunk = NULL; +static Tcl_HashTable chunkHash; + +static Tcl_Obj * +allocateNewChunk() { + register Tcl_ObjAllocChunk *chunk; + register Tcl_Obj *prevPtr; + register int i; + int isNew; + + /* Must allocate page-aligned! */ + chunk = (Tcl_ObjAllocChunk *)allocatePageForChunk(); + if (((unsigned long)chunk) & ~PAGE_MASK) { + panic("page allocation not page-aligned"); + } + memset(chunk, 0, sizeof(Tcl_ObjAllocChunk)); +#ifdef DEBUG_CHUNK_ALLOCATOR + fprintf(stderr,"allocated chunk at %p\n",chunk); +#endif + prevPtr = NULL; + for (i=0 ; iobjects[i].internalRep.otherValuePtr = (VOID *) prevPtr; + prevPtr = chunk->objects+i; + } + chunk->countAndFlags = (OBJS_PER_CHUNK-1)<freeList = (Tcl_Obj *)prevPtr->internalRep.otherValuePtr; + if (chunkList) { + chunkList->prevChunk = chunk; + chunk->nextChunk = chunkList; + } + chunkList = chunk; + Tcl_CreateHashEntry(&chunkHash, (char *)chunk, &isNew); + return prevPtr; +} +Tcl_Obj * +Tcl_NewObj() { + register Tcl_Obj *objPtr = NULL; + register Tcl_ObjAllocChunk *chunkPtr; + + Tcl_MutexLock(&tclObjMutex); + if (chunkList == NULL) { + Tcl_InitHashTable(&chunkHash, TCL_ONE_WORD_KEYS); + } else { + for (chunkPtr=chunkList ; chunkPtr!=NULL ; + chunkPtr=chunkPtr->nextChunk) { + if (chunkPtr->countAndFlags >> COUNT_SHIFT) { + objPtr = chunkPtr->freeList; + chunkPtr->freeList = + (Tcl_Obj *)objPtr->internalRep.otherValuePtr; + chunkPtr->countAndFlags -= 1<nextChunk = chunkList; + chunkList->prevChunk = freedChunk; + chunkList = freedChunk; + freedChunk = NULL; + objPtr = chunkList->freeList; + chunkList->freeList = (Tcl_Obj *)objPtr->internalRep.otherValuePtr; + chunkList->countAndFlags -= 1<refCount = 0; + objPtr->bytes = tclEmptyStringRep; + objPtr->length = 0; + objPtr->typePtr = NULL; +#ifdef TCL_COMPILE_STATS + tclObjsAlloced++; +#endif /* TCL_COMPILE_STATS */ + Tcl_MutexUnlock(&tclObjMutex); + return objPtr; +} + +VOID +Tcl_MarkObjChunkAsStatic(objPtr) + Tcl_Obj *objPtr; +{ + register Tcl_ObjAllocChunk *chunkPtr = (Tcl_ObjAllocChunk *) + (((unsigned long)objPtr) & PAGE_MASK); + chunkPtr->countAndFlags |= STATIC_CHUNK_FLAG; +} + +#else + Tcl_Obj * Tcl_NewObj() { @@ -450,6 +590,7 @@ Tcl_MutexUnlock(&tclObjMutex); return objPtr; } +#endif /* OBJ_CHUNK_ALLOCATOR */ #endif /* TCL_MEM_DEBUG */ /* @@ -591,7 +732,75 @@ * *---------------------------------------------------------------------- */ +#ifdef OBJ_CHUNK_ALLOCATOR +void +TclFreeObj(objPtr) + register Tcl_Obj *objPtr; /* The object to be freed. */ +{ + register Tcl_ObjType *typePtr = objPtr->typePtr; + register Tcl_ObjAllocChunk *chunkPtr = (Tcl_ObjAllocChunk *) + (((unsigned long)objPtr) & PAGE_MASK); + Tcl_HashEntry *hEntry; + +#ifdef TCL_MEM_DEBUG + if ((objPtr)->refCount < -1) { + panic("Reference count for %lx was negative", objPtr); + } +#endif /* TCL_MEM_DEBUG */ + + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + typePtr->freeIntRepProc(objPtr); + } + Tcl_InvalidateStringRep(objPtr); + /* + * If debugging Tcl's memory usage, deallocate the object using ckfree. + * Otherwise, deallocate it by adding it onto the list of free + * Tcl_Obj structs we maintain. + */ + + Tcl_MutexLock(&tclObjMutex); + hEntry = Tcl_FindHashEntry(&chunkHash, (char *)chunkPtr); + if (hEntry) { + objPtr->internalRep.otherValuePtr = (VOID *) chunkPtr->freeList; +#if defined(DEBUG_CHUNK_ALLOCATOR) && DEBUG_CHUNK_ALLOCATOR==1 + fprintf(stderr,"releasing object at %p (chunk %p)\n",objPtr,chunkPtr); +#endif + chunkPtr->freeList = objPtr; + chunkPtr->countAndFlags += 1 << COUNT_SHIFT; + if (chunkPtr->countAndFlags == (OBJS_PER_CHUNK << COUNT_SHIFT)) { + /* all objects freed and flag not set */ + /* release previously "freed" chunk */ + if (freedChunk != NULL) { +#ifdef DEBUG_CHUNK_ALLOCATOR + fprintf(stderr,"releasing chunk at %p\n",freedChunk); +#endif + hEntry = Tcl_FindHashEntry(&chunkHash, (char *)freedChunk); + Tcl_DeleteHashEntry(hEntry); + releasePageForChunk(freedChunk); + } +#ifdef DEBUG_CHUNK_ALLOCATOR + fprintf(stderr,"reserving chunk %p for reuse\n",chunkPtr); +#endif + freedChunk = chunkPtr; + /* splice out of chunk list */ + if (chunkPtr->prevChunk) { + chunkPtr->prevChunk->nextChunk = chunkPtr->nextChunk; + } else { + chunkList = chunkPtr->nextChunk; + } + if (chunkPtr->nextChunk) { + chunkPtr->nextChunk->prevChunk = chunkPtr->prevChunk; + } + } + } + +#ifdef TCL_COMPILE_STATS + tclObjsFreed++; +#endif /* TCL_COMPILE_STATS */ + Tcl_MutexUnlock(&tclObjMutex); +} +#else void TclFreeObj(objPtr) register Tcl_Obj *objPtr; /* The object to be freed. */ @@ -628,6 +837,7 @@ #endif /* TCL_COMPILE_STATS */ Tcl_MutexUnlock(&tclObjMutex); } +#endif /* OBJ_CHUNK_ALLOCATOR */ /* *----------------------------------------------------------------------