Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-23 21:37:34 +00:00
Code Issues Projects Releases Packages Wiki Activity

Catch-up merge from master sources @186540 to branch/2014-05-17/chunk-tree.

Browse source 
Copied from Perforce
 Change: 186546
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Gareth Rees 2014-06-12 17:55:16 +01:00
commit 08f341fcc9
91 changed files with 1854 additions and 1389 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
mps/code/abq.c
View file

@ -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;

4
mps/code/abq.h
View file

@ -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);

8
mps/code/amcss.c
View file

@ -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);

3
mps/code/amsss.c
View file

@ -16,6 +16,7 @@
#include "mpsavm.h"
#include "mpstd.h"
#include "mps.h"
#include "mpm.h"
#include <stdio.h> /* 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) {

39
mps/code/apss.c
View file

@ -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; i<testSetSIZE; ++i) {
@ -97,7 +115,9 @@ 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;
}
check_allocated_size(pool, ap, allocated);
}
allocFail:
@ -145,8 +165,8 @@ static void testInArena(mps_arena_t arena, mps_pool_debug_option_s *options)
MPS_ARGS_ADD(args, MPS_KEY_MVFF_ARENA_HIGH, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_SLOT_HIGH, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, TRUE);
die(stress(arena, align, randomSizeAligned, "MVFF", mps_class_mvff(), args),
"stress MVFF");
die(stress(arena, NULL, align, randomSizeAligned, "MVFF",
mps_class_mvff(), args), "stress MVFF");
} MPS_ARGS_END(args);
/* IWBN to test MVFFDebug, but the MPS doesn't support debugging APs, */
@ -155,24 +175,23 @@ static void testInArena(mps_arena_t arena, mps_pool_debug_option_s *options)
MPS_ARGS_BEGIN(args) {
mps_align_t align = (mps_align_t)1 << (rnd() % 6);
MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
die(stress(arena, align, randomSizeAligned, "MV", mps_class_mv(), args),
"stress MV");
die(stress(arena, NULL, align, randomSizeAligned, "MV",
mps_class_mv(), args), "stress MV");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
mps_align_t align = (mps_align_t)1 << (rnd() % 6);
MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, options);
die(stress(arena, align, randomSizeAligned, "MV debug",
mps_class_mv_debug(), args),
"stress MV debug");
die(stress(arena, options, align, randomSizeAligned, "MV debug",
mps_class_mv_debug(), args), "stress MV debug");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
mps_align_t align = sizeof(void *) << (rnd() % 4);
MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
die(stress(arena, align, randomSizeAligned, "MVT", mps_class_mvt(), args),
"stress MVT");
die(stress(arena, NULL, align, randomSizeAligned, "MVT",
mps_class_mvt(), args), "stress MVT");
} MPS_ARGS_END(args);
}

79
mps/code/arena.c
View file

@ -17,9 +17,9 @@
SRCID(arena, "$Id$");
#define ArenaControlPool(arena) MV2Pool(&(arena)->controlPoolStruct)
#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;
}

5
mps/code/arenacv.c
View file

@ -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);
}

4
mps/code/arenavm.c
View file

@ -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)

38
mps/code/buffer.c
View file

@ -146,31 +146,26 @@ Bool BufferCheck(Buffer buffer)
*
* See <code/mpmst.h> 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;

59
mps/code/cbs.c
View file

@ -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 <design/type/#addr.use>.
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 <design/land/#function.describe>.
*/
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;
}

1
mps/code/cbs.h
View file

@ -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);

4
mps/code/chain.h
View file

@ -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 */

16
mps/code/clock.h
View file

@ -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

1
mps/code/config.h
View file

@ -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 <code/poolmv2.c> */

27
mps/code/event.c
View file

@ -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, " <unknown code $U>", event->any.code, NULL);
res = WriteF(stream, 0, " <unknown code $U>", 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;
}

2
mps/code/event.h
View file

@ -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);

4
mps/code/failover.c
View file

@ -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,

2
mps/code/failover.h
View file

@ -13,6 +13,8 @@
typedef struct FailoverStruct *Failover;
#define FailoverLand(fo) (&(fo)->landStruct)
extern Bool FailoverCheck(Failover failover);
extern LandClass FailoverLandClassGet(void);

10
mps/code/fbmtest.c
View file

@ -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);
}
}

13
mps/code/finalcv.c
View file

@ -18,14 +18,15 @@
* This code was created by first copying <code/weakcv.c>
*/
#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 <stdio.h> /* 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());
/* <design/poolmrg/#test.promise.ut.churn> */

17
mps/code/finaltest.c
View file

@ -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);

4
mps/code/format.c
View file

@ -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,

18
mps/code/freelist.c
View file

@ -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 <design/freelist/#impl.grain.align> */
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;
}

2
mps/code/freelist.h
View file

@ -13,6 +13,8 @@
typedef struct FreelistStruct *Freelist;
#define FreelistLand(fl) (&(fl)->landStruct)
extern Bool FreelistCheck(Freelist freelist);
/* See <design/freelist/#impl.grain.align> */

