diff --git a/mps/code/abq.c b/mps/code/abq.c index 22286354c77..74abcdf009a 100644 --- a/mps/code/abq.c +++ b/mps/code/abq.c @@ -156,7 +156,7 @@ Bool ABQPeek(ABQ abq, void *elementReturn) /* ABQDescribe -- Describe an ABQ */ -Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *stream) +Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *stream, Count depth) { Res res; Index index; @@ -164,8 +164,8 @@ Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *strea if (!TESTT(ABQ, abq)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, - "ABQ $P\n{\n", (WriteFP)abq, + res = WriteF(stream, depth, + "ABQ $P {\n", (WriteFP)abq, " elements: $U \n", (WriteFU)abq->elements, " in: $U \n", (WriteFU)abq->in, " out: $U \n", (WriteFU)abq->out, @@ -175,22 +175,18 @@ Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *strea return res; for (index = abq->out; index != abq->in; ) { - res = (*describeElement)(ABQElement(abq, index), stream); + res = (*describeElement)(ABQElement(abq, index), stream, depth + 2); if(res != ResOK) return res; index = ABQNextIndex(abq, index); } - res = WriteF(stream, "\n", NULL); - if(res != ResOK) - return res; + METER_WRITE(abq->push, stream, depth + 2); + METER_WRITE(abq->pop, stream, depth + 2); + METER_WRITE(abq->peek, stream, depth + 2); + METER_WRITE(abq->delete, stream, depth + 2); - METER_WRITE(abq->push, stream); - METER_WRITE(abq->pop, stream); - METER_WRITE(abq->peek, stream); - METER_WRITE(abq->delete, stream); - - res = WriteF(stream, "}\n", NULL); + res = WriteF(stream, depth, "} ABQ $P\n", (WriteFP)abq, NULL); if(res != ResOK) return res; diff --git a/mps/code/abq.h b/mps/code/abq.h index 022fc7e5301..ec37cbfaa31 100644 --- a/mps/code/abq.h +++ b/mps/code/abq.h @@ -23,7 +23,7 @@ /* Prototypes */ typedef struct ABQStruct *ABQ; -typedef Res (*ABQDescribeElement)(void *element, mps_lib_FILE *stream); +typedef Res (*ABQDescribeElement)(void *element, mps_lib_FILE *stream, Count depth); typedef Bool (*ABQIterateMethod)(Bool *deleteReturn, void *element, void *closureP, Size closureS); extern Res ABQInit(Arena arena, ABQ abq, void *owner, Count elements, Size elementSize); @@ -32,7 +32,7 @@ extern void ABQFinish(Arena arena, ABQ abq); extern Bool ABQPush(ABQ abq, void *element); extern Bool ABQPop(ABQ abq, void *elementReturn); extern Bool ABQPeek(ABQ abq, void *elementReturn); -extern Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *stream); +extern Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *stream, Count depth); extern Bool ABQIsEmpty(ABQ abq); extern Bool ABQIsFull(ABQ abq); extern Count ABQDepth(ABQ abq); diff --git a/mps/code/amcss.c b/mps/code/amcss.c index 20e86f80897..d91e819e0b7 100644 --- a/mps/code/amcss.c +++ b/mps/code/amcss.c @@ -8,6 +8,7 @@ #include "fmtdy.h" #include "fmtdytst.h" #include "testlib.h" +#include "mpm.h" #include "mpslib.h" #include "mpscamc.h" #include "mpsavm.h" @@ -20,7 +21,7 @@ /* These values have been tuned in the hope of getting one dynamic collection. */ #define testArenaSIZE ((size_t)1000*1024) -#define gen1SIZE ((size_t)150) +#define gen1SIZE ((size_t)40) #define gen2SIZE ((size_t)170) #define avLEN 3 #define exactRootsCOUNT 180 @@ -135,6 +136,7 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count) mps_ap_t busy_ap; mps_addr_t busy_init; mps_pool_t pool; + int described = 0; die(dylan_fmt(&format, arena), "fmt_create"); die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); @@ -175,6 +177,10 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count) c = mps_collections(arena); if (collections != c) { + if (!described) { + die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe"); + described = TRUE; + } collections = c; report(arena); diff --git a/mps/code/amsss.c b/mps/code/amsss.c index 0ed1ca966d8..ea6b17ea72f 100644 --- a/mps/code/amsss.c +++ b/mps/code/amsss.c @@ -16,6 +16,7 @@ #include "mpsavm.h" #include "mpstd.h" #include "mps.h" +#include "mpm.h" #include /* fflush, printf */ @@ -141,6 +142,8 @@ static void test_pool(mps_class_t pool_class, mps_arg_s args[], /* create an ap, and leave it busy */ die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy"); + die(PoolDescribe(pool, mps_lib_get_stdout(), 0), "PoolDescribe"); + objs = 0; totalSize = 0; while(totalSize < totalSizeMAX) { if (totalSize > lastStep + totalSizeSTEP) { diff --git a/mps/code/apss.c b/mps/code/apss.c index 55717dbfeeb..7ee07d356bd 100644 --- a/mps/code/apss.c +++ b/mps/code/apss.c @@ -41,9 +41,21 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size) } +/* check_allocated_size -- check the allocated size of the pool */ + +static void check_allocated_size(mps_pool_t pool, mps_ap_t ap, size_t allocated) +{ + size_t total = mps_pool_total_size(pool); + size_t free = mps_pool_free_size(pool); + size_t ap_free = (size_t)((char *)ap->limit - (char *)ap->init); + Insist(total - free == allocated + ap_free); +} + + /* stress -- create a pool of the requested type and allocate in it */ -static mps_res_t stress(mps_arena_t arena, mps_align_t align, +static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options, + mps_align_t align, size_t (*size)(size_t i, mps_align_t align), const char *name, mps_class_t class, mps_arg_s args[]) { @@ -53,6 +65,8 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align, size_t i, k; int *ps[testSetSIZE]; size_t ss[testSetSIZE]; + size_t allocated = 0; /* Total allocated memory */ + size_t debugOverhead = options ? 2 * alignUp(options->fence_size, align) : 0; printf("stress %s\n", name); @@ -66,8 +80,10 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align, res = make((mps_addr_t *)&ps[i], ap, ss[i]); if (res != MPS_RES_OK) goto allocFail; + allocated += ss[i] + debugOverhead; if (ss[i] >= sizeof(ps[i])) *ps[i] = 1; /* Write something, so it gets swap. */ + check_allocated_size(pool, ap, allocated); } mps_pool_check_fenceposts(pool); @@ -90,6 +106,8 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align, mps_free(pool, (mps_addr_t)ps[i], ss[i]); /* if (i == testSetSIZE/2) */ /* PoolDescribe((Pool)pool, mps_lib_stdout); */ + Insist(ss[i] + debugOverhead <= allocated); + allocated -= ss[i] + debugOverhead; } /* allocate some new objects */ for (i=testSetSIZE/2; icontrolPoolStruct) -#define ArenaCBSBlockPool(arena) (&(arena)->freeCBSBlockPoolStruct.poolStruct) -#define ArenaFreeLand(arena) (&(arena)->freeLandStruct.landStruct) +#define ArenaControlPool(arena) MVPool(&(arena)->controlPoolStruct) +#define ArenaCBSBlockPool(arena) MFSPool(&(arena)->freeCBSBlockPoolStruct) +#define ArenaFreeLand(arena) CBSLand(&(arena)->freeLandStruct) /* Forward declarations */ @@ -30,7 +30,7 @@ static void arenaFreePage(Arena arena, Addr base, Pool pool); /* ArenaTrivDescribe -- produce trivial description of an arena */ -static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream) +static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream, Count depth) { if (!TESTT(Arena, arena)) return ResFAIL; if (stream == NULL) return ResFAIL; @@ -47,8 +47,8 @@ static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream) * subclass describe method should avoid invoking * ARENA_SUPERCLASS()->describe. RHSK 2007-04-27. */ - return WriteF(stream, - " No class-specific description available.\n", NULL); + return WriteF(stream, depth, + " No class-specific description available.\n", NULL); } @@ -408,7 +408,7 @@ Res ControlInit(Arena arena) AVERT(Arena, arena); MPS_ARGS_BEGIN(args) { MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, CONTROL_EXTEND_BY); - res = PoolInit(&arena->controlPoolStruct.poolStruct, arena, + res = PoolInit(MVPool(&arena->controlPoolStruct), arena, PoolClassMV(), args); } MPS_ARGS_END(args); if (res != ResOK) @@ -424,13 +424,13 @@ void ControlFinish(Arena arena) { AVERT(Arena, arena); arena->poolReady = FALSE; - PoolFinish(&arena->controlPoolStruct.poolStruct); + PoolFinish(MVPool(&arena->controlPoolStruct)); } /* ArenaDescribe -- describe the arena */ -Res ArenaDescribe(Arena arena, mps_lib_FILE *stream) +Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth) { Res res; Size reserved; @@ -438,58 +438,57 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream) if (!TESTT(Arena, arena)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, "Arena $P {\n", (WriteFP)arena, + res = WriteF(stream, depth, "Arena $P {\n", (WriteFP)arena, " class $P (\"$S\")\n", (WriteFP)arena->class, arena->class->name, NULL); if (res != ResOK) return res; if (arena->poolReady) { - res = WriteF(stream, - " controlPool $P\n", (WriteFP)&arena->controlPoolStruct, + res = WriteF(stream, depth + 2, + "controlPool $P\n", (WriteFP)&arena->controlPoolStruct, NULL); if (res != ResOK) return res; } /* Note: this Describe clause calls a function */ reserved = ArenaReserved(arena); - res = WriteF(stream, - " reserved $W <-- " + res = WriteF(stream, depth + 2, + "reserved $W <-- " "total size of address-space reserved\n", (WriteFW)reserved, NULL); if (res != ResOK) return res; - res = WriteF(stream, - " committed $W <-- " + res = WriteF(stream, depth + 2, + "committed $W <-- " "total bytes currently stored (in RAM or swap)\n", (WriteFW)arena->committed, - " commitLimit $W\n", (WriteFW)arena->commitLimit, - " spareCommitted $W\n", (WriteFW)arena->spareCommitted, - " spareCommitLimit $W\n", (WriteFW)arena->spareCommitLimit, - " zoneShift $U\n", (WriteFU)arena->zoneShift, - " alignment $W\n", (WriteFW)arena->alignment, + "commitLimit $W\n", (WriteFW)arena->commitLimit, + "spareCommitted $W\n", (WriteFW)arena->spareCommitted, + "spareCommitLimit $W\n", (WriteFW)arena->spareCommitLimit, + "zoneShift $U\n", (WriteFU)arena->zoneShift, + "alignment $W\n", (WriteFW)arena->alignment, NULL); if (res != ResOK) return res; - res = WriteF(stream, - " droppedMessages $U$S\n", (WriteFU)arena->droppedMessages, + res = WriteF(stream, depth + 2, + "droppedMessages $U$S\n", (WriteFU)arena->droppedMessages, (arena->droppedMessages == 0 ? "" : " -- MESSAGES DROPPED!"), NULL); if (res != ResOK) return res; - res = (*arena->class->describe)(arena, stream); + res = (*arena->class->describe)(arena, stream, depth); if (res != ResOK) return res; - /* Do not call GlobalsDescribe: it makes too much output, thanks. - * RHSK 2007-04-27 - */ -#if 0 - res = GlobalsDescribe(ArenaGlobals(arena), stream); + res = WriteF(stream, depth + 2, "Globals {\n", NULL); + if (res != ResOK) return res; + res = GlobalsDescribe(ArenaGlobals(arena), stream, depth + 4); if (res != ResOK) return res; -#endif + res = WriteF(stream, depth + 2, "} Globals\n", NULL); + if (res != ResOK) return res; - res = WriteF(stream, + res = WriteF(stream, depth, "} Arena $P ($U)\n", (WriteFP)arena, (WriteFU)arena->serial, NULL); @@ -502,6 +501,7 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream) static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS) { mps_lib_FILE *stream = closureP; + Count depth = closureS; Chunk chunk; Tract tract; Addr addr; @@ -510,9 +510,8 @@ static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS) chunk = ChunkOfTree(tree); if (!TESTT(Chunk, chunk)) return ResFAIL; if (stream == NULL) return ResFAIL; - UNUSED(closureS); - res = WriteF(stream, "Chunk [$P, $P) ($U) {\n", + res = WriteF(stream, depth, "Chunk [$P, $P) ($U) {\n", (WriteFP)chunk->base, (WriteFP)chunk->limit, (WriteFU)chunk->serial, NULL); @@ -522,8 +521,8 @@ static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS) PageTract(ChunkPage(chunk, chunk->allocBase)), chunk->limit) { - res = WriteF(stream, - " [$P, $P) $P $U ($S)\n", + res = WriteF(stream, depth + 2, + "[$P, $P) $P $U ($S)\n", (WriteFP)TractBase(tract), (WriteFP)TractLimit(tract), (WriteFP)TractPool(tract), (WriteFU)(TractPool(tract)->serial), @@ -532,7 +531,7 @@ static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS) if (res != ResOK) return res; } - res = WriteF(stream, "} Chunk [$P, $P)\n", + res = WriteF(stream, depth, "} Chunk [$P, $P)\n", (WriteFP)chunk->base, (WriteFP)chunk->limit, NULL); return res; @@ -541,13 +540,13 @@ static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS) /* ArenaDescribeTracts -- describe all the tracts in the arena */ -Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream) +Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth) { if (!TESTT(Arena, arena)) return ResFAIL; if (stream == NULL) return ResFAIL; (void)TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey, - arenaDescribeTractsInChunk, stream, 0); + arenaDescribeTractsInChunk, stream, depth); return ResOK; } @@ -599,14 +598,14 @@ void ControlFree(Arena arena, void* base, size_t size) /* ControlDescribe -- describe the arena's control pool */ -Res ControlDescribe(Arena arena, mps_lib_FILE *stream) +Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth) { Res res; if (!TESTT(Arena, arena)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = PoolDescribe(ArenaControlPool(arena), stream); + res = PoolDescribe(ArenaControlPool(arena), stream, depth); return res; } diff --git a/mps/code/arenacv.c b/mps/code/arenacv.c index d5e56eaec2d..fada3b82692 100644 --- a/mps/code/arenacv.c +++ b/mps/code/arenacv.c @@ -332,7 +332,6 @@ static void testAllocAndIterate(Arena arena, Pool pool, } SegPrefExpress(&pref, SegPrefZoneSet, &zone); } - } @@ -363,6 +362,10 @@ static void testPageTable(ArenaClass class, Size size, Addr addr, Bool zoned) testAllocAndIterate(arena, pool, pageSize, tractsPerPage, &allocatorSegStruct); + die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe"); + die(ArenaDescribeTracts(arena, mps_lib_get_stdout(), 0), + "ArenaDescribeTracts"); + PoolDestroy(pool); ArenaDestroy(arena); } diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c index 73ea711f39c..e8c3cdd15e5 100644 --- a/mps/code/arenavm.c +++ b/mps/code/arenavm.c @@ -186,7 +186,7 @@ static Bool VMArenaCheck(VMArena vmArena) /* VMArenaDescribe -- describe the VMArena */ -static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream) +static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth) { Res res; VMArena vmArena; @@ -206,7 +206,7 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream) * */ - res = WriteF(stream, + res = WriteF(stream, depth, " spareSize: $U\n", (WriteFU)vmArena->spareSize, NULL); if(res != ResOK) diff --git a/mps/code/buffer.c b/mps/code/buffer.c index 9f0a1c02e8c..0198e7d461a 100644 --- a/mps/code/buffer.c +++ b/mps/code/buffer.c @@ -146,31 +146,26 @@ Bool BufferCheck(Buffer buffer) * * See for structure definitions. */ -Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream) +Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth) { Res res; - char abzMode[5]; if (!TESTT(Buffer, buffer)) return ResFAIL; if (stream == NULL) return ResFAIL; - abzMode[0] = (char)( (buffer->mode & BufferModeTRANSITION) ? 't' : '_' ); - abzMode[1] = (char)( (buffer->mode & BufferModeLOGGED) ? 'l' : '_' ); - abzMode[2] = (char)( (buffer->mode & BufferModeFLIPPED) ? 'f' : '_' ); - abzMode[3] = (char)( (buffer->mode & BufferModeATTACHED) ? 'a' : '_' ); - abzMode[4] = '\0'; - - res = WriteF(stream, + res = WriteF(stream, depth, "Buffer $P ($U) {\n", (WriteFP)buffer, (WriteFU)buffer->serial, " class $P (\"$S\")\n", (WriteFP)buffer->class, buffer->class->name, " Arena $P\n", (WriteFP)buffer->arena, " Pool $P\n", (WriteFP)buffer->pool, - buffer->isMutator ? - " Mutator Buffer\n" : " Internal Buffer\n", - " mode $S (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n", - (WriteFS)abzMode, + " ", buffer->isMutator ? "Mutator" : "Internal", " Buffer\n", + " mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n", + (WriteFC)((buffer->mode & BufferModeTRANSITION) ? 't' : '_'), + (WriteFC)((buffer->mode & BufferModeLOGGED) ? 'l' : '_'), + (WriteFC)((buffer->mode & BufferModeFLIPPED) ? 'f' : '_'), + (WriteFC)((buffer->mode & BufferModeATTACHED) ? 'a' : '_'), " fillSize $UKb\n", (WriteFU)(buffer->fillSize / 1024), " emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024), " alignment $W\n", (WriteFW)buffer->alignment, @@ -183,10 +178,10 @@ Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream) NULL); if (res != ResOK) return res; - res = buffer->class->describe(buffer, stream); + res = buffer->class->describe(buffer, stream, depth + 2); if (res != ResOK) return res; - res = WriteF(stream, "} Buffer $P ($U)\n", + res = WriteF(stream, depth, "} Buffer $P ($U)\n", (WriteFP)buffer, (WriteFU)buffer->serial, NULL); return res; @@ -1166,10 +1161,11 @@ static void bufferNoReassignSeg(Buffer buffer, Seg seg) /* bufferTrivDescribe -- basic Buffer describe method */ -static Res bufferTrivDescribe(Buffer buffer, mps_lib_FILE *stream) +static Res bufferTrivDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth) { if (!TESTT(Buffer, buffer)) return ResFAIL; if (stream == NULL) return ResFAIL; + UNUSED(depth); /* dispatching function does it all */ return ResOK; } @@ -1424,7 +1420,7 @@ static void segBufReassignSeg (Buffer buffer, Seg seg) /* segBufDescribe -- describe method for SegBuf */ -static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream) +static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth) { SegBuf segbuf; BufferClass super; @@ -1437,12 +1433,12 @@ static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream) /* Describe the superclass fields first via next-method call */ super = BUFFER_SUPERCLASS(SegBufClass); - res = super->describe(buffer, stream); + res = super->describe(buffer, stream, depth); if (res != ResOK) return res; - res = WriteF(stream, - " Seg $P\n", (WriteFP)segbuf->seg, - " rankSet $U\n", (WriteFU)segbuf->rankSet, + res = WriteF(stream, depth, + "Seg $P\n", (WriteFP)segbuf->seg, + "rankSet $U\n", (WriteFU)segbuf->rankSet, NULL); return res; diff --git a/mps/code/cbs.c b/mps/code/cbs.c index 6f0350d0519..d98f742fbf2 100644 --- a/mps/code/cbs.c +++ b/mps/code/cbs.c @@ -26,7 +26,6 @@ SRCID(cbs, "$Id$"); #define CBSBlockSize(block) AddrOffset((block)->base, (block)->limit) -#define cbsLand(cbs) (&((cbs)->landStruct)) #define cbsOfLand(land) PARENT(CBSStruct, landStruct, land) #define cbsSplay(cbs) (&((cbs)->splayTreeStruct)) #define cbsOfSplay(_splay) PARENT(CBSStruct, splayTreeStruct, _splay) @@ -36,9 +35,16 @@ SRCID(cbs, "$Id$"); PARENT(CBSFastBlockStruct, cbsBlockStruct, cbsBlockOfTree(_tree)) #define cbsZonedBlockOfTree(_tree) \ PARENT(CBSZonedBlockStruct, cbsFastBlockStruct, cbsFastBlockOfTree(_tree)) -#define cbsBlockKey(block) (&((block)->base)) #define cbsBlockPool(cbs) RVALUE((cbs)->blockPool) +/* We pass the block base directly as a TreeKey (void *) assuming that + Addr can be encoded, and possibly breaking . + On an exotic platform where this isn't true, pass the address of base. + i.e. add an & */ +#define cbsBlockKey(block) ((TreeKey)(block)->base) +#define keyOfBaseVar(baseVar) ((TreeKey)(baseVar)) +#define baseOfKey(key) ((Addr)(key)) + /* CBSCheck -- Check CBS */ @@ -47,7 +53,7 @@ Bool CBSCheck(CBS cbs) /* See .enter-leave.simple. */ Land land; CHECKS(CBS, cbs); - land = cbsLand(cbs); + land = CBSLand(cbs); CHECKD(Land, land); CHECKD(SplayTree, cbsSplay(cbs)); CHECKD(Pool, cbs->blockPool); @@ -85,10 +91,11 @@ static Compare cbsCompare(Tree tree, TreeKey key) Addr base1, base2, limit2; CBSBlock cbsBlock; - AVER(tree != NULL); - AVER(tree != TreeEMPTY); + AVERT_CRITICAL(Tree, tree); + AVER_CRITICAL(tree != TreeEMPTY); + AVER_CRITICAL(key != NULL); - base1 = *(Addr *)key; + base1 = baseOfKey(key); cbsBlock = cbsBlockOfTree(tree); base2 = cbsBlock->base; limit2 = cbsBlock->limit; @@ -118,7 +125,7 @@ static Bool cbsTestNode(SplayTree splay, Tree tree, AVERT(Tree, tree); AVER(closureP == NULL); AVER(size > 0); - AVER(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSFastLandClass)); + AVER(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSFastLandClass)); block = cbsBlockOfTree(tree); @@ -134,7 +141,7 @@ static Bool cbsTestTree(SplayTree splay, Tree tree, AVERT(Tree, tree); AVER(closureP == NULL); AVER(size > 0); - AVER(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSFastLandClass)); + AVER(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSFastLandClass)); block = cbsFastBlockOfTree(tree); @@ -150,7 +157,7 @@ static void cbsUpdateFastNode(SplayTree splay, Tree tree) AVERT_CRITICAL(SplayTree, splay); AVERT_CRITICAL(Tree, tree); - AVER_CRITICAL(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSFastLandClass)); + AVER_CRITICAL(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSFastLandClass)); maxSize = CBSBlockSize(cbsBlockOfTree(tree)); @@ -181,13 +188,13 @@ static void cbsUpdateZonedNode(SplayTree splay, Tree tree) AVERT_CRITICAL(SplayTree, splay); AVERT_CRITICAL(Tree, tree); - AVER_CRITICAL(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSZonedLandClass)); + AVER_CRITICAL(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSZonedLandClass)); cbsUpdateFastNode(splay, tree); zonedBlock = cbsZonedBlockOfTree(tree); block = &zonedBlock->cbsFastBlockStruct.cbsBlockStruct; - arena = LandArena(cbsLand(cbsOfSplay(splay))); + arena = LandArena(CBSLand(cbsOfSplay(splay))); zones = ZoneSetOfRange(arena, CBSBlockBase(block), CBSBlockLimit(block)); if (TreeHasLeft(tree)) @@ -450,7 +457,7 @@ static Res cbsInsert(Range rangeReturn, Land land, Range range) limit = RangeLimit(range); METER_ACC(cbs->treeSearch, cbs->treeSize); - b = SplayTreeNeighbours(&leftSplay, &rightSplay, cbsSplay(cbs), &base); + b = SplayTreeNeighbours(&leftSplay, &rightSplay, cbsSplay(cbs), keyOfBaseVar(base)); if (!b) { res = ResFAIL; goto fail; @@ -553,7 +560,7 @@ static Res cbsDelete(Range rangeReturn, Land land, Range range) limit = RangeLimit(range); METER_ACC(cbs->treeSearch, cbs->treeSize); - if (!SplayTreeFind(&tree, cbsSplay(cbs), (void *)&base)) { + if (!SplayTreeFind(&tree, cbsSplay(cbs), keyOfBaseVar(base))) { res = ResFAIL; goto failSplayTreeSearch; } @@ -619,7 +626,7 @@ static Res cbsBlockDescribe(CBSBlock block, mps_lib_FILE *stream) if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, 0, "[$P,$P)", (WriteFP)block->base, (WriteFP)block->limit, @@ -647,7 +654,7 @@ static Res cbsFastBlockDescribe(CBSFastBlock block, mps_lib_FILE *stream) if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, 0, "[$P,$P) {$U}", (WriteFP)block->cbsBlockStruct.base, (WriteFP)block->cbsBlockStruct.limit, @@ -676,7 +683,7 @@ static Res cbsZonedBlockDescribe(CBSZonedBlock block, mps_lib_FILE *stream) if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, 0, "[$P,$P) {$U, $B}", (WriteFP)block->cbsFastBlockStruct.cbsBlockStruct.base, (WriteFP)block->cbsFastBlockStruct.cbsBlockStruct.limit, @@ -832,7 +839,7 @@ static Bool cbsFindFirst(Range rangeReturn, Range oldRangeReturn, AVERT(Land, land); cbs = cbsOfLand(land); AVERT(CBS, cbs); - AVER(IsLandSubclass(cbsLand(cbs), CBSFastLandClass)); + AVER(IsLandSubclass(CBSLand(cbs), CBSFastLandClass)); AVER(rangeReturn != NULL); AVER(oldRangeReturn != NULL); @@ -917,7 +924,7 @@ static Bool cbsFindLast(Range rangeReturn, Range oldRangeReturn, AVERT(Land, land); cbs = cbsOfLand(land); AVERT(CBS, cbs); - AVER(IsLandSubclass(cbsLand(cbs), CBSFastLandClass)); + AVER(IsLandSubclass(CBSLand(cbs), CBSFastLandClass)); AVER(rangeReturn != NULL); AVER(oldRangeReturn != NULL); @@ -954,7 +961,7 @@ static Bool cbsFindLargest(Range rangeReturn, Range oldRangeReturn, AVERT(Land, land); cbs = cbsOfLand(land); AVERT(CBS, cbs); - AVER(IsLandSubclass(cbsLand(cbs), CBSFastLandClass)); + AVER(IsLandSubclass(CBSLand(cbs), CBSFastLandClass)); AVER(rangeReturn != NULL); AVER(oldRangeReturn != NULL); @@ -1005,7 +1012,7 @@ static Res cbsFindInZones(Bool *foundReturn, Range rangeReturn, AVERT(Land, land); cbs = cbsOfLand(land); AVERT(CBS, cbs); - AVER(IsLandSubclass(cbsLand(cbs), CBSZonedLandClass)); + AVER(IsLandSubclass(CBSLand(cbs), CBSZonedLandClass)); /* AVERT(ZoneSet, zoneSet); */ AVER(BoolCheck(high)); @@ -1065,7 +1072,7 @@ static Res cbsFindInZones(Bool *foundReturn, Range rangeReturn, * See . */ -static Res cbsDescribe(Land land, mps_lib_FILE *stream) +static Res cbsDescribe(Land land, mps_lib_FILE *stream, Count depth) { CBS cbs; Res res; @@ -1079,7 +1086,7 @@ static Res cbsDescribe(Land land, mps_lib_FILE *stream) if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "CBS $P {\n", (WriteFP)cbs, " blockPool: $P\n", (WriteFP)cbsBlockPool(cbs), " ownPool: $U\n", (WriteFU)cbs->ownPool, @@ -1087,6 +1094,8 @@ static Res cbsDescribe(Land land, mps_lib_FILE *stream) NULL); if (res != ResOK) return res; + METER_WRITE(cbs->treeSearch, stream, depth + 2); + if (IsLandSubclass(land, CBSZonedLandClass)) describe = cbsZonedSplayNodeDescribe; else if (IsLandSubclass(land, CBSFastLandClass)) @@ -1094,12 +1103,12 @@ static Res cbsDescribe(Land land, mps_lib_FILE *stream) else describe = cbsSplayNodeDescribe; - res = SplayTreeDescribe(cbsSplay(cbs), stream, describe); + res = SplayTreeDescribe(cbsSplay(cbs), stream, depth + 2, describe); if (res != ResOK) return res; - METER_WRITE(cbs->treeSearch, stream); + res = WriteF(stream, depth, "} CBS $P\n", (WriteFP)cbs, NULL); - res = WriteF(stream, "}\n", NULL); + res = WriteF(stream, 0, "}\n", NULL); return res; } diff --git a/mps/code/cbs.h b/mps/code/cbs.h index e6bc276f067..a1496b3f771 100644 --- a/mps/code/cbs.h +++ b/mps/code/cbs.h @@ -37,6 +37,7 @@ typedef struct CBSZonedBlockStruct { typedef struct CBSStruct *CBS; extern Bool CBSCheck(CBS cbs); +#define CBSLand(cbs) (&(cbs)->landStruct) extern LandClass CBSLandClassGet(void); extern LandClass CBSFastLandClassGet(void); diff --git a/mps/code/chain.h b/mps/code/chain.h index 87cfa08dd71..5c9b4b10f55 100644 --- a/mps/code/chain.h +++ b/mps/code/chain.h @@ -73,6 +73,8 @@ typedef struct mps_chain_s { } ChainStruct; +extern Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth); + extern Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount, GenParamStruct *params); extern void ChainDestroy(Chain chain); @@ -84,6 +86,7 @@ extern void ChainStartGC(Chain chain, Trace trace); extern void ChainEndGC(Chain chain, Trace trace); extern size_t ChainGens(Chain chain); extern GenDesc ChainGen(Chain chain, Index gen); +extern Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth); extern Bool PoolGenCheck(PoolGen pgen); extern Res PoolGenInit(PoolGen pgen, GenDesc gen, Pool pool); @@ -99,6 +102,7 @@ extern void PoolGenAccountForReclaim(PoolGen pgen, Size reclaimed, Bool deferred extern void PoolGenUndefer(PoolGen pgen, Size oldSize, Size newSize); extern void PoolGenAccountForSegSplit(PoolGen pgen); extern void PoolGenAccountForSegMerge(PoolGen pgen); +extern Res PoolGenDescribe(PoolGen gen, mps_lib_FILE *stream, Count depth); #endif /* chain_h */ diff --git a/mps/code/clock.h b/mps/code/clock.h index d5fd7bc0e4e..0453643882f 100644 --- a/mps/code/clock.h +++ b/mps/code/clock.h @@ -65,8 +65,8 @@ typedef union EventClockUnion { (*(EventClockUnion *)&(clock)).half.high, \ (*(EventClockUnion *)&(clock)).half.low) -#define EVENT_CLOCK_WRITE(stream, clock) \ - WriteF(stream, "$W$W", \ +#define EVENT_CLOCK_WRITE(stream, depth, clock) \ + WriteF(stream, depth, "$W$W", \ (*(EventClockUnion *)&(clock)).half.high, \ (*(EventClockUnion *)&(clock)).half.low, \ NULL) @@ -85,8 +85,8 @@ typedef union EventClockUnion { #endif -#define EVENT_CLOCK_WRITE(stream, clock) \ - WriteF(stream, "$W", (WriteFW)(clock), NULL) +#define EVENT_CLOCK_WRITE(stream, depth, clock) \ + WriteF(stream, depth, "$W", (WriteFW)(clock), NULL) #endif @@ -135,8 +135,8 @@ __extension__ typedef unsigned long long EventClock; (unsigned long)((clock) >> 32), \ (unsigned long)((clock) & 0xffffffff)) -#define EVENT_CLOCK_WRITE(stream, clock) \ - WriteF(stream, "$W$W", (WriteFW)((clock) >> 32), (WriteFW)clock, NULL) +#define EVENT_CLOCK_WRITE(stream, depth, clock) \ + WriteF(stream, depth, "$W$W", (WriteFW)((clock) >> 32), (WriteFW)clock, NULL) #endif /* Intel, GCC or Clang */ @@ -153,8 +153,8 @@ typedef mps_clock_t EventClock; #define EVENT_CLOCK_PRINT(stream, clock) \ fprintf(stream, "%lu", (unsigned long)clock) -#define EVENT_CLOCK_WRITE(stream, clock) \ - WriteF(stream, "$W", (WriteFW)clock, NULL) +#define EVENT_CLOCK_WRITE(stream, depth, clock) \ + WriteF(stream, depth, "$W", (WriteFW)clock, NULL) #endif diff --git a/mps/code/config.h b/mps/code/config.h index 552b3c943d9..dc5a199d01f 100644 --- a/mps/code/config.h +++ b/mps/code/config.h @@ -378,6 +378,7 @@ #define MVFF_SLOT_HIGH_DEFAULT FALSE #define MVFF_ARENA_HIGH_DEFAULT FALSE #define MVFF_FIRST_FIT_DEFAULT TRUE +#define MVFF_SPARE_DEFAULT 0.75 /* Pool MVT Configuration -- see */ diff --git a/mps/code/event.c b/mps/code/event.c index 475fa4f875c..5897031bcbe 100644 --- a/mps/code/event.c +++ b/mps/code/event.c @@ -319,7 +319,7 @@ void EventLabelAddr(Addr addr, EventStringId id) " $U", (WriteFU)event->name.f##index, -Res EventDescribe(Event event, mps_lib_FILE *stream) +Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth) { Res res; @@ -329,14 +329,14 @@ Res EventDescribe(Event event, mps_lib_FILE *stream) if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "Event $P {\n", (WriteFP)event, " code $U\n", (WriteFU)event->any.code, " clock ", NULL); if (res != ResOK) return res; - res = EVENT_CLOCK_WRITE(stream, event->any.clock); + res = EVENT_CLOCK_WRITE(stream, depth, event->any.clock); if (res != ResOK) return res; - res = WriteF(stream, "\n size $U\n", (WriteFU)event->any.size, NULL); + res = WriteF(stream, depth, "\n size $U\n", (WriteFU)event->any.size, NULL); if (res != ResOK) return res; switch (event->any.code) { @@ -347,7 +347,7 @@ Res EventDescribe(Event event, mps_lib_FILE *stream) #define EVENT_DESC(X, name, _code, always, kind) \ case _code: \ - res = WriteF(stream, \ + res = WriteF(stream, depth, \ " event \"$S\"", (WriteFS)#name, \ EVENT_##name##_PARAMS(EVENT_DESC_PARAM, name) \ NULL); \ @@ -357,13 +357,13 @@ Res EventDescribe(Event event, mps_lib_FILE *stream) EVENT_LIST(EVENT_DESC, X) default: - res = WriteF(stream, " event type unknown", NULL); + res = WriteF(stream, depth, " event type unknown", NULL); if (res != ResOK) return res; /* TODO: Hexdump unknown event contents. */ break; } - res = WriteF(stream, + res = WriteF(stream, depth, "\n} Event $P\n", (WriteFP)event, NULL); return res; @@ -377,7 +377,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream) if (event == NULL) return ResFAIL; if (stream == NULL) return ResFAIL; - res = EVENT_CLOCK_WRITE(stream, event->any.clock); + res = EVENT_CLOCK_WRITE(stream, 0, event->any.clock); if (res != ResOK) return res; @@ -388,7 +388,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream) #define EVENT_WRITE(X, name, code, always, kind) \ case code: \ - res = WriteF(stream, " $S", #name, \ + res = WriteF(stream, 0, " $S", #name, \ EVENT_##name##_PARAMS(EVENT_WRITE_PARAM, name) \ NULL); \ if (res != ResOK) return res; \ @@ -396,7 +396,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream) EVENT_LIST(EVENT_WRITE, X) default: - res = WriteF(stream, " ", event->any.code, NULL); + res = WriteF(stream, 0, " ", event->any.code, NULL); if (res != ResOK) return res; /* TODO: Hexdump unknown event contents. */ break; @@ -416,7 +416,7 @@ void EventDump(mps_lib_FILE *stream) /* This can happen if there's a backtrace very early in the life of the MPS, and will cause an access violation if we continue. */ if (!eventInited) { - (void)WriteF(stream, "No events\n", NULL); + (void)WriteF(stream, 0, "No events\n", NULL); return; } @@ -427,7 +427,7 @@ void EventDump(mps_lib_FILE *stream) /* Try to keep going even if there's an error, because this is used as a backtrace and we'll take what we can get. */ (void)EventWrite(event, stream); - (void)WriteF(stream, "\n", NULL); + (void)WriteF(stream, 0, "\n", NULL); } } } @@ -490,10 +490,11 @@ void EventLabelAddr(Addr addr, Word id) } -Res EventDescribe(Event event, mps_lib_FILE *stream) +Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth) { UNUSED(event); UNUSED(stream); + UNUSED(depth); return ResUNIMPL; } diff --git a/mps/code/event.h b/mps/code/event.h index 11884d30d6c..a586509f23e 100644 --- a/mps/code/event.h +++ b/mps/code/event.h @@ -33,7 +33,7 @@ extern EventStringId EventInternString(const char *label); extern EventStringId EventInternGenString(size_t, const char *label); extern void EventLabelAddr(Addr addr, Word id); extern void EventFlush(EventKind kind); -extern Res EventDescribe(Event event, mps_lib_FILE *stream); +extern Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth); extern Res EventWrite(Event event, mps_lib_FILE *stream); extern void EventDump(mps_lib_FILE *stream); diff --git a/mps/code/failover.c b/mps/code/failover.c index 7e9f07d7b8c..7cb596f8f33 100644 --- a/mps/code/failover.c +++ b/mps/code/failover.c @@ -276,7 +276,7 @@ static Bool failoverFindInZones(Bool *foundReturn, Range rangeReturn, Range oldR } -static Res failoverDescribe(Land land, mps_lib_FILE *stream) +static Res failoverDescribe(Land land, mps_lib_FILE *stream, Count depth) { Failover fo; Res res; @@ -286,7 +286,7 @@ static Res failoverDescribe(Land land, mps_lib_FILE *stream) if (!TESTT(Failover, fo)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "Failover $P {\n", (WriteFP)fo, " primary = $P ($S)\n", (WriteFP)fo->primary, fo->primary->class->name, diff --git a/mps/code/failover.h b/mps/code/failover.h index 56e6149e05e..3676bade103 100644 --- a/mps/code/failover.h +++ b/mps/code/failover.h @@ -13,6 +13,8 @@ typedef struct FailoverStruct *Failover; +#define FailoverLand(fo) (&(fo)->landStruct) + extern Bool FailoverCheck(Failover failover); extern LandClass FailoverLandClassGet(void); diff --git a/mps/code/fbmtest.c b/mps/code/fbmtest.c index 47666563db7..f5aa6831db8 100644 --- a/mps/code/fbmtest.c +++ b/mps/code/fbmtest.c @@ -38,7 +38,7 @@ SRCID(fbmtest, "$Id$"); static Count NAllocateTried, NAllocateSucceeded, NDeallocateTried, NDeallocateSucceeded; -static int verbose = 0; +static Bool verbose = FALSE; typedef unsigned FBMType; enum { @@ -80,10 +80,12 @@ static Index (indexOfAddr)(FBMState state, Addr a) static void describe(FBMState state) { switch (state->type) { case FBMTypeCBS: - die(CBSDescribe(state->the.cbs, mps_lib_get_stdout()), "CBSDescribe"); + die(CBSDescribe(state->the.cbs, mps_lib_get_stdout(), 0), + "CBSDescribe"); break; case FBMTypeFreelist: - die(FreelistDescribe(state->the.fl, mps_lib_get_stdout()), "FreelistDescribe"); + die(FreelistDescribe(state->the.fl, mps_lib_get_stdout(), 0), + "FreelistDescribe"); break; default: cdie(0, "invalid state->type"); @@ -542,6 +544,8 @@ static void test(FBMState state, unsigned n) { } if ((i + 1) % 1000 == 0) check(state); + if (i == 100) + describe(state); } } diff --git a/mps/code/finalcv.c b/mps/code/finalcv.c index 931503cf9bb..9f22226dc17 100644 --- a/mps/code/finalcv.c +++ b/mps/code/finalcv.c @@ -18,14 +18,15 @@ * This code was created by first copying */ -#include "testlib.h" -#include "mpslib.h" -#include "mps.h" -#include "mpscamc.h" -#include "mpsavm.h" #include "fmtdy.h" #include "fmtdytst.h" +#include "mpm.h" +#include "mps.h" +#include "mpsavm.h" +#include "mpscamc.h" +#include "mpslib.h" #include "mpstd.h" +#include "testlib.h" #include /* printf */ @@ -141,6 +142,8 @@ static void *test(void *arg, size_t s) } p = NULL; + die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe"); + mps_message_type_enable(arena, mps_message_type_finalization()); /* */ diff --git a/mps/code/finaltest.c b/mps/code/finaltest.c index 2e36c31ee10..da04a38c7ba 100644 --- a/mps/code/finaltest.c +++ b/mps/code/finaltest.c @@ -147,7 +147,7 @@ static mps_addr_t test_awl_find_dependent(mps_addr_t addr) static void *root[rootCOUNT]; static void test_trees(int mode, const char *name, mps_arena_t arena, - mps_ap_t ap, + mps_pool_t pool, mps_ap_t ap, mps_word_t (*make)(mps_word_t, mps_ap_t), void (*reg)(mps_word_t, mps_arena_t)) { @@ -158,7 +158,9 @@ static void test_trees(int mode, const char *name, mps_arena_t arena, object_count = 0; - printf("Making some %s finalized trees of objects.\n", name); + printf("---- Mode %s, pool class %s, %s trees ----\n", + mode == ModePARK ? "PARK" : "POLL", + pool->class->name, name); mps_arena_park(arena); /* make some trees */ @@ -167,7 +169,6 @@ static void test_trees(int mode, const char *name, mps_arena_t arena, (*reg)((mps_word_t)root[i], arena); } - printf("Losing all pointers to the trees.\n"); /* clean out the roots */ for(i = 0; i < rootCOUNT; ++i) { root[i] = 0; @@ -190,9 +191,15 @@ static void test_trees(int mode, const char *name, mps_arena_t arena, object_alloc = 0; while (object_alloc < 1000 && !mps_message_poll(arena)) (void)DYLAN_INT(object_alloc++); + printf(" Done.\n"); break; } ++ collections; + { + size_t live_size = (object_count - finals) * sizeof(void *) * 3; + size_t alloc_size = mps_pool_total_size(pool) - mps_pool_free_size(pool); + Insist(live_size <= alloc_size); + } while (mps_message_poll(arena)) { mps_message_t message; mps_addr_t objaddr; @@ -238,9 +245,9 @@ static void test_pool(int mode, mps_arena_t arena, mps_chain_t chain, "root_create\n"); die(mps_ap_create(&ap, pool, mps_rank_exact()), "ap_create\n"); - test_trees(mode, "numbered", arena, ap, make_numbered_tree, + test_trees(mode, "numbered", arena, pool, ap, make_numbered_tree, register_numbered_tree); - test_trees(mode, "indirect", arena, ap, make_indirect_tree, + test_trees(mode, "indirect", arena, pool, ap, make_indirect_tree, register_indirect_tree); mps_ap_destroy(ap); diff --git a/mps/code/format.c b/mps/code/format.c index 88a86283ef8..965ca61c306 100644 --- a/mps/code/format.c +++ b/mps/code/format.c @@ -193,11 +193,11 @@ Arena FormatArena(Format format) /* FormatDescribe -- describe a format */ -Res FormatDescribe(Format format, mps_lib_FILE *stream) +Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth) { Res res; - res = WriteF(stream, + res = WriteF(stream, depth, "Format $P ($U) {\n", (WriteFP)format, (WriteFU)format->serial, " arena $P ($U)\n", (WriteFP)format->arena, (WriteFU)format->arena->serial, diff --git a/mps/code/freelist.c b/mps/code/freelist.c index 44553927cbf..f09f8757c3a 100644 --- a/mps/code/freelist.c +++ b/mps/code/freelist.c @@ -14,7 +14,7 @@ SRCID(freelist, "$Id$"); #define freelistOfLand(land) PARENT(FreelistStruct, landStruct, land) -#define freelistAlignment(fl) LandAlignment(&(fl)->landStruct) +#define freelistAlignment(fl) LandAlignment(FreelistLand(fl)) typedef union FreelistBlockUnion { @@ -171,7 +171,7 @@ Bool FreelistCheck(Freelist fl) { Land land; CHECKS(Freelist, fl); - land = &fl->landStruct; + land = FreelistLand(fl); CHECKD(Land, land); /* See */ CHECKL(AlignIsAligned(freelistAlignment(fl), FreelistMinimumAlignment)); @@ -748,14 +748,14 @@ static Bool freelistDescribeVisitor(Land land, Range range, { Res res; mps_lib_FILE *stream = closureP; + Count depth = closureS; if (!TESTT(Land, land)) return FALSE; if (!RangeCheck(range)) return FALSE; if (stream == NULL) return FALSE; - if (closureS != UNUSED_SIZE) return FALSE; - res = WriteF(stream, - " [$P,", (WriteFP)RangeBase(range), + res = WriteF(stream, depth, + "[$P,", (WriteFP)RangeBase(range), "$P)", (WriteFP)RangeLimit(range), " {$U}\n", (WriteFU)RangeSize(range), NULL); @@ -764,7 +764,7 @@ static Bool freelistDescribeVisitor(Land land, Range range, } -static Res freelistDescribe(Land land, mps_lib_FILE *stream) +static Res freelistDescribe(Land land, mps_lib_FILE *stream, Count depth) { Freelist fl; Res res; @@ -775,15 +775,15 @@ static Res freelistDescribe(Land land, mps_lib_FILE *stream) if (!TESTT(Freelist, fl)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "Freelist $P {\n", (WriteFP)fl, " listSize = $U\n", (WriteFU)fl->listSize, NULL); - b = LandIterate(land, freelistDescribeVisitor, stream, UNUSED_SIZE); + b = LandIterate(land, freelistDescribeVisitor, stream, depth + 2); if (!b) return ResFAIL; - res = WriteF(stream, "}\n", NULL); + res = WriteF(stream, depth, "} Freelist $P\n", (WriteFP)fl, NULL); return res; } diff --git a/mps/code/freelist.h b/mps/code/freelist.h index db75837253e..dab791c9c03 100644 --- a/mps/code/freelist.h +++ b/mps/code/freelist.h @@ -13,6 +13,8 @@ typedef struct FreelistStruct *Freelist; +#define FreelistLand(fl) (&(fl)->landStruct) + extern Bool FreelistCheck(Freelist freelist); /* See */ diff --git a/mps/code/global.c b/mps/code/global.c index eca9e8671cc..31b4296d482 100644 --- a/mps/code/global.c +++ b/mps/code/global.c @@ -1008,88 +1008,100 @@ Ref ArenaRead(Arena arena, Ref *p) /* GlobalsDescribe -- describe the arena globals */ -Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream) +Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth) { Res res; Arena arena; Ring node, nextNode; Index i; + TraceId ti; + Trace trace; if (!TESTT(Globals, arenaGlobals)) return ResFAIL; if (stream == NULL) return ResFAIL; arena = GlobalsArena(arenaGlobals); - res = WriteF(stream, - " mpsVersion $S\n", arenaGlobals->mpsVersionString, - " lock $P\n", (WriteFP)arenaGlobals->lock, - " pollThreshold $U kB\n", + res = WriteF(stream, depth, + "mpsVersion $S\n", arenaGlobals->mpsVersionString, + "lock $P\n", (WriteFP)arenaGlobals->lock, + "pollThreshold $U kB\n", (WriteFU)(arenaGlobals->pollThreshold / 1024), arenaGlobals->insidePoll ? "inside poll\n" : "outside poll\n", arenaGlobals->clamped ? "clamped\n" : "released\n", - " fillMutatorSize $U kB\n", - (WriteFU)(arenaGlobals->fillMutatorSize / 1024), - " emptyMutatorSize $U kB\n", - (WriteFU)(arenaGlobals->emptyMutatorSize / 1024), - " allocMutatorSize $U kB\n", - (WriteFU)(arenaGlobals->allocMutatorSize / 1024), - " fillInternalSize $U kB\n", - (WriteFU)(arenaGlobals->fillInternalSize / 1024), - " emptyInternalSize $U kB\n", - (WriteFU)(arenaGlobals->emptyInternalSize / 1024), - " poolSerial $U\n", (WriteFU)arenaGlobals->poolSerial, - " rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial, - " formatSerial $U\n", (WriteFU)arena->formatSerial, - " threadSerial $U\n", (WriteFU)arena->threadSerial, + "fillMutatorSize $U kB\n", + (WriteFU)(arenaGlobals->fillMutatorSize / 1024), + "emptyMutatorSize $U kB\n", + (WriteFU)(arenaGlobals->emptyMutatorSize / 1024), + "allocMutatorSize $U kB\n", + (WriteFU)(arenaGlobals->allocMutatorSize / 1024), + "fillInternalSize $U kB\n", + (WriteFU)(arenaGlobals->fillInternalSize / 1024), + "emptyInternalSize $U kB\n", + (WriteFU)(arenaGlobals->emptyInternalSize / 1024), + "poolSerial $U\n", (WriteFU)arenaGlobals->poolSerial, + "rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial, + "formatSerial $U\n", (WriteFU)arena->formatSerial, + "threadSerial $U\n", (WriteFU)arena->threadSerial, arena->insideShield ? "inside shield\n" : "outside shield\n", - " busyTraces $B\n", (WriteFB)arena->busyTraces, - " flippedTraces $B\n", (WriteFB)arena->flippedTraces, - /* @@@@ no TraceDescribe function */ - " epoch $U\n", (WriteFU)arena->epoch, + "busyTraces $B\n", (WriteFB)arena->busyTraces, + "flippedTraces $B\n", (WriteFB)arena->flippedTraces, + "epoch $U\n", (WriteFU)arena->epoch, + "prehistory = $B\n", (WriteFB)arena->prehistory, + "history {\n", + " [note: indices are raw, not rotated]\n", NULL); if (res != ResOK) return res; for(i=0; i < LDHistoryLENGTH; ++ i) { - res = WriteF(stream, - " history[$U] = $B\n", i, arena->history[i], + res = WriteF(stream, depth + 2, + "[$U] = $B\n", i, arena->history[i], NULL); if (res != ResOK) return res; } - res = WriteF(stream, - " [note: indices are raw, not rotated]\n" - " prehistory = $B\n", (WriteFB)arena->prehistory, - NULL); - if (res != ResOK) return res; - - res = WriteF(stream, - " suspended $S\n", arena->suspended ? "YES" : "NO", - " shDepth $U\n", arena->shDepth, - " shCacheI $U\n", arena->shCacheI, + res = WriteF(stream, depth, + "} history\n", + "suspended $S\n", arena->suspended ? "YES" : "NO", + "shDepth $U\n", arena->shDepth, + "shCacheI $U\n", arena->shCacheI, /* @@@@ should SegDescribe the cached segs? */ NULL); if (res != ResOK) return res; - res = RootsDescribe(arenaGlobals, stream); + res = RootsDescribe(arenaGlobals, stream, depth); if (res != ResOK) return res; RING_FOR(node, &arenaGlobals->poolRing, nextNode) { Pool pool = RING_ELT(Pool, arenaRing, node); - res = PoolDescribe(pool, stream); + res = PoolDescribe(pool, stream, depth); if (res != ResOK) return res; } RING_FOR(node, &arena->formatRing, nextNode) { Format format = RING_ELT(Format, arenaRing, node); - res = FormatDescribe(format, stream); + res = FormatDescribe(format, stream, depth); if (res != ResOK) return res; } RING_FOR(node, &arena->threadRing, nextNode) { Thread thread = ThreadRingThread(node); - res = ThreadDescribe(thread, stream); + res = ThreadDescribe(thread, stream, depth); if (res != ResOK) return res; } + RING_FOR(node, &arena->chainRing, nextNode) { + Chain chain = RING_ELT(Chain, chainRing, node); + res = ChainDescribe(chain, stream, depth); + if (res != ResOK) return res; + } + + TRACE_SET_ITER(ti, trace, TraceSetUNIV, arena) + if (TraceSetIsMember(arena->busyTraces, trace)) { + res = TraceDescribe(trace, stream, depth); + if (res != ResOK) return res; + } + TRACE_SET_ITER_END(ti, trace, TraceSetUNIV, arena); + /* @@@@ What about grey rings? */ return res; } diff --git a/mps/code/land.c b/mps/code/land.c index 19f26057623..fa0e9c62a8a 100644 --- a/mps/code/land.c +++ b/mps/code/land.c @@ -371,14 +371,14 @@ Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, * See */ -Res LandDescribe(Land land, mps_lib_FILE *stream) +Res LandDescribe(Land land, mps_lib_FILE *stream, Count depth) { Res res; if (!TESTT(Land, land)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "Land $P {\n", (WriteFP)land, " class $P", (WriteFP)land->class, " (\"$S\")\n", land->class->name, @@ -389,11 +389,11 @@ Res LandDescribe(Land land, mps_lib_FILE *stream) if (res != ResOK) return res; - res = (*land->class->describe)(land, stream); + res = (*land->class->describe)(land, stream, depth + 2); if (res != ResOK) return res; - res = WriteF(stream, "} Land $P\n", (WriteFP)land, NULL); + res = WriteF(stream, depth, "} Land $P\n", (WriteFP)land, NULL); return ResOK; } @@ -568,12 +568,13 @@ static Res landNoFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRang return ResUNIMPL; } -static Res landTrivDescribe(Land land, mps_lib_FILE *stream) +static Res landTrivDescribe(Land land, mps_lib_FILE *stream, Count depth) { if (!TESTT(Land, land)) return ResFAIL; if (stream == NULL) return ResFAIL; + UNUSED(depth); /* dispatching function does it all */ return ResOK; } diff --git a/mps/code/landtest.c b/mps/code/landtest.c index af6beff29ac..f5f6a27647d 100644 --- a/mps/code/landtest.c +++ b/mps/code/landtest.c @@ -71,7 +71,7 @@ static Index (indexOfAddr)(TestState state, Addr a) static void describe(TestState state) { - die(LandDescribe(state->land, mps_lib_get_stdout()), "LandDescribe"); + die(LandDescribe(state->land, mps_lib_get_stdout(), 0), "LandDescribe"); } @@ -486,10 +486,10 @@ extern int main(int argc, char *argv[]) CBSStruct cbsStruct; FreelistStruct flStruct; FailoverStruct foStruct; - Land cbs = &cbsStruct.landStruct; - Land fl = &flStruct.landStruct; - Land fo = &foStruct.landStruct; - Pool mfs = &blockPool.poolStruct; + Land cbs = CBSLand(&cbsStruct); + Land fl = FreelistLand(&flStruct); + Land fo = FailoverLand(&foStruct); + Pool mfs = MFSPool(&blockPool); Align align; int i; diff --git a/mps/code/locus.c b/mps/code/locus.c index 537eea666e8..aea81751725 100644 --- a/mps/code/locus.c +++ b/mps/code/locus.c @@ -126,6 +126,35 @@ static Size GenDescTotalSize(GenDesc gen) } +/* GenDescDescribe -- describe a generation in a chain */ + +Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth) +{ + Res res; + Ring node, nextNode; + + if (!TESTT(GenDesc, gen)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, depth, + "GenDesc $P {\n", (WriteFP)gen, + " zones $B\n", (WriteFB)gen->zones, + " capacity $U\n", (WriteFU)gen->capacity, + " mortality $D\n", (WriteFD)gen->mortality, + NULL); + if (res != ResOK) return res; + + RING_FOR(node, &gen->locusRing, nextNode) { + PoolGen pgen = RING_ELT(PoolGen, genRing, node); + res = PoolGenDescribe(pgen, stream, depth + 2); + if (res != ResOK) return res; + } + + res = WriteF(stream, depth, "} GenDesc $P\n", (WriteFP)gen, NULL); + return res; +} + + /* ChainCreate -- create a generation chain */ Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount, @@ -412,6 +441,35 @@ void ChainEndGC(Chain chain, Trace trace) } +/* ChainDescribe -- describe a chain */ + +Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth) +{ + Res res; + size_t i; + + if (!TESTT(Chain, chain)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, depth, + "Chain $P {\n", (WriteFP)chain, + " arena $P\n", (WriteFP)chain->arena, + " activeTraces $B\n", (WriteFB)chain->activeTraces, + NULL); + if (res != ResOK) return res; + + for (i = 0; i < chain->genCount; ++i) { + res = GenDescDescribe(&chain->gens[i], stream, depth + 2); + if (res != ResOK) return res; + } + + res = WriteF(stream, depth, + "} Chain $P\n", (WriteFP)chain, + NULL); + return res; +} + + /* PoolGenInit -- initialize a PoolGen */ Res PoolGenInit(PoolGen pgen, GenDesc gen, Pool pool) @@ -665,6 +723,33 @@ void PoolGenFree(PoolGen pgen, Seg seg, Size freeSize, Size oldSize, } +/* PoolGenDescribe -- describe a PoolGen */ + +Res PoolGenDescribe(PoolGen pgen, mps_lib_FILE *stream, Count depth) +{ + Res res; + + if (!TESTT(PoolGen, pgen)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + res = WriteF(stream, depth, + "PoolGen $P {\n", (WriteFP)pgen, + " pool $P ($U) \"$S\"\n", + (WriteFP)pgen->pool, (WriteFU)pgen->pool->serial, + (WriteFS)pgen->pool->class->name, + " segs $U\n", (WriteFU)pgen->segs, + " totalSize $U\n", (WriteFU)pgen->totalSize, + " freeSize $U\n", (WriteFU)pgen->freeSize, + " oldSize $U\n", (WriteFU)pgen->oldSize, + " oldDeferredSize $U\n", (WriteFU)pgen->oldDeferredSize, + " newSize $U\n", (WriteFU)pgen->newSize, + " newDeferredSize $U\n", (WriteFU)pgen->newDeferredSize, + "} PoolGen $P\n", (WriteFP)pgen, + NULL); + return res; +} + + /* LocusInit -- initialize the locus module */ void LocusInit(Arena arena) diff --git a/mps/code/meter.c b/mps/code/meter.c index 92937c1c941..e112986119d 100644 --- a/mps/code/meter.c +++ b/mps/code/meter.c @@ -64,12 +64,12 @@ void MeterAccumulate(Meter meter, Size amount) /* MeterWrite -- describe method for meters */ -Res MeterWrite(Meter meter, mps_lib_FILE *stream) +Res MeterWrite(Meter meter, mps_lib_FILE *stream, Count depth) { Res res = ResOK; - res = WriteF(stream, - "meter $S {", meter->name, + res = WriteF(stream, depth, + "meter \"$S\" {", meter->name, "count: $U", meter->count, NULL); if (res != ResOK) @@ -77,7 +77,7 @@ Res MeterWrite(Meter meter, mps_lib_FILE *stream) if (meter->count > 0) { double mean = meter->total / (double)meter->count; - res = WriteF(stream, + res = WriteF(stream, 0, ", total: $D", meter->total, ", max: $U", meter->max, ", min: $U", meter->min, @@ -87,7 +87,7 @@ Res MeterWrite(Meter meter, mps_lib_FILE *stream) if (res != ResOK) return res; } - res = WriteF(stream, "}\n", NULL); + res = WriteF(stream, 0, "}\n", NULL); return res; } @@ -98,7 +98,7 @@ Res MeterWrite(Meter meter, mps_lib_FILE *stream) void MeterEmit(Meter meter) { EVENT6(MeterValues, meter, meter->total, meter->meanSquared, - meter->count, meter->max, meter->min); + meter->count, meter->max, meter->min); } diff --git a/mps/code/meter.h b/mps/code/meter.h index f1731400e42..9ac571cae22 100644 --- a/mps/code/meter.h +++ b/mps/code/meter.h @@ -35,7 +35,7 @@ typedef struct MeterStruct extern void MeterInit(Meter meter, const char *name, void *owner); extern void MeterAccumulate(Meter meter, Size amount); -extern Res MeterWrite(Meter meter, mps_lib_FILE *stream); +extern Res MeterWrite(Meter meter, mps_lib_FILE *stream, Count depth); extern void MeterEmit(Meter meter); #define METER_DECL(meter) STATISTIC_DECL(struct MeterStruct meter) @@ -45,12 +45,12 @@ extern void MeterEmit(Meter meter); #define METER_ACC(meter, delta) \ STATISTIC(MeterAccumulate(&(meter), delta)) #if defined(STATISTICS) -#define METER_WRITE(meter, stream) BEGIN \ - Res _res = MeterWrite(&(meter), (stream)); \ +#define METER_WRITE(meter, stream, depth) BEGIN \ + Res _res = MeterWrite(&(meter), (stream), (depth)); \ if (_res != ResOK) return _res; \ END #elif defined(STATISTICS_NONE) -#define METER_WRITE(meter, stream) NOOP +#define METER_WRITE(meter, stream, depth) NOOP #else #error "No statistics configured." #endif diff --git a/mps/code/misc.h b/mps/code/misc.h index 3d0f259ff72..c07647f54db 100644 --- a/mps/code/misc.h +++ b/mps/code/misc.h @@ -156,13 +156,12 @@ typedef const struct SrcIdStruct { * * Use these values for unused pointer, size closure arguments and * check them in the callback or visitor. - * - * We use PointerAdd rather than a cast to avoid "warning C4306: 'type - * cast' : conversion from 'unsigned int' to 'Pointer' of greater - * size" on platform w3i6mv. + * + * Ensure that they have high bits set on 64-bit platforms for maximum + * unusability. */ -#define UNUSED_POINTER PointerAdd(0, 0xB60405ED) /* PointeR UNUSED */ -#define UNUSED_SIZE ((Size)0x520405ED) /* SiZe UNUSED */ +#define UNUSED_POINTER (Pointer)((Word)~0xFFFFFFFF | (Word)0xB60405ED) /* PointeR UNUSED */ +#define UNUSED_SIZE ((Size)~0xFFFFFFFF | (Size)0x520405ED) /* SiZe UNUSED */ /* PARENT -- parent structure diff --git a/mps/code/mpm.c b/mps/code/mpm.c index a46fdf5fb10..35bd33ea6f0 100644 --- a/mps/code/mpm.c +++ b/mps/code/mpm.c @@ -430,34 +430,35 @@ static Res WriteDouble(mps_lib_FILE *stream, double d) * .writef.check: See .check.writef. */ -Res WriteF(mps_lib_FILE *stream, ...) +Res WriteF(mps_lib_FILE *stream, Count depth, ...) { Res res; va_list args; - va_start(args, stream); - res = WriteF_v(stream, args); + va_start(args, depth); + res = WriteF_v(stream, depth, args); va_end(args); return res; } -Res WriteF_v(mps_lib_FILE *stream, va_list args) +Res WriteF_v(mps_lib_FILE *stream, Count depth, va_list args) { const char *firstformat; Res res; firstformat = va_arg(args, const char *); - res = WriteF_firstformat_v(stream, firstformat, args); + res = WriteF_firstformat_v(stream, depth, firstformat, args); return res; } -Res WriteF_firstformat_v(mps_lib_FILE *stream, +Res WriteF_firstformat_v(mps_lib_FILE *stream, Count depth, const char *firstformat, va_list args) { const char *format; int r; size_t i; Res res; + Bool start_of_line = TRUE; AVER(stream != NULL); @@ -468,9 +469,18 @@ Res WriteF_firstformat_v(mps_lib_FILE *stream, break; while(*format != '\0') { + if (start_of_line) { + for (i = 0; i < depth; ++i) { + mps_lib_fputc(' ', stream); + } + start_of_line = FALSE; + } if (*format != '$') { r = mps_lib_fputc(*format, stream); /* Could be more efficient */ if (r == mps_lib_EOF) return ResIO; + if (*format == '\n') { + start_of_line = TRUE; + } } else { ++format; AVER(*format != '\0'); @@ -493,7 +503,7 @@ Res WriteF_firstformat_v(mps_lib_FILE *stream, case 'F': { /* function */ WriteFF f = va_arg(args, WriteFF); Byte *b = (Byte *)&f; - /* ISO C forbits casting function pointers to integer, so + /* ISO C forbids casting function pointers to integer, so decode bytes (see design.writef.f). TODO: Be smarter about endianness. */ for(i=0; i < sizeof(WriteFF); i++) { diff --git a/mps/code/mpm.h b/mps/code/mpm.h index c30d4c31509..ccec0aff383 100644 --- a/mps/code/mpm.h +++ b/mps/code/mpm.h @@ -156,9 +156,9 @@ extern Bool (WordIsP2)(Word word); /* Formatted Output -- see , */ -extern Res WriteF(mps_lib_FILE *stream, ...); -extern Res WriteF_v(mps_lib_FILE *stream, va_list args); -extern Res WriteF_firstformat_v(mps_lib_FILE *stream, +extern Res WriteF(mps_lib_FILE *stream, Count depth, ...); +extern Res WriteF_v(mps_lib_FILE *stream, Count depth, va_list args); +extern Res WriteF_firstformat_v(mps_lib_FILE *stream, Count depth, const char *firstformat, va_list args); @@ -181,7 +181,7 @@ extern Res PoolInit(Pool pool, Arena arena, PoolClass class, ArgList args); extern void PoolFinish(Pool pool); extern Bool PoolClassCheck(PoolClass class); extern Bool PoolCheck(Pool pool); -extern Res PoolDescribe(Pool pool, mps_lib_FILE *stream); +extern Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth); /* Must be thread-safe. See . */ #define PoolArena(pool) ((pool)->arena) @@ -224,6 +224,9 @@ extern Res PoolAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr); extern void PoolWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, void *v, size_t s); extern void PoolFreeWalk(Pool pool, FreeBlockStepMethod f, void *p); +extern Size PoolTotalSize(Pool pool); +extern Size PoolFreeSize(Pool pool); + extern Res PoolTrivInit(Pool pool, ArgList arg); extern void PoolTrivFinish(Pool pool); extern Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size, @@ -242,7 +245,7 @@ extern void PoolNoBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit); extern void PoolTrivBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit); -extern Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream); +extern Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream, Count depth); extern Res PoolNoTraceBegin(Pool pool, Trace trace); extern Res PoolTrivTraceBegin(Pool pool, Trace trace); extern Res PoolNoAccess(Pool pool, Seg seg, Addr addr, @@ -277,6 +280,7 @@ extern void PoolNoWalk(Pool pool, Seg seg, FormattedObjectsStepMethod step, extern void PoolTrivFreeWalk(Pool pool, FreeBlockStepMethod f, void *p); extern PoolDebugMixin PoolNoDebugMixin(Pool pool); extern BufferClass PoolNoBufferClass(void); +extern Size PoolNoSize(Pool pool); #define ClassOfPool(pool) ((pool)->class) #define SuperclassOfPool(pool) \ @@ -398,6 +402,7 @@ extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode); extern void TraceQuantum(Trace trace); extern Res TraceStartCollectAll(Trace *traceReturn, Arena arena, int why); +extern Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth); /* traceanc.c -- Trace Ancillary */ @@ -493,8 +498,8 @@ extern void ArenaDestroy(Arena arena); extern Res ArenaInit(Arena arena, ArenaClass class, Align alignment, ArgList args); extern void ArenaFinish(Arena arena); -extern Res ArenaDescribe(Arena arena, mps_lib_FILE *stream); -extern Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream); +extern Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth); +extern Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth); extern Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context); extern Res ArenaFreeLandInsert(Arena arena, Addr base, Addr limit); extern void ArenaFreeLandDelete(Arena arena, Addr base, Addr limit); @@ -505,7 +510,7 @@ extern Res GlobalsInit(Globals arena); extern void GlobalsFinish(Globals arena); extern Res GlobalsCompleteCreate(Globals arenaGlobals); extern void GlobalsPrepareToDestroy(Globals arenaGlobals); -extern Res GlobalsDescribe(Globals arena, mps_lib_FILE *stream); +extern Res GlobalsDescribe(Globals arena, mps_lib_FILE *stream, Count depth); extern Ring GlobalsRememberedSummaryRing(Globals); #define ArenaGlobals(arena) (&(arena)->globals) @@ -562,7 +567,7 @@ extern void ControlFinish(Arena arena); extern Res ControlAlloc(void **baseReturn, Arena arena, size_t size, Bool withReservoirPermit); extern void ControlFree(Arena arena, void *base, size_t size); -extern Res ControlDescribe(Arena arena, mps_lib_FILE *stream); +extern Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth); /* Peek/Poke @@ -660,7 +665,6 @@ extern Bool SegOfAddr(Seg *segReturn, Arena arena, Addr addr); extern Bool SegFirst(Seg *segReturn, Arena arena); extern Bool SegNext(Seg *segReturn, Arena arena, Seg seg); extern Bool SegNextOfRing(Seg *segReturn, Arena arena, Pool pool, Ring next); -extern Bool SegFindAboveAddr(Seg *segReturn, Arena arena, Addr addr); extern void SegSetWhite(Seg seg, TraceSet white); extern void SegSetGrey(Seg seg, TraceSet grey); extern void SegSetRankSet(Seg seg, RankSet rankSet); @@ -669,7 +673,7 @@ extern Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi, Bool withReservoirPermit); extern Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at, Bool withReservoirPermit); -extern Res SegDescribe(Seg seg, mps_lib_FILE *stream); +extern Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth); extern void SegSetSummary(Seg seg, RefSet summary); extern Buffer SegBuffer(Seg seg); extern void SegSetBuffer(Seg seg, Buffer buffer); @@ -728,7 +732,7 @@ extern Res BufferCreate(Buffer *bufferReturn, BufferClass class, extern void BufferDestroy(Buffer buffer); extern Bool BufferCheck(Buffer buffer); extern Bool SegBufCheck(SegBuf segbuf); -extern Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream); +extern Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth); extern Res BufferReserve(Addr *pReturn, Buffer buffer, Size size, Bool withReservoirPermit); /* macro equivalent for BufferReserve, keep in sync with */ @@ -827,7 +831,7 @@ extern Bool FormatCheck(Format format); extern Res FormatCreate(Format *formatReturn, Arena arena, ArgList args); extern void FormatDestroy(Format format); extern Arena FormatArena(Format format); -extern Res FormatDescribe(Format format, mps_lib_FILE *stream); +extern Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth); /* Reference Interface -- see */ @@ -974,8 +978,8 @@ extern Res RootCreateFun(Root *rootReturn, Arena arena, extern void RootDestroy(Root root); extern Bool RootModeCheck(RootMode mode); extern Bool RootCheck(Root root); -extern Res RootDescribe(Root root, mps_lib_FILE *stream); -extern Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream); +extern Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth); +extern Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth); extern Rank RootRank(Root root); extern AccessSet RootPM(Root root); extern RefSet RootSummary(Root root); @@ -1021,7 +1025,7 @@ extern Bool LandFindFirst(Range rangeReturn, Range oldRangeReturn, Land land, Si extern Bool LandFindLast(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete); extern Bool LandFindLargest(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete); extern Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high); -extern Res LandDescribe(Land land, mps_lib_FILE *stream); +extern Res LandDescribe(Land land, mps_lib_FILE *stream, Count depth); extern Bool LandFlush(Land dest, Land src); extern Size LandSlowSize(Land land); diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c index 9b6c3150897..078c0d6ff68 100644 --- a/mps/code/mpmss.c +++ b/mps/code/mpmss.c @@ -5,14 +5,15 @@ * Portions copyright (C) 2002 Global Graphics Software. */ +#include "mpm.h" +#include "mps.h" +#include "mpsavm.h" +#include "mpscmfs.h" #include "mpscmv.h" #include "mpscmvff.h" -#include "mpscmfs.h" #include "mpslib.h" -#include "mpsavm.h" +#include "mpslib.h" #include "testlib.h" -#include "mpslib.h" -#include "mps.h" #include /* printf */ @@ -23,9 +24,20 @@ #define testLOOPS 10 +/* check_allocated_size -- check the allocated size of the pool */ + +static void check_allocated_size(mps_pool_t pool, size_t allocated) +{ + size_t total = mps_pool_total_size(pool); + size_t free = mps_pool_free_size(pool); + Insist(total - free == allocated); +} + + /* stress -- create a pool of the requested type and allocate in it */ -static mps_res_t stress(mps_arena_t arena, size_t (*size)(size_t i), +static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options, + size_t (*size)(size_t i), mps_align_t align, const char *name, mps_class_t pool_class, mps_arg_s *args) { @@ -34,8 +46,10 @@ static mps_res_t stress(mps_arena_t arena, size_t (*size)(size_t i), size_t i, k; int *ps[testSetSIZE]; size_t ss[testSetSIZE]; + size_t allocated = 0; /* Total allocated memory */ + size_t debugOverhead = options ? 2 * alignUp(options->fence_size, align) : 0; - printf("%s\n", name); + printf("Pool class %s, alignment %u\n", name, (unsigned)align); res = mps_pool_create_k(&pool, arena, pool_class, args); if (res != MPS_RES_OK) @@ -48,8 +62,10 @@ static mps_res_t stress(mps_arena_t arena, size_t (*size)(size_t i), res = mps_alloc((mps_addr_t *)&ps[i], pool, ss[i]); if (res != MPS_RES_OK) return res; + allocated += alignUp(ss[i], align) + debugOverhead; if (ss[i] >= sizeof(ps[i])) *ps[i] = 1; /* Write something, so it gets swap. */ + check_allocated_size(pool, allocated); } mps_pool_check_fenceposts(pool); @@ -72,15 +88,20 @@ static mps_res_t stress(mps_arena_t arena, size_t (*size)(size_t i), mps_free(pool, (mps_addr_t)ps[i], ss[i]); /* if (i == testSetSIZE/2) */ /* PoolDescribe((Pool)pool, mps_lib_stdout); */ + Insist(alignUp(ss[i], align) + debugOverhead <= allocated); + allocated -= alignUp(ss[i], align) + debugOverhead; } /* allocate some new objects */ for (i=testSetSIZE/2; i */ } MFSStruct; @@ -158,7 +162,7 @@ typedef struct MVStruct { /* MV pool outer structure */ Size extendBy; /* segment size to extend pool by */ Size avgSize; /* client estimate of allocation size */ Size maxSize; /* client estimate of maximum size */ - Size space; /* total free space in pool */ + Size free; /* free space in pool */ Size lost; /* */ RingStruct spans; /* span chain */ Sig sig; /* */ diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h index 74d1faaa9e4..fabc1f5edb7 100644 --- a/mps/code/mpmtypes.h +++ b/mps/code/mpmtypes.h @@ -128,7 +128,7 @@ typedef void (*ArenaFreeMethod)(Addr base, Size size, Pool pool); typedef Res (*ArenaChunkInitMethod)(Chunk chunk, BootBlock boot); typedef void (*ArenaChunkFinishMethod)(Chunk chunk); typedef void (*ArenaCompactMethod)(Arena arena, Trace trace); -typedef Res (*ArenaDescribeMethod)(Arena arena, mps_lib_FILE *stream); +typedef Res (*ArenaDescribeMethod)(Arena arena, mps_lib_FILE *stream, Count depth); typedef Res (*ArenaPagesMarkAllocatedMethod)(Arena arena, Chunk chunk, Index baseIndex, Count pages, Pool pool); @@ -168,7 +168,7 @@ typedef void (*SegSetRankSummaryMethod)(Seg seg, RankSet rankSet, typedef void (*SegSetSummaryMethod)(Seg seg, RefSet summary); typedef Buffer (*SegBufferMethod)(Seg seg); typedef void (*SegSetBufferMethod)(Seg seg, Buffer buffer); -typedef Res (*SegDescribeMethod)(Seg seg, mps_lib_FILE *stream); +typedef Res (*SegDescribeMethod)(Seg seg, mps_lib_FILE *stream, Count depth); typedef Res (*SegMergeMethod)(Seg seg, Seg segHi, Addr base, Addr mid, Addr limit, Bool withReservoirPermit); @@ -188,7 +188,7 @@ typedef Seg (*BufferSegMethod)(Buffer buffer); typedef RankSet (*BufferRankSetMethod)(Buffer buffer); typedef void (*BufferSetRankSetMethod)(Buffer buffer, RankSet rankSet); typedef void (*BufferReassignSegMethod)(Buffer buffer, Seg seg); -typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream); +typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count depth); /* Pool*Method -- see */ @@ -235,8 +235,9 @@ typedef void (*PoolWalkMethod)(Pool pool, Seg seg, void *v, size_t s); typedef void (*PoolFreeWalkMethod)(Pool pool, FreeBlockStepMethod f, void *p); typedef BufferClass (*PoolBufferClassMethod)(void); -typedef Res (*PoolDescribeMethod)(Pool pool, mps_lib_FILE *stream); +typedef Res (*PoolDescribeMethod)(Pool pool, mps_lib_FILE *stream, Count depth); typedef PoolDebugMixin (*PoolDebugMixinMethod)(Pool pool); +typedef Size (*PoolSizeMethod)(Pool pool); /* Messages @@ -277,7 +278,7 @@ typedef Bool (*LandIterateMethod)(Land land, LandVisitor visitor, void *closureP typedef Bool (*LandIterateAndDeleteMethod)(Land land, LandDeleteVisitor visitor, void *closureP, Size closureS); typedef Bool (*LandFindMethod)(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete); typedef Res (*LandFindInZonesMethod)(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high); -typedef Res (*LandDescribeMethod)(Land land, mps_lib_FILE *stream); +typedef Res (*LandDescribeMethod)(Land land, mps_lib_FILE *stream, Count depth); /* CONSTANTS */ diff --git a/mps/code/mps.h b/mps/code/mps.h index 050696e19d0..c9260cc6715 100644 --- a/mps/code/mps.h +++ b/mps/code/mps.h @@ -188,6 +188,9 @@ extern const struct mps_key_s _mps_key_max_size; extern const struct mps_key_s _mps_key_align; #define MPS_KEY_ALIGN (&_mps_key_align) #define MPS_KEY_ALIGN_FIELD align +extern const struct mps_key_s _mps_key_spare; +#define MPS_KEY_SPARE (&_mps_key_spare) +#define MPS_KEY_SPARE_FIELD double extern const struct mps_key_s _mps_key_interior; #define MPS_KEY_INTERIOR (&_mps_key_interior) #define MPS_KEY_INTERIOR_FIELD b @@ -469,6 +472,11 @@ extern mps_res_t mps_pool_create_v(mps_pool_t *, mps_arena_t, extern mps_res_t mps_pool_create_k(mps_pool_t *, mps_arena_t, mps_class_t, mps_arg_s []); extern void mps_pool_destroy(mps_pool_t); +extern size_t mps_pool_total_size(mps_pool_t); +extern size_t mps_pool_free_size(mps_pool_t); + + +/* Chains */ /* .gen-param: This structure must match . */ typedef struct mps_gen_param_s { @@ -480,6 +488,9 @@ extern mps_res_t mps_chain_create(mps_chain_t *, mps_arena_t, size_t, mps_gen_param_s *); extern void mps_chain_destroy(mps_chain_t); + +/* Manual Allocation */ + extern mps_res_t mps_alloc(mps_addr_t *, mps_pool_t, size_t); extern mps_res_t mps_alloc_v(mps_addr_t *, mps_pool_t, size_t, va_list); extern void mps_free(mps_pool_t, mps_addr_t, size_t); diff --git a/mps/code/mpscmv.h b/mps/code/mpscmv.h index 805db19b8af..5c6522ae1e9 100644 --- a/mps/code/mpscmv.h +++ b/mps/code/mpscmv.h @@ -9,8 +9,9 @@ #include "mps.h" -extern size_t mps_mv_free_size(mps_pool_t mps_pool); -extern size_t mps_mv_size(mps_pool_t mps_pool); +#define mps_mv_free_size mps_pool_free_size +#define mps_mv_size mps_pool_total_size + extern mps_class_t mps_class_mv(void); extern mps_class_t mps_class_mv_debug(void); diff --git a/mps/code/mpscmv2.h b/mps/code/mpscmv2.h index 8586a639901..8925d38d3b3 100644 --- a/mps/code/mpscmv2.h +++ b/mps/code/mpscmv2.h @@ -1,27 +1,24 @@ /* mpscmv2.h: MEMORY POOL SYSTEM CLASS "MVT" * * $Id$ - * Copyright (c) 2001 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * + * The MVT pool class used to be known as "MV2" in some places: this + * header provides backwards compatibility for prograns that included + * it under its old name. */ #ifndef mpscmv2_h #define mpscmv2_h -#include "mps.h" - -extern mps_class_t mps_class_mvt(void); - -/* The mvt pool class supports two extensions to the pool protocol: - size and free_size. */ -extern size_t mps_mvt_free_size(mps_pool_t mps_pool); -extern size_t mps_mvt_size(mps_pool_t mps_pool); +#include "mpscmvt.h" #endif /* mpscmv2_h */ /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2002 Ravenbrook Limited . + * Copyright (C) 2001-2014 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mpscmvff.h b/mps/code/mpscmvff.h index f8bc97b7f3b..ca1fbcae697 100644 --- a/mps/code/mpscmvff.h +++ b/mps/code/mpscmvff.h @@ -19,8 +19,9 @@ extern const struct mps_key_s _mps_key_mvff_first_fit; #define MPS_KEY_MVFF_FIRST_FIT (&_mps_key_mvff_first_fit) #define MPS_KEY_MVFF_FIRST_FIT_FIELD b -extern size_t mps_mvff_free_size(mps_pool_t mps_pool); -extern size_t mps_mvff_size(mps_pool_t mps_pool); +#define mps_mvff_free_size mps_pool_free_size +#define mps_mvff_size mps_pool_total_size + extern mps_class_t mps_class_mvff(void); extern mps_class_t mps_class_mvff_debug(void); diff --git a/mps/code/mpscmvt.h b/mps/code/mpscmvt.h index f46e43267df..9490d5ffb77 100644 --- a/mps/code/mpscmvt.h +++ b/mps/code/mpscmvt.h @@ -16,28 +16,10 @@ extern const struct mps_key_s _mps_key_mvt_frag_limit; #define MPS_KEY_MVT_FRAG_LIMIT (&_mps_key_mvt_frag_limit) #define MPS_KEY_MVT_FRAG_LIMIT_FIELD d -/* The mvt pool class has five extra parameters to mps_pool_create: - * mps_res_t mps_pool_create(mps_pool_t * pool, mps_arena_t arena, - * mps_class_t mvt_class, - * size_t minimum_size, - * size_t mean_size, - * size_t maximum_size, - * mps_count_t reserve_depth - * mps_count_t fragmentation_limit); - * minimum_, mean_, and maximum_size are the mimimum, mean, and - * maximum (typical) size of objects expected to be allocated in the - * pool. reserve_depth is a measure of the expected hysteresis of the - * object population. fragmentation_limit is a percentage (between 0 - * and 100): if the free space managed by the pool exceeds the - * specified percentage, the pool will resort to a "first fit" - * allocation policy. - */ extern mps_class_t mps_class_mvt(void); -/* The mvt pool class supports two extensions to the pool protocol: - size and free_size. */ -extern size_t mps_mvt_free_size(mps_pool_t mps_pool); -extern size_t mps_mvt_size(mps_pool_t mps_pool); +#define mps_mvt_free_size mps_pool_free_size +#define mps_mvt_size mps_pool_total_size #endif /* mpscmvt_h */ diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c index 0573a6d4256..a679955456d 100644 --- a/mps/code/mpsi.c +++ b/mps/code/mpsi.c @@ -678,6 +678,40 @@ void mps_pool_destroy(mps_pool_t pool) ArenaLeave(arena); } +size_t mps_pool_total_size(mps_pool_t pool) +{ + Arena arena; + Size size; + + AVER(TESTT(Pool, pool)); + arena = PoolArena(pool); + + ArenaEnter(arena); + + size = PoolTotalSize(pool); + + ArenaLeave(arena); + + return (size_t)size; +} + +size_t mps_pool_free_size(mps_pool_t pool) +{ + Arena arena; + Size size; + + AVER(TESTT(Pool, pool)); + arena = PoolArena(pool); + + ArenaEnter(arena); + + size = PoolFreeSize(pool); + + ArenaLeave(arena); + + return (size_t)size; +} + mps_res_t mps_alloc(mps_addr_t *p_o, mps_pool_t pool, size_t size) { diff --git a/mps/code/mv2test.c b/mps/code/mv2test.c index bf29f61981f..a3c5e807a04 100644 --- a/mps/code/mv2test.c +++ b/mps/code/mv2test.c @@ -4,18 +4,19 @@ * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. */ -#include +#include #include +#include #include -#include "mpscmvt.h" +#include "mpm.h" #include "mps.h" -#include "mpslib.h" #include "mpsavm.h" +#include "mpscmvt.h" +#include "mpslib.h" +#include "mpstd.h" #include "testlib.h" -#include - /* expdev() -- exponentially distributed random deviates * * From @@ -113,6 +114,9 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align, printf("%"PRIwWORD PRIXLONGEST" %6"PRIXLONGEST" ", (ulongest_t)ps[i], (ulongest_t)ss[i]); } + if (i == 100) { + PoolDescribe(pool, mps_lib_get_stdout(), 0); + } } if (verbose) { putchar('\n'); diff --git a/mps/code/nailboard.c b/mps/code/nailboard.c index 852c98949e7..46fa3a2f582 100644 --- a/mps/code/nailboard.c +++ b/mps/code/nailboard.c @@ -403,7 +403,7 @@ Bool NailboardIsResRange(Nailboard board, Addr base, Addr limit) } -Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream) +Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream, Count depth) { Index i, j; Res res; @@ -413,35 +413,38 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream) if (stream == NULL) return ResFAIL; - res = WriteF(stream, - "Nailboard $P\n{\n", (WriteFP)board, - " base: $P\n", (WriteFP)RangeBase(&board->range), - " limit: $P\n", (WriteFP)RangeLimit(&board->range), - " levels: $U\n", (WriteFU)board->levels, - " newNails: $S\n", board->newNails ? "TRUE" : "FALSE", - " alignShift: $U\n", (WriteFU)board->alignShift, - NULL); + res = WriteF(stream, depth, "Nailboard $P {\n", (WriteFP)board, NULL); if (res != ResOK) return res; + res = RangeDescribe(&board->range, stream, depth + 2); + if (res != ResOK) + return res; + + res = WriteF(stream, depth + 2, + "levels: $U\n", (WriteFU)board->levels, + "newNails: $S\n", board->newNails ? "TRUE" : "FALSE", + "alignShift: $U\n", (WriteFU)board->alignShift, + NULL); + for(i = 0; i < board->levels; ++i) { Count levelNails = nailboardLevelBits(nailboardNails(board), i); Count resetNails = BTCountResRange(board->level[i], 0, levelNails); - res = WriteF(stream, " Level $U ($U bits, $U set): ", + res = WriteF(stream, depth + 2, "Level $U ($U bits, $U set): ", i, levelNails, levelNails - resetNails, NULL); if (res != ResOK) return res; for (j = 0; j < levelNails; ++j) { char c = BTGet(board->level[i], j) ? '*' : '.'; - res = WriteF(stream, "$C", c, NULL); + res = WriteF(stream, 0, "$C", c, NULL); if (res != ResOK) return res; } - res = WriteF(stream, "\n", NULL); + res = WriteF(stream, 0, "\n", NULL); if (res != ResOK) return res; } - res = WriteF(stream, "}\n", NULL); + res = WriteF(stream, depth, "} Nailboard $P\n", (WriteFP)board, NULL); if (res != ResOK) return res; diff --git a/mps/code/nailboard.h b/mps/code/nailboard.h index 66141067f5f..538a46e9249 100644 --- a/mps/code/nailboard.h +++ b/mps/code/nailboard.h @@ -45,7 +45,7 @@ extern Bool NailboardSet(Nailboard board, Addr addr); extern void NailboardSetRange(Nailboard board, Addr base, Addr limit); extern Bool NailboardIsSetRange(Nailboard board, Addr base, Addr limit); extern Bool NailboardIsResRange(Nailboard board, Addr base, Addr limit); -extern Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream); +extern Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream, Count depth); #endif /* nailboard.h */ diff --git a/mps/code/nailboardtest.c b/mps/code/nailboardtest.c index 24bf3be36c2..93e9796e2dd 100644 --- a/mps/code/nailboardtest.c +++ b/mps/code/nailboardtest.c @@ -49,6 +49,8 @@ static void test(mps_arena_t arena) "NailboardIsResRange"); } } + + die(NailboardDescribe(board, mps_lib_get_stdout(), 0), "NailboardDescribe"); } int main(int argc, char **argv) diff --git a/mps/code/pool.c b/mps/code/pool.c index b3dd0588500..f9b10c6027a 100644 --- a/mps/code/pool.c +++ b/mps/code/pool.c @@ -72,6 +72,8 @@ Bool PoolClassCheck(PoolClass class) CHECKL(FUNCHECK(class->bufferClass)); CHECKL(FUNCHECK(class->describe)); CHECKL(FUNCHECK(class->debugMixin)); + CHECKL(FUNCHECK(class->totalSize)); + CHECKL(FUNCHECK(class->freeSize)); CHECKS(PoolClass, class); return TRUE; } @@ -114,6 +116,7 @@ ARG_DEFINE_KEY(min_size, Size); ARG_DEFINE_KEY(mean_size, Size); ARG_DEFINE_KEY(max_size, Size); ARG_DEFINE_KEY(align, Align); +ARG_DEFINE_KEY(spare, double); ARG_DEFINE_KEY(interior, Bool); @@ -517,9 +520,29 @@ void PoolFreeWalk(Pool pool, FreeBlockStepMethod f, void *p) } +/* PoolTotalSize -- return total memory allocated from arena */ + +Size PoolTotalSize(Pool pool) +{ + AVERT(Pool, pool); + + return (*pool->class->totalSize)(pool); +} + + +/* PoolFreeSize -- return free memory (unused by client program) */ + +Size PoolFreeSize(Pool pool) +{ + AVERT(Pool, pool); + + return (*pool->class->freeSize)(pool); +} + + /* PoolDescribe -- describe a pool */ -Res PoolDescribe(Pool pool, mps_lib_FILE *stream) +Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { Res res; Ring node, nextNode; @@ -527,7 +550,7 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream) if (!TESTT(Pool, pool)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "Pool $P ($U) {\n", (WriteFP)pool, (WriteFU)pool->serial, " class $P (\"$S\")\n", (WriteFP)pool->class, pool->class->name, @@ -537,31 +560,31 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream) NULL); if (res != ResOK) return res; if (NULL != pool->format) { - res = FormatDescribe(pool->format, stream); + res = FormatDescribe(pool->format, stream, depth + 2); if (res != ResOK) return res; } - res = WriteF(stream, - " fillMutatorSize $UKb\n", - (WriteFU)(pool->fillMutatorSize / 1024), - " emptyMutatorSize $UKb\n", - (WriteFU)(pool->emptyMutatorSize / 1024), - " fillInternalSize $UKb\n", - (WriteFU)(pool->fillInternalSize / 1024), - " emptyInternalSize $UKb\n", - (WriteFU)(pool->emptyInternalSize / 1024), + res = WriteF(stream, depth + 2, + "fillMutatorSize $UKb\n", + (WriteFU)(pool->fillMutatorSize / 1024), + "emptyMutatorSize $UKb\n", + (WriteFU)(pool->emptyMutatorSize / 1024), + "fillInternalSize $UKb\n", + (WriteFU)(pool->fillInternalSize / 1024), + "emptyInternalSize $UKb\n", + (WriteFU)(pool->emptyInternalSize / 1024), NULL); if (res != ResOK) return res; - res = (*pool->class->describe)(pool, stream); + res = (*pool->class->describe)(pool, stream, depth + 2); if (res != ResOK) return res; RING_FOR(node, &pool->bufferRing, nextNode) { Buffer buffer = RING_ELT(Buffer, poolRing, node); - res = BufferDescribe(buffer, stream); + res = BufferDescribe(buffer, stream, depth + 2); if (res != ResOK) return res; } - res = WriteF(stream, + res = WriteF(stream, depth, "} Pool $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial, NULL); if (res != ResOK) return res; diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c index 2fa5eb17d25..ecc05abb2ad 100644 --- a/mps/code/poolabs.c +++ b/mps/code/poolabs.c @@ -145,6 +145,8 @@ DEFINE_CLASS(AbstractPoolClass, class) class->bufferClass = PoolNoBufferClass; class->describe = PoolTrivDescribe; class->debugMixin = PoolNoDebugMixin; + class->totalSize = PoolNoSize; + class->freeSize = PoolNoSize; class->labelled = FALSE; class->sig = PoolClassSig; } @@ -290,11 +292,13 @@ void PoolTrivBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit) } -Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream) +Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { AVERT(Pool, pool); AVER(stream != NULL); - return WriteF(stream, " No class-specific description available.\n", NULL); + return WriteF(stream, depth, + "No class-specific description available.\n", + NULL); } @@ -675,6 +679,14 @@ BufferClass PoolNoBufferClass(void) } +Size PoolNoSize(Pool pool) +{ + AVERT(Pool, pool); + NOTREACHED; + return UNUSED_SIZE; +} + + /* C. COPYRIGHT AND LICENSE * * Copyright (C) 2001-2014 Ravenbrook Limited . diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c index 12f7c5e99f7..4b90357db45 100644 --- a/mps/code/poolamc.c +++ b/mps/code/poolamc.c @@ -48,7 +48,7 @@ typedef struct amcGenStruct { Sig sig; /* */ } amcGenStruct; -#define amcGenAMC(amcgen) Pool2AMC((amcgen)->pgen.pool) +#define amcGenAMC(amcgen) PoolAMC((amcgen)->pgen.pool) #define amcGenPool(amcgen) ((amcgen)->pgen.pool) #define amcGenNr(amcgen) ((amcgen)->pgen.nr) @@ -235,7 +235,7 @@ static void AMCSegSketch(Seg seg, char *pbSketch, size_t cbSketch) * * See . */ -static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream) +static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) { Res res; Pool pool; @@ -256,7 +256,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream) /* Describe the superclass fields first via next-method call */ super = SEG_SUPERCLASS(amcSegClass); - res = super->describe(seg, stream); + res = super->describe(seg, stream, depth); if(res != ResOK) return res; @@ -268,7 +268,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream) p = AddrAdd(base, pool->format->headerSize); limit = SegLimit(seg); - res = WriteF(stream, + res = WriteF(stream, depth, "AMC seg $P [$A,$A){\n", (WriteFP)seg, (WriteFA)base, (WriteFA)limit, NULL); @@ -276,16 +276,17 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream) return res; if(amcSegHasNailboard(seg)) { - res = WriteF(stream, " Boarded\n", NULL); + res = WriteF(stream, depth + 2, "Boarded\n", NULL); } else if(SegNailed(seg) == TraceSetEMPTY) { - res = WriteF(stream, " Mobile\n", NULL); + res = WriteF(stream, depth + 2, "Mobile\n", NULL); } else { - res = WriteF(stream, " Stuck\n", NULL); + res = WriteF(stream, depth + 2, "Stuck\n", NULL); } if(res != ResOK) return res; - res = WriteF(stream, " Map: *===:object @+++:nails bbbb:buffer\n", NULL); + res = WriteF(stream, depth + 2, + "Map: *===:object @+++:nails bbbb:buffer\n", NULL); if(res != ResOK) return res; @@ -298,7 +299,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream) Addr j; char c; - res = WriteF(stream, " $A ", i, NULL); + res = WriteF(stream, depth + 2, "$A ", i, NULL); if(res != ResOK) return res; @@ -318,22 +319,22 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream) c = (nailed ? '+' : '='); } } - res = WriteF(stream, "$C", c, NULL); + res = WriteF(stream, 0, "$C", c, NULL); if(res != ResOK) return res; } - res = WriteF(stream, "\n", NULL); + res = WriteF(stream, 0, "\n", NULL); if(res != ResOK) return res; } AMCSegSketch(seg, abzSketch, NELEMS(abzSketch)); - res = WriteF(stream, " Sketch: $S\n", (WriteFS)abzSketch, NULL); + res = WriteF(stream, depth + 2, "Sketch: $S\n", (WriteFS)abzSketch, NULL); if(res != ResOK) return res; - res = WriteF(stream, "} AMC Seg $P\n", (WriteFP)seg, NULL); + res = WriteF(stream, depth, "} AMC Seg $P\n", (WriteFP)seg, NULL); if(res != ResOK) return res; @@ -478,8 +479,8 @@ typedef struct AMCStruct { /* */ Sig sig; /* */ } AMCStruct; -#define Pool2AMC(pool) PARENT(AMCStruct, poolStruct, (pool)) -#define AMC2Pool(amc) (&(amc)->poolStruct) +#define PoolAMC(pool) PARENT(AMCStruct, poolStruct, (pool)) +#define AMCPool(amc) (&(amc)->poolStruct) /* amcGenCheck -- check consistency of a generation structure */ @@ -583,7 +584,7 @@ static Res AMCBufInit(Buffer buffer, Pool pool, ArgList args) AVERT(Buffer, buffer); AVERT(Pool, pool); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); if (ArgPick(&arg, args, amcKeyAPHashArrays)) @@ -656,7 +657,7 @@ static Res amcGenCreate(amcGen *genReturn, AMC amc, GenDesc gen) Res res; void *p; - pool = AMC2Pool(amc); + pool = AMCPool(amc); arena = pool->arena; res = ControlAlloc(&p, arena, sizeof(amcGenStruct), FALSE); @@ -712,21 +713,26 @@ static void amcGenDestroy(amcGen gen) /* amcGenDescribe -- describe an AMC generation */ -static Res amcGenDescribe(amcGen gen, mps_lib_FILE *stream) +static Res amcGenDescribe(amcGen gen, mps_lib_FILE *stream, Count depth) { Res res; if(!TESTT(amcGen, gen)) return ResFAIL; + if (stream == NULL) + return ResFAIL; - res = WriteF(stream, - " amcGen $P {\n", (WriteFP)gen, - " buffer $P\n", gen->forward, - " segs $U, totalSize $U, newSize $U\n", - (WriteFU)gen->pgen.segs, - (WriteFU)gen->pgen.totalSize, - (WriteFU)gen->pgen.newSize, - " } amcGen\n", NULL); + res = WriteF(stream, depth, + "amcGen $P {\n", (WriteFP)gen, + " buffer $P\n", gen->forward, NULL); + if (res != ResOK) + return res; + + res = PoolGenDescribe(&gen->pgen, stream, depth + 2); + if (res != ResOK) + return res; + + res = WriteF(stream, depth, "} amcGen $P\n", (WriteFP)gen, NULL); return res; } @@ -757,7 +763,7 @@ static Res amcSegCreateNailboard(Seg seg, Pool pool) static Bool amcPinnedInterior(AMC amc, Nailboard board, Addr base, Addr limit) { - Size headerSize = AMC2Pool(amc)->format->headerSize; + Size headerSize = AMCPool(amc)->format->headerSize; return !NailboardIsResRange(board, AddrSub(base, headerSize), AddrSub(limit, headerSize)); } @@ -817,7 +823,7 @@ static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args) AVER(pool != NULL); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); arena = PoolArena(pool); ArgRequire(&arg, args, MPS_KEY_FORMAT); @@ -933,7 +939,7 @@ static void AMCFinish(Pool pool) Ring node, nextNode; AVERT(Pool, pool); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); EVENT1(AMCFinish, amc); @@ -995,7 +1001,7 @@ static Res AMCBufferFill(Addr *baseReturn, Addr *limitReturn, amcBuf amcbuf; AVERT(Pool, pool); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); AVER(baseReturn != NULL); AVER(limitReturn != NULL); @@ -1084,7 +1090,7 @@ static void AMCBufferEmpty(Pool pool, Buffer buffer, Seg seg; AVERT(Pool, pool); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); AVERT(Buffer, buffer); AVER(BufferIsReady(buffer)); @@ -1123,7 +1129,7 @@ static void AMCRampBegin(Pool pool, Buffer buf, Bool collectAll) AMC amc; AVERT(Pool, pool); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); AVERT(Buffer, buf); AVERT(Bool, collectAll); @@ -1145,7 +1151,7 @@ static void AMCRampEnd(Pool pool, Buffer buf) AMC amc; AVERT(Pool, pool); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); AVERT(Buffer, buf); @@ -1277,7 +1283,7 @@ static Res AMCWhiten(Pool pool, Trace trace, Seg seg) condemned += SegSize(seg); trace->condemned += condemned; - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); STATISTIC_STAT( { @@ -1334,7 +1340,7 @@ static Res amcScanNailedRange(Bool *totalReturn, Bool *moreReturn, Format format; Size headerSize; Addr p, clientLimit; - Pool pool = AMC2Pool(amc); + Pool pool = AMCPool(amc); format = pool->format; headerSize = format->headerSize; p = AddrAdd(base, headerSize); @@ -1477,7 +1483,7 @@ static Res AMCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) AVERT(ScanState, ss); AVERT(Seg, seg); AVERT(Pool, pool); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); @@ -1589,7 +1595,7 @@ static Res AMCFixEmergency(Pool pool, ScanState ss, Seg seg, arena = PoolArena(pool); AVERT(Arena, arena); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); ss->wasMarked = TRUE; @@ -1667,7 +1673,7 @@ static Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) return ResOK; } - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT_CRITICAL(AMC, amc); format = pool->format; ref = *refIO; @@ -1816,7 +1822,7 @@ static Res AMCHeaderFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) return ResOK; } - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT_CRITICAL(AMC, amc); format = pool->format; headerSize = format->headerSize; @@ -1930,7 +1936,7 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg) /* All arguments AVERed by AMCReclaim */ - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); format = pool->format; @@ -2048,7 +2054,7 @@ static void AMCReclaim(Pool pool, Trace trace, Seg seg) amcGen gen; AVERT_CRITICAL(Pool, pool); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT_CRITICAL(AMC, amc); AVERT_CRITICAL(Trace, trace); AVERT_CRITICAL(Seg, seg); @@ -2094,7 +2100,7 @@ static void AMCTraceEnd(Pool pool, Trace trace) AVERT(Pool, pool); AVERT(Trace, trace); - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); ti = trace->ti; AVERT(TraceId, ti); @@ -2138,7 +2144,7 @@ static void AMCWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, if(SegWhite(seg) == TraceSetEMPTY && SegGrey(seg) == TraceSetEMPTY && SegNailed(seg) == TraceSetEMPTY) { - amc = Pool2AMC(pool); + amc = PoolAMC(pool); AVERT(AMC, amc); format = pool->format; @@ -2266,11 +2272,55 @@ static Res AMCAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr) } +/* AMCTotalSize -- total memory allocated from the arena */ + +static Size AMCTotalSize(Pool pool) +{ + AMC amc; + Size size = 0; + Ring node, nextNode; + + AVERT(Pool, pool); + amc = PoolAMC(pool); + AVERT(AMC, amc); + + RING_FOR(node, &amc->genRing, nextNode) { + amcGen gen = RING_ELT(amcGen, amcRing, node); + AVERT(amcGen, gen); + size += gen->pgen.totalSize; + } + + return size; +} + + +/* AMCFreeSize -- free memory (unused by client program) */ + +static Size AMCFreeSize(Pool pool) +{ + AMC amc; + Size size = 0; + Ring node, nextNode; + + AVERT(Pool, pool); + amc = PoolAMC(pool); + AVERT(AMC, amc); + + RING_FOR(node, &amc->genRing, nextNode) { + amcGen gen = RING_ELT(amcGen, amcRing, node); + AVERT(amcGen, gen); + size += gen->pgen.freeSize; + } + + return size; +} + + /* AMCDescribe -- describe the contents of the AMC pool * * See . */ -static Res AMCDescribe(Pool pool, mps_lib_FILE *stream) +static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { Res res; AMC amc; @@ -2279,59 +2329,55 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream) if(!TESTT(Pool, pool)) return ResFAIL; - amc = Pool2AMC(pool); + amc = PoolAMC(pool); if(!TESTT(AMC, amc)) return ResFAIL; if(stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, (amc->rankSet == RankSetEMPTY) ? "AMCZ" : "AMC", " $P {\n", (WriteFP)amc, " pool $P ($U)\n", - (WriteFP)AMC2Pool(amc), (WriteFU)AMC2Pool(amc)->serial, + (WriteFP)AMCPool(amc), (WriteFU)AMCPool(amc)->serial, NULL); if(res != ResOK) return res; switch(amc->rampMode) { - #define RAMP_DESCRIBE(e, s) \ case e: \ rampmode = s; \ break; - RAMP_RELATION(RAMP_DESCRIBE) #undef RAMP_DESCRIBE - default: rampmode = "unknown ramp mode"; break; - } - res = WriteF(stream, - " ", rampmode, " ($U)\n", (WriteFU)amc->rampCount, + res = WriteF(stream, depth + 2, + rampmode, " ($U)\n", (WriteFU)amc->rampCount, NULL); if(res != ResOK) return res; RING_FOR(node, &amc->genRing, nextNode) { amcGen gen = RING_ELT(amcGen, amcRing, node); - res = amcGenDescribe(gen, stream); + res = amcGenDescribe(gen, stream, depth + 2); if(res != ResOK) return res; } if(0) { /* SegDescribes */ - RING_FOR(node, &AMC2Pool(amc)->segRing, nextNode) { + RING_FOR(node, &AMCPool(amc)->segRing, nextNode) { Seg seg = RING_ELT(Seg, poolRing, node); - res = AMCSegDescribe(seg, stream); + res = AMCSegDescribe(seg, stream, depth + 2); if(res != ResOK) return res; } } - res = WriteF(stream, "} AMC $P\n", (WriteFP)amc, NULL); + res = WriteF(stream, depth, "} AMC $P\n", (WriteFP)amc, NULL); if(res != ResOK) return res; @@ -2365,6 +2411,8 @@ DEFINE_POOL_CLASS(AMCZPoolClass, this) this->addrObject = AMCAddrObject; this->walk = AMCWalk; this->bufferClass = amcBufClassGet; + this->totalSize = AMCTotalSize; + this->freeSize = AMCFreeSize; this->describe = AMCDescribe; AVERT(PoolClass, this); } @@ -2458,8 +2506,8 @@ ATTRIBUTE_UNUSED static Bool AMCCheck(AMC amc) { CHECKS(AMC, amc); - CHECKD(Pool, &amc->poolStruct); - CHECKL(IsSubclassPoly(amc->poolStruct.class, AMCZPoolClassGet())); + CHECKD(Pool, AMCPool(amc)); + CHECKL(IsSubclassPoly(AMCPool(amc)->class, AMCZPoolClassGet())); CHECKL(RankSetCheck(amc->rankSet)); CHECKD_NOSIG(Ring, &amc->genRing); CHECKL(BoolCheck(amc->gensBooted)); diff --git a/mps/code/poolams.c b/mps/code/poolams.c index b5e942c7e84..68f368702aa 100644 --- a/mps/code/poolams.c +++ b/mps/code/poolams.c @@ -50,7 +50,7 @@ Bool AMSSegCheck(AMSSeg amsseg) CHECKS(AMSSeg, amsseg); CHECKD(GCSeg, &amsseg->gcSegStruct); CHECKU(AMS, amsseg->ams); - CHECKL(AMS2Pool(amsseg->ams) == SegPool(seg)); + CHECKL(AMSPool(amsseg->ams) == SegPool(seg)); CHECKD_NOSIG(Ring, &amsseg->segRing); CHECKL(amsseg->grains == AMSGrains(amsseg->ams, SegSize(seg))); @@ -226,7 +226,7 @@ static Res AMSSegInit(Seg seg, Pool pool, Addr base, Size size, AVERT(Seg, seg); amsseg = Seg2AMSSeg(seg); AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); arena = PoolArena(pool); /* no useful checks for base and size */ @@ -287,7 +287,7 @@ static void AMSSegFinish(Seg seg) AVERT(AMSSeg, amsseg); ams = amsseg->ams; AVERT(AMS, ams); - arena = PoolArena(AMS2Pool(ams)); + arena = PoolArena(AMSPool(ams)); AVER(SegBuffer(seg) == NULL); /* keep the destructions in step with AMSSegInit failure cases */ @@ -346,7 +346,7 @@ static Res AMSSegMerge(Seg seg, Seg segHi, AVERT(AMSSeg, amssegHi); /* other parameters are checked by next-method */ arena = PoolArena(SegPool(seg)); - ams = Pool2AMS(SegPool(seg)); + ams = PoolAMS(SegPool(seg)); loGrains = amsseg->grains; hiGrains = amssegHi->grains; @@ -432,7 +432,7 @@ static Res AMSSegSplit(Seg seg, Seg segHi, AVERT(AMSSeg, amsseg); /* other parameters are checked by next-method */ arena = PoolArena(SegPool(seg)); - ams = Pool2AMS(SegPool(seg)); + ams = PoolAMS(SegPool(seg)); loGrains = AMSGrains(ams, AddrOffset(base, mid)); hiGrains = AMSGrains(ams, AddrOffset(mid, limit)); @@ -526,12 +526,12 @@ static Res AMSSegSplit(Seg seg, Seg segHi, BEGIN \ if ((buffer) != NULL \ && (i) == AMS_ADDR_INDEX(seg, accessor(buffer))) { \ - Res _res = WriteF(stream, char, NULL); \ + Res _res = WriteF(stream, 0, char, NULL); \ if (_res != ResOK) return _res; \ } \ END -static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream) +static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) { Res res; AMSSeg amsseg; @@ -546,12 +546,12 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream) /* Describe the superclass fields first via next-method call */ super = SEG_SUPERCLASS(AMSSegClass); - res = super->describe(seg, stream); + res = super->describe(seg, stream, depth); if (res != ResOK) return res; buffer = SegBuffer(seg); - res = WriteF(stream, + res = WriteF(stream, depth, " AMS $P\n", (WriteFP)amsseg->ams, " grains $W\n", (WriteFW)amsseg->grains, " freeGrains $W\n", (WriteFW)amsseg->freeGrains, @@ -560,19 +560,19 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream) NULL); if (res != ResOK) return res; if (amsseg->allocTableInUse) - res = WriteF(stream, - " alloctable $P\n", (WriteFP)amsseg->allocTable, + res = WriteF(stream, depth, + "alloctable $P\n", (WriteFP)amsseg->allocTable, NULL); else - res = WriteF(stream, - " firstFree $W\n", (WriteFW)amsseg->firstFree, + res = WriteF(stream, depth, + "firstFree $W\n", (WriteFW)amsseg->firstFree, NULL); if (res != ResOK) return res; - res = WriteF(stream, - " tables: nongrey $P, nonwhite $P\n", + res = WriteF(stream, depth, + "tables: nongrey $P, nonwhite $P\n", (WriteFP)amsseg->nongreyTable, (WriteFP)amsseg->nonwhiteTable, - " map: \n", + "map:", NULL); if (res != ResOK) return res; @@ -580,7 +580,9 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream) char c = 0; if (i % 64 == 0) { - res = WriteF(stream, "\n ", NULL); + res = WriteF(stream, 0, "\n", NULL); + if (res != ResOK) return res; + res = WriteF(stream, depth, " ", NULL); if (res != ResOK) return res; } @@ -602,7 +604,7 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream) c = '.'; } else c = ' '; - res = WriteF(stream, "$C", c, NULL); + res = WriteF(stream, 0, "$C", c, NULL); if (res != ResOK) return res; @@ -610,8 +612,7 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream) WRITE_BUFFER_LIMIT(stream, seg, i+1, buffer, BufferLimit, "]"); } - res = WriteF(stream, "\n", NULL); - return res; + return ResOK; } @@ -631,8 +632,6 @@ DEFINE_CLASS(AMSSegClass, class) } - - /* AMSPoolRing -- the ring of segments in the pool */ static Ring AMSPoolRing(AMS ams, RankSet rankSet, Size size) @@ -687,7 +686,7 @@ static Res AMSSegCreate(Seg *segReturn, Pool pool, Size size, AVERT(RankSet, rankSet); AVERT(Bool, withReservoirPermit); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS,ams); arena = PoolArena(pool); @@ -732,7 +731,7 @@ static void AMSSegsDestroy(AMS ams) { Ring ring, node, next; /* for iterating over the segments */ - ring = PoolSegRing(AMS2Pool(ams)); + ring = PoolSegRing(AMSPool(ams)); RING_FOR(node, ring, next) { Seg seg = SegOfPoolRing(node); AMSSeg amsseg = Seg2AMSSeg(seg); @@ -805,7 +804,7 @@ static Res AMSInit(Pool pool, ArgList args) /* .ambiguous.noshare: If the pool is required to support ambiguous */ /* references, the alloc and white tables cannot be shared. */ - res = AMSInitInternal(Pool2AMS(pool), format, chain, gen, !supportAmbiguous); + res = AMSInitInternal(PoolAMS(pool), format, chain, gen, !supportAmbiguous); if (res == ResOK) { EVENT3(PoolInitAMS, pool, PoolArena(pool), format); } @@ -826,7 +825,7 @@ Res AMSInitInternal(AMS ams, Format format, Chain chain, unsigned gen, AVERT(Chain, chain); AVER(gen <= ChainGens(chain)); - pool = AMS2Pool(ams); + pool = AMSPool(ams); AVERT(Pool, pool); pool->format = format; pool->alignment = pool->format->alignment; @@ -862,7 +861,7 @@ void AMSFinish(Pool pool) AMS ams; AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); (ams->segsDestroy)(ams); @@ -896,7 +895,7 @@ static Bool amsSegAlloc(Index *baseReturn, Index *limitReturn, AVERT(AMS, ams); AVER(size > 0); - AVER(SizeIsAligned(size, PoolAlignment(AMS2Pool(ams)))); + AVER(SizeIsAligned(size, PoolAlignment(AMSPool(ams)))); grains = AMSGrains(ams, size); AVER(grains > 0); @@ -951,7 +950,7 @@ static Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn, AVER(baseReturn != NULL); AVER(limitReturn != NULL); AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); AVERT(Buffer, buffer); AVER(size > 0); @@ -1018,7 +1017,7 @@ static void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit) Size size; AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); AVERT(Buffer,buffer); AVER(BufferIsReady(buffer)); @@ -1109,7 +1108,7 @@ static Res AMSWhiten(Pool pool, Trace trace, Seg seg) Count uncondemned; AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); AVERT(Trace, trace); @@ -1214,9 +1213,9 @@ static Res amsIterate(Seg seg, AMSObjectFunction f, void *closure) AVERT(AMSSeg, amsseg); ams = amsseg->ams; AVERT(AMS, ams); - format = AMS2Pool(ams)->format; + format = AMSPool(ams)->format; AVERT(Format, format); - alignment = PoolAlignment(AMS2Pool(ams)); + alignment = PoolAlignment(AMSPool(ams)); /* If we're using the alloc table as a white table, we can't use it to */ /* determine where there are objects. */ @@ -1302,7 +1301,7 @@ static Res amsScanObject(Seg seg, Index i, Addr p, Addr next, void *clos) AVERT(ScanState, closure->ss); AVERT(Bool, closure->scanAllObjects); - format = AMS2Pool(amsseg->ams)->format; + format = AMSPool(amsseg->ams)->format; AVERT(Format, format); /* @@@@ This isn't quite right for multiple traces. */ @@ -1343,7 +1342,7 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) AVER(totalReturn != NULL); AVERT(ScanState, ss); AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); arena = PoolArena(pool); AVERT(Seg, seg); @@ -1371,7 +1370,7 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) AVER(amsseg->colourTablesInUse); format = pool->format; AVERT(Format, format); - alignment = PoolAlignment(AMS2Pool(ams)); + alignment = PoolAlignment(AMSPool(ams)); do { /* */ amsseg->marksChanged = FALSE; /* */ /* */ @@ -1436,7 +1435,7 @@ static Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) Format format; AVERT_CRITICAL(Pool, pool); - AVER_CRITICAL(TESTT(AMS, Pool2AMS(pool))); + AVER_CRITICAL(TESTT(AMS, PoolAMS(pool))); AVERT_CRITICAL(ScanState, ss); AVERT_CRITICAL(Seg, seg); AVER_CRITICAL(refIO != NULL); @@ -1474,7 +1473,7 @@ static Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) switch (ss->rank) { case RankAMBIG: - if (Pool2AMS(pool)->shareAllocTable) + if (PoolAMS(pool)->shareAllocTable) /* In this state, the pool doesn't support ambiguous references (see */ /* .ambiguous.noshare), so this is not a reference. */ break; @@ -1551,7 +1550,7 @@ static void AMSBlacken(Pool pool, TraceSet traceSet, Seg seg) Res res; AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); AVERT(TraceSet, traceSet); AVERT(Seg, seg); @@ -1578,7 +1577,7 @@ static void AMSReclaim(Pool pool, Trace trace, Seg seg) PoolDebugMixin debug; AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); AVERT(Trace, trace); AVERT(Seg, seg); @@ -1650,7 +1649,7 @@ static void AMSFreeWalk(Pool pool, FreeBlockStepMethod f, void *p) Ring node, ring, nextNode; /* for iterating over the segments */ AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); ring = &ams->segRing; @@ -1660,22 +1659,50 @@ static void AMSFreeWalk(Pool pool, FreeBlockStepMethod f, void *p) } +/* AMSTotalSize -- total memory allocated from the arena */ + +static Size AMSTotalSize(Pool pool) +{ + AMS ams; + + AVERT(Pool, pool); + ams = PoolAMS(pool); + AVERT(AMS, ams); + + return ams->pgen.totalSize; +} + + +/* AMSFreeSize -- free memory (unused by client program) */ + +static Size AMSFreeSize(Pool pool) +{ + AMS ams; + + AVERT(Pool, pool); + ams = PoolAMS(pool); + AVERT(AMS, ams); + + return ams->pgen.freeSize; +} + + /* AMSDescribe -- the pool class description method * * Iterates over the segments, describing all of them. */ -static Res AMSDescribe(Pool pool, mps_lib_FILE *stream) +static Res AMSDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { AMS ams; Ring node, nextNode; Res res; if (!TESTT(Pool, pool)) return ResFAIL; - ams = Pool2AMS(pool); + ams = PoolAMS(pool); if (!TESTT(AMS, ams)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "AMS $P {\n", (WriteFP)ams, " pool $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial, @@ -1683,21 +1710,19 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream) NULL); if (res != ResOK) return res; - res = WriteF(stream, - " segments\n" - " * = black, + = grey, - = white, . = alloc, ! = bad\n" - " buffers: [ = base, < = scan limit, | = init,\n" - " > = alloc, ] = limit\n", + res = WriteF(stream, depth + 2, + "segments: * black + grey - white . alloc ! bad\n" + "buffers: [ base < scan limit | init > alloc ] limit\n", NULL); if (res != ResOK) return res; RING_FOR(node, &ams->segRing, nextNode) { AMSSeg amsseg = RING_ELT(AMSSeg, segRing, node); - res = SegDescribe(AMSSeg2Seg(amsseg), stream); + res = SegDescribe(AMSSeg2Seg(amsseg), stream, depth + 2); if (res != ResOK) return res; } - res = WriteF(stream, "} AMS $P\n",(WriteFP)ams, NULL); + res = WriteF(stream, depth, "} AMS $P\n",(WriteFP)ams, NULL); if (res != ResOK) return res; @@ -1731,6 +1756,8 @@ DEFINE_CLASS(AMSPoolClass, this) this->reclaim = AMSReclaim; this->walk = PoolNoWalk; /* TODO: job003738 */ this->freewalk = AMSFreeWalk; + this->totalSize = AMSTotalSize; + this->freeSize = AMSFreeSize; this->describe = AMSDescribe; AVERT(PoolClass, this); } @@ -1743,7 +1770,7 @@ static PoolDebugMixin AMSDebugMixin(Pool pool) AMS ams; AVERT(Pool, pool); - ams = Pool2AMS(pool); + ams = PoolAMS(pool); AVERT(AMS, ams); /* Can't check AMSDebug, because this is called during init */ return &(AMS2AMSDebug(ams)->debug); @@ -1769,10 +1796,10 @@ DEFINE_POOL_CLASS(AMSDebugPoolClass, this) Bool AMSCheck(AMS ams) { CHECKS(AMS, ams); - CHECKD(Pool, AMS2Pool(ams)); - CHECKL(IsSubclassPoly(AMS2Pool(ams)->class, AMSPoolClassGet())); - CHECKL(PoolAlignment(AMS2Pool(ams)) == AMSGrainsSize(ams, (Size)1)); - CHECKL(PoolAlignment(AMS2Pool(ams)) == AMS2Pool(ams)->format->alignment); + CHECKD(Pool, AMSPool(ams)); + CHECKL(IsSubclassPoly(AMSPool(ams)->class, AMSPoolClassGet())); + CHECKL(PoolAlignment(AMSPool(ams)) == AMSGrainsSize(ams, (Size)1)); + CHECKL(PoolAlignment(AMSPool(ams)) == AMSPool(ams)->format->alignment); CHECKD(PoolGen, &ams->pgen); CHECKL(FUNCHECK(ams->segSize)); CHECKD_NOSIG(Ring, &ams->segRing); diff --git a/mps/code/poolams.h b/mps/code/poolams.h index 8c567910b77..a69926e2354 100644 --- a/mps/code/poolams.h +++ b/mps/code/poolams.h @@ -79,8 +79,8 @@ typedef struct AMSSegStruct { #define Seg2AMSSeg(seg) ((AMSSeg)(seg)) #define AMSSeg2Seg(amsseg) ((Seg)(amsseg)) -#define Pool2AMS(pool) PARENT(AMSStruct, poolStruct, pool) -#define AMS2Pool(ams) (&(ams)->poolStruct) +#define PoolAMS(pool) PARENT(AMSStruct, poolStruct, pool) +#define AMSPool(ams) (&(ams)->poolStruct) /* macros for abstracting index/address computations */ diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c index 9f751a92059..888f6cd42e7 100644 --- a/mps/code/poolawl.c +++ b/mps/code/poolawl.c @@ -91,7 +91,8 @@ typedef struct AWLStruct { Sig sig; } AWLStruct, *AWL; -#define Pool2AWL(pool) PARENT(AWLStruct, poolStruct, pool) +#define PoolAWL(pool) PARENT(AWLStruct, poolStruct, pool) +#define AWLPool(awl) (&(awl)->poolStruct) #define AWLGrainsSize(awl, grains) ((grains) << (awl)->alignShift) @@ -198,7 +199,7 @@ static Res AWLSegInit(Seg seg, Pool pool, Addr base, Size size, /* AWL only accepts two ranks */ AVER(RankSetSingle(RankEXACT) == rankSet || RankSetSingle(RankWEAK) == rankSet); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); /* Initialize the superclass fields first via next-method call */ @@ -262,7 +263,7 @@ static void AWLSegFinish(Seg seg) AVERT(AWLSeg, awlseg); pool = SegPool(seg); AVERT(Pool, pool); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); arena = PoolArena(pool); AVERT(Arena, arena); @@ -465,7 +466,7 @@ static Res AWLSegCreate(AWLSeg *awlsegReturn, AVER(size > 0); AVERT(Bool, reservoirPermit); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); arena = PoolArena(pool); @@ -549,7 +550,7 @@ static Res AWLInit(Pool pool, ArgList args) /* Weak check, as half-way through initialization. */ AVER(pool != NULL); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); ArgRequire(&arg, args, MPS_KEY_FORMAT); format = arg.val.format; @@ -602,7 +603,7 @@ static void AWLFinish(Pool pool) AVERT(Pool, pool); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); ring = &pool->segRing; @@ -640,7 +641,7 @@ static Res AWLBufferFill(Addr *baseReturn, Addr *limitReturn, AVER(size > 0); AVERT(Bool, reservoirPermit); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); RING_FOR(node, &pool->segRing, nextNode) { @@ -708,7 +709,7 @@ static void AWLBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit) AVERT(Seg, seg); AVER(init <= limit); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); awlseg = Seg2AWLSeg(seg); AVERT(AWLSeg, awlseg); @@ -753,7 +754,7 @@ static Res AWLWhiten(Pool pool, Trace trace, Seg seg) /* All parameters checked by generic PoolWhiten. */ - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); awlseg = Seg2AWLSeg(seg); AVERT(AWLSeg, awlseg); @@ -819,7 +820,7 @@ static void AWLGrey(Pool pool, Trace trace, Seg seg) AWL awl; AWLSeg awlseg; - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); awlseg = Seg2AWLSeg(seg); AVERT(AWLSeg, awlseg); @@ -853,7 +854,7 @@ static void AWLBlacken(Pool pool, TraceSet traceSet, Seg seg) AVERT(TraceSet, traceSet); AVERT(Seg, seg); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); awlseg = Seg2AWLSeg(seg); AVERT(AWLSeg, awlseg); @@ -920,7 +921,7 @@ static Res awlScanSinglePass(Bool *anyScannedReturn, AVERT(Seg, seg); AVERT(Bool, scanAllObjects); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); arena = PoolArena(pool); AVERT(Arena, arena); @@ -996,7 +997,7 @@ static Res AWLScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) awlseg = Seg2AWLSeg(seg); AVERT(AWLSeg, awlseg); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); /* If the scanner isn't going to scan all the objects then the */ @@ -1046,7 +1047,7 @@ static Res AWLFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) AVER(TraceSetInter(SegWhite(seg), ss->traces) != TraceSetEMPTY); AVER(refIO != NULL); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); awlseg = Seg2AWLSeg(seg); AVERT(AWLSeg, awlseg); @@ -1110,7 +1111,7 @@ static void AWLReclaim(Pool pool, Trace trace, Seg seg) AVERT(Trace, trace); AVERT(Seg, seg); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); awlseg = Seg2AWLSeg(seg); AVERT(AWLSeg, awlseg); @@ -1188,7 +1189,7 @@ static Res AWLAccess(Pool pool, Seg seg, Addr addr, Res res; AVERT(Pool, pool); - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); AVERT(Seg, seg); AVER(SegBase(seg) <= addr); @@ -1235,7 +1236,7 @@ static void AWLWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, AVER(FUNCHECK(f)); /* p and s are arbitrary closures and can't be checked */ - awl = Pool2AWL(pool); + awl = PoolAWL(pool); AVERT(AWL, awl); awlseg = Seg2AWLSeg(seg); AVERT(AWLSeg, awlseg); @@ -1281,6 +1282,34 @@ static void AWLWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, } +/* AWLTotalSize -- total memory allocated from the arena */ + +static Size AWLTotalSize(Pool pool) +{ + AWL awl; + + AVERT(Pool, pool); + awl = PoolAWL(pool); + AVERT(AWL, awl); + + return awl->pgen.totalSize; +} + + +/* AWLFreeSize -- free memory (unused by client program) */ + +static Size AWLFreeSize(Pool pool) +{ + AWL awl; + + AVERT(Pool, pool); + awl = PoolAWL(pool); + AVERT(AWL, awl); + + return awl->pgen.freeSize; +} + + /* AWLPoolClass -- the class definition */ DEFINE_POOL_CLASS(AWLPoolClass, this) @@ -1305,6 +1334,8 @@ DEFINE_POOL_CLASS(AWLPoolClass, this) this->fixEmergency = AWLFix; this->reclaim = AWLReclaim; this->walk = AWLWalk; + this->totalSize = AWLTotalSize; + this->freeSize = AWLFreeSize; AVERT(PoolClass, this); } @@ -1321,9 +1352,9 @@ ATTRIBUTE_UNUSED static Bool AWLCheck(AWL awl) { CHECKS(AWL, awl); - CHECKD(Pool, &awl->poolStruct); - CHECKL(awl->poolStruct.class == AWLPoolClassGet()); - CHECKL(AWLGrainsSize(awl, (Count)1) == awl->poolStruct.alignment); + CHECKD(Pool, AWLPool(awl)); + CHECKL(AWLPool(awl)->class == AWLPoolClassGet()); + CHECKL(AWLGrainsSize(awl, (Count)1) == PoolAlignment(AWLPool(awl))); /* Nothing to check about succAccesses. */ CHECKL(FUNCHECK(awl->findDependent)); /* Don't bother to check stats. */ diff --git a/mps/code/poollo.c b/mps/code/poollo.c index c561f351fc1..a690df298d8 100644 --- a/mps/code/poollo.c +++ b/mps/code/poollo.c @@ -794,6 +794,34 @@ static void LOReclaim(Pool pool, Trace trace, Seg seg) } +/* LOTotalSize -- total memory allocated from the arena */ + +static Size LOTotalSize(Pool pool) +{ + LO lo; + + AVERT(Pool, pool); + lo = PoolPoolLO(pool); + AVERT(LO, lo); + + return lo->pgen.totalSize; +} + + +/* LOFreeSize -- free memory (unused by client program) */ + +static Size LOFreeSize(Pool pool) +{ + LO lo; + + AVERT(Pool, pool); + lo = PoolPoolLO(pool); + AVERT(LO, lo); + + return lo->pgen.freeSize; +} + + /* LOPoolClass -- the class definition */ DEFINE_POOL_CLASS(LOPoolClass, this) @@ -814,6 +842,8 @@ DEFINE_POOL_CLASS(LOPoolClass, this) this->fixEmergency = LOFix; this->reclaim = LOReclaim; this->walk = LOWalk; + this->totalSize = LOTotalSize; + this->freeSize = LOFreeSize; AVERT(PoolClass, this); } @@ -832,10 +862,10 @@ ATTRIBUTE_UNUSED static Bool LOCheck(LO lo) { CHECKS(LO, lo); - CHECKD(Pool, &lo->poolStruct); - CHECKL(lo->poolStruct.class == EnsureLOPoolClass()); + CHECKD(Pool, LOPool(lo)); + CHECKL(LOPool(lo)->class == EnsureLOPoolClass()); CHECKL(ShiftCheck(lo->alignShift)); - CHECKL(LOGrainsSize(lo, (Count)1) == PoolAlignment(&lo->poolStruct)); + CHECKL(LOGrainsSize(lo, (Count)1) == PoolAlignment(LOPool(lo))); CHECKD(PoolGen, &lo->pgen); return TRUE; } diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c index c098eea4c05..8a448f3ae5e 100644 --- a/mps/code/poolmfs.c +++ b/mps/code/poolmfs.c @@ -60,13 +60,6 @@ typedef struct MFSHeaderStruct { #define UNIT_MIN sizeof(HeaderStruct) -Pool (MFSPool)(MFS mfs) -{ - AVERT(MFS, mfs); - return &mfs->poolStruct; -} - - /* MFSVarargs -- decode obsolete varargs */ static void MFSVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs) @@ -123,6 +116,8 @@ static Res MFSInit(Pool pool, ArgList args) mfs->unitSize = unitSize; mfs->freeList = NULL; mfs->tractList = NULL; + mfs->total = 0; + mfs->free = 0; mfs->sig = MFSSig; AVERT(MFS, mfs); @@ -199,6 +194,10 @@ void MFSExtend(Pool pool, Addr base, Size size) TractSetP(tract, (void *)mfs->tractList); mfs->tractList = tract; + /* Update accounting */ + mfs->total += size; + mfs->free += size; + /* Sew together all the new empty units in the region, working down */ /* from the top so that they are in ascending order of address on the */ /* free list. */ @@ -272,6 +271,8 @@ static Res MFSAlloc(Addr *pReturn, Pool pool, Size size, /* Detach the first free unit from the free list and return its address. */ mfs->freeList = f->next; + AVER(mfs->free >= mfs->unitSize); + mfs->free -= mfs->unitSize; *pReturn = (Addr)f; return ResOK; @@ -300,10 +301,39 @@ static void MFSFree(Pool pool, Addr old, Size size) h = (Header)old; h->next = mfs->freeList; mfs->freeList = h; + mfs->free += mfs->unitSize; } -static Res MFSDescribe(Pool pool, mps_lib_FILE *stream) +/* MFSTotalSize -- total memory allocated from the arena */ + +static Size MFSTotalSize(Pool pool) +{ + MFS mfs; + + AVERT(Pool, pool); + mfs = PoolPoolMFS(pool); + AVERT(MFS, mfs); + + return mfs->total; +} + + +/* MFSFreeSize -- free memory (unused by client program) */ + +static Size MFSFreeSize(Pool pool) +{ + MFS mfs; + + AVERT(Pool, pool); + mfs = PoolPoolMFS(pool); + AVERT(MFS, mfs); + + return mfs->free; +} + + +static Res MFSDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { MFS mfs; Res res; @@ -314,12 +344,12 @@ static Res MFSDescribe(Pool pool, mps_lib_FILE *stream) AVER(stream != NULL); - res = WriteF(stream, - " unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize, - " unit size $W\n", (WriteFW)mfs->unitSize, - " extent size $W\n", (WriteFW)mfs->extendBy, - " free list begins at $P\n", (WriteFP)mfs->freeList, - " tract list begin at $P\n", (WriteFP)mfs->tractList, + res = WriteF(stream, depth, + "unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize, + "unit size $W\n", (WriteFW)mfs->unitSize, + "extent size $W\n", (WriteFW)mfs->extendBy, + "free list begins at $P\n", (WriteFP)mfs->freeList, + "tract list begin at $P\n", (WriteFP)mfs->tractList, NULL); if(res != ResOK) return res; @@ -338,6 +368,8 @@ DEFINE_POOL_CLASS(MFSPoolClass, this) this->finish = MFSFinish; this->alloc = MFSAlloc; this->free = MFSFree; + this->totalSize = MFSTotalSize; + this->freeSize = MFSFreeSize; this->describe = MFSDescribe; AVERT(PoolClass, this); } @@ -360,18 +392,20 @@ Bool MFSCheck(MFS mfs) Arena arena; CHECKS(MFS, mfs); - CHECKD(Pool, &mfs->poolStruct); - CHECKL(mfs->poolStruct.class == EnsureMFSPoolClass()); + CHECKD(Pool, MFSPool(mfs)); + CHECKL(MFSPool(mfs)->class == EnsureMFSPoolClass()); CHECKL(mfs->unitSize >= UNIT_MIN); CHECKL(mfs->extendBy >= UNIT_MIN); CHECKL(BoolCheck(mfs->extendSelf)); - arena = PoolArena(&mfs->poolStruct); + arena = PoolArena(MFSPool(mfs)); CHECKL(SizeIsAligned(mfs->extendBy, ArenaAlign(arena))); - CHECKL(SizeAlignUp(mfs->unroundedUnitSize, mfs->poolStruct.alignment) == + CHECKL(SizeAlignUp(mfs->unroundedUnitSize, PoolAlignment(MFSPool(mfs))) == mfs->unitSize); if(mfs->tractList != NULL) { CHECKD_NOSIG(Tract, mfs->tractList); } + CHECKL(mfs->free <= mfs->total); + CHECKL((mfs->total - mfs->free) % mfs->unitSize == 0); return TRUE; } diff --git a/mps/code/poolmfs.h b/mps/code/poolmfs.h index 5f2fd0780ed..e08682329b0 100644 --- a/mps/code/poolmfs.h +++ b/mps/code/poolmfs.h @@ -33,11 +33,11 @@ typedef struct MFSStruct *MFS; +#define MFSPool(mfs) (&(mfs)->poolStruct) + extern PoolClass PoolClassMFS(void); extern Bool MFSCheck(MFS mfs); -extern Pool (MFSPool)(MFS mfs); - extern const struct mps_key_s _mps_key_MFSExtendSelf; #define MFSExtendSelf (&_mps_key_MFSExtendSelf) diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c index 3e343ee5ed4..1635400ac29 100644 --- a/mps/code/poolmrg.c +++ b/mps/code/poolmrg.c @@ -119,8 +119,8 @@ typedef struct MRGStruct { Sig sig; /* */ } MRGStruct; -#define Pool2MRG(pool) PARENT(MRGStruct, poolStruct, pool) -#define MRG2Pool(mrg) (&(mrg)->poolStruct) +#define PoolMRG(pool) PARENT(MRGStruct, poolStruct, pool) +#define MRGPool(mrg) (&(mrg)->poolStruct) /* MRGCheck -- check an MRG pool */ @@ -129,12 +129,12 @@ ATTRIBUTE_UNUSED static Bool MRGCheck(MRG mrg) { CHECKS(MRG, mrg); - CHECKD(Pool, &mrg->poolStruct); - CHECKL(MRG2Pool(mrg)->class == PoolClassMRG()); + CHECKD(Pool, MRGPool(mrg)); + CHECKL(MRGPool(mrg)->class == PoolClassMRG()); CHECKD_NOSIG(Ring, &mrg->entryRing); CHECKD_NOSIG(Ring, &mrg->freeRing); CHECKD_NOSIG(Ring, &mrg->refRing); - CHECKL(mrg->extendBy == ArenaAlign(PoolArena(MRG2Pool(mrg)))); + CHECKL(mrg->extendBy == ArenaAlign(PoolArena(MRGPool(mrg)))); return TRUE; } @@ -225,7 +225,7 @@ static Res MRGLinkSegInit(Seg seg, Pool pool, Addr base, Size size, AVERT(Seg, seg); linkseg = Seg2LinkSeg(seg); AVERT(Pool, pool); - mrg = Pool2MRG(pool); + mrg = PoolMRG(pool); AVERT(MRG, mrg); /* no useful checks for base and size */ AVERT(Bool, reservoirPermit); @@ -268,7 +268,7 @@ static Res MRGRefSegInit(Seg seg, Pool pool, Addr base, Size size, AVERT(Seg, seg); refseg = Seg2RefSeg(seg); AVERT(Pool, pool); - mrg = Pool2MRG(pool); + mrg = PoolMRG(pool); AVERT(MRG, mrg); /* no useful checks for base and size */ AVERT(Bool, reservoirPermit); @@ -360,7 +360,7 @@ static RefPart MRGRefPartOfLink(Link link, Arena arena) linkBase = (Link)SegBase(seg); AVER(link >= linkBase); indx = (Index)(link - linkBase); - AVER(indx < MRGGuardiansPerSeg(Pool2MRG(SegPool(seg)))); + AVER(indx < MRGGuardiansPerSeg(PoolMRG(SegPool(seg)))); return refPartOfIndex(linkseg->refSeg, indx); } @@ -389,7 +389,7 @@ static Link MRGLinkOfRefPart(RefPart refPart, Arena arena) refPartBase = (RefPart)SegBase(seg); AVER(refPart >= refPartBase); indx = refPart - refPartBase; - AVER(indx < MRGGuardiansPerSeg(Pool2MRG(SegPool(seg)))); + AVER(indx < MRGGuardiansPerSeg(PoolMRG(SegPool(seg)))); return linkOfIndex(refseg->linkSeg, indx); } @@ -408,7 +408,7 @@ static void MRGGuardianInit(MRG mrg, Link link, RefPart refPart) link->state = MRGGuardianFREE; RingAppend(&mrg->freeRing, &link->the.linkRing); /* */ - MRGRefPartSetRef(PoolArena(&mrg->poolStruct), refPart, 0); + MRGRefPartSetRef(PoolArena(MRGPool(mrg)), refPart, 0); } @@ -434,7 +434,7 @@ static void MRGMessageDelete(Message message) link = linkOfMessage(message); AVER(link->state == MRGGuardianFINAL); MessageFinish(message); - MRGGuardianInit(Pool2MRG(pool), link, MRGRefPartOfLink(link, arena)); + MRGGuardianInit(PoolMRG(pool), link, MRGRefPartOfLink(link, arena)); } @@ -516,7 +516,7 @@ static Res MRGSegPairCreate(MRGRefSeg *refSegReturn, MRG mrg, AVER(refSegReturn != NULL); - pool = MRG2Pool(mrg); + pool = MRGPool(mrg); arena = PoolArena(pool); nGuardians = MRGGuardiansPerSeg(mrg); @@ -566,7 +566,7 @@ static void MRGFinalize(Arena arena, MRGLinkSeg linkseg, Index indx) Link link; Message message; - AVER(indx < MRGGuardiansPerSeg(Pool2MRG(SegPool(LinkSeg2Seg(linkseg))))); + AVER(indx < MRGGuardiansPerSeg(PoolMRG(SegPool(LinkSeg2Seg(linkseg))))); link = linkOfIndex(linkseg, indx); @@ -597,7 +597,7 @@ static Res MRGRefSegScan(ScanState ss, MRGRefSeg refseg, MRG mrg) AVERT(MRGRefSeg, refseg); AVERT(MRG, mrg); - arena = PoolArena(MRG2Pool(mrg)); + arena = PoolArena(MRGPool(mrg)); linkseg = refseg->linkSeg; nGuardians = MRGGuardiansPerSeg(mrg); @@ -638,7 +638,7 @@ static Res MRGInit(Pool pool, ArgList args) AVERT(ArgList, args); UNUSED(args); - mrg = Pool2MRG(pool); + mrg = PoolMRG(pool); RingInit(&mrg->entryRing); RingInit(&mrg->freeRing); @@ -660,7 +660,7 @@ static void MRGFinish(Pool pool) Ring node, nextNode; AVERT(Pool, pool); - mrg = Pool2MRG(pool); + mrg = PoolMRG(pool); AVERT(MRG, mrg); /* .finish.ring: Before destroying the segments, we isolate the */ @@ -714,7 +714,7 @@ Res MRGRegister(Pool pool, Ref ref) AVERT(Pool, pool); AVER(ref != 0); - mrg = Pool2MRG(pool); + mrg = PoolMRG(pool); AVERT(MRG, mrg); arena = PoolArena(pool); @@ -757,7 +757,7 @@ Res MRGDeregister(Pool pool, Ref obj) AVERT(Pool, pool); /* Can't check obj */ - mrg = Pool2MRG(pool); + mrg = PoolMRG(pool); AVERT(MRG, mrg); nGuardians = MRGGuardiansPerSeg(mrg); arena = PoolArena(pool); @@ -796,7 +796,7 @@ Res MRGDeregister(Pool pool, Ref obj) * This could be improved by implementing MRGSegDescribe * and having MRGDescribe iterate over all the pool's segments. */ -static Res MRGDescribe(Pool pool, mps_lib_FILE *stream) +static Res MRGDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { MRG mrg; Arena arena; @@ -805,20 +805,27 @@ static Res MRGDescribe(Pool pool, mps_lib_FILE *stream) Res res; if (!TESTT(Pool, pool)) return ResFAIL; - mrg = Pool2MRG(pool); + mrg = PoolMRG(pool); if (!TESTT(MRG, mrg)) return ResFAIL; if (stream == NULL) return ResFAIL; arena = PoolArena(pool); - res = WriteF(stream, " extendBy $W\n", mrg->extendBy, NULL); + res = WriteF(stream, depth, "extendBy $W\n", mrg->extendBy, NULL); if (res != ResOK) return res; - res = WriteF(stream, " Entry queue:\n", NULL); + res = WriteF(stream, depth, "Entry queue:\n", NULL); if (res != ResOK) return res; RING_FOR(node, &mrg->entryRing, nextNode) { + Bool outsideShield = !arena->insideShield; refPart = MRGRefPartOfLink(linkOfRing(node), arena); - res = WriteF(stream, " at $A Ref $A\n", + if (outsideShield) { + ShieldEnter(arena); + } + res = WriteF(stream, depth, "at $A Ref $A\n", (WriteFA)refPart, (WriteFA)MRGRefPartRef(arena, refPart), NULL); + if (outsideShield) { + ShieldLeave(arena); + } if (res != ResOK) return res; } @@ -836,7 +843,7 @@ static Res MRGScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) AVERT(Pool, pool); AVERT(Seg, seg); - mrg = Pool2MRG(pool); + mrg = PoolMRG(pool); AVERT(MRG, mrg); AVER(SegRankSet(seg) == RankSetSingle(RankFINAL)); /* .improve.rank */ diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c index 3826b0c6cc8..1f8d6c0d96f 100644 --- a/mps/code/poolmv.c +++ b/mps/code/poolmv.c @@ -38,7 +38,7 @@ SRCID(poolmv, "$Id$"); #define mvSpanPool(mv) MFSPool(&(mv)->spanPoolStruct) -#define Pool2MV(pool) PARENT(MVStruct, poolStruct, pool) +#define PoolMV(pool) PARENT(MVStruct, poolStruct, pool) /* MVDebug -- MV Debug pool class */ @@ -116,7 +116,7 @@ typedef struct MVSpanStruct { MVBlockStruct base; /* sentinel at base of span */ MVBlockStruct limit; /* sentinel at limit of span */ MVBlock blocks; /* allocated blocks */ - Size space; /* total free space in span */ + Size free; /* free space in span */ Size largest; /* .design.largest */ Bool largestKnown; /* .design.largest */ unsigned blockCount; /* number of blocks on chain */ @@ -160,11 +160,11 @@ static Bool MVSpanCheck(MVSpan span) /* The sentinels mustn't overlap. */ CHECKL(span->base.limit <= span->limit.base); /* The free space can't be more than the gap between the sentinels. */ - CHECKL(span->space <= SpanInsideSentinels(span)); + CHECKL(span->free <= SpanInsideSentinels(span)); CHECKL(BoolCheck(span->largestKnown)); if (span->largestKnown) { /* .design.largest */ - CHECKL(span->largest <= span->space); + CHECKL(span->largest <= span->free); /* at least this much is free */ } else { CHECKL(span->largest == SpanSize(span)+1); @@ -244,7 +244,7 @@ static Res MVInit(Pool pool, ArgList args) AVER(extendBy <= maxSize); pool->alignment = align; - mv = Pool2MV(pool); + mv = PoolMV(pool); arena = PoolArena(pool); /* At 100% fragmentation we will need one block descriptor for every other */ @@ -257,7 +257,7 @@ static Res MVInit(Pool pool, ArgList args) MPS_ARGS_BEGIN(piArgs) { MPS_ARGS_ADD(piArgs, MPS_KEY_EXTEND_BY, blockExtendBy); MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(MVBlockStruct)); - res = PoolInit(&mv->blockPoolStruct.poolStruct, arena, PoolClassMFS(), piArgs); + res = PoolInit(mvBlockPool(mv), arena, PoolClassMFS(), piArgs); } MPS_ARGS_END(piArgs); if(res != ResOK) return res; @@ -267,7 +267,7 @@ static Res MVInit(Pool pool, ArgList args) MPS_ARGS_BEGIN(piArgs) { MPS_ARGS_ADD(piArgs, MPS_KEY_EXTEND_BY, spanExtendBy); MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(MVSpanStruct)); - res = PoolInit(&mv->spanPoolStruct.poolStruct, arena, PoolClassMFS(), piArgs); + res = PoolInit(mvSpanPool(mv), arena, PoolClassMFS(), piArgs); } MPS_ARGS_END(piArgs); if(res != ResOK) return res; @@ -277,7 +277,7 @@ static Res MVInit(Pool pool, ArgList args) mv->maxSize = maxSize; RingInit(&mv->spans); - mv->space = 0; + mv->free = 0; mv->lost = 0; mv->sig = MVSig; @@ -296,7 +296,7 @@ static void MVFinish(Pool pool) MVSpan span; AVERT(Pool, pool); - mv = Pool2MV(pool); + mv = PoolMV(pool); AVERT(MV, mv); /* Destroy all the spans attached to the pool. */ @@ -309,8 +309,8 @@ static void MVFinish(Pool pool) mv->sig = SigInvalid; - PoolFinish(&mv->blockPoolStruct.poolStruct); - PoolFinish(&mv->spanPoolStruct.poolStruct); + PoolFinish(mvBlockPool(mv)); + PoolFinish(mvSpanPool(mv)); } @@ -368,7 +368,7 @@ static Bool MVSpanAlloc(Addr *addrReturn, MVSpan span, Size size, span->largest = SpanSize(span) + 1; /* .design.largest */ } - span->space -= size; + span->free -= size; *addrReturn = new; return TRUE; } @@ -484,7 +484,7 @@ static Res MVSpanFree(MVSpan span, Addr base, Addr limit, Pool blockPool) AVERT(MVBlock, block); - span->space += AddrOffset(base, limit); + span->free += AddrOffset(base, limit); if (freeAreaSize > span->largest) { /* .design.largest */ AVER(span->largestKnown); @@ -521,23 +521,23 @@ static Res MVAlloc(Addr *pReturn, Pool pool, Size size, AVER(pReturn != NULL); AVERT(Pool, pool); - mv = Pool2MV(pool); + mv = PoolMV(pool); AVERT(MV, mv); AVER(size > 0); AVERT(Bool, withReservoirPermit); size = SizeAlignUp(size, pool->alignment); - if(size <= mv->space) { + if(size <= mv->free) { spans = &mv->spans; RING_FOR(node, spans, nextNode) { span = RING_ELT(MVSpan, spans, node); if((size <= span->largest) && /* .design.largest.alloc */ - (size <= span->space)) { + (size <= span->free)) { Addr new; if(MVSpanAlloc(&new, span, size, mvBlockPool(mv))) { - mv->space -= size; + mv->free -= size; AVER(AddrIsAligned(new, pool->alignment)); *pReturn = new; return ResOK; @@ -593,20 +593,20 @@ static Res MVAlloc(Addr *pReturn, Pool pool, Size size, RingInit(&span->spans); span->base.base = span->base.limit = base; span->limit.base = span->limit.limit = limit; - span->space = AddrOffset(span->base.limit, span->limit.base); + span->free = AddrOffset(span->base.limit, span->limit.base); span->limit.next = NULL; span->base.next = &span->limit; span->blocks = &span->base; span->blockCount = 2; span->base.limit = AddrAdd(span->base.limit, size); - span->space -= size; - span->largest = span->space; + span->free -= size; + span->largest = span->free; span->largestKnown = TRUE; span->sig = MVSpanSig; AVERT(MVSpan, span); - mv->space += span->space; + mv->free += span->free; RingInsert(&mv->spans, &span->spans); /* use RingInsert so that we examine this new span first when allocating */ @@ -627,7 +627,7 @@ static void MVFree(Pool pool, Addr old, Size size) Tract tract = NULL; /* suppress "may be used uninitialized" */ AVERT(Pool, pool); - mv = Pool2MV(pool); + mv = PoolMV(pool); AVERT(MV, mv); AVER(old != (Addr)0); @@ -655,16 +655,16 @@ static void MVFree(Pool pool, Addr old, Size size) if(res != ResOK) mv->lost += size; else - mv->space += size; + mv->free += size; /* free space should be less than total space */ - AVER(span->space <= SpanInsideSentinels(span)); - if(span->space == SpanSize(span)) { /* the whole span is free */ + AVER(span->free <= SpanInsideSentinels(span)); + if(span->free == SpanSize(span)) { /* the whole span is free */ AVER(span->blockCount == 2); /* both blocks are the trivial sentinel blocks */ AVER(span->base.limit == span->base.base); AVER(span->limit.limit == span->limit.base); - mv->space -= span->space; + mv->free -= span->free; ArenaFree(TractBase(span->tract), span->size, pool); RingRemove(&span->spans); RingFinish(&span->spans); @@ -680,14 +680,59 @@ static PoolDebugMixin MVDebugMixin(Pool pool) MV mv; AVERT(Pool, pool); - mv = Pool2MV(pool); + mv = PoolMV(pool); AVERT(MV, mv); /* Can't check MVDebug, because this is called during MVDebug init */ return &(MV2MVDebug(mv)->debug); } -static Res MVDescribe(Pool pool, mps_lib_FILE *stream) +/* MVTotalSize -- total memory allocated from the arena */ + +static Size MVTotalSize(Pool pool) +{ + MV mv; + Size size = 0; + Ring node, next; + + AVERT(Pool, pool); + mv = PoolMV(pool); + AVERT(MV, mv); + + RING_FOR(node, &mv->spans, next) { + MVSpan span = RING_ELT(MVSpan, spans, node); + AVERT(MVSpan, span); + size += span->size; + } + + return size; +} + + +/* MVFreeSize -- free memory (unused by client program) */ + +static Size MVFreeSize(Pool pool) +{ + MV mv; + Size size = 0; + Ring node, next; + + AVERT(Pool, pool); + mv = PoolMV(pool); + AVERT(MV, mv); + + RING_FOR(node, &mv->spans, next) { + MVSpan span = RING_ELT(MVSpan, spans, node); + AVERT(MVSpan, span); + size += span->free; + } + + AVER(size == mv->free + mv->lost); + return size; +} + + +static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { Res res; MV mv; @@ -698,50 +743,23 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream) Ring spans, node = NULL, nextNode; /* gcc whinge stop */ if(!TESTT(Pool, pool)) return ResFAIL; - mv = Pool2MV(pool); + mv = PoolMV(pool); if(!TESTT(MV, mv)) return ResFAIL; if(stream == NULL) return ResFAIL; - res = WriteF(stream, - " blockPool $P ($U)\n", + res = WriteF(stream, depth, + "blockPool $P ($U)\n", (WriteFP)mvBlockPool(mv), (WriteFU)mvBlockPool(mv)->serial, - " spanPool $P ($U)\n", + "spanPool $P ($U)\n", (WriteFP)mvSpanPool(mv), (WriteFU)mvSpanPool(mv)->serial, - " extendBy $W\n", (WriteFW)mv->extendBy, - " avgSize $W\n", (WriteFW)mv->avgSize, - " maxSize $W\n", (WriteFW)mv->maxSize, - " space $P\n", (WriteFP)mv->space, + "extendBy $W\n", (WriteFW)mv->extendBy, + "avgSize $W\n", (WriteFW)mv->avgSize, + "maxSize $W\n", (WriteFW)mv->maxSize, + "free $W\n", (WriteFP)mv->free, + "lost $W\n", (WriteFP)mv->lost, NULL); if(res != ResOK) return res; - res = WriteF(stream, " Spans\n", NULL); - if(res != ResOK) return res; - - spans = &mv->spans; - RING_FOR(node, spans, nextNode) { - span = RING_ELT(MVSpan, spans, node); - AVERT(MVSpan, span); - - res = WriteF(stream, - " span $P", (WriteFP)span, - " tract $P", (WriteFP)span->tract, - " space $W", (WriteFW)span->space, - " blocks $U", (WriteFU)span->blockCount, - " largest ", - NULL); - if(res != ResOK) return res; - - if (span->largestKnown) /* .design.largest */ - res = WriteF(stream, "$W\n", (WriteFW)span->largest, NULL); - else - res = WriteF(stream, "unknown\n", NULL); - - if(res != ResOK) return res; - } - - res = WriteF(stream, " Span allocation maps\n", NULL); - if(res != ResOK) return res; - step = pool->alignment; length = 0x40 * step; @@ -750,13 +768,28 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream) Addr i, j; MVBlock block; span = RING_ELT(MVSpan, spans, node); - res = WriteF(stream, " MVSpan $P\n", (WriteFP)span, NULL); + res = WriteF(stream, depth, "MVSpan $P {\n", (WriteFP)span, NULL); + if(res != ResOK) return res; + + res = WriteF(stream, depth + 2, + "span $P\n", (WriteFP)span, + "tract $P\n", (WriteFP)span->tract, + "free $W\n", (WriteFW)span->free, + "blocks $U\n", (WriteFU)span->blockCount, + "largest ", + NULL); + if(res != ResOK) return res; + + if (span->largestKnown) /* .design.largest */ + res = WriteF(stream, 0, "$W\n", (WriteFW)span->largest, NULL); + else + res = WriteF(stream, 0, "unknown\n", NULL); if(res != ResOK) return res; block = span->blocks; for(i = span->base.base; i < span->limit.limit; i = AddrAdd(i, length)) { - res = WriteF(stream, " $A ", i, NULL); + res = WriteF(stream, depth + 2, "$A ", i, NULL); if(res != ResOK) return res; for(j = i; @@ -779,12 +812,14 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream) c = ']'; else /* j > block->base && j < block->limit */ c = '='; - res = WriteF(stream, "$C", c, NULL); + res = WriteF(stream, 0, "$C", c, NULL); if(res != ResOK) return res; } - res = WriteF(stream, "\n", NULL); + res = WriteF(stream, 0, "\n", NULL); if(res != ResOK) return res; } + res = WriteF(stream, depth, "} MVSpan $P\n", (WriteFP)span, NULL); + if(res != ResOK) return res; } return ResOK; @@ -805,6 +840,8 @@ DEFINE_POOL_CLASS(MVPoolClass, this) this->finish = MVFinish; this->alloc = MVAlloc; this->free = MVFree; + this->totalSize = MVTotalSize; + this->freeSize = MVFreeSize; this->describe = MVDescribe; AVERT(PoolClass, this); } @@ -846,65 +883,13 @@ mps_class_t mps_class_mv_debug(void) } -/* mps_mv_free_size -- free bytes in pool */ - -size_t mps_mv_free_size(mps_pool_t mps_pool) -{ - Pool pool; - MV mv; - MVSpan span; - Size f = 0; - Ring spans, node = NULL, nextNode; /* gcc whinge stop */ - - pool = (Pool)mps_pool; - - AVERT(Pool, pool); - mv = Pool2MV(pool); - AVERT(MV, mv); - - spans = &mv->spans; - RING_FOR(node, spans, nextNode) { - span = RING_ELT(MVSpan, spans, node); - AVERT(MVSpan, span); - f += span->space; - } - - return (size_t)f; -} - - -size_t mps_mv_size(mps_pool_t mps_pool) -{ - Pool pool; - MV mv; - MVSpan span; - Size f = 0; - Ring spans, node = NULL, nextNode; /* gcc whinge stop */ - - pool = (Pool)mps_pool; - - AVERT(Pool, pool); - mv = Pool2MV(pool); - AVERT(MV, mv); - - spans = &mv->spans; - RING_FOR(node, spans, nextNode) { - span = RING_ELT(MVSpan, spans, node); - AVERT(MVSpan, span); - f += span->size; - } - - return (size_t)f; -} - - /* MVCheck -- check the consistency of an MV structure */ Bool MVCheck(MV mv) { CHECKS(MV, mv); - CHECKD(Pool, &mv->poolStruct); - CHECKL(IsSubclassPoly(mv->poolStruct.class, EnsureMVPoolClass())); + CHECKD(Pool, MVPool(mv)); + CHECKL(IsSubclassPoly(MVPool(mv)->class, EnsureMVPoolClass())); CHECKD(MFS, &mv->blockPoolStruct); CHECKD(MFS, &mv->spanPoolStruct); CHECKL(mv->extendBy > 0); diff --git a/mps/code/poolmv.h b/mps/code/poolmv.h index 8e6885254bc..01c5b9ebd73 100644 --- a/mps/code/poolmv.h +++ b/mps/code/poolmv.h @@ -26,7 +26,7 @@ extern PoolClass PoolClassMV(void); extern Bool MVCheck(MV mv); -#define MV2Pool(mv) (&(mv)->poolStruct) +#define MVPool(mv) (&(mv)->poolStruct) #endif /* poolmv_h */ diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c index 2fe533d484e..051ba0af63d 100644 --- a/mps/code/poolmv2.c +++ b/mps/code/poolmv2.c @@ -39,7 +39,9 @@ static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn, Bool withReservoirPermit); static void MVTBufferEmpty(Pool pool, Buffer buffer, Addr base, Addr limit); static void MVTFree(Pool pool, Addr base, Size size); -static Res MVTDescribe(Pool pool, mps_lib_FILE *stream); +static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth); +static Size MVTTotalSize(Pool pool); +static Size MVTFreeSize(Pool pool); static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size, Bool withReservoirPermit); @@ -52,9 +54,9 @@ static Res MVTContingencySearch(Addr *baseReturn, Addr *limitReturn, MVT mvt, Size min); static Bool MVTCheckFit(Addr base, Addr limit, Size min, Arena arena); static ABQ MVTABQ(MVT mvt); -static Land MVTCBS(MVT mvt); -static Land MVTFreelist(MVT mvt); -static Land MVTFailover(MVT mvt); +static Land MVTFreePrimary(MVT mvt); +static Land MVTFreeSecondary(MVT mvt); +static Land MVTFreeLand(MVT mvt); /* Types */ @@ -145,14 +147,16 @@ DEFINE_POOL_CLASS(MVTPoolClass, this) this->free = MVTFree; this->bufferFill = MVTBufferFill; this->bufferEmpty = MVTBufferEmpty; + this->totalSize = MVTTotalSize; + this->freeSize = MVTFreeSize; this->describe = MVTDescribe; AVERT(PoolClass, this); } /* Macros */ -#define Pool2MVT(pool) PARENT(MVTStruct, poolStruct, pool) -#define MVT2Pool(mvt) (&(mvt)->poolStruct) +#define PoolMVT(pool) PARENT(MVTStruct, poolStruct, pool) +#define MVTPool(mvt) (&(mvt)->poolStruct) /* Accessors */ @@ -164,21 +168,21 @@ static ABQ MVTABQ(MVT mvt) } -static Land MVTCBS(MVT mvt) +static Land MVTFreePrimary(MVT mvt) { - return &mvt->cbsStruct.landStruct; + return CBSLand(&mvt->cbsStruct); } -static Land MVTFreelist(MVT mvt) +static Land MVTFreeSecondary(MVT mvt) { - return &mvt->flStruct.landStruct; + return FreelistLand(&mvt->flStruct); } -static Land MVTFailover(MVT mvt) +static Land MVTFreeLand(MVT mvt) { - return &mvt->foStruct.landStruct; + return FailoverLand(&mvt->foStruct); } @@ -233,7 +237,7 @@ static Res MVTInit(Pool pool, ArgList args) ArgStruct arg; AVERT(Pool, pool); - mvt = Pool2MVT(pool); + mvt = PoolMVT(pool); /* can't AVERT mvt, yet */ arena = PoolArena(pool); AVERT(Arena, arena); @@ -276,28 +280,28 @@ static Res MVTInit(Pool pool, ArgList args) if (abqDepth < 3) abqDepth = 3; - res = LandInit(MVTCBS(mvt), CBSFastLandClassGet(), arena, align, mvt, + res = LandInit(MVTFreePrimary(mvt), CBSFastLandClassGet(), arena, align, mvt, mps_args_none); if (res != ResOK) - goto failCBS; + goto failFreePrimaryInit; - res = LandInit(MVTFreelist(mvt), FreelistLandClassGet(), arena, align, mvt, - mps_args_none); + res = LandInit(MVTFreeSecondary(mvt), FreelistLandClassGet(), arena, align, + mvt, mps_args_none); if (res != ResOK) - goto failFreelist; + goto failFreeSecondaryInit; MPS_ARGS_BEGIN(foArgs) { - MPS_ARGS_ADD(foArgs, FailoverPrimary, MVTCBS(mvt)); - MPS_ARGS_ADD(foArgs, FailoverSecondary, MVTFreelist(mvt)); - res = LandInit(MVTFailover(mvt), FailoverLandClassGet(), arena, align, mvt, + MPS_ARGS_ADD(foArgs, FailoverPrimary, MVTFreePrimary(mvt)); + MPS_ARGS_ADD(foArgs, FailoverSecondary, MVTFreeSecondary(mvt)); + res = LandInit(MVTFreeLand(mvt), FailoverLandClassGet(), arena, align, mvt, foArgs); } MPS_ARGS_END(foArgs); if (res != ResOK) - goto failFailover; + goto failFreeLandInit; res = ABQInit(arena, MVTABQ(mvt), (void *)mvt, abqDepth, sizeof(RangeStruct)); if (res != ResOK) - goto failABQ; + goto failABQInit; pool->alignment = align; mvt->reuseSize = reuseSize; @@ -361,13 +365,13 @@ static Res MVTInit(Pool pool, ArgList args) reserveDepth, fragLimit); return ResOK; -failABQ: - LandFinish(MVTFailover(mvt)); -failFailover: - LandFinish(MVTFreelist(mvt)); -failFreelist: - LandFinish(MVTCBS(mvt)); -failCBS: +failABQInit: + LandFinish(MVTFreeLand(mvt)); +failFreeLandInit: + LandFinish(MVTFreeSecondary(mvt)); +failFreeSecondaryInit: + LandFinish(MVTFreePrimary(mvt)); +failFreePrimaryInit: AVER(res != ResOK); return res; } @@ -379,8 +383,8 @@ ATTRIBUTE_UNUSED static Bool MVTCheck(MVT mvt) { CHECKS(MVT, mvt); - CHECKD(Pool, &mvt->poolStruct); - CHECKL(mvt->poolStruct.class == MVTPoolClassGet()); + CHECKD(Pool, MVTPool(mvt)); + CHECKL(MVTPool(mvt)->class == MVTPoolClassGet()); CHECKD(CBS, &mvt->cbsStruct); CHECKD(ABQ, &mvt->abqStruct); CHECKD(Freelist, &mvt->flStruct); @@ -418,7 +422,7 @@ static void MVTFinish(Pool pool) Ring node, nextNode; AVERT(Pool, pool); - mvt = Pool2MVT(pool); + mvt = PoolMVT(pool); AVERT(MVT, mvt); arena = PoolArena(pool); AVERT(Arena, arena); @@ -436,9 +440,9 @@ static void MVTFinish(Pool pool) /* Finish the ABQ, Failover, Freelist and CBS structures */ ABQFinish(arena, MVTABQ(mvt)); - LandFinish(MVTFailover(mvt)); - LandFinish(MVTFreelist(mvt)); - LandFinish(MVTCBS(mvt)); + LandFinish(MVTFreeLand(mvt)); + LandFinish(MVTFreeSecondary(mvt)); + LandFinish(MVTFreePrimary(mvt)); } @@ -494,7 +498,7 @@ static Res MVTOversizeFill(Addr *baseReturn, Addr base, limit; Size alignedSize; - alignedSize = SizeAlignUp(minSize, ArenaAlign(PoolArena(MVT2Pool(mvt)))); + alignedSize = SizeAlignUp(minSize, ArenaAlign(PoolArena(MVTPool(mvt)))); res = MVTSegAlloc(&seg, mvt, alignedSize, withReservoirPermit); if (res != ResOK) @@ -568,7 +572,7 @@ static void MVTOneSegOnly(Addr *baseIO, Addr *limitIO, MVT mvt, Size minSize) base = *baseIO; limit = *limitIO; - arena = PoolArena(MVT2Pool(mvt)); + arena = PoolArena(MVTPool(mvt)); SURELY(SegOfAddr(&seg, arena, base)); segLimit = SegLimit(seg); @@ -690,7 +694,7 @@ static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn, AVER(baseReturn != NULL); AVER(limitReturn != NULL); AVERT(Pool, pool); - mvt = Pool2MVT(pool); + mvt = PoolMVT(pool); AVERT(MVT, mvt); AVERT(Buffer, buffer); AVER(BufferIsReset(buffer)); @@ -782,7 +786,7 @@ static Bool MVTReserve(MVT mvt, Range range) /* See */ if (!ABQPush(MVTABQ(mvt), range)) { - Arena arena = PoolArena(MVT2Pool(mvt)); + Arena arena = PoolArena(MVTPool(mvt)); RangeStruct oldRange; /* We just failed to push, so the ABQ must be full, and so surely * the peek will succeed. */ @@ -816,7 +820,7 @@ static Res MVTInsert(MVT mvt, Addr base, Addr limit) AVER(base < limit); RangeInit(&range, base, limit); - res = LandInsert(&newRange, MVTFailover(mvt), &range); + res = LandInsert(&newRange, MVTFreeLand(mvt), &range); if (res != ResOK) return res; @@ -845,7 +849,7 @@ static Res MVTDelete(MVT mvt, Addr base, Addr limit) AVER(base < limit); RangeInit(&range, base, limit); - res = LandDelete(&rangeOld, MVTFailover(mvt), &range); + res = LandDelete(&rangeOld, MVTFreeLand(mvt), &range); if (res != ResOK) return res; AVER(RangesNest(&rangeOld, &range)); @@ -884,7 +888,7 @@ static void MVTBufferEmpty(Pool pool, Buffer buffer, Res res; AVERT(Pool, pool); - mvt = Pool2MVT(pool); + mvt = PoolMVT(pool); AVERT(MVT, mvt); AVERT(Buffer, buffer); AVER(BufferIsReady(buffer)); @@ -949,7 +953,7 @@ static void MVTFree(Pool pool, Addr base, Size size) Addr limit; AVERT(Pool, pool); - mvt = Pool2MVT(pool); + mvt = PoolMVT(pool); AVERT(MVT, mvt); AVER(base != (Addr)0); AVER(size > 0); @@ -987,80 +991,109 @@ static void MVTFree(Pool pool, Addr base, Size size) } +/* MVTTotalSize -- total memory allocated from the arena */ + +static Size MVTTotalSize(Pool pool) +{ + MVT mvt; + + AVERT(Pool, pool); + mvt = PoolMVT(pool); + AVERT(MVT, mvt); + + return mvt->size; +} + + +/* MVTFreeSize -- free memory (unused by client program) */ + +static Size MVTFreeSize(Pool pool) +{ + MVT mvt; + + AVERT(Pool, pool); + mvt = PoolMVT(pool); + AVERT(MVT, mvt); + + return mvt->available + mvt->unavailable; +} + + /* MVTDescribe -- describe an MVT pool */ -static Res MVTDescribe(Pool pool, mps_lib_FILE *stream) +static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { Res res; MVT mvt; if (!TESTT(Pool, pool)) return ResFAIL; - mvt = Pool2MVT(pool); + mvt = PoolMVT(pool); if (!TESTT(MVT, mvt)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, - "MVT $P\n{\n", (WriteFP)mvt, - " minSize: $U \n", (WriteFU)mvt->minSize, - " meanSize: $U \n", (WriteFU)mvt->meanSize, - " maxSize: $U \n", (WriteFU)mvt->maxSize, - " fragLimit: $U \n", (WriteFU)mvt->fragLimit, - " reuseSize: $U \n", (WriteFU)mvt->reuseSize, - " fillSize: $U \n", (WriteFU)mvt->fillSize, - " availLimit: $U \n", (WriteFU)mvt->availLimit, - " abqOverflow: $S \n", mvt->abqOverflow?"TRUE":"FALSE", - " splinter: $S \n", mvt->splinter?"TRUE":"FALSE", - " splinterBase: $A \n", (WriteFA)mvt->splinterBase, - " splinterLimit: $A \n", (WriteFU)mvt->splinterLimit, - " size: $U \n", (WriteFU)mvt->size, - " allocated: $U \n", (WriteFU)mvt->allocated, - " available: $U \n", (WriteFU)mvt->available, - " unavailable: $U \n", (WriteFU)mvt->unavailable, + res = WriteF(stream, depth, + "MVT $P {\n", (WriteFP)mvt, + " minSize: $U\n", (WriteFU)mvt->minSize, + " meanSize: $U\n", (WriteFU)mvt->meanSize, + " maxSize: $U\n", (WriteFU)mvt->maxSize, + " fragLimit: $U\n", (WriteFU)mvt->fragLimit, + " reuseSize: $U\n", (WriteFU)mvt->reuseSize, + " fillSize: $U\n", (WriteFU)mvt->fillSize, + " availLimit: $U\n", (WriteFU)mvt->availLimit, + " abqOverflow: $S\n", mvt->abqOverflow?"TRUE":"FALSE", + " splinter: $S\n", mvt->splinter?"TRUE":"FALSE", + " splinterBase: $A\n", (WriteFA)mvt->splinterBase, + " splinterLimit: $A\n", (WriteFU)mvt->splinterLimit, + " size: $U\n", (WriteFU)mvt->size, + " allocated: $U\n", (WriteFU)mvt->allocated, + " available: $U\n", (WriteFU)mvt->available, + " unavailable: $U\n", (WriteFU)mvt->unavailable, NULL); if(res != ResOK) return res; - res = LandDescribe(MVTCBS(mvt), stream); + res = LandDescribe(MVTFreePrimary(mvt), stream, depth + 2); if(res != ResOK) return res; - res = LandDescribe(MVTFreelist(mvt), stream); + res = LandDescribe(MVTFreeSecondary(mvt), stream, depth + 2); if(res != ResOK) return res; - res = LandDescribe(MVTFailover(mvt), stream); + res = LandDescribe(MVTFreeLand(mvt), stream, depth + 2); if(res != ResOK) return res; - res = ABQDescribe(MVTABQ(mvt), (ABQDescribeElement)RangeDescribe, stream); + res = ABQDescribe(MVTABQ(mvt), (ABQDescribeElement)RangeDescribe, stream, + depth + 2); if(res != ResOK) return res; - METER_WRITE(mvt->segAllocs, stream); - METER_WRITE(mvt->segFrees, stream); - METER_WRITE(mvt->bufferFills, stream); - METER_WRITE(mvt->bufferEmpties, stream); - METER_WRITE(mvt->poolFrees, stream); - METER_WRITE(mvt->poolSize, stream); - METER_WRITE(mvt->poolAllocated, stream); - METER_WRITE(mvt->poolAvailable, stream); - METER_WRITE(mvt->poolUnavailable, stream); - METER_WRITE(mvt->poolUtilization, stream); - METER_WRITE(mvt->finds, stream); - METER_WRITE(mvt->overflows, stream); - METER_WRITE(mvt->underflows, stream); - METER_WRITE(mvt->refills, stream); - METER_WRITE(mvt->refillPushes, stream); - METER_WRITE(mvt->returns, stream); - METER_WRITE(mvt->perfectFits, stream); - METER_WRITE(mvt->firstFits, stream); - METER_WRITE(mvt->secondFits, stream); - METER_WRITE(mvt->failures, stream); - METER_WRITE(mvt->emergencyContingencies, stream); - METER_WRITE(mvt->fragLimitContingencies, stream); - METER_WRITE(mvt->contingencySearches, stream); - METER_WRITE(mvt->contingencyHardSearches, stream); - METER_WRITE(mvt->splinters, stream); - METER_WRITE(mvt->splintersUsed, stream); - METER_WRITE(mvt->splintersDropped, stream); - METER_WRITE(mvt->sawdust, stream); - METER_WRITE(mvt->exceptions, stream); - METER_WRITE(mvt->exceptionSplinters, stream); - METER_WRITE(mvt->exceptionReturns, stream); + METER_WRITE(mvt->segAllocs, stream, depth + 2); + METER_WRITE(mvt->segFrees, stream, depth + 2); + METER_WRITE(mvt->bufferFills, stream, depth + 2); + METER_WRITE(mvt->bufferEmpties, stream, depth + 2); + METER_WRITE(mvt->poolFrees, stream, depth + 2); + METER_WRITE(mvt->poolSize, stream, depth + 2); + METER_WRITE(mvt->poolAllocated, stream, depth + 2); + METER_WRITE(mvt->poolAvailable, stream, depth + 2); + METER_WRITE(mvt->poolUnavailable, stream, depth + 2); + METER_WRITE(mvt->poolUtilization, stream, depth + 2); + METER_WRITE(mvt->finds, stream, depth + 2); + METER_WRITE(mvt->overflows, stream, depth + 2); + METER_WRITE(mvt->underflows, stream, depth + 2); + METER_WRITE(mvt->refills, stream, depth + 2); + METER_WRITE(mvt->refillPushes, stream, depth + 2); + METER_WRITE(mvt->returns, stream, depth + 2); + METER_WRITE(mvt->perfectFits, stream, depth + 2); + METER_WRITE(mvt->firstFits, stream, depth + 2); + METER_WRITE(mvt->secondFits, stream, depth + 2); + METER_WRITE(mvt->failures, stream, depth + 2); + METER_WRITE(mvt->emergencyContingencies, stream, depth + 2); + METER_WRITE(mvt->fragLimitContingencies, stream, depth + 2); + METER_WRITE(mvt->contingencySearches, stream, depth + 2); + METER_WRITE(mvt->contingencyHardSearches, stream, depth + 2); + METER_WRITE(mvt->splinters, stream, depth + 2); + METER_WRITE(mvt->splintersUsed, stream, depth + 2); + METER_WRITE(mvt->splintersDropped, stream, depth + 2); + METER_WRITE(mvt->sawdust, stream, depth + 2); + METER_WRITE(mvt->exceptions, stream, depth + 2); + METER_WRITE(mvt->exceptionSplinters, stream, depth + 2); + METER_WRITE(mvt->exceptionReturns, stream, depth + 2); - res = WriteF(stream, "}\n", NULL); + res = WriteF(stream, depth, "} MVT $P\n", (WriteFP)mvt, NULL); return res; } @@ -1087,44 +1120,6 @@ mps_class_t mps_class_mvt(void) } -/* MPS Interface extensions --- should these be pool generics? */ - - -/* mps_mvt_size -- number of bytes committed to the pool */ - -size_t mps_mvt_size(mps_pool_t mps_pool) -{ - Pool pool; - MVT mvt; - - pool = (Pool)mps_pool; - - AVERT(Pool, pool); - mvt = Pool2MVT(pool); - AVERT(MVT, mvt); - - return (size_t)mvt->size; -} - - -/* mps_mvt_free_size -- number of bytes comitted to the pool that are - * available for allocation - */ -size_t mps_mvt_free_size(mps_pool_t mps_pool) -{ - Pool pool; - MVT mvt; - - pool = (Pool)mps_pool; - - AVERT(Pool, pool); - mvt = Pool2MVT(pool); - AVERT(MVT, mvt); - - return (size_t)mvt->available; -} - - /* Internal methods */ @@ -1137,7 +1132,7 @@ static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size, /* Can't use plain old SegClass here because we need to call * SegBuffer() in MVTFree(). */ Res res = SegAlloc(segReturn, SegClassGet(), - SegPrefDefault(), size, MVT2Pool(mvt), withReservoirPermit, + SegPrefDefault(), size, MVTPool(mvt), withReservoirPermit, argsNone); if (res == ResOK) { @@ -1240,7 +1235,7 @@ static void MVTRefillABQIfEmpty(MVT mvt, Size size) mvt->abqOverflow = FALSE; METER_ACC(mvt->refills, size); /* The iteration stops if the ABQ overflows, so may finish or not. */ - (void)LandIterate(MVTFailover(mvt), MVTRefillVisitor, mvt, UNUSED_SIZE); + (void)LandIterate(MVTFreeLand(mvt), MVTRefillVisitor, mvt, UNUSED_SIZE); } } @@ -1306,12 +1301,12 @@ static Bool MVTContingencySearch(Addr *baseReturn, Addr *limitReturn, MVTContigencyClosureStruct cls; cls.mvt = mvt; - cls.arena = PoolArena(MVT2Pool(mvt)); + cls.arena = PoolArena(MVTPool(mvt)); cls.min = min; cls.steps = 0; cls.hardSteps = 0; - if (LandIterate(MVTFailover(mvt), MVTContingencyVisitor, &cls, UNUSED_SIZE)) + if (LandIterate(MVTFreeLand(mvt), MVTContingencyVisitor, &cls, UNUSED_SIZE)) return FALSE; AVER(RangeSize(&cls.range) >= min); @@ -1363,10 +1358,10 @@ Land _mps_mvt_cbs(Pool pool) { MVT mvt; AVERT(Pool, pool); - mvt = Pool2MVT(pool); + mvt = PoolMVT(pool); AVERT(MVT, mvt); - return MVTCBS(mvt); + return MVTFreePrimary(mvt); } diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c index f1a53868c81..e9620079e13 100644 --- a/mps/code/poolmvff.c +++ b/mps/code/poolmvff.c @@ -6,24 +6,26 @@ * * .purpose: This is a pool class for manually managed objects of * variable size where address-ordered first fit is an appropriate - * policy. Provision is made to allocate in reverse. This pool - * can allocate across segment boundaries. + * policy. Provision is made to allocate in reverse. * * .design: * + * NOTE * - * TRANSGRESSIONS - * - * .trans.stat: mps_mvff_stat is a temporary hack for measurement purposes, - * see .stat below. + * There's potential for up to 4% speed improvement by calling Land + * methods statically instead of indirectly via the Land abstraction + * (thus, cbsInsert instead of LandInsert, and so on). See + * */ -#include "mpscmvff.h" -#include "dbgpool.h" #include "cbs.h" +#include "dbgpool.h" #include "failover.h" #include "freelist.h" #include "mpm.h" +#include "mpscmvff.h" +#include "mpscmfs.h" +#include "poolmfs.h" SRCID(poolmvff, "$Id$"); @@ -43,25 +45,29 @@ extern PoolClass PoolClassMVFF(void); typedef struct MVFFStruct *MVFF; typedef struct MVFFStruct { /* MVFF pool outer structure */ PoolStruct poolStruct; /* generic structure */ - SegPref segPref; /* the preferences for segments */ - Size extendBy; /* segment size to extend pool by */ - Size minSegSize; /* minimum size of segment */ + SegPrefStruct segPrefStruct; /* the preferences for allocation */ + Size extendBy; /* size to extend pool by */ Size avgSize; /* client estimate of allocation size */ - Size total; /* total bytes in pool */ - CBSStruct cbsStruct; /* free list */ - FreelistStruct flStruct; /* emergency free list */ - FailoverStruct foStruct; /* fail-over mechanism */ + double spare; /* spare space fraction, see MVFFReduce */ + MFSStruct cbsBlockPoolStruct; /* stores blocks for CBSs */ + CBSStruct totalCBSStruct; /* all memory allocated from the arena */ + CBSStruct freeCBSStruct; /* free memory (primary) */ + FreelistStruct flStruct; /* free memory (secondary, for emergencies) */ + FailoverStruct foStruct; /* free memory (fail-over mechanism) */ Bool firstFit; /* as opposed to last fit */ Bool slotHigh; /* prefers high part of large block */ Sig sig; /* */ } MVFFStruct; -#define Pool2MVFF(pool) PARENT(MVFFStruct, poolStruct, pool) -#define MVFF2Pool(mvff) (&((mvff)->poolStruct)) -#define CBSOfMVFF(mvff) (&((mvff)->cbsStruct.landStruct)) -#define FreelistOfMVFF(mvff) (&((mvff)->flStruct.landStruct)) -#define FailoverOfMVFF(mvff) (&((mvff)->foStruct.landStruct)) +#define PoolMVFF(pool) PARENT(MVFFStruct, poolStruct, pool) +#define MVFFPool(mvff) (&(mvff)->poolStruct) +#define MVFFTotalLand(mvff) CBSLand(&(mvff)->totalCBSStruct) +#define MVFFFreePrimary(mvff) CBSLand(&(mvff)->freeCBSStruct) +#define MVFFFreeSecondary(mvff) FreelistLand(&(mvff)->flStruct) +#define MVFFFreeLand(mvff) FailoverLand(&(mvff)->foStruct) +#define MVFFSegPref(mvff) (&(mvff)->segPrefStruct) +#define MVFFBlockPool(mvff) MFSPool(&(mvff)->cbsBlockPoolStruct) static Bool MVFFCheck(MVFF mvff); @@ -80,178 +86,215 @@ typedef MVFFDebugStruct *MVFFDebug; #define MVFFDebug2MVFF(mvffd) (&((mvffd)->mvffStruct)) -/* MVFFInsert -- add given range to free lists +/* MVFFReduce -- return memory to the arena * - * Updates rangeIO to be maximally coalesced range containing given - * range. Does not attempt to free segments (see MVFFFreeSegs). + * This is usually called immediately after inserting a range into the + * MVFFFreeLand. (But not in all cases: see MVFFExtend.) */ -static Res MVFFInsert(Range rangeIO, MVFF mvff) { - AVERT(Range, rangeIO); - AVERT(MVFF, mvff); - - return LandInsert(rangeIO, FailoverOfMVFF(mvff), rangeIO); -} - - -/* MVFFFreeSegs -- free segments from given range - * - * Given a free range, attempts to find entire segments within it, and - * returns them to the arena, updating total size counter. - * - * This is usually called immediately after MVFFInsert. It is not - * combined with MVFFInsert because the latter is also called when new - * segments are added under MVFFAlloc. - */ -static void MVFFFreeSegs(MVFF mvff, Range range) +static void MVFFReduce(MVFF mvff) { - Seg seg = NULL; /* suppress "may be used uninitialized" */ Arena arena; - Bool b; - Addr segLimit; /* limit of the current segment when iterating */ - Addr segBase; /* base of the current segment when iterating */ - Res res; + Size freeSize, freeLimit, targetFree; + RangeStruct freeRange, oldFreeRange; + Align align; AVERT(MVFF, mvff); - AVERT(Range, range); - /* Could profitably AVER that the given range is free, */ - /* but the CBS doesn't provide that facility. */ + arena = PoolArena(MVFFPool(mvff)); - if (RangeSize(range) < mvff->minSegSize) - return; /* not large enough for entire segments */ + /* NOTE: Memory is returned to the arena in the smallest units + possible (arena grains). There's a possibility that this could + lead to fragmentation in the arena (because allocation is in + multiples of mvff->extendBy). If so, try setting align = + mvff->extendBy here. */ - arena = PoolArena(MVFF2Pool(mvff)); - b = SegOfAddr(&seg, arena, RangeBase(range)); - AVER(b); + align = ArenaAlign(arena); - segBase = SegBase(seg); - segLimit = SegLimit(seg); + /* Try to return memory when the amount of free memory exceeds a + threshold fraction of the total memory. */ - while(segLimit <= RangeLimit(range)) { /* segment ends in range */ - if (segBase >= RangeBase(range)) { /* segment starts in range */ - RangeStruct delRange, oldRange; - RangeInit(&delRange, segBase, segLimit); + freeLimit = (Size)(LandSize(MVFFTotalLand(mvff)) * mvff->spare); + freeSize = LandSize(MVFFFreeLand(mvff)); + if (freeSize < freeLimit) + return; - res = LandDelete(&oldRange, FailoverOfMVFF(mvff), &delRange); - AVER(res == ResOK); - AVER(RangesNest(&oldRange, &delRange)); + /* For hysteresis, return only a proportion of the free memory. */ - /* Can't free the segment earlier, because if it was on the - * Freelist rather than the CBS then it likely contains data - * that needs to be read in order to update the Freelist. */ - SegFree(seg); + targetFree = freeLimit / 2; - AVER(mvff->total >= RangeSize(&delRange)); - mvff->total -= RangeSize(&delRange); - } + /* Each time around this loop we either break, or we free at least + one page back to the arena, thus ensuring that eventually the + loop will terminate */ - /* Avoid calling SegFindAboveAddr if the next segment would fail */ - /* the loop test, mainly because there might not be a */ - /* next segment. */ - if (segLimit == RangeLimit(range)) /* segment ends at end of range */ + /* NOTE: If this code becomes very hot, then the test of whether there's + a large free block in the CBS could be inlined, since it's a property + stored at the root node. */ + + while (freeSize > targetFree + && LandFindLargest(&freeRange, &oldFreeRange, MVFFFreeLand(mvff), + align, FindDeleteNONE)) + { + RangeStruct pageRange, oldRange; + Size size; + Res res; + Addr base, limit; + + AVER(RangesEqual(&freeRange, &oldFreeRange)); + + base = AddrAlignUp(RangeBase(&freeRange), align); + limit = AddrAlignDown(RangeLimit(&freeRange), align); + + /* Give up if this block doesn't contain a whole aligned page, + even though smaller better-aligned blocks might, because + LandFindLargest won't be able to find those anyway. */ + if (base >= limit) break; - b = SegFindAboveAddr(&seg, arena, segBase); - AVER(b); - segBase = SegBase(seg); - segLimit = SegLimit(seg); - } + size = AddrOffset(base, limit); - return; + /* Don't return (much) more than we need to. */ + if (size > freeSize - targetFree) + size = SizeAlignUp(freeSize - targetFree, align); + + /* Calculate the range of pages we can return to the arena near the + top end of the free memory (because we're first fit). */ + RangeInit(&pageRange, AddrSub(limit, size), limit); + AVER(!RangeIsEmpty(&pageRange)); + AVER(RangesNest(&freeRange, &pageRange)); + AVER(RangeIsAligned(&pageRange, align)); + + /* Delete the range from the free list before attempting to delete + it from the total allocated memory, so that we don't have + dangling blocks in the free list, even for a moment. If we fail + to delete from the TotalCBS we add back to the free list, which + can't fail. */ + + res = LandDelete(&oldRange, MVFFFreeLand(mvff), &pageRange); + if (res != ResOK) + break; + freeSize -= RangeSize(&pageRange); + AVER(freeSize == LandSize(MVFFFreeLand(mvff))); + + res = LandDelete(&oldRange, MVFFTotalLand(mvff), &pageRange); + if (res != ResOK) { + RangeStruct coalescedRange; + res = LandInsert(&coalescedRange, MVFFFreeLand(mvff), &pageRange); + AVER(res == ResOK); + break; + } + + ArenaFree(RangeBase(&pageRange), RangeSize(&pageRange), MVFFPool(mvff)); + } } -/* MVFFAddSeg -- Allocates a new segment from the arena +/* MVFFExtend -- allocate a new range from the arena * - * Allocates a new segment from the arena (with the given + * Allocate a new range from the arena (with the given * withReservoirPermit flag) of at least the specified size. The - * specified size should be pool-aligned. Adds it to the free lists. + * specified size should be pool-aligned. Add it to the allocated and + * free lists. */ -static Res MVFFAddSeg(Seg *segReturn, - MVFF mvff, Size size, Bool withReservoirPermit) +static Res MVFFExtend(Range rangeReturn, MVFF mvff, Size size, + Bool withReservoirPermit) { Pool pool; Arena arena; - Size segSize; - Seg seg; - Res res; + Size allocSize; Align align; - RangeStruct range; + RangeStruct range, coalescedRange; + Addr base; + Res res; AVERT(MVFF, mvff); AVER(size > 0); AVERT(Bool, withReservoirPermit); - pool = MVFF2Pool(mvff); + pool = MVFFPool(mvff); arena = PoolArena(pool); align = ArenaAlign(arena); AVER(SizeIsAligned(size, PoolAlignment(pool))); /* Use extendBy unless it's too small (see */ - /* ). */ + /* ). */ if (size <= mvff->extendBy) - segSize = mvff->extendBy; + allocSize = mvff->extendBy; else - segSize = size; + allocSize = size; - segSize = SizeAlignUp(segSize, align); + allocSize = SizeAlignUp(allocSize, align); - res = SegAlloc(&seg, SegClassGet(), mvff->segPref, segSize, pool, - withReservoirPermit, argsNone); + res = ArenaAlloc(&base, MVFFSegPref(mvff), allocSize, pool, withReservoirPermit); if (res != ResOK) { - /* try again for a seg just large enough for object */ + /* try again with a range just large enough for object */ /* see */ - segSize = SizeAlignUp(size, align); - res = SegAlloc(&seg, SegClassGet(), mvff->segPref, segSize, pool, - withReservoirPermit, argsNone); - if (res != ResOK) { + allocSize = SizeAlignUp(size, align); + res = ArenaAlloc(&base, MVFFSegPref(mvff), allocSize, pool, + withReservoirPermit); + if (res != ResOK) return res; - } } - mvff->total += segSize; - RangeInitSize(&range, SegBase(seg), segSize); + RangeInitSize(&range, base, allocSize); + res = LandInsert(&coalescedRange, MVFFTotalLand(mvff), &range); + if (res != ResOK) { + /* Can't record this memory, so return it to the arena and fail. */ + ArenaFree(base, allocSize, pool); + return res; + } + DebugPoolFreeSplat(pool, RangeBase(&range), RangeLimit(&range)); - res = MVFFInsert(&range, mvff); + res = LandInsert(rangeReturn, MVFFFreeLand(mvff), &range); + /* Insertion must succeed because it fails over to a Freelist. */ AVER(res == ResOK); - AVER(RangeBase(&range) <= SegBase(seg)); - if (mvff->minSegSize > segSize) mvff->minSegSize = segSize; - /* Don't call MVFFFreeSegs; that would be silly. */ + /* Don't call MVFFReduce; that would be silly. */ - *segReturn = seg; return ResOK; } -/* MVFFFindFree -- find the first (or last) suitable free block +/* mvffFindFree -- find a suitable free block or add one * - * Finds a free block of the given (pool aligned) size, according - * to a first (or last) fit policy controlled by the MVFF fields - * firstFit, slotHigh (for whether to allocate the top or bottom - * portion of a larger block). + * Finds a free block of the given (pool aligned) size, using the + * policy (first fit, last fit, or worst fit) specified by findMethod + * and findDelete. * - * Will return FALSE if the free lists have no large enough block. In - * particular, will not attempt to allocate a new segment. + * If there is no suitable free block, try extending the pool. */ -static Bool MVFFFindFree(Range rangeReturn, MVFF mvff, Size size) +static Res mvffFindFree(Range rangeReturn, MVFF mvff, Size size, + LandFindMethod findMethod, FindDelete findDelete, + Bool withReservoirPermit) { - Bool foundBlock; - FindDelete findDelete; + Bool found; RangeStruct oldRange; + Land land; AVER(rangeReturn != NULL); AVERT(MVFF, mvff); AVER(size > 0); - AVER(SizeIsAligned(size, PoolAlignment(MVFF2Pool(mvff)))); + AVER(SizeIsAligned(size, PoolAlignment(MVFFPool(mvff)))); + AVER(FUNCHECK(findMethod)); + AVERT(FindDelete, findDelete); + AVERT(Bool, withReservoirPermit); - findDelete = mvff->slotHigh ? FindDeleteHIGH : FindDeleteLOW; + land = MVFFFreeLand(mvff); + found = (*findMethod)(rangeReturn, &oldRange, land, size, findDelete); + if (!found) { + RangeStruct newRange; + Res res; + res = MVFFExtend(&newRange, mvff, size, withReservoirPermit); + if (res != ResOK) + return res; + found = (*findMethod)(rangeReturn, &oldRange, land, size, findDelete); - foundBlock = - (mvff->firstFit ? LandFindFirst : LandFindLast) - (rangeReturn, &oldRange, FailoverOfMVFF(mvff), size, findDelete); + /* We know that the found range must intersect the newly added + * range. But it doesn't necessarily lie entirely within it. */ + AVER(found && RangesOverlap(rangeReturn, &newRange)); + } + AVER(found); - return foundBlock; + return ResOK; } @@ -263,41 +306,27 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size, Res res; MVFF mvff; RangeStruct range; - Bool foundBlock; - - AVERT(Pool, pool); - mvff = Pool2MVFF(pool); - AVERT(MVFF, mvff); + LandFindMethod findMethod; + FindDelete findDelete; AVER(aReturn != NULL); + AVERT(Pool, pool); + mvff = PoolMVFF(pool); + AVERT(MVFF, mvff); AVER(size > 0); AVERT(Bool, withReservoirPermit); size = SizeAlignUp(size, PoolAlignment(pool)); + findMethod = mvff->firstFit ? LandFindFirst : LandFindLast; + findDelete = mvff->slotHigh ? FindDeleteHIGH : FindDeleteLOW; - foundBlock = MVFFFindFree(&range, mvff, size); - if (!foundBlock) { - Seg seg; + res = mvffFindFree(&range, mvff, size, findMethod, findDelete, + withReservoirPermit); + if (res != ResOK) + return res; - res = MVFFAddSeg(&seg, mvff, size, withReservoirPermit); - if (res != ResOK) - return res; - foundBlock = MVFFFindFree(&range, mvff, size); - - /* We know that the found range must intersect the new segment. */ - /* In particular, it doesn't necessarily lie entirely within it. */ - /* The next two AVERs test for intersection of two intervals. */ - AVER(RangeBase(&range) < SegLimit(seg)); - AVER(SegBase(seg) < RangeLimit(&range)); - - /* We also know that the found range is no larger than the segment. */ - AVER(SegSize(seg) >= RangeSize(&range)); - } - AVER(foundBlock); AVER(RangeSize(&range) == size); - *aReturn = RangeBase(&range); - return ResOK; } @@ -307,11 +336,11 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size, static void MVFFFree(Pool pool, Addr old, Size size) { Res res; - RangeStruct range; + RangeStruct range, coalescedRange; MVFF mvff; AVERT(Pool, pool); - mvff = Pool2MVFF(pool); + mvff = PoolMVFF(pool); AVERT(MVFF, mvff); AVER(old != (Addr)0); @@ -319,19 +348,17 @@ static void MVFFFree(Pool pool, Addr old, Size size) AVER(size > 0); RangeInitSize(&range, old, SizeAlignUp(size, PoolAlignment(pool))); - - res = MVFFInsert(&range, mvff); + res = LandInsert(&coalescedRange, MVFFFreeLand(mvff), &range); + /* Insertion must succeed because it fails over to a Freelist. */ AVER(res == ResOK); - if (res == ResOK) - MVFFFreeSegs(mvff, &range); - - return; + MVFFReduce(mvff); } /* MVFFBufferFill -- Fill the buffer * - * Fill it with the largest block we can find. + * Fill it with the largest block we can find. This is worst-fit + * allocation policy; see . */ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn, Pool pool, Buffer buffer, Size size, @@ -339,29 +366,22 @@ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn, { Res res; MVFF mvff; - RangeStruct range, oldRange; - Bool found; - Seg seg = NULL; + RangeStruct range; + AVER(baseReturn != NULL); AVER(limitReturn != NULL); AVERT(Pool, pool); - mvff = Pool2MVFF(pool); + mvff = PoolMVFF(pool); AVERT(MVFF, mvff); AVERT(Buffer, buffer); AVER(size > 0); AVER(SizeIsAligned(size, PoolAlignment(pool))); AVERT(Bool, withReservoirPermit); - found = LandFindLargest(&range, &oldRange, FailoverOfMVFF(mvff), size, FindDeleteENTIRE); - if (!found) { - /* Add a new segment to the free lists and try again. */ - res = MVFFAddSeg(&seg, mvff, size, withReservoirPermit); - if (res != ResOK) - return res; - found = LandFindLargest(&range, &oldRange, FailoverOfMVFF(mvff), size, FindDeleteENTIRE); - } - AVER(found); - + res = mvffFindFree(&range, mvff, size, LandFindLargest, FindDeleteENTIRE, + withReservoirPermit); + if (res != ResOK) + return res; AVER(RangeSize(&range) >= size); *baseReturn = RangeBase(&range); @@ -377,10 +397,10 @@ static void MVFFBufferEmpty(Pool pool, Buffer buffer, { Res res; MVFF mvff; - RangeStruct range; + RangeStruct range, coalescedRange; AVERT(Pool, pool); - mvff = Pool2MVFF(pool); + mvff = PoolMVFF(pool); AVERT(MVFF, mvff); AVERT(Buffer, buffer); AVER(BufferIsReady(buffer)); @@ -389,12 +409,9 @@ static void MVFFBufferEmpty(Pool pool, Buffer buffer, if (RangeIsEmpty(&range)) return; - res = MVFFInsert(&range, mvff); + res = LandInsert(&coalescedRange, MVFFFreeLand(mvff), &range); AVER(res == ResOK); - if (res == ResOK) - MVFFFreeSegs(mvff, &range); - - return; + MVFFReduce(mvff); } @@ -440,10 +457,10 @@ static Res MVFFInit(Pool pool, ArgList args) Bool slotHigh = MVFF_SLOT_HIGH_DEFAULT; Bool arenaHigh = MVFF_ARENA_HIGH_DEFAULT; Bool firstFit = MVFF_FIRST_FIT_DEFAULT; + double spare = MVFF_SPARE_DEFAULT; MVFF mvff; Arena arena; Res res; - void *p; ArgStruct arg; AVERT(Pool, pool); @@ -463,6 +480,9 @@ static Res MVFFInit(Pool pool, ArgList args) if (ArgPick(&arg, args, MPS_KEY_ALIGN)) align = arg.val.align; + if (ArgPick(&arg, args, MPS_KEY_SPARE)) + spare = arg.val.d; + if (ArgPick(&arg, args, MPS_KEY_MVFF_SLOT_HIGH)) slotHigh = arg.val.b; @@ -475,6 +495,8 @@ static Res MVFFInit(Pool pool, ArgList args) AVER(extendBy > 0); /* .arg.check */ AVER(avgSize > 0); /* .arg.check */ AVER(avgSize <= extendBy); /* .arg.check */ + AVER(spare >= 0.0); /* .arg.check */ + AVER(spare <= 1.0); /* .arg.check */ AVERT(Align, align); /* This restriction on the alignment is necessary because of the use * of a Freelist to store the free address ranges in low-memory @@ -485,46 +507,60 @@ static Res MVFFInit(Pool pool, ArgList args) AVERT(Bool, arenaHigh); AVERT(Bool, firstFit); - mvff = Pool2MVFF(pool); + mvff = PoolMVFF(pool); mvff->extendBy = extendBy; if (extendBy < ArenaAlign(arena)) - mvff->minSegSize = ArenaAlign(arena); - else - mvff->minSegSize = extendBy; + mvff->extendBy = ArenaAlign(arena); mvff->avgSize = avgSize; pool->alignment = align; mvff->slotHigh = slotHigh; mvff->firstFit = firstFit; + mvff->spare = spare; - res = ControlAlloc(&p, arena, sizeof(SegPrefStruct), FALSE); + SegPrefInit(MVFFSegPref(mvff)); + SegPrefExpress(MVFFSegPref(mvff), arenaHigh ? SegPrefHigh : SegPrefLow, NULL); + + /* An MFS pool is explicitly initialised for the two CBSs partly to + * share space, but mostly to avoid a call to PoolCreate, so that + * MVFF can be used during arena bootstrap as the control pool. */ + + MPS_ARGS_BEGIN(piArgs) { + MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSFastBlockStruct)); + res = PoolInit(MVFFBlockPool(mvff), arena, PoolClassMFS(), piArgs); + } MPS_ARGS_END(piArgs); if (res != ResOK) - return res; + goto failBlockPoolInit; - mvff->segPref = (SegPref)p; - SegPrefInit(mvff->segPref); - SegPrefExpress(mvff->segPref, arenaHigh ? SegPrefHigh : SegPrefLow, NULL); + MPS_ARGS_BEGIN(liArgs) { + MPS_ARGS_ADD(liArgs, CBSBlockPool, MVFFBlockPool(mvff)); + res = LandInit(MVFFTotalLand(mvff), CBSFastLandClassGet(), arena, align, + mvff, liArgs); + } MPS_ARGS_END(liArgs); + if (res != ResOK) + goto failTotalLandInit; - mvff->total = 0; + MPS_ARGS_BEGIN(liArgs) { + MPS_ARGS_ADD(liArgs, CBSBlockPool, MVFFBlockPool(mvff)); + res = LandInit(MVFFFreePrimary(mvff), CBSFastLandClassGet(), arena, align, + mvff, liArgs); + } MPS_ARGS_END(liArgs); + if (res != ResOK) + goto failFreePrimaryInit; - res = LandInit(FreelistOfMVFF(mvff), FreelistLandClassGet(), arena, align, + res = LandInit(MVFFFreeSecondary(mvff), FreelistLandClassGet(), arena, align, mvff, mps_args_none); if (res != ResOK) - goto failFreelistInit; - - res = LandInit(CBSOfMVFF(mvff), CBSFastLandClassGet(), arena, align, mvff, - mps_args_none); - if (res != ResOK) - goto failCBSInit; + goto failFreeSecondaryInit; MPS_ARGS_BEGIN(foArgs) { - MPS_ARGS_ADD(foArgs, FailoverPrimary, CBSOfMVFF(mvff)); - MPS_ARGS_ADD(foArgs, FailoverSecondary, FreelistOfMVFF(mvff)); - res = LandInit(FailoverOfMVFF(mvff), FailoverLandClassGet(), arena, align, + MPS_ARGS_ADD(foArgs, FailoverPrimary, MVFFFreePrimary(mvff)); + MPS_ARGS_ADD(foArgs, FailoverSecondary, MVFFFreeSecondary(mvff)); + res = LandInit(MVFFFreeLand(mvff), FailoverLandClassGet(), arena, align, mvff, foArgs); } MPS_ARGS_END(foArgs); if (res != ResOK) - goto failFailoverInit; + goto failFreeLandInit; mvff->sig = MVFFSig; AVERT(MVFF, mvff); @@ -532,50 +568,57 @@ static Res MVFFInit(Pool pool, ArgList args) BOOLOF(slotHigh), BOOLOF(arenaHigh), BOOLOF(firstFit)); return ResOK; -failFailoverInit: - LandFinish(CBSOfMVFF(mvff)); -failCBSInit: - LandFinish(FreelistOfMVFF(mvff)); -failFreelistInit: - ControlFree(arena, p, sizeof(SegPrefStruct)); +failFreeLandInit: + LandFinish(MVFFFreeSecondary(mvff)); +failFreeSecondaryInit: + LandFinish(MVFFFreePrimary(mvff)); +failFreePrimaryInit: + LandFinish(MVFFTotalLand(mvff)); +failTotalLandInit: + PoolFinish(MVFFBlockPool(mvff)); +failBlockPoolInit: return res; } /* MVFFFinish -- finish method for MVFF */ +static Bool mvffFinishVisitor(Land land, Range range, + void *closureP, Size closureS) +{ + Pool pool; + + AVERT(Land, land); + AVERT(Range, range); + AVER(closureP != NULL); + pool = closureP; + AVERT(Pool, pool); + UNUSED(closureS); + + ArenaFree(RangeBase(range), RangeSize(range), pool); + return TRUE; +} + static void MVFFFinish(Pool pool) { MVFF mvff; - Arena arena; - Ring ring, node, nextNode; AVERT(Pool, pool); - mvff = Pool2MVFF(pool); + mvff = PoolMVFF(pool); AVERT(MVFF, mvff); - - ring = PoolSegRing(pool); - RING_FOR(node, ring, nextNode) { - Size size; - Seg seg; - seg = SegOfPoolRing(node); - AVER(SegPool(seg) == pool); - size = AddrOffset(SegBase(seg), SegLimit(seg)); - AVER(size <= mvff->total); - mvff->total -= size; - SegFree(seg); - } - - AVER(mvff->total == 0); - - arena = PoolArena(pool); - ControlFree(arena, mvff->segPref, sizeof(SegPrefStruct)); - - LandFinish(FailoverOfMVFF(mvff)); - LandFinish(FreelistOfMVFF(mvff)); - LandFinish(CBSOfMVFF(mvff)); - mvff->sig = SigInvalid; + + LandIterate(MVFFTotalLand(mvff), mvffFinishVisitor, pool, 0); + + /* TODO: would like to check that LandSize(MVFFTotalLand(mvff)) == 0 + * now, but CBS doesn't support deletion while iterating. See + * job003826. */ + + LandFinish(MVFFFreeLand(mvff)); + LandFinish(MVFFFreeSecondary(mvff)); + LandFinish(MVFFFreePrimary(mvff)); + LandFinish(MVFFTotalLand(mvff)); + PoolFinish(MVFFBlockPool(mvff)); } @@ -586,46 +629,80 @@ static PoolDebugMixin MVFFDebugMixin(Pool pool) MVFF mvff; AVERT(Pool, pool); - mvff = Pool2MVFF(pool); + mvff = PoolMVFF(pool); AVERT(MVFF, mvff); /* Can't check MVFFDebug, because this is called during init */ return &(MVFF2MVFFDebug(mvff)->debug); } +/* MVFFTotalSize -- total memory allocated from the arena */ + +static Size MVFFTotalSize(Pool pool) +{ + MVFF mvff; + + AVERT(Pool, pool); + mvff = PoolMVFF(pool); + AVERT(MVFF, mvff); + + return LandSize(MVFFTotalLand(mvff)); +} + + +/* MVFFFreeSize -- free memory (unused by client program) */ + +static Size MVFFFreeSize(Pool pool) +{ + MVFF mvff; + + AVERT(Pool, pool); + mvff = PoolMVFF(pool); + AVERT(MVFF, mvff); + + return LandSize(MVFFFreeLand(mvff)); +} + + /* MVFFDescribe -- describe an MVFF pool */ -static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream) +static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { Res res; MVFF mvff; if (!TESTT(Pool, pool)) return ResFAIL; - mvff = Pool2MVFF(pool); + mvff = PoolMVFF(pool); if (!TESTT(MVFF, mvff)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "MVFF $P {\n", (WriteFP)mvff, " pool $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial, " extendBy $W\n", (WriteFW)mvff->extendBy, " avgSize $W\n", (WriteFW)mvff->avgSize, - " total $U\n", (WriteFU)mvff->total, + " firstFit $U\n", (WriteFU)mvff->firstFit, + " slotHigh $U\n", (WriteFU)mvff->slotHigh, + " spare $D\n", (WriteFD)mvff->spare, NULL); - if (res != ResOK) - return res; + if (res != ResOK) return res; - res = LandDescribe(CBSOfMVFF(mvff), stream); - if (res != ResOK) - return res; + /* TODO: SegPrefDescribe(MVFFSegPref(mvff), stream); */ - res = LandDescribe(FreelistOfMVFF(mvff), stream); - if (res != ResOK) - return res; + /* Don't describe MVFFBlockPool(mvff) otherwise it'll appear twice + * in the output of GlobalDescribe. */ - res = WriteF(stream, "}\n", NULL); + res = LandDescribe(MVFFTotalLand(mvff), stream, depth + 2); + if (res != ResOK) return res; + res = LandDescribe(MVFFFreePrimary(mvff), stream, depth + 2); + if (res != ResOK) return res; + + res = LandDescribe(MVFFFreeSecondary(mvff), stream, depth + 2); + if (res != ResOK) return res; + + res = WriteF(stream, depth, "} MVFF $P\n", (WriteFP)mvff, NULL); return res; } @@ -644,6 +721,8 @@ DEFINE_POOL_CLASS(MVFFPoolClass, this) this->free = MVFFFree; this->bufferFill = MVFFBufferFill; this->bufferEmpty = MVFFBufferEmpty; + this->totalSize = MVFFTotalSize; + this->freeSize = MVFFFreeSize; this->describe = MVFFDescribe; AVERT(PoolClass, this); } @@ -683,57 +762,28 @@ mps_class_t mps_class_mvff_debug(void) } -/* Total free bytes. See */ - -size_t mps_mvff_free_size(mps_pool_t mps_pool) -{ - Pool pool; - MVFF mvff; - Land land; - - pool = (Pool)mps_pool; - AVERT(Pool, pool); - mvff = Pool2MVFF(pool); - AVERT(MVFF, mvff); - land = FailoverOfMVFF(mvff); - - return (size_t)LandSize(land); -} - -/* Total owned bytes. See */ - -size_t mps_mvff_size(mps_pool_t mps_pool) -{ - Pool pool; - MVFF mvff; - - pool = (Pool)mps_pool; - AVERT(Pool, pool); - mvff = Pool2MVFF(pool); - AVERT(MVFF, mvff); - - return (size_t)mvff->total; -} - - /* MVFFCheck -- check the consistency of an MVFF structure */ ATTRIBUTE_UNUSED static Bool MVFFCheck(MVFF mvff) { CHECKS(MVFF, mvff); - CHECKD(Pool, MVFF2Pool(mvff)); - CHECKL(IsSubclassPoly(MVFF2Pool(mvff)->class, MVFFPoolClassGet())); - CHECKD(SegPref, mvff->segPref); - CHECKL(mvff->extendBy > 0); /* see .arg.check */ - CHECKL(mvff->minSegSize >= ArenaAlign(PoolArena(MVFF2Pool(mvff)))); + CHECKD(Pool, MVFFPool(mvff)); + CHECKL(IsSubclassPoly(MVFFPool(mvff)->class, MVFFPoolClassGet())); + CHECKD(SegPref, MVFFSegPref(mvff)); + CHECKL(mvff->extendBy >= ArenaAlign(PoolArena(MVFFPool(mvff)))); CHECKL(mvff->avgSize > 0); /* see .arg.check */ CHECKL(mvff->avgSize <= mvff->extendBy); /* see .arg.check */ - CHECKL(SizeIsAligned(mvff->total, ArenaAlign(PoolArena(MVFF2Pool(mvff))))); - CHECKD(CBS, &mvff->cbsStruct); + CHECKL(mvff->spare >= 0.0); /* see .arg.check */ + CHECKL(mvff->spare <= 1.0); /* see .arg.check */ + CHECKD(MFS, &mvff->cbsBlockPoolStruct); + CHECKD(CBS, &mvff->totalCBSStruct); + CHECKD(CBS, &mvff->freeCBSStruct); CHECKD(Freelist, &mvff->flStruct); CHECKD(Failover, &mvff->foStruct); - CHECKL(mvff->total >= LandSize(FailoverOfMVFF(mvff))); + CHECKL(LandSize(MVFFTotalLand(mvff)) >= LandSize(MVFFFreeLand(mvff))); + CHECKL(SizeIsAligned(LandSize(MVFFFreeLand(mvff)), PoolAlignment(MVFFPool(mvff)))); + CHECKL(SizeIsAligned(LandSize(MVFFTotalLand(mvff)), ArenaAlign(PoolArena(MVFFPool(mvff))))); CHECKL(BoolCheck(mvff->slotHigh)); CHECKL(BoolCheck(mvff->firstFit)); return TRUE; @@ -747,10 +797,10 @@ Land _mps_mvff_cbs(Pool pool) { MVFF mvff; AVERT(Pool, pool); - mvff = Pool2MVFF(pool); + mvff = PoolMVFF(pool); AVERT(MVFF, mvff); - return CBSOfMVFF(mvff); + return MVFFFreePrimary(mvff); } diff --git a/mps/code/pooln.c b/mps/code/pooln.c index a53e1dceca2..cfb7bc0b61d 100644 --- a/mps/code/pooln.c +++ b/mps/code/pooln.c @@ -133,7 +133,7 @@ static void NBufferEmpty(Pool pool, Buffer buffer, /* NDescribe -- describe method for class N */ -static Res NDescribe(Pool pool, mps_lib_FILE *stream) +static Res NDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { PoolN poolN; @@ -142,6 +142,7 @@ static Res NDescribe(Pool pool, mps_lib_FILE *stream) AVERT(PoolN, poolN); UNUSED(stream); /* TODO: should output something here */ + UNUSED(depth); return ResOK; } @@ -303,8 +304,8 @@ PoolClass PoolClassN(void) Bool PoolNCheck(PoolN poolN) { CHECKL(poolN != NULL); - CHECKD(Pool, &poolN->poolStruct); - CHECKL(poolN->poolStruct.class == EnsureNPoolClass()); + CHECKD(Pool, PoolNPool(poolN)); + CHECKL(PoolNPool(poolN)->class == EnsureNPoolClass()); UNUSED(poolN); /* */ return TRUE; diff --git a/mps/code/poolncv.c b/mps/code/poolncv.c index 8b8dab2a8a1..a3f85342cb8 100644 --- a/mps/code/poolncv.c +++ b/mps/code/poolncv.c @@ -5,10 +5,10 @@ */ #include "mpm.h" -#include "pooln.h" #include "mpsavm.h" -#include "testlib.h" #include "mpslib.h" +#include "pooln.h" +#include "testlib.h" #include /* printf */ @@ -28,6 +28,7 @@ static void testit(ArenaClass class, ArgList args) error("Error: Unexpectedly succeeded in" "allocating block from PoolN\n"); } + PoolDescribe(pool, mps_lib_get_stdout(), 0); PoolDestroy(pool); ArenaDestroy(arena); } diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c index 139865fc5ec..9263b06bbd5 100644 --- a/mps/code/poolsnc.c +++ b/mps/code/poolsnc.c @@ -24,9 +24,6 @@ SRCID(poolsnc, "$Id$"); -#define SNCGen ((Serial)1) /* "generation" for SNC pools */ - - /* SNCStruct -- structure for an SNC pool * * See design.mps.poolsnc.poolstruct. @@ -40,8 +37,8 @@ typedef struct SNCStruct { Sig sig; } SNCStruct, *SNC; -#define Pool2SNC(pool) \ - PARENT(SNCStruct, poolStruct, (pool)) +#define PoolSNC(pool) PARENT(SNCStruct, poolStruct, (pool)) +#define SNCPool(snc) (&(snc)->poolStruct) /* Forward declarations */ @@ -165,7 +162,7 @@ static void SNCBufFinish(Buffer buffer) AVERT(SNCBuf, sncbuf); pool = BufferPool(buffer); - snc = Pool2SNC(pool); + snc = PoolSNC(pool); /* Put any segments which haven't bee popped onto the free list */ sncPopPartialSegChain(snc, buffer, NULL); @@ -384,7 +381,7 @@ static Res SNCInit(Pool pool, ArgList args) /* weak check, as half-way through initialization */ AVER(pool != NULL); - snc = Pool2SNC(pool); + snc = PoolSNC(pool); ArgRequire(&arg, args, MPS_KEY_FORMAT); format = arg.val.format; @@ -408,7 +405,7 @@ static void SNCFinish(Pool pool) Ring ring, node, nextNode; AVERT(Pool, pool); - snc = Pool2SNC(pool); + snc = PoolSNC(pool); AVERT(SNC, snc); ring = &pool->segRing; @@ -438,7 +435,7 @@ static Res SNCBufferFill(Addr *baseReturn, Addr *limitReturn, AVERT(Bool, withReservoirPermit); AVER(BufferIsReset(buffer)); - snc = Pool2SNC(pool); + snc = PoolSNC(pool); AVERT(SNC, snc); /* Try to find a free segment with enough space already */ @@ -485,7 +482,7 @@ static void SNCBufferEmpty(Pool pool, Buffer buffer, seg = BufferSeg(buffer); AVER(init <= limit); AVER(SegLimit(seg) == limit); - snc = Pool2SNC(pool); + snc = PoolSNC(pool); AVERT(SNC, snc); AVER(BufferFrameState(buffer) == BufferFrameVALID); /* .lw-frame-state */ @@ -514,7 +511,7 @@ static Res SNCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) AVERT(ScanState, ss); AVERT(Seg, seg); AVERT(Pool, pool); - snc = Pool2SNC(pool); + snc = PoolSNC(pool); AVERT(SNC, snc); format = pool->format; @@ -591,7 +588,7 @@ static void SNCFramePopPending(Pool pool, Buffer buf, AllocFrame frame) AVERT(Pool, pool); AVERT(Buffer, buf); /* frame is an Addr and can't be directly checked */ - snc = Pool2SNC(pool); + snc = PoolSNC(pool); AVERT(SNC, snc); AVER(BufferFrameState(buf) == BufferFrameVALID); @@ -644,7 +641,7 @@ static void SNCWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f, SNC snc; Format format; - snc = Pool2SNC(pool); + snc = PoolSNC(pool); AVERT(SNC, snc); format = pool->format; @@ -702,8 +699,8 @@ ATTRIBUTE_UNUSED static Bool SNCCheck(SNC snc) { CHECKS(SNC, snc); - CHECKD(Pool, &snc->poolStruct); - CHECKL(snc->poolStruct.class == SNCPoolClassGet()); + CHECKD(Pool, SNCPool(snc)); + CHECKL(SNCPool(snc)->class == SNCPoolClassGet()); if (snc->freeSegs != NULL) { CHECKD(Seg, snc->freeSegs); } diff --git a/mps/code/range.c b/mps/code/range.c index 1c7f297c46d..8b8f1c8bf8a 100644 --- a/mps/code/range.c +++ b/mps/code/range.c @@ -41,19 +41,19 @@ void RangeFinish(Range range) AVERT(Range, range); } -Res RangeDescribe(Range range, mps_lib_FILE *stream) +Res RangeDescribe(Range range, mps_lib_FILE *stream, Count depth) { Res res; AVERT(Range, range); AVER(stream != NULL); - res = WriteF(stream, - "Range $P\n{\n", (WriteFP)range, + res = WriteF(stream, depth, + "Range $P {\n", (WriteFP)range, " base: $P\n", (WriteFP)RangeBase(range), " limit: $P\n", (WriteFP)RangeLimit(range), " size: $U\n", (WriteFU)RangeSize(range), - "}\n", NULL); + "} Range $P\n", (WriteFP)range, NULL); if (res != ResOK) { return res; } diff --git a/mps/code/range.h b/mps/code/range.h index c6fd41bad5e..ac262c98c1a 100644 --- a/mps/code/range.h +++ b/mps/code/range.h @@ -25,7 +25,7 @@ extern void RangeInit(Range range, Addr base, Addr limit); extern void RangeInitSize(Range range, Addr base, Size size); extern void RangeFinish(Range range); -extern Res RangeDescribe(Range range, mps_lib_FILE *stream); +extern Res RangeDescribe(Range range, mps_lib_FILE *stream, Count depth); extern Bool RangeCheck(Range range); extern Bool RangeIsAligned(Range range, Align align); extern Bool RangesOverlap(Range range1, Range range2); diff --git a/mps/code/reserv.c b/mps/code/reserv.c index c7dd0507482..f6340c5b5cc 100644 --- a/mps/code/reserv.c +++ b/mps/code/reserv.c @@ -16,7 +16,7 @@ SRCID(reserv, "$Id$"); /* The reservoir pool is defined here. See */ -#define Pool2Reservoir(pool) PARENT(ReservoirStruct, poolStruct, pool) +#define PoolReservoir(pool) PARENT(ReservoirStruct, poolStruct, pool) /* Management of tracts @@ -30,7 +30,7 @@ SRCID(reserv, "$Id$"); #define resTractSetNext(tract, next) (TractSetP((tract), (void*)(next))) -#define reservoirArena(reservoir) ((reservoir)->poolStruct.arena) +#define reservoirArena(reservoir) (PoolArena(ReservoirPool(reservoir))) /* ResPoolInit -- Reservoir pool init method */ @@ -58,7 +58,7 @@ static void ResPoolFinish(Pool pool) Reservoir reservoir; AVERT(Pool, pool); - reservoir = Pool2Reservoir(pool); + reservoir = PoolReservoir(pool); AVERT(Reservoir, reservoir); AVER(reservoir->reserve == NULL); /* .reservoir.finish */ } @@ -88,7 +88,7 @@ Bool ReservoirCheck(Reservoir reservoir) CHECKS(Reservoir, reservoir); CHECKD(Pool, ReservoirPool(reservoir)); - CHECKL(reservoir->poolStruct.class == reservoircl); + CHECKL(ReservoirPool(reservoir)->class == reservoircl); UNUSED(reservoircl); /* */ arena = reservoirArena(reservoir); CHECKU(Arena, arena); diff --git a/mps/code/root.c b/mps/code/root.c index 4277550a7fb..4732af15a62 100644 --- a/mps/code/root.c +++ b/mps/code/root.c @@ -580,14 +580,14 @@ Res RootsIterate(Globals arena, RootIterateFn f, void *p) /* RootDescribe -- describe a root */ -Res RootDescribe(Root root, mps_lib_FILE *stream) +Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth) { Res res; if (!TESTT(Root, root)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "Root $P ($U) {\n", (WriteFP)root, (WriteFU)root->serial, " arena $P ($U)\n", (WriteFP)root->arena, (WriteFU)root->arena->serial, @@ -599,15 +599,16 @@ Res RootDescribe(Root root, mps_lib_FILE *stream) switch(root->var) { case RootTABLE: - res = WriteF(stream, - " table base $A limit $A\n", + res = WriteF(stream, depth + 2, + "table base $A limit $A\n", root->the.table.base, root->the.table.limit, NULL); if (res != ResOK) return res; break; case RootTABLE_MASKED: - res = WriteF(stream, " table base $A limit $A mask $B\n", + res = WriteF(stream, depth + 2, + "table base $A limit $A mask $B\n", root->the.tableMasked.base, root->the.tableMasked.limit, root->the.tableMasked.mask, NULL); @@ -615,26 +616,26 @@ Res RootDescribe(Root root, mps_lib_FILE *stream) break; case RootFUN: - res = WriteF(stream, - " scan function $F\n", (WriteFF)root->the.fun.scan, - " environment p $P s $W\n", + res = WriteF(stream, depth + 2, + "scan function $F\n", (WriteFF)root->the.fun.scan, + "environment p $P s $W\n", root->the.fun.p, (WriteFW)root->the.fun.s, NULL); if (res != ResOK) return res; break; case RootREG: - res = WriteF(stream, - " thread $P\n", (WriteFP)root->the.reg.thread, - " environment p $P", root->the.reg.p, + res = WriteF(stream, depth + 2, + "thread $P\n", (WriteFP)root->the.reg.thread, + "environment p $P", root->the.reg.p, NULL); if (res != ResOK) return res; break; case RootFMT: - res = WriteF(stream, - " scan function $F\n", (WriteFF)root->the.fmt.scan, - " format base $A limit $A\n", + res = WriteF(stream, depth + 2, + "scan function $F\n", (WriteFF)root->the.fmt.scan, + "format base $A limit $A\n", root->the.fmt.base, root->the.fmt.limit, NULL); if (res != ResOK) return res; @@ -644,7 +645,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream) NOTREACHED; } - res = WriteF(stream, + res = WriteF(stream, depth, "} Root $P ($U)\n", (WriteFP)root, (WriteFU)root->serial, NULL); if (res != ResOK) return res; @@ -655,14 +656,14 @@ Res RootDescribe(Root root, mps_lib_FILE *stream) /* RootsDescribe -- describe all roots */ -Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream) +Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth) { Res res = ResOK; Ring node, next; RING_FOR(node, &arenaGlobals->rootRing, next) { Root root = RING_ELT(Root, arenaRing, node); - res = RootDescribe(root, stream); /* this outputs too much */ + res = RootDescribe(root, stream, depth); if (res != ResOK) return res; } return res; diff --git a/mps/code/seg.c b/mps/code/seg.c index e03947bdd6c..cdbdf539070 100644 --- a/mps/code/seg.c +++ b/mps/code/seg.c @@ -359,7 +359,7 @@ void SegSetBuffer(Seg seg, Buffer buffer) /* SegDescribe -- describe a segment */ -Res SegDescribe(Seg seg, mps_lib_FILE *stream) +Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) { Res res; Pool pool; @@ -369,7 +369,7 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream) pool = SegPool(seg); - res = WriteF(stream, + res = WriteF(stream, depth, "Segment $P [$A,$A) {\n", (WriteFP)seg, (WriteFA)SegBase(seg), (WriteFA)SegLimit(seg), " class $P (\"$S\")\n", @@ -379,11 +379,13 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream) NULL); if (res != ResOK) return res; - res = seg->class->describe(seg, stream); + res = seg->class->describe(seg, stream, depth + 2); if (res != ResOK) return res; - res = WriteF(stream, "\n", - "} Segment $P\n", (WriteFP)seg, NULL); + res = WriteF(stream, 0, "\n", NULL); + if (res != ResOK) return res; + + res = WriteF(stream, depth, "} Segment $P\n", (WriteFP)seg, NULL); return res; } @@ -526,43 +528,6 @@ Bool SegNext(Seg *segReturn, Arena arena, Seg seg) } -/* SegFindAboveAddr -- return the "next" seg in the arena - * - * Finds the seg with the lowest base address which is - * greater than a specified address. The address must be (or once - * have been) the base address of a seg. - */ - -Bool SegFindAboveAddr(Seg *segReturn, Arena arena, Addr addr) -{ - Tract tract; - Addr base = addr; - AVER_CRITICAL(segReturn != NULL); /* .seg.critical */ - AVERT_CRITICAL(Arena, arena); - - while (TractNext(&tract, arena, base)) { - Seg seg; - if (TRACT_SEG(&seg, tract)) { - if (tract == seg->firstTract) { - *segReturn = seg; - return TRUE; - } else { - /* found the next tract in a large segment */ - /* base & addr must be the base of this segment */ - AVER_CRITICAL(TractBase(seg->firstTract) == addr); - AVER_CRITICAL(addr == base); - /* set base to the last tract in the segment */ - base = AddrSub(seg->limit, ArenaAlign(arena)); - AVER_CRITICAL(base > addr); - } - } else { - base = TractBase(tract); - } - } - return FALSE; -} - - /* SegMerge -- Merge two adjacent segments * * See @@ -1036,59 +1001,30 @@ static Res segTrivSplit(Seg seg, Seg segHi, /* segTrivDescribe -- Basic Seg description method */ -static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream) +static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream, Count depth) { Res res; if (!TESTT(Seg, seg)) return ResFAIL; if (stream == NULL) return ResFAIL; - res = WriteF(stream, - " shield depth $U\n", (WriteFU)seg->depth, - " protection mode:", - NULL); - if (res != ResOK) return res; - if (SegPM(seg) & AccessREAD) { - res = WriteF(stream, " read", NULL); - if (res != ResOK) return res; - } - if (SegPM(seg) & AccessWRITE) { - res = WriteF(stream, " write", NULL); - if (res != ResOK) return res; - } - res = WriteF(stream, "\n shield mode:", NULL); - if (res != ResOK) return res; - if (SegSM(seg) & AccessREAD) { - res = WriteF(stream, " read", NULL); - if (res != ResOK) return res; - } - if (SegSM(seg) & AccessWRITE) { - res = WriteF(stream, " write", NULL); - if (res != ResOK) return res; - } - res = WriteF(stream, "\n ranks:", NULL); - if (res != ResOK) return res; - /* This bit ought to be in a RankSetDescribe in ref.c. */ - if (RankSetIsMember(seg->rankSet, RankAMBIG)) { - res = WriteF(stream, " ambiguous", NULL); - if (res != ResOK) return res; - } - if (RankSetIsMember(seg->rankSet, RankEXACT)) { - res = WriteF(stream, " exact", NULL); - if (res != ResOK) return res; - } - if (RankSetIsMember(seg->rankSet, RankFINAL)) { - res = WriteF(stream, " final", NULL); - if (res != ResOK) return res; - } - if (RankSetIsMember(seg->rankSet, RankWEAK)) { - res = WriteF(stream, " weak", NULL); - if (res != ResOK) return res; - } - res = WriteF(stream, "\n", - " white $B\n", (WriteFB)seg->white, - " grey $B\n", (WriteFB)seg->grey, - " nailed $B\n", (WriteFB)seg->nailed, + res = WriteF(stream, depth, + "shield depth $U\n", (WriteFU)seg->depth, + "protection mode: ", + (SegPM(seg) & AccessREAD) ? "" : "!", "READ", " ", + (SegPM(seg) & AccessWRITE) ? "" : "!", "WRITE", "\n", + "shield mode: ", + (SegSM(seg) & AccessREAD) ? "" : "!", "READ", " ", + (SegSM(seg) & AccessWRITE) ? "" : "!", "WRITE", "\n", + "ranks:", + RankSetIsMember(seg->rankSet, RankAMBIG) ? " ambiguous" : "", + RankSetIsMember(seg->rankSet, RankEXACT) ? " exact" : "", + RankSetIsMember(seg->rankSet, RankFINAL) ? " final" : "", + RankSetIsMember(seg->rankSet, RankWEAK) ? " weak" : "", + "\n", + "white $B\n", (WriteFB)seg->white, + "grey $B\n", (WriteFB)seg->grey, + "nailed $B\n", (WriteFB)seg->nailed, NULL); return res; } @@ -1624,7 +1560,7 @@ static Res gcSegSplit(Seg seg, Seg segHi, /* gcSegDescribe -- GCSeg description method */ -static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream) +static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) { Res res; SegClass super; @@ -1637,19 +1573,18 @@ static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream) /* Describe the superclass fields first via next-method call */ super = SEG_SUPERCLASS(GCSegClass); - res = super->describe(seg, stream); + res = super->describe(seg, stream, depth); if (res != ResOK) return res; - res = WriteF(stream, - " summary $W\n", (WriteFW)gcseg->summary, + res = WriteF(stream, depth, + "summary $W\n", (WriteFW)gcseg->summary, NULL); if (res != ResOK) return res; if (gcseg->buffer == NULL) { - res = WriteF(stream, " buffer: NULL\n", NULL); - } - else { - res = BufferDescribe(gcseg->buffer, stream); + res = WriteF(stream, depth, "buffer: NULL\n", NULL); + } else { + res = BufferDescribe(gcseg->buffer, stream, depth); } if (res != ResOK) return res; diff --git a/mps/code/segsmss.c b/mps/code/segsmss.c index 20cedf67dd2..056a794cda2 100644 --- a/mps/code/segsmss.c +++ b/mps/code/segsmss.c @@ -52,7 +52,7 @@ typedef struct AMSTStruct { typedef struct AMSTStruct *AMST; -#define Pool2AMST(pool) PARENT(AMSTStruct, amsStruct, PARENT(AMSStruct, poolStruct, (pool))) +#define PoolAMST(pool) PARENT(AMSTStruct, amsStruct, PARENT(AMSStruct, poolStruct, (pool))) #define AMST2AMS(amst) (&(amst)->amsStruct) @@ -122,7 +122,7 @@ static Res amstSegInit(Seg seg, Pool pool, Addr base, Size size, AVERT(Seg, seg); amstseg = Seg2AMSTSeg(seg); AVERT(Pool, pool); - amst = Pool2AMST(pool); + amst = PoolAMST(pool); AVERT(AMST, amst); /* no useful checks for base and size */ AVERT(Bool, reservoirPermit); @@ -190,7 +190,7 @@ static Res amstSegMerge(Seg seg, Seg segHi, amstsegHi = Seg2AMSTSeg(segHi); AVERT(AMSTSeg, amstseg); AVERT(AMSTSeg, amstsegHi); - amst = Pool2AMST(SegPool(seg)); + amst = PoolAMST(SegPool(seg)); /* Merge the superclass fields via direct next-method call */ super = SEG_SUPERCLASS(AMSTSegClass); @@ -241,7 +241,7 @@ static Res amstSegSplit(Seg seg, Seg segHi, amstseg = Seg2AMSTSeg(seg); amstsegHi = Seg2AMSTSeg(segHi); AVERT(AMSTSeg, amstseg); - amst = Pool2AMST(SegPool(seg)); + amst = PoolAMST(SegPool(seg)); /* Split the superclass fields via direct next-method call */ super = SEG_SUPERCLASS(AMSTSegClass); @@ -351,11 +351,11 @@ static Res AMSTInit(Pool pool, ArgList args) ArgRequire(&arg, args, MPS_KEY_FORMAT); format = arg.val.format; - res = AMSInitInternal(Pool2AMS(pool), format, chain, gen, FALSE); + res = AMSInitInternal(PoolAMS(pool), format, chain, gen, FALSE); if (res != ResOK) return res; - amst = Pool2AMST(pool); - ams = Pool2AMS(pool); + amst = PoolAMST(pool); + ams = PoolAMS(pool); ams->segSize = AMSTSegSizePolicy; ams->segClass = AMSTSegClassGet; amst->failSegs = TRUE; @@ -378,7 +378,7 @@ static void AMSTFinish(Pool pool) AMST amst; AVERT(Pool, pool); - amst = Pool2AMST(pool); + amst = PoolAMST(pool); AVERT(AMST, amst); printf("\nDestroying pool, having performed:\n"); @@ -418,7 +418,7 @@ static Bool AMSSegRegionIsFree(Seg seg, Addr base, Addr limit) AVERT(Seg, seg); amsseg = Seg2AMSSeg(seg); sbase = SegBase(seg); - ams = Pool2AMS(SegPool(seg)); + ams = PoolAMS(SegPool(seg)); bgrain = AMSGrains(ams, AddrOffset(sbase, base)); lgrain = AMSGrains(ams, AddrOffset(sbase, limit)); @@ -544,8 +544,8 @@ static Res AMSTBufferFill(Addr *baseReturn, Addr *limitReturn, AVER(limitReturn != NULL); /* other parameters are checked by next method */ arena = PoolArena(pool); - ams = Pool2AMS(pool); - amst = Pool2AMST(pool); + ams = PoolAMS(pool); + amst = PoolAMST(pool); /* call next method */ super = POOL_SUPERCLASS(AMSTPoolClass); @@ -630,7 +630,7 @@ static void AMSTStressBufferedSeg(Seg seg, Buffer buffer) AVERT(AMSTSeg, amstseg); limit = BufferLimit(buffer); arena = PoolArena(SegPool(seg)); - amst = Pool2AMST(SegPool(seg)); + amst = PoolAMST(SegPool(seg)); AVERT(AMST, amst); if (amstseg->next != NULL) { diff --git a/mps/code/splay.c b/mps/code/splay.c index 8acf3a886b9..78a829bdb9f 100644 --- a/mps/code/splay.c +++ b/mps/code/splay.c @@ -1020,21 +1020,22 @@ Tree SplayTreeNext(SplayTree splay, TreeKey oldKey) { */ static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream, - TreeDescribeMethod nodeDescribe) { + TreeDescribeMethod nodeDescribe) +{ Res res; if (!TreeCheck(node)) return ResFAIL; if (stream == NULL) return ResFAIL; if (!FUNCHECK(nodeDescribe)) return ResFAIL; - res = WriteF(stream, "( ", NULL); + res = WriteF(stream, 0, "( ", NULL); if (res != ResOK) return res; if (TreeHasLeft(node)) { res = SplayNodeDescribe(TreeLeft(node), stream, nodeDescribe); if (res != ResOK) return res; - res = WriteF(stream, " / ", NULL); + res = WriteF(stream, 0, " / ", NULL); if (res != ResOK) return res; } @@ -1042,14 +1043,14 @@ static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream, if (res != ResOK) return res; if (TreeHasRight(node)) { - res = WriteF(stream, " \\ ", NULL); + res = WriteF(stream, 0, " \\ ", NULL); if (res != ResOK) return res; res = SplayNodeDescribe(TreeRight(node), stream, nodeDescribe); if (res != ResOK) return res; } - res = WriteF(stream, " )", NULL); + res = WriteF(stream, 0, " )", NULL); if (res != ResOK) return res; return ResOK; @@ -1350,15 +1351,16 @@ void SplayNodeInit(SplayTree splay, Tree node) * See . */ -Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, - TreeDescribeMethod nodeDescribe) { +Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, Count depth, + TreeDescribeMethod nodeDescribe) +{ Res res; if (!TESTT(SplayTree, splay)) return ResFAIL; if (stream == NULL) return ResFAIL; if (!FUNCHECK(nodeDescribe)) return ResFAIL; - res = WriteF(stream, + res = WriteF(stream, depth, "Splay $P {\n", (WriteFP)splay, " compare $F\n", (WriteFF)splay->compare, " nodeKey $F\n", (WriteFF)splay->nodeKey, @@ -1367,11 +1369,13 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, if (res != ResOK) return res; if (SplayTreeRoot(splay) != TreeEMPTY) { + res = WriteF(stream, depth, " tree ", NULL); + if (res != ResOK) return res; res = SplayNodeDescribe(SplayTreeRoot(splay), stream, nodeDescribe); if (res != ResOK) return res; } - res = WriteF(stream, "\n}\n", NULL); + res = WriteF(stream, depth, "\n} Splay $P\n", (WriteFP)splay, NULL); return res; } diff --git a/mps/code/splay.h b/mps/code/splay.h index c71cdb17bfb..414eb8e6b51 100644 --- a/mps/code/splay.h +++ b/mps/code/splay.h @@ -72,7 +72,7 @@ extern void SplayNodeRefresh(SplayTree splay, Tree node); extern void SplayNodeInit(SplayTree splay, Tree node); extern Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, - TreeDescribeMethod nodeDescribe); + Count depth, TreeDescribeMethod nodeDescribe); extern void SplayDebugUpdate(SplayTree splay, Tree tree); extern Count SplayDebugCount(SplayTree splay); diff --git a/mps/code/th.h b/mps/code/th.h index 30a2205a356..8c7da150fd0 100644 --- a/mps/code/th.h +++ b/mps/code/th.h @@ -28,7 +28,7 @@ extern Bool ThreadCheck(Thread thread); extern Bool ThreadCheckSimple(Thread thread); -extern Res ThreadDescribe(Thread thread, mps_lib_FILE *stream); +extern Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth); /* Register/Deregister diff --git a/mps/code/than.c b/mps/code/than.c index a1dab12adc8..0ee0a3cc363 100644 --- a/mps/code/than.c +++ b/mps/code/than.c @@ -128,11 +128,11 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) } -Res ThreadDescribe(Thread thread, mps_lib_FILE *stream) +Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth) { Res res; - res = WriteF(stream, + res = WriteF(stream, depth, "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, " arena $P ($U)\n", (WriteFP)thread->arena, (WriteFU)thread->arena->serial, diff --git a/mps/code/thix.c b/mps/code/thix.c index cc380dd040f..cc6a3b61219 100644 --- a/mps/code/thix.c +++ b/mps/code/thix.c @@ -272,11 +272,11 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) /* ThreadDescribe -- describe a thread */ -Res ThreadDescribe(Thread thread, mps_lib_FILE *stream) +Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth) { Res res; - res = WriteF(stream, + res = WriteF(stream, depth, "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, " arena $P ($U)\n", (WriteFP)thread->arena, (WriteFU)thread->arena->serial, diff --git a/mps/code/thw3.c b/mps/code/thw3.c index 701ffc53cdd..96af1f83f6b 100644 --- a/mps/code/thw3.c +++ b/mps/code/thw3.c @@ -212,11 +212,11 @@ Arena ThreadArena(Thread thread) return thread->arena; } -Res ThreadDescribe(Thread thread, mps_lib_FILE *stream) +Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth) { Res res; - res = WriteF(stream, + res = WriteF(stream, depth, "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, " arena $P ($U)\n", (WriteFP)thread->arena, (WriteFU)thread->arena->serial, diff --git a/mps/code/thxc.c b/mps/code/thxc.c index 9e6a6bd325c..3160bec9caf 100644 --- a/mps/code/thxc.c +++ b/mps/code/thxc.c @@ -248,11 +248,11 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) } -Res ThreadDescribe(Thread thread, mps_lib_FILE *stream) +Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth) { Res res; - res = WriteF(stream, + res = WriteF(stream, depth, "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, " arena $P ($U)\n", (WriteFP)thread->arena, (WriteFU)thread->arena->serial, diff --git a/mps/code/trace.c b/mps/code/trace.c index 56abf698e39..163d8b63a39 100644 --- a/mps/code/trace.c +++ b/mps/code/trace.c @@ -1909,6 +1909,51 @@ Size TracePoll(Globals globals) } +/* TraceDescribe -- describe a trace */ + +Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth) +{ + Res res; + const char *state; + + if (!TESTT(Trace, trace)) return ResFAIL; + if (stream == NULL) return ResFAIL; + + switch (trace->state) { + case TraceINIT: state = "INIT"; break; + case TraceUNFLIPPED: state = "UNFLIPPED"; break; + case TraceFLIPPED: state = "FLIPPED"; break; + case TraceRECLAIM: state = "RECLAIM"; break; + case TraceFINISHED: state = "FINISHED"; break; + default: state = "unknown"; break; + } + + res = WriteF(stream, depth, + "Trace $P ($U) {\n", (WriteFP)trace, (WriteFU)trace->ti, + " arena $P ($U)\n", (WriteFP)trace->arena, + (WriteFU)trace->arena->serial, + " why \"$S\"\n", (WriteFS)TraceStartWhyToString(trace->why), + " state $S\n", (WriteFS)state, + " band $U\n", (WriteFU)trace->band, + " white $B\n", (WriteFB)trace->white, + " mayMove $B\n", (WriteFB)trace->mayMove, + " chain $P\n", (WriteFP)trace->chain, + " condemned $U\n", (WriteFU)trace->condemned, + " notCondemned $U\n", (WriteFU)trace->notCondemned, + " foundation $U\n", (WriteFU)trace->foundation, + " rate $U\n", (WriteFU)trace->rate, + " rootScanSize $U\n", (WriteFU)trace->rootScanSize, + " rootCopiedSize $U\n", (WriteFU)trace->rootCopiedSize, + " segScanSize $U\n", (WriteFU)trace->segScanSize, + " segCopiedSize $U\n", (WriteFU)trace->segCopiedSize, + " forwardedSize $U\n", (WriteFU)trace->forwardedSize, + " preservedInPlaceSize $U\n", (WriteFU)trace->preservedInPlaceSize, + "} Trace $P\n", (WriteFP)trace, + NULL); + return res; +} + + /* C. COPYRIGHT AND LICENSE * * Copyright (C) 2001-2014 Ravenbrook Limited diff --git a/mps/code/tract.c b/mps/code/tract.c index 1230d8fb024..834cb50a9f3 100644 --- a/mps/code/tract.c +++ b/mps/code/tract.c @@ -392,7 +392,7 @@ Res ChunkNodeDescribe(Tree node, mps_lib_FILE *stream) chunk = ChunkOfTree(node); if (!TESTT(Chunk, chunk)) return ResFAIL; - return WriteF(stream, "[$P,$P)", (WriteFP)chunk->base, + return WriteF(stream, 0, "[$P,$P)", (WriteFP)chunk->base, (WriteFP)chunk->limit, NULL); } diff --git a/mps/code/tract.h b/mps/code/tract.h index 305b41bd7a1..0d6b5d87535 100644 --- a/mps/code/tract.h +++ b/mps/code/tract.h @@ -210,7 +210,8 @@ extern Index IndexOfAddr(Chunk chunk, Addr addr); Chunk _ch = NULL; \ \ UNUSED(_ch); \ - AVER(ChunkOfAddr(&_ch, arena, rangeBase) && (rangeLimit) <= _ch->limit); \ + AVER(ChunkOfAddr(&_ch, arena, rangeBase)); \ + AVER((rangeLimit) <= _ch->limit); \ END diff --git a/mps/design/buffer.txt b/mps/design/buffer.txt index 391e86b7c62..6f5f49ac3db 100644 --- a/mps/design/buffer.txt +++ b/mps/design/buffer.txt @@ -243,10 +243,10 @@ setter method which sets the rank set of a buffer. It is called from ``BufferSetRankSet()``. Clients should not need to define their own methods for this. -``typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream)`` +``typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count depth)`` _`.class.method.describe`: ``describe()`` is a class-specific method -called to describe a buffer, via BufferDescribe. Client-defined +called to describe a buffer, via ``BufferDescribe()``. Client-defined methods must call their superclass method (via a next-method call) before describing any class-specific state. diff --git a/mps/design/diag.txt b/mps/design/diag.txt index 68fe1301d4b..0c9ee32c52b 100644 --- a/mps/design/diag.txt +++ b/mps/design/diag.txt @@ -77,21 +77,23 @@ There are two mechanism for getting diagnostic output: (gdb) frame 12 #12 0x000000010000b1fc in MVTFree (pool=0x103ffe160, base=0x101dfd000, size=5024) at poolmv2.c:711 711 Res res = CBSInsert(MVTCBS(mvt), base, limit); - (gdb) p MVTDescribe(mvt, mps_lib_get_stdout()) - MVT 0000000103FFE160 - { - minSize: 8 - meanSize: 42 - maxSize: 8192 - fragLimit: 30 - reuseSize: 16384 - fillSize: 8192 - availLimit: 1110835 - abqOverflow: FALSE - splinter: TRUE - splinterSeg: 0000000103FEE780 - splinterBase: 0000000101D7ABB8 - splinterLimit: 0000000101D7B000 + (gdb) p MVTDescribe(mvt, mps_lib_get_stdout(), 0) + MVT 0000000103FFE160 { + minSize: 8 + meanSize: 42 + maxSize: 8192 + fragLimit: 30 + reuseSize: 16384 + fillSize: 8192 + availLimit: 90931 + abqOverflow: FALSE + splinter: TRUE + splinterBase: 0000000106192FF0 + splinterLimit: 0000000106193000 + size: 303104 + allocated: 262928 + available: 40176 + unavailable: 0 # ... etc ... } diff --git a/mps/design/poolawl.txt b/mps/design/poolawl.txt index 790956b28f9..fe7f0c999d4 100644 --- a/mps/design/poolawl.txt +++ b/mps/design/poolawl.txt @@ -451,7 +451,7 @@ objects. Now reclaim doesn't need to check that the objects are allocated before skipping them. There may be a corresponding change for scan as well. -``Res AWLDescribe(Pool pool, mps_lib_FILE *stream)`` +``Res AWLDescribe(Pool pool, mps_lib_FILE *stream, Count depth)`` _`.fun.describe`: diff --git a/mps/design/poolmrg.txt b/mps/design/poolmrg.txt index 26e401ff9a6..cb31274915f 100644 --- a/mps/design/poolmrg.txt +++ b/mps/design/poolmrg.txt @@ -471,11 +471,12 @@ required. See analysis.mps.poolmrg.improve.scan.nomove for a suggested improvement that avoids redundant unlinking and relinking. -``Res MRGDescribe(Pool pool, mps_lib_FILE *stream)`` +``Res MRGDescribe(Pool pool, mps_lib_FILE *stream, Count depth)`` _`.describe`: Describes an MRG pool. Iterates along each of the entry and exit lists and prints the guardians in each. The location of the guardian and the value of the reference in it will be printed out. +Provided for debugging only. _`.functions.unused`: All of these will be unused: ``BufferInit()``, ``BufferFill()``, ``BufferEmpty()``, ``BufferFinish()``, diff --git a/mps/design/poolmvff.txt b/mps/design/poolmvff.txt index c842fe03a6c..d29efc6ba89 100644 --- a/mps/design/poolmvff.txt +++ b/mps/design/poolmvff.txt @@ -40,85 +40,24 @@ allocation can be used at the same time, but in that case, the first ap must be created before any allocations. _`.over.buffer.class`: The pool uses the simplest buffer class, -BufferClass. This is appropriate since these buffers don't attach to -segments, and hence don't constrain buffered regions to lie within +``BufferClass``. This is appropriate since these buffers don't attach +to segments, and hence don't constrain buffered regions to lie within segment boundaries. -_`.over.segments`: The pool uses the simplest segment class -(SegClass). There's no need for anything more complex. - Methods ------- -_`.method`: The MVFF pool supports the following methods: - -``Res MVFFInit(Pool pool, Args arg)`` - -_`.method.init`: This takes six `keyword arguments`_: - -.. _`keyword arguments`: keyword-arguments - -================================== ============================================ -Keyword argument Description -================================== ============================================ -``MPS_KEY_EXTEND_BY`` The segment size. -``MPS_KEY_MEAN_SIZE`` The average object size. -``MPS_KEY_ALIGN`` The alignment of allocations and frees. - Must be at least ``sizeof(void *)``. -``MPS_KEY_MVFF_SLOT_HIGH`` Whether to allocate objects at the end of - free blocks found, as opposed to at - the start (for unbuffered - allocation). -``MPS_KEY_MVFF_ARENA_HIGH`` Whether to express ``SegPrefHIGH`` - to the arena, as opposed to - ``SegPrefLOW``. -``MPS_KEY_MVFF_FIRST_FIT`` whether to use the suitable block of lowest - address, as opposed to the highest - (for unbuffered allocation) -================================== ============================================ - -_`.method.init.epdl`: To simulate the EPDL pool, specify ``extendBy``, -``avgSize``, and ``maxSize`` as normal, and use ``slotHigh=FALSE``, -``arenaHigh=FALSE``, ``firstFit=TRUE``. - -_`.method.init.epdr`: To simulate the EPDR pool, specify ``extendBy``, -``avgSize``, and ``maxSize`` as normal, and use ``slotHigh=TRUE``, -``arenaHigh=TRUE``, ``firstFit=TRUE``. - -_`.method.init.other`: The performance characteristics of other -combinations are unknown. - -_`.method.finish`: The ``PoolFinish()`` method, - -_`.method.alloc`: ``PoolAlloc()`` and ``PoolFree()`` methods are -supported, implementing the policy set by the pool params (see -`.method.init`_). - -_`.method.describe`: The usual describe method. - _`.method.buffer`: The buffer methods implement a worst-fit fill strategy. -External Functions ------------------- - -_`.function`: MVFF supports the following external functions: - -_`.function.free-size`: ``mps_mvff_free_size()`` returns the total -size of free space in segments allocated to the MVFF pool instance. - -_`.function.size`: ``mps_mvff_size()`` returns the total memory used -by pool segments, whether free or allocated. - -_`.function.class`: ``mps_class_mvff()`` returns the class object for -the pool class, to be used in pool creation. - - Implementation -------------- +_`.impl.alloc_list`: The pool stores the address ranges that it has +acquired from the arena in a CBS (see design.mps.cbs_). + _`.impl.free-list`: The pool stores its free list in a CBS (see design.mps.cbs_), failing over in emergencies to a Freelist (see design.mps.freelist_) when the CBS cannot allocate new control @@ -131,13 +70,14 @@ structures. This is the reason for the alignment restriction above. Details ------- -_`.design.seg-size`: When adding a segment, we use extendBy as the -segment size unless the object won't fit, in which case we use the -object size (in both cases we align up). +_`.design.acquire-size`: When acquiring memory from the arena, we use +``extendBy`` as the unit of allocation unless the object won't fit, in +which case we use the object size (in both cases we align up to the +arena alignment). -_`.design.seg-fail`: If allocating a segment fails, we try again with -a segment size just large enough for the object we're allocating. This -is in response to request.mps.170186_. +_`.design.acquire-fail`: If allocating ``extendBy``, we try again with +an aligned size just large enough for the object we're allocating. +This is in response to request.mps.170186_. .. _request.mps.170186: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/mps/170186 @@ -162,6 +102,12 @@ Document History - 2013-06-04 GDR_ The CBS module no longer maintains its own emergency list, so MVFF handles the fail-over from its CBS to a Freelist. +- 2014-04-15 GDR_ The address ranges acquired from the arena are now + stored in a CBS; segments are no longer used for this purpose. + +- 2014-06-12 GDR_ Remove public interface documentation (this is in + the reference manual). + .. _RB: http://www.ravenbrook.com/consultants/rb/ .. _GDR: http://www.ravenbrook.com/consultants/gdr/ diff --git a/mps/design/splay.txt b/mps/design/splay.txt index fefb40fe8a9..05554152ff9 100644 --- a/mps/design/splay.txt +++ b/mps/design/splay.txt @@ -190,7 +190,7 @@ _`.type.tree.describe.method`: A function of type ``TreeDescribeMethod`` is required to write (via ``WriteF()``) a client-oriented representation of the splay node. The output should be non-empty, short, and without newline characters. This is provided for -debugging purposes only. +debugging only. Functions @@ -340,12 +340,13 @@ _`.function.splay.tree.next`: If the tree contains a right neighbour for ``key``, splay the tree at that node and return it. Otherwise return ``TreeEMPTY``. See `.req.iterate`_. -``Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, TreeDescribeMethod nodeDescribe)`` +``Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, Count depth, TreeDescribeMethod nodeDescribe)`` -_`.function.splay.tree.describe`: Print (using ``WriteF``) a textual -representation of the given splay tree to the stream, using -``nodeDescribe`` to print client-oriented representations of the nodes -(see `.req.debug`_). +_`.function.splay.tree.describe`: This function prints (using +``WriteF()``) to the stream a textual representation of the given +splay tree, using ``nodeDescribe`` to print client-oriented +representations of the nodes (see `.req.debug`_). Provided for +debugging only. ``Bool SplayFindFirst(Tree *nodeReturn, SplayTree splay, SplayTestNodeMethod testNode, SplayTestTreeMethod testTree, void *closureP, Size closureS)`` @@ -386,19 +387,19 @@ _`.prop`: To support `.req.property.find`_, this splay tree implementation provides additional features to permit clients to cache maximum (or minimum) values of client properties for all the nodes in a subtree. The splay tree implementation uses the cached values as -part of ``SplayFindFirst`` and ``SplayFindLast`` via the ``testNode`` -and ``testTree`` methods. The client is free to choose how to -represent the client property, and how to compute and store the cached -value. +part of ``SplayFindFirst()`` and ``SplayFindLast()`` via the +``testNode`` and ``testTree`` methods. The client is free to choose +how to represent the client property, and how to compute and store the +cached value. _`.prop.update`: The cached values depend upon the topology of the tree, which may vary as a result of operations on the tree. The client is given the opportunity to compute new cache values whenever necessary, via the ``updateNode`` method (see `.function.splay.tree.init`_). This happens whenever the tree is -restructured. The client may use the ``SplayNodeRefresh`` method to +restructured. The client may use the ``SplayNodeRefresh()`` method to indicate that the client attributes at a node have changed (see -`.req.property.change`_). A call to ``SplayNodeRefresh`` splays the +`.req.property.change`_). A call to ``SplayNodeRefresh()`` splays the tree at the specified node, which may provoke calls to the ``updateNode`` method as a result of the tree restructuring. The ``updateNode`` method will also be called whenever a new splay node is diff --git a/mps/design/telemetry.txt b/mps/design/telemetry.txt index 2bc359ed352..dc8b2619f65 100644 --- a/mps/design/telemetry.txt +++ b/mps/design/telemetry.txt @@ -409,7 +409,7 @@ _`.debug.dump`: The contents of all buffers can be dumped with the _`.debug.describe`: Individual events can be described with the EventDescribe function, for example:: - gdb> print EventDescribe(EventLast[3], mps_lib_get_stdout()) + gdb> print EventDescribe(EventLast[3], mps_lib_get_stdout(), 0) _`.debug.core`: The event buffers are preserved in core dumps and can be used to work out what the MPS was doing before a crash. Since the diff --git a/mps/design/writef.txt b/mps/design/writef.txt index 9e5558b675a..bfb2a131e26 100644 --- a/mps/design/writef.txt +++ b/mps/design/writef.txt @@ -34,37 +34,52 @@ depends on ``fputc()`` and ``fputs()``, via the Library Interface freestanding environment. This is achieved by implementing our own internal output routines in mpm.c. -Our output requirements are few, so the code is short. The only output -function which should be used in the rest of the MPM is ``WriteF()``, -which is similar to ``fprintf()``: +_`.writef`: Our output requirements are few, so the code is short. The +only output function which should be used in the rest of the MPM is +``WriteF()``. -``Res WriteF(mps_lib_FILE *stream, ...)`` +``Res WriteF(mps_lib_FILE *stream, Count depth, ...)`` + +If ``depth`` is greater than zero, then the first format character, +and each format character after a newline, is preceded by ``depth`` +spaces. ``WriteF()`` expects a format string followed by zero or more items to insert into the output, followed by another format string, more items, and so on, and finally a ``NULL`` format string. For example:: - WriteF(stream, - "Hello: $A\n", address, - "Spong: $U ($S)\n", number, string, - NULL); + res = WriteF(stream, depth, + "Hello: $A\n", address, + "Spong: $U ($S)\n", number, string, + NULL); + if (res != ResOK) return res; -This makes ``Describe()`` methods much easier to write. For example, ``BufferDescribe()`` might contain the following code:: +This makes ``Describe()`` methods much easier to write. For example, ``BufferDescribe()`` contains the following code:: - WriteF(stream, - "Buffer $P ($U) {\n", (WriteFP)buffer, (WriteFU)buffer->serial, - " base $A init $A alloc $A limit $A\n", - (WriteFA)buffer->base, (WriteFA)buffer->ap.init, - (WriteFA)buffer->ap.alloc, (WriteFA)buffer->ap.limit, - " Pool $P\n", (WriteFP)buffer->pool, - " Seg $P\n", (WriteFP)buffer->seg, - " rank $U\n", (WriteFU)buffer->rank, - " alignment $W\n", (WriteFW)buffer->alignment, - " grey $B\n", (WriteFB)buffer->grey, - " shieldMode $B\n", (WriteFB)buffer->shieldMode, - " p $P i $U\n", (WriteFP)buffer->p, (WriteFU)buffer->i, - "} Buffer $P ($U)\n", (WriteFP)buffer, (WriteFU)buffer->serial, - NULL); + res = WriteF(stream, depth, + "Buffer $P ($U) {\n", + (WriteFP)buffer, (WriteFU)buffer->serial, + " class $P (\"$S\")\n", + (WriteFP)buffer->class, buffer->class->name, + " Arena $P\n", (WriteFP)buffer->arena, + " Pool $P\n", (WriteFP)buffer->pool, + " ", buffer->isMutator ? "Mutator" : "Internal", " Buffer\n", + " mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n", + (WriteFC)((buffer->mode & BufferModeTRANSITION) ? 't' : '_'), + (WriteFC)((buffer->mode & BufferModeLOGGED) ? 'l' : '_'), + (WriteFC)((buffer->mode & BufferModeFLIPPED) ? 'f' : '_'), + (WriteFC)((buffer->mode & BufferModeATTACHED) ? 'a' : '_'), + " fillSize $UKb\n", (WriteFU)(buffer->fillSize / 1024), + " emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024), + " alignment $W\n", (WriteFW)buffer->alignment, + " base $A\n", buffer->base, + " initAtFlip $A\n", buffer->initAtFlip, + " init $A\n", buffer->ap_s.init, + " alloc $A\n", buffer->ap_s.alloc, + " limit $A\n", buffer->ap_s.limit, + " poolLimit $A\n", buffer->poolLimit, + NULL); + if (res != ResOK) return res; _`.types`: For each format ``$X`` that ``WriteF()`` supports, there is a type defined in impl.h.mpmtypes ``WriteFX()`` which is the promoted @@ -79,7 +94,7 @@ used in future in some generalisation of varargs in the MPS. _`.formats`: The formats supported are as follows. ======= =========== ================== ====================================== -Code Bame Type Example rendering +Code Name Type Example rendering ======= =========== ================== ====================================== ``$A`` address ``Addr`` ``000000019EF60010`` ``$P`` pointer ``void *`` ``000000019EF60100`` @@ -97,8 +112,8 @@ promotion of a ``char`` (see `.types`_). _`.snazzy`: We should resist the temptation to make ``WriteF()`` an incredible snazzy output engine. We only need it for ``Describe()`` -methods and assertion messages. At the moment it's a very simple bit -of code -- let's keep it that way. +methods. At the moment it's a simple bit of code -- let's keep it that +way. _`.f`: The ``F`` code is used for function pointers. ISO C forbids casting function pointers to other types, so the bytes of their representation are @@ -115,6 +130,8 @@ Document History - 2013-05-22 GDR_ Converted to reStructuredText. +- 2014-04-17 GDR_ ``WriteF()`` now takes a ``depth`` parameter. + .. _RB: http://www.ravenbrook.com/consultants/rb/ .. _GDR: http://www.ravenbrook.com/consultants/gdr/ diff --git a/mps/manual/source/pool/mvff.rst b/mps/manual/source/pool/mvff.rst index 208bd5f2686..bf878156771 100644 --- a/mps/manual/source/pool/mvff.rst +++ b/mps/manual/source/pool/mvff.rst @@ -132,6 +132,12 @@ MVFF interface alignment. The minimum alignment supported by pools of this class is ``sizeof(void *)``. + * :c:macro:`MPS_KEY_SPARE` (type :c:type:`double`, default 0.75) + is the maximum proportion of memory that the pool will keep + spare for future allocations. If the proportion of memory that's + free exceeds this, then the pool will return some of it to the + arena for use by other pools. + * :c:macro:`MPS_KEY_MVFF_ARENA_HIGH` (type :c:type:`mps_bool_t`, default false) determines whether new segments are acquired at high addresses (if true), or at low addresses (if false). diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst index fba274d4a55..a866fb566f4 100644 --- a/mps/manual/source/release.rst +++ b/mps/manual/source/release.rst @@ -39,6 +39,9 @@ New features was considered, and a chain was collected up to, but not including, the lowest generation whose new size was within its capacity.) +#. New pool introspection functions :c:func:`mps_pool_total_size` and + :c:func:`mps_pool_free_size`. + Interface changes ................. @@ -57,6 +60,10 @@ Interface changes in a :ref:`pool-mv` pool, by passing the :c:macro:`MPS_KEY_ALIGN` keyword argument to :c:func:`mps_pool_create_k`. +#. The :ref:`pool-mvff` pool class takes a new keyword argument + :c:macro:`MPS_KEY_SPARE`. This specifies the maximum proportion of + memory that the pool will keep spare for future allocations. + #. The alignment requirements for :ref:`pool-mvff` and :ref:`pool-mvt` pools have been relaxed on the platforms ``w3i3mv`` and ``w3i6mv``. On all platforms it is now possible to specify alignments down to @@ -123,6 +130,10 @@ Other changes .. _job003773: https://www.ravenbrook.com/project/mps/issue/job003773/ +#. The :ref:`pool-mvt` and :ref:`pool-mvff` pool classes are now + around 25% faster (in our benchmarks) than they were in release + 1.113.0. + .. _release-notes-1.113: diff --git a/mps/manual/source/topic/keyword.rst b/mps/manual/source/topic/keyword.rst index a97201b4fd9..936aedc0394 100644 --- a/mps/manual/source/topic/keyword.rst +++ b/mps/manual/source/topic/keyword.rst @@ -115,6 +115,7 @@ now :c:macro:`MPS_KEY_ARGS_END`. :c:macro:`MPS_KEY_MVT_RESERVE_DEPTH` :c:type:`mps_count_t` ``count`` :c:func:`mps_class_mvt` :c:macro:`MPS_KEY_POOL_DEBUG_OPTIONS` ``mps_pool_debug_options_s *`` ``pool_debug_options`` :c:func:`mps_class_ams_debug`, :c:func:`mps_class_mv_debug`, :c:func:`mps_class_mvff_debug` :c:macro:`MPS_KEY_RANK` :c:type:`mps_rank_t` ``rank`` :c:func:`mps_class_ams`, :c:func:`mps_class_awl`, :c:func:`mps_class_snc` + :c:macro:`MPS_KEY_SPARE` :c:type:`double` ``d`` :c:func:`mps_class_mvff` :c:macro:`MPS_KEY_VMW3_TOP_DOWN` :c:type:`mps_bool_t` ``b`` :c:func:`mps_arena_class_vm` ======================================== ====================================================== ========================================================== diff --git a/mps/manual/source/topic/pool.rst b/mps/manual/source/topic/pool.rst index 5fe096f9aeb..0ba60e8c1ce 100644 --- a/mps/manual/source/topic/pool.rst +++ b/mps/manual/source/topic/pool.rst @@ -135,6 +135,31 @@ See the :ref:`pool` for a list of pool classes. Pool introspection ------------------ +.. c:function:: size_t mps_pool_total_size(mps_pool_t pool) + + Return the total memory allocated from the arena and managed by + the pool. + + ``pool`` is the pool. + + The result includes memory in use by the client program, memory + that's available for use by the client program, and memory + that's lost to fragmentation. It does not include memory used by + the pool's internal control structures. + + +.. c:function:: size_t mps_pool_free_size(mps_pool_t pool) + + Return the free memory: memory managed by the pool but not in use + by the client program. + + ``pool`` is the pool. + + The result includes memory that's available for use by the client + program, and memory that's lost to fragmentation. It does not + include memory used by the pool's internal control structures. + + .. c:function:: mps_bool_t mps_addr_pool(mps_pool_t *pool_o, mps_arena_t arena, mps_addr_t addr) Determine the :term:`pool` to which an address belongs.