90
mps/code/global.c
View file

@ -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;
}

11
mps/code/land.c
View file

@ -371,14 +371,14 @@ Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn,
* See <design/land/#function.describe>
*/
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;
}

10
mps/code/landtest.c
View file

@ -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;

85
mps/code/locus.c
View file

@ -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)

12
mps/code/meter.c
View file

@ -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);
}

8
mps/code/meter.h
View file

@ -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

11
mps/code/misc.h
View file

@ -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

24
mps/code/mpm.c
View file

@ -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++) {

36
mps/code/mpm.h
View file

@ -156,9 +156,9 @@ extern Bool (WordIsP2)(Word word);
/* Formatted Output -- see <design/writef/>, <code/mpm.c> */
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 <design/interface-c/#thread-safety>. */
#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 <code/buffer.c> */
@ -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 <code/ref.c> */
@ -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);

53
mps/code/mpmss.c
View file

@ -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 <stdio.h> /* 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<testSetSIZE; ++i) {
ss[i] = (*size)(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;
}
check_allocated_size(pool, allocated);
}
die(PoolDescribe(pool, mps_lib_get_stdout(), 0), "PoolDescribe");
mps_pool_destroy(pool);
return MPS_RES_OK;
@ -150,8 +171,8 @@ static void testInArena(mps_arena_class_t arena_class, mps_arg_s *arena_args,
MPS_ARGS_ADD(args, MPS_KEY_MVFF_ARENA_HIGH, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_SLOT_HIGH, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, TRUE);
die(stress(arena, randomSize8, "MVFF", mps_class_mvff(), args),
"stress MVFF");
die(stress(arena, NULL, randomSize8, align, "MVFF",
mps_class_mvff(), args), "stress MVFF");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
@ -161,31 +182,31 @@ static void testInArena(mps_arena_class_t arena_class, mps_arg_s *arena_args,
MPS_ARGS_ADD(args, MPS_KEY_MVFF_SLOT_HIGH, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, options);
die(stress(arena, randomSize8, "MVFF debug", mps_class_mvff_debug(), args),
"stress MVFF debug");
die(stress(arena, options, randomSize8, align, "MVFF debug",
mps_class_mvff_debug(), args), "stress MVFF debug");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
mps_align_t align = (mps_align_t)1 << (rnd() % 6);
MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
die(stress(arena, randomSize, "MV", mps_class_mv(), args),
"stress MV");
die(stress(arena, NULL, randomSize, align, "MV",
mps_class_mv(), args), "stress MV");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
mps_align_t align = (mps_align_t)1 << (rnd() % 6);
MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, options);
die(stress(arena, randomSize, "MV debug", mps_class_mv_debug(), args),
"stress MV debug");
die(stress(arena, options, randomSize, align, "MV debug",
mps_class_mv_debug(), args), "stress MV debug");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
fixedSizeSize = 1 + rnd() % 64;
MPS_ARGS_ADD(args, MPS_KEY_MFS_UNIT_SIZE, fixedSizeSize);
MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, 100000);
die(stress(arena, fixedSize, "MFS", mps_class_mfs(), args),
"stress MFS");
die(stress(arena, NULL, fixedSize, MPS_PF_ALIGN, "MFS",
mps_class_mfs(), args), "stress MFS");
} MPS_ARGS_END(args);
mps_arena_destroy(arena);

6
mps/code/mpmst.h
View file

@ -81,6 +81,8 @@ typedef struct mps_class_s {
PoolBufferClassMethod bufferClass; /* default BufferClass of pool */
PoolDescribeMethod describe; /* describe the contents of the pool */
PoolDebugMixinMethod debugMixin; /* find the debug mixin, if any */
PoolSizeMethod totalSize; /* total memory allocated from arena */
PoolSizeMethod freeSize; /* free memory (unused by client program) */
Bool labelled; /* whether it has been EventLabelled */
Sig sig; /* .class.end-sig */
} PoolClassStruct;
@ -136,6 +138,8 @@ typedef struct MFSStruct { /* MFS outer structure */
Bool extendSelf; /* whether to allocate tracts */
Size unitSize; /* rounded for management purposes */
struct MFSHeaderStruct *freeList; /* head of the free list */
Size total; /* total size allocated from arena */
Size free; /* free space in pool */
Tract tractList; /* the first tract */
Sig sig; /* <design/sig/> */
} 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; /* <design/poolmv/#lost> */
RingStruct spans; /* span chain */
Sig sig; /* <design/sig/> */

11
mps/code/mpmtypes.h
View file

@ -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 <design/class-interface/> */
@ -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 */

11
mps/code/mps.h
View file

@ -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 <code/chain.h#gen-param>. */
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);

5
mps/code/mpscmv.h
View file

@ -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);

17
mps/code/mpscmv2.h
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

5
mps/code/mpscmvff.h
View file

@ -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);

22
mps/code/mpscmvt.h
View file

@ -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 */

34
mps/code/mpsi.c
View file

@ -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)
{

14
mps/code/mv2test.c
View file

@ -4,18 +4,19 @@
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*/
#include <stdio.h>
#include <math.h>
#include <stdarg.h>
#include <stdio.h>
#include <time.h>
#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 <math.h>
/* expdev() -- exponentially distributed random deviates
*
* From <http://cfatab.harvard.edu/nr/bookcpdf/c7-2.pdf>
@ -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');

29
mps/code/nailboard.c
View file

@ -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;

2
mps/code/nailboard.h
View file

@ -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 */

2
mps/code/nailboardtest.c
View file

@ -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)

53
mps/code/pool.c
View file

@ -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;

16
mps/code/poolabs.c
View file

@ -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 <http://www.ravenbrook.com/>.

166
mps/code/poolamc.c
View file

@ -48,7 +48,7 @@ typedef struct amcGenStruct {
Sig sig; /* <code/misc.h#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 <design/poolamc/#seg-describe>.
*/
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 { /* <design/poolamc/#struct> */
Sig sig; /* <design/pool/#outer-structure.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 <design/poolamc/#describe>.
*/
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));

139
mps/code/poolams.c
View file

@ -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 { /* <design/poolams/#scan.iter> */
amsseg->marksChanged = FALSE; /* <design/poolams/#marked.scan> */
/* <design/poolams/#ambiguous.middle> */
@ -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);

4
mps/code/poolams.h
View file

@ -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 */

71
mps/code/poolawl.c
View file

@ -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. */

36
mps/code/poollo.c
View file

@ -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;
}

70
mps/code/poolmfs.c
View file

@ -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;
}

4
mps/code/poolmfs.h
View file

@ -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)

55
mps/code/poolmrg.c
View file

@ -119,8 +119,8 @@ typedef struct MRGStruct {
Sig sig; /* <code/mps.h#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);
/* <design/poolmrg/#free.overwrite> */
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 */

229
mps/code/poolmv.c
View file

@ -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);

2
mps/code/poolmv.h
View file

@ -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 */

281
mps/code/poolmv2.c
View file

@ -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 <design/poolmvt/#impl.c.free.merge> */
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);
}

630
mps/code/poolmvff.c
View file

@ -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: <design/poolmvff>
*
* 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
* <https://info.ravenbrook.com/mail/2014/05/13/16-38-50/0/>
*/
#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; /* <design/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 */
/* <design/poolmvff/#design.seg-size>). */
/* <design/poolmvff/#design.acquire-size>). */
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 <design/poolmvff/#design.seg-fail> */
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 <design/poolmvff/#over.buffer>.
*/
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 <design/poolmvff/#design.arena-enter> */
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 <design/poolmvff/#design.arena-enter> */
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);
}

7
mps/code/pooln.c
View file

@ -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); /* <code/mpm.c#check.unused> */
return TRUE;

5
mps/code/poolncv.c
View file

@ -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 <stdio.h> /* 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);
}

27
mps/code/poolsnc.c
View file

@ -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);
}

8
mps/code/range.c
View file

@ -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;
}

2
mps/code/range.h
View file

@ -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);

8
mps/code/reserv.c
View file

@ -16,7 +16,7 @@ SRCID(reserv, "$Id$");
/* The reservoir pool is defined here. See <design/reservoir/> */
#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); /* <code/mpm.c#check.unused> */
arena = reservoirArena(reservoir);
CHECKU(Arena, arena);

35
mps/code/root.c
View file

@ -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;

129
mps/code/seg.c
View file

@ -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 <design/seg/#merge>
@ -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;

24
mps/code/segsmss.c
View file

@ -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) {

22
mps/code/splay.c
View file

@ -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 <design/splay/#function.splay.tree.describe>.
*/
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;
}

2
mps/code/splay.h
View file

@ -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);

2
mps/code/th.h
View file

@ -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

4
mps/code/than.c
View file

@ -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,

4
mps/code/thix.c
View file

@ -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,

4
mps/code/thw3.c
View file

@ -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,

4
mps/code/thxc.c
View file

@ -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,

45
mps/code/trace.c
View file

@ -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

2
mps/code/tract.c
View file

@ -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);
}

3
mps/code/tract.h
View file

@ -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

4
mps/design/buffer.txt
View file

@ -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.

32
mps/design/diag.txt
View file

@ -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 ...
}

2
mps/design/poolawl.txt
View file

@ -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`:

3
mps/design/poolmrg.txt
View file

@ -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()``,

90
mps/design/poolmvff.txt
View file

@ -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/

25
mps/design/splay.txt
View file

@ -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

2
mps/design/telemetry.txt
View file

@ -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

69
mps/design/writef.txt
View file

@ -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/

6
mps/manual/source/pool/mvff.rst
View file

@ -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).

11
mps/manual/source/release.rst
View file

@ -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:

1
mps/manual/source/topic/keyword.rst
View file

@ -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`
======================================== ====================================================== ==========================================================

25
mps/manual/source/topic/pool.rst
View file

@ -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.