mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-22 13:40:44 -08:00
Code Issues Projects Releases Wiki Activity

Catch-up merge from master sources @186564 to branch/2014-06-11/grain.

Browse source 
Copied from Perforce
 Change: 186572
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Gareth Rees 2014-06-13 15:30:46 +01:00
commit a13a1aa1df
109 changed files with 2685 additions and 1997 deletions
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_size = mps_pool_total_size(pool);
size_t free_size = mps_pool_free_size(pool);
size_t ap_free = (size_t)((char *)ap->limit - (char *)ap->init);
Insist(total_size - free_size == 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);
}

164
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)
/* ArenaGrainSizeCheck -- check that size is a valid arena grain size */
@ -45,7 +45,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;
@ -62,7 +62,7 @@ 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,
return WriteF(stream, depth,
" No class-specific description available.\n", NULL);
}
@ -162,8 +162,10 @@ Bool ArenaCheck(Arena arena)
CHECKD(Chunk, arena->primary);
}
CHECKD_NOSIG(Ring, &arena->chunkRing);
/* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
CHECKL(TreeCheck(ArenaChunkTree(arena)));
/* TODO: check that the chunkRing and chunkTree have identical members */
/* nothing to check for chunkSerial */
CHECKD(ChunkCacheEntry, &arena->chunkCache);
CHECKL(LocusCheck(arena));
@ -220,8 +222,8 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
arena->primary = NULL;
RingInit(&arena->chunkRing);
arena->chunkTree = TreeEMPTY;
arena->chunkSerial = (Serial)0;
ChunkCacheEntryInit(&arena->chunkCache);
LocusInit(arena);
@ -321,13 +323,13 @@ Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
/* With the primary chunk initialised we can add page memory to the freeLand
that describes the free address space in the primary chunk. */
arena->hasFreeLand = TRUE;
res = ArenaFreeLandInsert(arena,
PageIndexBase(arena->primary,
arena->primary->allocBase),
arena->primary->limit);
if (res != ResOK)
goto failPrimaryLand;
arena->hasFreeLand = TRUE;
res = ControlInit(arena);
if (res != ResOK)
@ -360,11 +362,13 @@ failInit:
void ArenaFinish(Arena arena)
{
PoolFinish(ArenaCBSBlockPool(arena));
ReservoirFinish(ArenaReservoir(arena));
arena->sig = SigInvalid;
GlobalsFinish(ArenaGlobals(arena));
LocusFinish(arena);
RingFinish(&arena->chunkRing);
AVER(ArenaChunkTree(arena) == TreeEMPTY);
}
@ -405,7 +409,6 @@ void ArenaDestroy(Arena arena)
that would use the freeLand. */
MFSFinishTracts(ArenaCBSBlockPool(arena), arenaMFSPageFreeVisitor,
UNUSED_POINTER, UNUSED_SIZE);
PoolFinish(ArenaCBSBlockPool(arena));
/* Call class-specific finishing. This will call ArenaFinish. */
(*arena->class->finish)(arena);
@ -423,7 +426,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)
@ -439,13 +442,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;
@ -453,14 +456,14 @@ 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,
res = WriteF(stream, depth + 2,
"controlPool $P\n", (WriteFP)&arena->controlPoolStruct,
NULL);
if (res != ResOK) return res;
@ -468,14 +471,14 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
/* Note: this Describe clause calls a function */
reserved = ArenaReserved(arena);
res = WriteF(stream,
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,
res = WriteF(stream, depth + 2,
"committed $W <-- "
"total bytes currently stored (in RAM or swap)\n",
(WriteFW)arena->committed,
@ -487,24 +490,23 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
NULL);
if (res != ResOK) return res;
res = WriteF(stream,
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;
res = WriteF(stream, depth + 2, "} Globals\n", NULL);
if (res != ResOK) return res;
#endif
res = WriteF(stream,
res = WriteF(stream, depth,
"} Arena $P ($U)\n", (WriteFP)arena,
(WriteFU)arena->serial,
NULL);
@ -512,47 +514,68 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
}
/* ArenaDescribeTracts -- describe all the tracts in the arena */
/* arenaDescribeTractsInChunk -- describe the tracts in a chunk */
Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream)
static Res arenaDescribeTractsInChunk(Chunk chunk, mps_lib_FILE *stream, Count depth)
{
Res res;
Tract tract;
Bool b;
Addr oldLimit, base, limit;
Size size;
Index pi;
if (stream == NULL) return ResFAIL;
if (!TESTT(Chunk, chunk)) return ResFAIL;
if (stream == NULL) return ResFAIL;
res = WriteF(stream, depth, "Chunk [$P, $P) ($U) {\n",
(WriteFP)chunk->base, (WriteFP)chunk->limit,
(WriteFU)chunk->serial,
NULL);
if (res != ResOK) return res;
for (pi = chunk->allocBase; pi < chunk->pages; ++pi) {
if (BTGet(chunk->allocTable, pi)) {
Tract tract = PageTract(ChunkPage(chunk, pi));
res = WriteF(stream, depth + 2, "[$P, $P)",
(WriteFP)TractBase(tract),
(WriteFP)TractLimit(tract, ChunkArena(chunk)),
NULL);
if (res != ResOK) return res;
if (TractHasPool(tract)) {
Pool pool = TractPool(tract);
res = WriteF(stream, 0, " $P $U ($S)",
(WriteFP)pool,
(WriteFU)(pool->serial),
(WriteFS)(pool->class->name),
NULL);
if (res != ResOK) return res;
}
res = WriteF(stream, 0, "\n", NULL);
if (res != ResOK) return res;
}
}
res = WriteF(stream, depth, "} Chunk [$P, $P)\n",
(WriteFP)chunk->base, (WriteFP)chunk->limit,
NULL);
return res;
}
/* ArenaDescribeTracts -- describe all the tracts in the arena */
Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth)
{
Ring node, next;
Res res;
if (!TESTT(Arena, arena)) return ResFAIL;
if (stream == NULL) return ResFAIL;
b = TractFirst(&tract, arena);
oldLimit = TractBase(tract);
while (b) {
base = TractBase(tract);
limit = TractLimit(tract);
size = ArenaGrainSize(arena);
if (TractBase(tract) > oldLimit) {
res = WriteF(stream,
"[$P, $P) $W $U ---\n",
(WriteFP)oldLimit, (WriteFP)base,
(WriteFW)AddrOffset(oldLimit, base),
(WriteFU)AddrOffset(oldLimit, base),
NULL);
RING_FOR(node, &arena->chunkRing, next) {
Chunk chunk = RING_ELT(Chunk, chunkRing, node);
res = arenaDescribeTractsInChunk(chunk, stream, depth);
if (res != ResOK) return res;
}
res = WriteF(stream,
"[$P, $P) $W $U $P ($S)\n",
(WriteFP)base, (WriteFP)limit,
(WriteFW)size, (WriteFW)size,
(WriteFP)TractPool(tract),
(WriteFS)(TractPool(tract)->class->name),
NULL);
if (res != ResOK) return res;
b = TractNext(&tract, arena, TractBase(tract));
oldLimit = limit;
}
return ResOK;
}
@ -603,19 +626,38 @@ 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;
}
/* ArenaChunkInsert -- insert chunk into arena's chunk tree */
void ArenaChunkInsert(Arena arena, Chunk chunk) {
Bool inserted;
Tree tree, updatedTree = NULL;
AVERT(Arena, arena);
AVERT(Chunk, chunk);
tree = &chunk->chunkTree;
inserted = TreeInsert(&updatedTree, ArenaChunkTree(arena),
tree, ChunkKey(tree), ChunkCompare);
AVER(inserted && updatedTree);
TreeBalance(&updatedTree);
arena->chunkTree = updatedTree;
RingAppend(&arena->chunkRing, &chunk->chunkRing);
}
/* arenaAllocPage -- allocate one page from the arena
*
* This is a primitive allocator used to allocate pages for the arena
@ -654,6 +696,10 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
{
Res res;
AVER(baseReturn != NULL);
AVERT(Arena, arena);
AVERT(Pool, pool);
/* Favour the primary chunk, because pages allocated this way aren't
currently freed, and we don't want to prevent chunks being destroyed. */
/* TODO: Consider how the ArenaCBSBlockPool might free pages. */
@ -899,7 +945,7 @@ static Res arenaAllocFromLand(Tract *tractReturn, ZoneSet zones, Bool high,
/* Step 2. Make memory available in the address space range. */
b = CHUNK_OF_ADDR(&chunk, arena, RangeBase(&range));
b = ChunkOfAddr(&chunk, arena, RangeBase(&range));
AVER(b);
AVER(RangeIsAligned(&range, ChunkPageSize(chunk)));
baseIndex = INDEX_OF_ADDR(chunk, RangeBase(&range));

26
mps/code/arenacl.c
View file

@ -173,15 +173,26 @@ static Res ClientChunkInit(Chunk chunk, BootBlock boot)
/* clientChunkDestroy -- destroy a ClientChunk */
static void clientChunkDestroy(Chunk chunk)
static Bool clientChunkDestroy(Tree tree, void *closureP, Size closureS)
{
Chunk chunk;
ClientChunk clChunk;
AVERT(Tree, tree);
AVER(closureP == UNUSED_POINTER);
UNUSED(closureP);
AVER(closureS == UNUSED_SIZE);
UNUSED(closureS);
chunk = ChunkOfTree(tree);
AVERT(Chunk, chunk);
clChunk = Chunk2ClientChunk(chunk);
AVERT(ClientChunk, clChunk);
clChunk->sig = SigInvalid;
ChunkFinish(chunk);
return TRUE;
}
@ -290,16 +301,15 @@ failChunkCreate:
static void ClientArenaFinish(Arena arena)
{
ClientArena clientArena;
Ring node, next;
clientArena = Arena2ClientArena(arena);
AVERT(ClientArena, clientArena);
/* destroy all chunks */
RING_FOR(node, &arena->chunkRing, next) {
Chunk chunk = RING_ELT(Chunk, chunkRing, node);
clientChunkDestroy(chunk);
}
/* Destroy all chunks, including the primary. See
* <design/arena/#chunk.delete> */
arena->primary = NULL;
TreeTraverseAndDelete(&arena->chunkTree, clientChunkDestroy,
UNUSED_POINTER, UNUSED_SIZE);
clientArena->sig = SigInvalid;
@ -341,7 +351,7 @@ static Size ClientArenaReserved(Arena arena)
RING_FOR(node, &arena->chunkRing, nextNode) {
Chunk chunk = RING_ELT(Chunk, chunkRing, node);
AVERT(Chunk, chunk);
size += AddrOffset(chunk->base, chunk->limit);
size += ChunkSize(chunk);
}
return size;

76
mps/code/arenacv.c
View file

@ -87,6 +87,73 @@ typedef struct AllocatorClassStruct {
} AllocatorClassStruct;
/* tractSearchInChunk -- find a tract in a chunk
*
* .tract-search: Searches for a tract in the chunk starting at page
* index i, return FALSE if there is none.
*/
static Bool tractSearchInChunk(Tract *tractReturn, Chunk chunk, Index i)
{
AVER_CRITICAL(chunk->allocBase <= i);
AVER_CRITICAL(i <= chunk->pages);
while (i < chunk->pages
&& !(BTGet(chunk->allocTable, i)
&& PageIsAllocated(ChunkPage(chunk, i)))) {
++i;
}
if (i == chunk->pages)
return FALSE;
AVER(i < chunk->pages);
*tractReturn = PageTract(ChunkPage(chunk, i));
return TRUE;
}
/* tractSearch -- find next tract above address
*
* Searches for the next tract in increasing address order.
* The tract returned is the next one along from addr (i.e.,
* it has a base address bigger than addr and no other tract
* with a base address bigger than addr has a smaller base address).
*
* Returns FALSE if there is no tract to find (end of the arena).
*/
static Bool tractSearch(Tract *tractReturn, Arena arena, Addr addr)
{
Bool b;
Chunk chunk;
Tree tree;
b = ChunkOfAddr(&chunk, arena, addr);
if (b) {
Index i;
i = INDEX_OF_ADDR(chunk, addr);
/* There are fewer pages than addresses, therefore the */
/* page index can never wrap around */
AVER_CRITICAL(i+1 != 0);
if (tractSearchInChunk(tractReturn, chunk, i+1)) {
return TRUE;
}
}
while (TreeFindNext(&tree, ArenaChunkTree(arena), TreeKeyOfAddrVar(addr),
ChunkCompare))
{
chunk = ChunkOfTree(tree);
addr = chunk->base;
/* Start from allocBase to skip the tables. */
if (tractSearchInChunk(tractReturn, chunk, chunk->allocBase)) {
return TRUE;
}
}
return FALSE;
}
/* Implementation of the tract-based interchangability interface */
static Res allocAsTract(AllocInfoStruct *aiReturn, SegPref pref,
@ -114,7 +181,7 @@ static Bool firstAsTract(AllocInfoStruct *aiReturn, Arena arena)
{
Bool res;
Tract tract;
res = TractFirst(&tract, arena);
res = tractSearch(&tract, arena, 0);
if (res) {
aiReturn->the.tractData.base = TractBase(tract);
aiReturn->the.tractData.size = ArenaGrainSize(arena);;
@ -128,7 +195,7 @@ static Bool nextAsTract(AllocInfoStruct *nextReturn, AllocInfo ai,
{
Bool res;
Tract tract;
res = TractNext(&tract, arena, ai->the.tractData.base);
res = tractSearch(&tract, arena, ai->the.tractData.base);
if (res) {
nextReturn->the.tractData.base = TractBase(tract);
nextReturn->the.tractData.size = ArenaGrainSize(arena);;
@ -332,7 +399,6 @@ static void testAllocAndIterate(Arena arena, Pool pool,
}
SegPrefExpress(&pref, SegPrefZoneSet, &zone);
}
}
@ -363,6 +429,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);
}

95
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)
@ -401,11 +401,19 @@ failSaMapped:
/* vmChunkDestroy -- destroy a VMChunk */
static void vmChunkDestroy(Chunk chunk)
static Bool vmChunkDestroy(Tree tree, void *closureP, Size closureS)
{
VM vm;
Chunk chunk;
VMChunk vmChunk;
AVERT(Tree, tree);
AVER(closureP == UNUSED_POINTER);
UNUSED(closureP);
AVER(closureS == UNUSED_SIZE);
UNUSED(closureS);
chunk = ChunkOfTree(tree);
AVERT(Chunk, chunk);
vmChunk = Chunk2VMChunk(chunk);
AVERT(VMChunk, vmChunk);
@ -418,6 +426,8 @@ static void vmChunkDestroy(Chunk chunk)
vm = vmChunk->vm;
ChunkFinish(chunk);
VMDestroy(vm);
return TRUE;
}
@ -557,7 +567,7 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
/* bits in a word). Fail if the chunk is so small stripes are smaller */
/* than pages. Note that some zones are discontiguous in the chunk if */
/* the size is not a power of 2. See <design/arena/#class.fields>. */
chunkSize = AddrOffset(chunk->base, chunk->limit);
chunkSize = ChunkSize(chunk);
arena->zoneShift = SizeFloorLog2(chunkSize >> MPS_WORD_SHIFT);
AVER(chunk->pageSize == ArenaGrainSize(arena));
@ -588,7 +598,6 @@ failVMCreate:
static void VMArenaFinish(Arena arena)
{
VMArena vmArena;
Ring node, next;
VM arenaVM;
vmArena = Arena2VMArena(arena);
@ -597,12 +606,11 @@ static void VMArenaFinish(Arena arena)
EVENT1(ArenaDestroy, vmArena);
/* destroy all chunks, including the primary */
/* Destroy all chunks, including the primary. See
* <design/arena/#chunk.delete> */
arena->primary = NULL;
RING_FOR(node, &arena->chunkRing, next) {
Chunk chunk = RING_ELT(Chunk, chunkRing, node);
vmChunkDestroy(chunk);
}
TreeTraverseAndDelete(&arena->chunkTree, vmChunkDestroy,
UNUSED_POINTER, UNUSED_SIZE);
/* Destroying the chunks should have purged and removed all spare pages. */
RingFinish(&vmArena->spareRing);
@ -623,6 +631,7 @@ static void VMArenaFinish(Arena arena)
*
* Add up the reserved space from all the chunks.
*/
static Size VMArenaReserved(Arena arena)
{
Size reserved;
@ -943,8 +952,6 @@ static Size chunkUnmapAroundPage(Chunk chunk, Size size, Page page)
* unmapped.
*/
#define ArenaChunkRing(arena) (&(arena)->chunkRing)
static Size arenaUnmapSpare(Arena arena, Size size, Chunk filter)
{
Ring node;
@ -996,9 +1003,7 @@ static Size VMPurgeSpare(Arena arena, Size size)
static void chunkUnmapSpare(Chunk chunk)
{
AVERT(Chunk, chunk);
(void)arenaUnmapSpare(ChunkArena(chunk),
AddrOffset(chunk->base, chunk->limit),
chunk);
(void)arenaUnmapSpare(ChunkArena(chunk), ChunkSize(chunk), chunk);
}
@ -1054,8 +1059,9 @@ static void VMFree(Addr base, Size size, Pool pool)
BTResRange(chunk->allocTable, piBase, piLimit);
/* Consider returning memory to the OS. */
/* TODO: Chunks are only destroyed when ArenaCompact is called, and that is
only called from TraceReclaim. Should consider destroying chunks here. */
/* TODO: Chunks are only destroyed when ArenaCompact is called, and
that is only called from traceReclaim. Should consider destroying
chunks here. See job003815. */
if (arena->spareCommitted > arena->spareCommitLimit) {
/* Purge half of the spare memory, not just the extra sliver, so
that we return a reasonable amount of memory in one go, and avoid
@ -1068,10 +1074,41 @@ static void VMFree(Addr base, Size size, Pool pool)
}
/* vmChunkCompact -- delete chunk if empty and not primary */
static Bool vmChunkCompact(Tree tree, void *closureP, Size closureS)
{
Chunk chunk;
Arena arena = closureP;
VMArena vmArena;
AVERT(Tree, tree);
AVERT(Arena, arena);
AVER(closureS == UNUSED_SIZE);
UNUSED(closureS);
vmArena = Arena2VMArena(arena);
AVERT(VMArena, vmArena);
chunk = ChunkOfTree(tree);
AVERT(Chunk, chunk);
if(chunk != arena->primary
&& BTIsResRange(chunk->allocTable, 0, chunk->pages))
{
Addr base = chunk->base;
Size size = ChunkSize(chunk);
vmChunkDestroy(tree, UNUSED_POINTER, UNUSED_SIZE);
vmArena->contracted(arena, base, size);
return TRUE;
} else {
/* Keep this chunk. */
return FALSE;
}
}
static void VMCompact(Arena arena, Trace trace)
{
VMArena vmArena;
Ring node, next;
Size vmem1;
vmArena = Arena2VMArena(arena);
@ -1080,23 +1117,11 @@ static void VMCompact(Arena arena, Trace trace)
vmem1 = VMArenaReserved(arena);
RING_FOR(node, &arena->chunkRing, next) {
Chunk chunk = RING_ELT(Chunk, chunkRing, node);
if(chunk != arena->primary
&& BTIsResRange(chunk->allocTable, 0, chunk->pages)) {
Addr base = chunk->base;
Size size = AddrOffset(chunk->base, chunk->limit);
/* Ensure there are no spare (mapped) pages left in the chunk.
This could be short-cut if we're about to destroy the chunk,
provided we can do the correct accounting in the arena. */
chunkUnmapSpare(chunk);
vmChunkDestroy(chunk);
vmArena->contracted(arena, base, size);
}
}
/* Destroy chunks that are completely free, but not the primary
* chunk. See <design/arena/#chunk.delete>
* TODO: add hysteresis here. See job003815. */
TreeTraverseAndDelete(&arena->chunkTree, vmChunkCompact, arena,
UNUSED_SIZE);
{
Size vmem0 = trace->preTraceArenaReserved;

34
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,10 +1433,10 @@ 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,
res = WriteF(stream, depth,
"Seg $P\n", (WriteFP)segbuf->seg,
"rankSet $U\n", (WriteFU)segbuf->rankSet,
NULL);

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 @@ fail:
* 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,

16
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,13 +748,13 @@ 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,
res = WriteF(stream, depth,
"[$P,", (WriteFP)RangeBase(range),
"$P)", (WriteFP)RangeLimit(range),
" {$U}\n", (WriteFU)RangeSize(range),
@ -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> */

3
mps/code/gcbench.c
View file

@ -245,7 +245,8 @@ static void arena_setup(gcthread_fn_t fn,
} MPS_ARGS_END(args);
watch(fn, name);
mps_arena_park(arena);
printf("%u chunks\n", (unsigned)RingLength(&arena->chunkRing));
printf("%u chunks\n", (unsigned)TreeDebugCount(ArenaChunkTree(arena),
ChunkCompare, ChunkKey));
mps_pool_destroy(pool);
mps_fmt_destroy(format);
if (ngen > 0)

44
mps/code/global.c
View file

@ -1008,18 +1008,20 @@ 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,
res = WriteF(stream, depth,
"mpsVersion $S\n", arenaGlobals->mpsVersionString,
"lock $P\n", (WriteFP)arenaGlobals->lock,
"pollThreshold $U kB\n",
@ -1043,25 +1045,22 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
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,
"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,
res = WriteF(stream, depth,
"} history\n",
"suspended $S\n", arena->suspended ? "YES" : "NO",
"shDepth $U\n", arena->shDepth,
"shCacheI $U\n", arena->shCacheI,
@ -1069,27 +1068,40 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
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)

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

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

9
mps/code/misc.h
View file

@ -157,12 +157,11 @@ 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++) {

40
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, Size grainSize,
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)
@ -519,6 +524,7 @@ extern Ring GlobalsRememberedSummaryRing(Globals);
#define ArenaGrainSize(arena) ((arena)->grainSize)
#define ArenaGreyRing(arena, rank) (&(arena)->greyRing[rank])
#define ArenaPoolRing(arena) (&ArenaGlobals(arena)->poolRing)
#define ArenaChunkTree(arena) RVALUE((arena)->chunkTree)
extern Bool ArenaGrainSizeCheck(Size size);
#define AddrArenaGrainUp(addr, arena) AddrAlignUp(addr, ArenaGrainSize(arena))
@ -558,6 +564,7 @@ extern Res ArenaStartCollect(Globals globals, int why);
extern Res ArenaCollect(Globals globals, int why);
extern Bool ArenaHasAddr(Arena arena, Addr addr);
extern Res ArenaAddrObject(Addr *pReturn, Arena arena, Addr addr);
extern void ArenaChunkInsert(Arena arena, Chunk chunk);
extern void ArenaSetEmergency(Arena arena, Bool emergency);
extern Bool ArenaEmergency(Arena arean);
@ -567,7 +574,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
@ -622,8 +629,6 @@ extern void ArenaCompact(Arena arena, Trace trace);
extern Res ArenaFinalize(Arena arena, Ref obj);
extern Res ArenaDefinalize(Arena arena, Ref obj);
extern Bool ArenaIsReservedAddr(Arena arena, Addr addr);
#define ArenaReservoir(arena) (&(arena)->reservoirStruct)
#define ReservoirPool(reservoir) (&(reservoir)->poolStruct)
@ -667,7 +672,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);
@ -676,7 +680,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);
@ -735,7 +739,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> */
@ -834,7 +838,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> */
@ -981,8 +985,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);
@ -1028,7 +1032,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_size = mps_pool_total_size(pool);
size_t free_size = mps_pool_free_size(pool);
Insist(total_size - free_size == 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);

22
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/> */
@ -515,18 +519,6 @@ typedef struct TraceStruct {
} TraceStruct;
/* ChunkCacheEntryStruct -- cache entry in the chunk cache */
#define ChunkCacheEntrySig ((Sig)0x519C80CE) /* SIGnature CHUnk Cache Entry */
typedef struct ChunkCacheEntryStruct {
Sig sig;
Chunk chunk;
Addr base;
Addr limit;
} ChunkCacheEntryStruct;
/* ArenaClassStruct -- generic arena class interface */
#define ArenaClassSig ((Sig)0x519A6C1A) /* SIGnature ARena CLAss */
@ -740,9 +732,9 @@ typedef struct mps_arena_s {
Addr lastTractBase; /* base address of lastTract */
Chunk primary; /* the primary chunk */
RingStruct chunkRing; /* all the chunks */
RingStruct chunkRing; /* all the chunks, in a ring for iteration */
Tree chunkTree; /* all the chunks, in a tree for fast lookup */
Serial chunkSerial; /* next chunk number */
ChunkCacheEntryStruct chunkCache; /* just one entry */
Bool hasFreeLand; /* Is freeLand available? */
MFSStruct freeCBSBlockPoolStruct;

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

25
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),
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);
if (res != ResOK)
return res;
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)

62
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,10 +560,10 @@ 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,
res = WriteF(stream, depth + 2,
"fillMutatorSize $UKb\n",
(WriteFU)(pool->fillMutatorSize / 1024),
"emptyMutatorSize $UKb\n",
@ -552,16 +575,16 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
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;
@ -622,29 +645,32 @@ Bool PoolOfAddr(Pool *poolReturn, Arena arena, Addr addr)
*/
Bool PoolOfRange(Pool *poolReturn, Arena arena, Addr base, Addr limit)
{
Pool pool;
Bool havePool = FALSE;
Pool pool = NULL;
Tract tract;
Addr addr, alignedBase, alignedLimit;
AVER(poolReturn != NULL);
AVERT(Arena, arena);
AVER(base < limit);
if (!TractOfAddr(&tract, arena, base))
return FALSE;
alignedBase = AddrArenaGrainDown(base, arena);
alignedLimit = AddrArenaGrainUp(limit, arena);
pool = TractPool(tract);
if (!pool)
return FALSE;
while (TractLimit(tract) < limit) {
if (!TractNext(&tract, arena, TractBase(tract)))
return FALSE;
if (TractPool(tract) != pool)
TRACT_FOR(tract, addr, arena, alignedBase, alignedLimit) {
Pool p = TractPool(tract);
if (havePool && pool != p)
return FALSE;
pool = p;
havePool = TRUE;
}
if (havePool) {
*poolReturn = pool;
return TRUE;
} else {
return FALSE;
}
}

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

164
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,
res = WriteF(stream, depth,
"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);
" 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));

133
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 @@ failCreateTablesLo:
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,
res = WriteF(stream, depth,
"alloctable $P\n", (WriteFP)amsseg->allocTable,
NULL);
else
res = WriteF(stream,
res = WriteF(stream, depth,
"firstFree $W\n", (WriteFW)amsseg->firstFree,
NULL);
if (res != ResOK) return res;
res = WriteF(stream,
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;
}

60
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,7 +344,7 @@ static Res MFSDescribe(Pool pool, mps_lib_FILE *stream)
AVER(stream != NULL);
res = WriteF(stream,
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,
@ -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(SizeIsArenaGrains(mfs->extendBy, 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 == ArenaGrainSize(PoolArena(MRG2Pool(mrg))));
CHECKL(mrg->extendBy == ArenaGrainSize(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 */

219
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,11 +743,11 @@ 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,
res = WriteF(stream, depth,
"blockPool $P ($U)\n",
(WriteFP)mvBlockPool(mv), (WriteFU)mvBlockPool(mv)->serial,
"spanPool $P ($U)\n",
@ -710,38 +755,11 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
"extendBy $W\n", (WriteFW)mv->extendBy,
"avgSize $W\n", (WriteFW)mv->avgSize,
"maxSize $W\n", (WriteFW)mv->maxSize,
" space $P\n", (WriteFP)mv->space,
"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 */

251
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 = SizeArenaGrains(minSize, PoolArena(MVT2Pool(mvt)));
alignedSize = SizeArenaGrains(minSize, 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,20 +991,48 @@ 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,
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,
@ -1019,48 +1051,49 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
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);
}

617
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,176 +86,214 @@ 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 grainSize;
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 grainSize =
mvff->extendBy here. */
arena = PoolArena(MVFF2Pool(mvff));
b = SegOfAddr(&seg, arena, RangeBase(range));
AVER(b);
grainSize = ArenaGrainSize(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),
grainSize, FindDeleteNONE))
{
RangeStruct pageRange, oldRange;
Size size;
Res res;
Addr base, limit;
AVER(RangesEqual(&freeRange, &oldFreeRange));
base = AddrAlignUp(RangeBase(&freeRange), grainSize);
limit = AddrAlignDown(RangeLimit(&freeRange), grainSize);
/* 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);
/* Don't return (much) more than we need to. */
if (size > freeSize - targetFree)
size = SizeAlignUp(freeSize - targetFree, grainSize);
/* 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, grainSize));
/* 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;
}
return;
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;
Size allocSize;
RangeStruct range, coalescedRange;
Addr base;
Res res;
RangeStruct range;
AVERT(MVFF, mvff);
AVER(size > 0);
AVERT(Bool, withReservoirPermit);
pool = MVFF2Pool(mvff);
pool = MVFFPool(mvff);
arena = PoolArena(pool);
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 = SizeArenaGrains(segSize, arena);
allocSize = SizeArenaGrains(allocSize, arena);
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 = SizeArenaGrains(size, arena);
res = SegAlloc(&seg, SegClassGet(), mvff->segPref, segSize, pool,
withReservoirPermit, argsNone);
if (res != ResOK) {
allocSize = SizeArenaGrains(size, arena);
res = ArenaAlloc(&base, MVFFSegPref(mvff), allocSize, pool,
withReservoirPermit);
if (res != ResOK)
return res;
}
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;
}
mvff->total += segSize;
RangeInitSize(&range, SegBase(seg), segSize);
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;
}
@ -261,41 +305,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 = MVFFAddSeg(&seg, mvff, size, withReservoirPermit);
res = mvffFindFree(&range, mvff, size, findMethod, findDelete,
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;
}
@ -305,11 +335,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);
@ -317,19 +347,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,
@ -337,29 +365,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);
res = mvffFindFree(&range, mvff, size, LandFindLargest, FindDeleteENTIRE,
withReservoirPermit);
if (res != ResOK)
return res;
found = LandFindLargest(&range, &oldRange, FailoverOfMVFF(mvff), size, FindDeleteENTIRE);
}
AVER(found);
AVER(RangeSize(&range) >= size);
*baseReturn = RangeBase(&range);
@ -375,10 +396,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));
@ -387,12 +408,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);
}
@ -438,10 +456,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);
@ -461,6 +479,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;
@ -473,6 +494,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
@ -483,46 +506,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 < ArenaGrainSize(arena))
mvff->minSegSize = ArenaGrainSize(arena);
else
mvff->minSegSize = extendBy;
mvff->extendBy = ArenaGrainSize(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);
@ -530,50 +567,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));
}
@ -584,46 +628,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;
}
@ -642,6 +720,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);
}
@ -681,57 +761,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 >= ArenaGrainSize(PoolArena(MVFF2Pool(mvff))));
CHECKD(Pool, MVFFPool(mvff));
CHECKL(IsSubclassPoly(MVFFPool(mvff)->class, MVFFPoolClassGet()));
CHECKD(SegPref, MVFFSegPref(mvff));
CHECKL(mvff->extendBy >= ArenaGrainSize(PoolArena(MVFFPool(mvff))));
CHECKL(mvff->avgSize > 0); /* see .arg.check */
CHECKL(mvff->avgSize <= mvff->extendBy); /* see .arg.check */
CHECKL(SizeIsArenaGrains(mvff->total, 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(SizeIsArenaGrains(LandSize(MVFFTotalLand(mvff)), PoolArena(MVFFPool(mvff))));
CHECKL(BoolCheck(mvff->slotHigh));
CHECKL(BoolCheck(mvff->firstFit));
return TRUE;
@ -745,10 +796,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);

21
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,7 +599,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
switch(root->var) {
case RootTABLE:
res = WriteF(stream,
res = WriteF(stream, depth + 2,
"table base $A limit $A\n",
root->the.table.base, root->the.table.limit,
NULL);
@ -607,7 +607,8 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
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,7 +616,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
break;
case RootFUN:
res = WriteF(stream,
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,
@ -624,7 +625,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
break;
case RootREG:
res = WriteF(stream,
res = WriteF(stream, depth + 2,
"thread $P\n", (WriteFP)root->the.reg.thread,
"environment p $P", root->the.reg.p,
NULL);
@ -632,7 +633,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
break;
case RootFMT:
res = WriteF(stream,
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,
@ -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;

117
mps/code/seg.c
View file

@ -357,7 +357,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;
@ -367,7 +367,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",
@ -377,11 +377,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;
}
@ -524,43 +526,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, ArenaGrainSize(arena));
AVER_CRITICAL(base > addr);
}
} else {
base = TractBase(tract);
}
}
return FALSE;
}
/* SegMerge -- Merge two adjacent segments
*
* See <design/seg/#merge>
@ -1026,56 +991,27 @@ 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,
res = WriteF(stream, depth,
"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",
(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,
@ -1612,7 +1548,7 @@ failSuper:
/* 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;
@ -1625,19 +1561,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,
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) {

60
mps/code/splay.c
View file

@ -164,6 +164,21 @@ void SplayDebugUpdate(SplayTree splay, Tree tree)
}
/* SplayDebugCount -- count and check order of tree
*
* This function may be called from a debugger or temporarily inserted
* during development to check a tree's integrity. It may not be called
* from the production MPS because it uses indefinite stack depth.
* See <code/tree.c#.note.stack>.
*/
Count SplayDebugCount(SplayTree splay)
{
AVERT(SplayTree, splay);
return TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey);
}
/* SplayZig -- move to left child, prepending to right tree
*
* Link the top node of the middle tree into the left child of the
@ -679,7 +694,7 @@ static Compare SplaySplay(SplayTree splay, TreeKey key, TreeCompare compare)
SplayStateStruct stateStruct;
#ifdef SPLAY_DEBUG
Count count = TreeDebugCount(SplayTreeRoot(tree), tree->compare, tree->nodeKey);
Count count = SplayDebugCount(splay);
#endif
/* Short-circuit common cases. Splay trees often bring recently
@ -699,7 +714,7 @@ static Compare SplaySplay(SplayTree splay, TreeKey key, TreeCompare compare)
SplayTreeSetRoot(splay, stateStruct.middle);
#ifdef SPLAY_DEBUG
AVER(count == TreeDebugCount(SplayTreeRoot(tree), tree->compare, tree->nodeKey));
AVER(count == SplayDebugCount(splay));
#endif
return cmp;
@ -894,7 +909,7 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
Bool found;
Compare cmp;
#ifdef SPLAY_DEBUG
Count count = TreeDebugCount(SplayTreeRoot(tree), tree->compare, tree->nodeKey);
Count count = SplayDebugCount(splay);
#endif
@ -936,7 +951,7 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
SplayTreeSetRoot(splay, stateStruct.middle);
#ifdef SPLAY_DEBUG
AVER(count == TreeDebugCount(SplayTreeRoot(tree), tree->compare, tree->nodeKey));
AVER(count == SplayDebugCount(splay));
#endif
return found;
@ -988,10 +1003,10 @@ Tree SplayTreeNext(SplayTree splay, TreeKey oldKey) {
default:
NOTREACHED;
/* defensive fall-through */
case CompareGREATER:
case CompareLESS:
return SplayTreeRoot(splay);
case CompareLESS:
case CompareGREATER:
case CompareEQUAL:
return SplayTreeSuccessor(splay);
}
@ -1005,22 +1020,22 @@ Tree SplayTreeNext(SplayTree splay, TreeKey oldKey) {
*/
static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream,
TreeDescribeMethod nodeDescribe) {
TreeDescribeMethod nodeDescribe)
{
Res res;
#if defined(AVER_AND_CHECK)
if (!TreeCheck(node)) return ResFAIL;
/* stream and nodeDescribe checked by SplayTreeDescribe */
#endif
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;
}
@ -1028,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;
@ -1336,28 +1351,31 @@ 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 defined(AVER_AND_CHECK)
if (!SplayTreeCheck(splay)) return ResFAIL;
if (!TESTT(SplayTree, splay)) return ResFAIL;
if (stream == NULL) return ResFAIL;
if (!FUNCHECK(nodeDescribe)) return ResFAIL;
#endif
res = WriteF(stream,
res = WriteF(stream, depth,
"Splay $P {\n", (WriteFP)splay,
" compare $F\n", (WriteFF)splay->compare,
" nodeKey $F\n", (WriteFF)splay->nodeKey,
" updateNode $F\n", (WriteFF)splay->updateNode,
NULL);
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;
}

3
mps/code/splay.h
View file

@ -72,9 +72,10 @@ 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);
#endif /* splay_h */

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,

129
mps/code/trace.c
View file

@ -1260,7 +1260,12 @@ mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
{
ScanState ss = PARENT(ScanStateStruct, ss_s, mps_ss);
Ref ref;
Chunk chunk;
Index i;
Tract tract;
Seg seg;
Res res;
Pool pool;
/* Special AVER macros are used on the critical path. */
/* See <design/trace/#fix.noaver> */
@ -1277,13 +1282,49 @@ mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
STATISTIC(++ss->fixRefCount);
EVENT4(TraceFix, ss, mps_ref_io, ref, ss->rank);
TRACT_OF_ADDR(&tract, ss->arena, ref);
if(tract) {
if(TraceSetInter(TractWhite(tract), ss->traces) != TraceSetEMPTY) {
Seg seg;
/* This sequence of tests is equivalent to calling TractOfAddr(),
* but inlined so that we can distinguish between "not pointing to
* chunk" and "pointing to chunk but not to tract" so that we can
* check the rank in the latter case. See
* <design/trace/#fix.tractofaddr.inline>
*
* If compilers fail to do a good job of inlining ChunkOfAddr and
* TreeFind then it may become necessary to inline at least the
* comparison against the root of the tree. See
* <https://info.ravenbrook.com/mail/2014/06/11/13-32-08/0/>
*/
if (!ChunkOfAddr(&chunk, ss->arena, ref))
/* Reference points outside MPS-managed address space: ignore. */
goto done;
i = INDEX_OF_ADDR(chunk, ref);
if (!BTGet(chunk->allocTable, i)) {
/* Reference points into a chunk but not to an allocated tract.
* See <design/trace/#exact.legal> */
AVER_CRITICAL(ss->rank < RankEXACT);
goto done;
}
tract = PageTract(&chunk->pageTable[i]);
if (TraceSetInter(TractWhite(tract), ss->traces) == TraceSetEMPTY) {
/* Reference points to a tract that is not white for any of the
* active traces. See <design/trace/#fix.tractofaddr> */
STATISTIC_STAT
({
if(TRACT_SEG(&seg, tract)) {
Res res;
Pool pool;
++ss->segRefCount;
EVENT1(TraceFixSeg, seg);
}
});
goto done;
}
if (!TRACT_SEG(&seg, tract)) {
/* Tracts without segments must not be condemned. */
NOTREACHED;
goto done;
}
STATISTIC(++ss->segRefCount);
STATISTIC(++ss->whiteSegRefCount);
EVENT1(TraceFixSeg, seg);
@ -1291,7 +1332,7 @@ mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
pool = TractPool(tract);
res = (*ss->fix)(pool, ss, seg, &ref);
if (res != ResOK) {
/* PoolFixEmergency should never fail. */
/* PoolFixEmergency must not fail. */
AVER_CRITICAL(ss->fix != PoolFixEmergency);
/* Fix protocol (de facto): if Fix fails, ref must be unchanged
* Justification for this restriction:
@ -1300,36 +1341,11 @@ mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
* C: the code (here) already assumes this: it returns without
* updating ss->fixedSummary. RHSK 2007-03-21.
*/
AVER(ref == (Ref)*mps_ref_io);
AVER_CRITICAL(ref == (Ref)*mps_ref_io);
return res;
}
} else {
/* Only tracts with segments ought to have been condemned. */
/* SegOfAddr FALSE => a ref into a non-seg Tract (poolmv etc) */
/* .notwhite: ...But it should NOT be white.
* [I assert this both from logic, and from inspection of the
* current condemn code. RHSK 2010-11-30]
*/
NOTREACHED;
}
} else {
/* Tract isn't white. Don't compute seg for non-statistical */
/* variety. See <design/trace/#fix.tractofaddr> */
STATISTIC_STAT
({
Seg seg;
if(TRACT_SEG(&seg, tract)) {
++ss->segRefCount;
EVENT1(TraceFixSeg, seg);
}
});
}
} else {
/* See <design/trace/#exact.legal> */
AVER(ss->rank < RankEXACT
|| !ArenaIsReservedAddr(ss->arena, ref));
}
done:
/* See <design/trace/#fix.fixed.all> */
ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, ref);
@ -1893,6 +1909,51 @@ failStart:
}
/* 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

343
mps/code/tract.c
View file

@ -7,6 +7,17 @@
* free but never allocated as alloc starts searching after the tables.
* TractOfAddr uses the fact that these pages are marked as free in order
* to detect "references" to these pages as being bogus.
*
* .chunk.at.base: The chunks are stored in a balanced binary tree.
* Looking up an address in this tree is on the critical path, and
* therefore vital that it runs quickly. It is an implementation
* detail of chunks that they are always stored at the base of the
* region of address space they represent. Thus chunk happens to
* always be the same as chunk->base. We take advantage of this in the
* tree search by using chunk as its own key (instead of looking up
* chunk->base): this saves a dereference and perhaps a cache miss.
* See ChunkKey and ChunkCompare for this optimization. The necessary
* property is asserted in ChunkCheck.
*/
#include "tract.h"
@ -17,9 +28,6 @@
SRCID(tract, "$Id$");
static void ChunkDecache(Arena arena, Chunk chunk);
/* TractArena -- get the arena of a tract */
#define TractArena(tract) PoolArena(TractPool(tract))
@ -29,8 +37,10 @@ static void ChunkDecache(Arena arena, Chunk chunk);
Bool TractCheck(Tract tract)
{
if (TractHasPool(tract)) {
CHECKU(Pool, TractPool(tract));
CHECKL(AddrIsArenaGrain(TractBase(tract), TractArena(tract)));
}
if (TractHasSeg(tract)) {
CHECKL(TraceSetCheck(TractWhite(tract)));
CHECKU(Seg, (Seg)TractP(tract));
@ -91,13 +101,11 @@ Addr (TractBase)(Tract tract)
}
/* TractLimit -- return the limit address of a segment */
/* TractLimit -- return the limit address of a tract */
Addr TractLimit(Tract tract)
Addr TractLimit(Tract tract, Arena arena)
{
Arena arena;
AVERT_CRITICAL(Tract, tract); /* .tract.critical */
arena = TractArena(tract);
AVERT_CRITICAL(Arena, arena);
return AddrAdd(TractBase(tract), ArenaGrainSize(arena));
}
@ -113,17 +121,17 @@ Bool ChunkCheck(Chunk chunk)
CHECKS(Chunk, chunk);
CHECKU(Arena, chunk->arena);
CHECKL(chunk->serial < chunk->arena->chunkSerial);
CHECKD_NOSIG(Ring, &chunk->chunkRing);
/* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
CHECKL(TreeCheck(&chunk->chunkTree));
CHECKL(ChunkPagesToSize(chunk, 1) == ChunkPageSize(chunk));
CHECKL(ShiftCheck(ChunkPageShift(chunk)));
CHECKL(chunk->base != (Addr)0);
CHECKL(chunk->base < chunk->limit);
/* check chunk is in itself */
CHECKL(chunk->base <= (Addr)chunk);
/* check chunk structure is at its own base: see .chunk.at.base. */
CHECKL(chunk->base == (Addr)chunk);
CHECKL((Addr)(chunk+1) <= chunk->limit);
CHECKL(ChunkSizeToPages(chunk, AddrOffset(chunk->base, chunk->limit))
== chunk->pages);
CHECKL(ChunkSizeToPages(chunk, ChunkSize(chunk)) == chunk->pages);
/* check that the tables fit in the chunk */
CHECKL(chunk->allocBase <= chunk->pages);
CHECKL(chunk->allocBase >= chunk->pageTablePages);
@ -177,13 +185,12 @@ Res ChunkInit(Chunk chunk, Arena arena,
chunk->serial = (arena->chunkSerial)++;
chunk->arena = arena;
RingInit(&chunk->chunkRing);
RingAppend(&arena->chunkRing, &chunk->chunkRing);
chunk->pageSize = pageSize;
chunk->pageShift = pageShift = SizeLog2(pageSize);
chunk->base = base;
chunk->limit = limit;
size = AddrOffset(base, limit);
size = ChunkSize(chunk);
chunk->pages = pages = size >> pageShift;
res = BootAlloc(&p, boot, (size_t)BTSize(pages), MPS_PF_ALIGN);
@ -218,9 +225,13 @@ Res ChunkInit(Chunk chunk, Arena arena,
goto failLandInsert;
}
TreeInit(&chunk->chunkTree);
chunk->sig = ChunkSig;
AVERT(Chunk, chunk);
ArenaChunkInsert(arena, chunk);
/* As part of the bootstrap, the first created chunk becomes the primary
chunk. This step allows AreaFreeLandInsert to allocate pages. */
if (arena->primary == NULL)
@ -242,17 +253,23 @@ failAllocTable:
void ChunkFinish(Chunk chunk)
{
AVERT(Chunk, chunk);
AVER(BTIsResRange(chunk->allocTable, 0, chunk->pages));
ChunkDecache(chunk->arena, chunk);
chunk->sig = SigInvalid;
RingRemove(&chunk->chunkRing);
Arena arena;
if (ChunkArena(chunk)->hasFreeLand)
ArenaFreeLandDelete(ChunkArena(chunk),
AVERT(Chunk, chunk);
AVER(BTIsResRange(chunk->allocTable, 0, chunk->pages));
arena = ChunkArena(chunk);
if (arena->hasFreeLand)
ArenaFreeLandDelete(arena,
PageIndexBase(chunk, chunk->allocBase),
chunk->limit);
chunk->sig = SigInvalid;
TreeFinish(&chunk->chunkTree);
RingRemove(&chunk->chunkRing);
if (chunk->arena->primary == chunk)
chunk->arena->primary = NULL;
@ -262,92 +279,40 @@ void ChunkFinish(Chunk chunk)
}
/* Chunk Cache
*
* Functions for manipulating the chunk cache in the arena.
*/
/* ChunkCompare -- Compare key to [base,limit) */
/* ChunkCacheEntryCheck -- check a chunk cache entry
*
* The cache is EITHER empty:
* - chunk is null; AND
* - base & limit are both null
* OR full:
* - chunk is non-null, points to a ChunkStruct; AND
* - base & limit are not both null;
*
* .chunk.empty.fields: Fields of an empty cache are nonetheless read,
* and must be correct.
*/
Bool ChunkCacheEntryCheck(ChunkCacheEntry entry)
Compare ChunkCompare(Tree tree, TreeKey key)
{
CHECKS(ChunkCacheEntry, entry);
if (entry->chunk == NULL) {
CHECKL(entry->base == NULL); /* .chunk.empty.fields */
CHECKL(entry->limit == NULL); /* .chunk.empty.fields */
} else {
CHECKL(!(entry->base == NULL && entry->limit == NULL));
CHECKD(Chunk, entry->chunk);
CHECKL(entry->base == entry->chunk->base);
CHECKL(entry->limit == entry->chunk->limit);
}
return TRUE;
}
Addr base1, base2, limit2;
Chunk chunk;
AVERT_CRITICAL(Tree, tree);
AVER_CRITICAL(tree != TreeEMPTY);
/* ChunkCacheEntryInit -- initialize a chunk cache entry */
void ChunkCacheEntryInit(ChunkCacheEntry entry)
{
entry->chunk = NULL;
entry->base = NULL; /* .chunk.empty.fields */
entry->limit = NULL; /* .chunk.empty.fields */
entry->sig = ChunkCacheEntrySig;
AVERT(ChunkCacheEntry, entry);
return;
}
/* ChunkEncache -- cache a chunk */
static void ChunkEncache(Arena arena, Chunk chunk)
{
/* [Critical path](../design/critical-path.txt); called by ChunkOfAddr */
AVERT_CRITICAL(Arena, arena);
/* See .chunk.at.base. */
chunk = ChunkOfTree(tree);
AVERT_CRITICAL(Chunk, chunk);
AVER_CRITICAL(arena == chunk->arena);
AVERT_CRITICAL(ChunkCacheEntry, &arena->chunkCache);
/* check chunk already in cache first */
if (arena->chunkCache.chunk == chunk) {
return;
}
base1 = AddrOfTreeKey(key);
base2 = chunk->base;
limit2 = chunk->limit;
arena->chunkCache.chunk = chunk;
arena->chunkCache.base = chunk->base;
arena->chunkCache.limit = chunk->limit;
AVERT_CRITICAL(ChunkCacheEntry, &arena->chunkCache);
return;
if (base1 < base2)
return CompareLESS;
else if (base1 >= limit2)
return CompareGREATER;
else
return CompareEQUAL;
}
/* ChunkDecache -- make sure a chunk is not in the cache */
/* ChunkKey -- Return the key corresponding to a chunk */
static void ChunkDecache(Arena arena, Chunk chunk)
TreeKey ChunkKey(Tree tree)
{
AVERT(Arena, arena);
AVERT(Chunk, chunk);
AVER(arena == chunk->arena);
AVERT(ChunkCacheEntry, &arena->chunkCache);
if (arena->chunkCache.chunk == chunk) {
arena->chunkCache.chunk = NULL;
arena->chunkCache.base = NULL; /* .chunk.empty.fields */
arena->chunkCache.limit = NULL; /* .chunk.empty.fields */
}
AVERT(ChunkCacheEntry, &arena->chunkCache);
/* See .chunk.at.base. */
Chunk chunk = ChunkOfTree(tree);
return TreeKeyOfAddrVar(chunk);
}
@ -355,77 +320,25 @@ static void ChunkDecache(Arena arena, Chunk chunk)
Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr)
{
Ring node, next;
Tree tree;
AVER_CRITICAL(chunkReturn != NULL);
AVERT_CRITICAL(Arena, arena);
/* addr is arbitrary */
/* check cache first; see also .chunk.empty.fields */
AVERT_CRITICAL(ChunkCacheEntry, &arena->chunkCache);
if (arena->chunkCache.base <= addr && addr < arena->chunkCache.limit) {
*chunkReturn = arena->chunkCache.chunk;
AVER_CRITICAL(*chunkReturn != NULL);
return TRUE;
}
RING_FOR(node, &arena->chunkRing, next) {
Chunk chunk = RING_ELT(Chunk, chunkRing, node);
if (chunk->base <= addr && addr < chunk->limit) {
/* Gotcha! */
ChunkEncache(arena, chunk);
if (TreeFind(&tree, ArenaChunkTree(arena), TreeKeyOfAddrVar(addr),
ChunkCompare)
== CompareEQUAL)
{
Chunk chunk = ChunkOfTree(tree);
AVER_CRITICAL(chunk->base <= addr && addr < chunk->limit);
*chunkReturn = chunk;
return TRUE;
}
}
return FALSE;
}
/* ChunkOfNextAddr
*
* Finds the next higher chunk in memory which does _not_ contain addr.
* Returns FALSE if there is none.
*
* [The name is misleading; it should be "NextChunkAboveAddr" -- the
* word "Next" applies to chunks, not to addrs. RHSK 2010-03-20.]
*/
static Bool ChunkOfNextAddr(Chunk *chunkReturn, Arena arena, Addr addr)
{
Addr leastBase;
Chunk leastChunk;
Ring node, next;
leastBase = (Addr)(Word)-1;
leastChunk = NULL;
RING_FOR(node, &arena->chunkRing, next) {
Chunk chunk = RING_ELT(Chunk, chunkRing, node);
if (addr < chunk->base && chunk->base < leastBase) {
leastBase = chunk->base;
leastChunk = chunk;
}
}
if (leastChunk != NULL) {
*chunkReturn = leastChunk;
return TRUE;
}
return FALSE;
}
/* ArenaIsReservedAddr -- is address managed by this arena? */
Bool ArenaIsReservedAddr(Arena arena, Addr addr)
{
Chunk dummy;
AVERT(Arena, arena);
/* addr is arbitrary */
return ChunkOfAddr(&dummy, arena, addr);
}
/* IndexOfAddr -- return the index of the page containing an address
*
* Function version of INDEX_OF_ADDR, for debugging purposes.
@ -440,6 +353,24 @@ Index IndexOfAddr(Chunk chunk, Addr addr)
}
/* ChunkNodeDescribe -- describe a single node in the tree of chunks,
* for SplayTreeDescribe
*/
Res ChunkNodeDescribe(Tree node, mps_lib_FILE *stream)
{
Chunk chunk;
if (!TreeCheck(node)) return ResFAIL;
if (stream == NULL) return ResFAIL;
chunk = ChunkOfTree(node);
if (!TESTT(Chunk, chunk)) return ResFAIL;
return WriteF(stream, 0, "[$P,$P)", (WriteFP)chunk->base,
(WriteFP)chunk->limit, NULL);
}
/* Page table functions */
/* .tract.critical: These Tract functions are low-level and are on
@ -508,110 +439,6 @@ Tract TractOfBaseAddr(Arena arena, Addr addr)
}
/* tractSearchInChunk -- search for a tract
*
* .tract-search: Searches for a tract in the chunk starting at page
* index i, return NULL if there is none. .tract-search.private: This
* function is private to this module and is used in the tract iteration
* protocol (TractFirst and TractNext).
*/
static Bool tractSearchInChunk(Tract *tractReturn, Chunk chunk, Index i)
{
AVER_CRITICAL(chunk->allocBase <= i);
AVER_CRITICAL(i <= chunk->pages);
while (i < chunk->pages
&& !(BTGet(chunk->allocTable, i)
&& PageIsAllocated(ChunkPage(chunk, i)))) {
++i;
}
if (i == chunk->pages)
return FALSE;
AVER(i < chunk->pages);
*tractReturn = PageTract(ChunkPage(chunk, i));
return TRUE;
}
/* tractSearch
*
* Searches for the next tract in increasing address order.
* The tract returned is the next one along from addr (i.e.,
* it has a base address bigger than addr and no other tract
* with a base address bigger than addr has a smaller base address).
*
* Returns FALSE if there is no tract to find (end of the arena).
*/
static Bool tractSearch(Tract *tractReturn, Arena arena, Addr addr)
{
Bool b;
Chunk chunk;
b = ChunkOfAddr(&chunk, arena, addr);
if (b) {
Index i;
i = INDEX_OF_ADDR(chunk, addr);
/* There are fewer pages than addresses, therefore the */
/* page index can never wrap around */
AVER_CRITICAL(i+1 != 0);
if (tractSearchInChunk(tractReturn, chunk, i+1)) {
return TRUE;
}
}
while (ChunkOfNextAddr(&chunk, arena, addr)) {
/* If the ring was kept in address order, this could be improved. */
addr = chunk->base;
/* Start from allocBase to skip the tables. */
if (tractSearchInChunk(tractReturn, chunk, chunk->allocBase)) {
return TRUE;
}
}
return FALSE;
}
/* TractFirst -- return the first tract in the arena
*
* This is used to start an iteration over all tracts in the arena, not
* including the ones used for page tables and other arena structures.
*/
Bool TractFirst(Tract *tractReturn, Arena arena)
{
AVER(tractReturn != NULL);
AVERT(Arena, arena);
/* .tractfirst.assume.nozero: We assume that there is no tract */
/* with base address (Addr)0. Happily this assumption is sound */
/* for a number of reasons. */
return tractSearch(tractReturn, arena, (Addr)0);
}
/* TractNext -- return the "next" tract in the arena
*
* TractNext finds the tract 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 tract.
*
* This is used as the iteration step when iterating over all
* tracts in the arena.
*/
Bool TractNext(Tract *tractReturn, Arena arena, Addr addr)
{
AVER_CRITICAL(tractReturn != NULL); /* .tract.critical */
AVERT_CRITICAL(Arena, arena);
AVER_CRITICAL(AddrIsAligned(addr, ArenaGrainSize(arena)));
return tractSearch(tractReturn, arena, addr);
}
/* PageAlloc
*
* Sets up the page descriptor for an allocated page to turn it into a Tract.

61
mps/code/tract.h
View file

@ -9,8 +9,9 @@
#define tract_h
#include "mpmtypes.h"
#include "ring.h"
#include "bt.h"
#include "ring.h"
#include "tree.h"
/* Page states
@ -50,8 +51,10 @@ typedef struct TractStruct { /* Tract structure */
extern Addr (TractBase)(Tract tract);
#define TractBase(tract) ((tract)->base)
extern Addr TractLimit(Tract tract);
extern Addr TractLimit(Tract tract, Arena arena);
#define TractHasPool(tract) \
((tract)->pool.state == PageStateALLOC && TractPool(tract))
#define TractPool(tract) ((tract)->pool.pool)
#define TractP(tract) ((tract)->p)
#define TractSetP(tract, pp) ((void)((tract)->p = (pp)))
@ -134,7 +137,8 @@ typedef struct ChunkStruct {
Sig sig; /* <design/sig/> */
Serial serial; /* serial within the arena */
Arena arena; /* parent arena */
RingStruct chunkRing; /* ring of all chunks in arena */
RingStruct chunkRing; /* node in ring of all chunks in arena */
TreeStruct chunkTree; /* node in tree of all chunks in arena */
Size pageSize; /* size of pages */
Shift pageShift; /* log2 of page size, for shifts */
Addr base; /* base address of chunk */
@ -148,31 +152,24 @@ typedef struct ChunkStruct {
#define ChunkArena(chunk) RVALUE((chunk)->arena)
#define ChunkSize(chunk) AddrOffset((chunk)->base, (chunk)->limit)
#define ChunkPageSize(chunk) RVALUE((chunk)->pageSize)
#define ChunkPageShift(chunk) RVALUE((chunk)->pageShift)
#define ChunkPagesToSize(chunk, pages) ((Size)(pages) << (chunk)->pageShift)
#define ChunkSizeToPages(chunk, size) ((Count)((size) >> (chunk)->pageShift))
#define ChunkPage(chunk, pi) (&(chunk)->pageTable[pi])
#define ChunkOfTree(tree) PARENT(ChunkStruct, chunkTree, tree)
extern Bool ChunkCheck(Chunk chunk);
extern Res ChunkInit(Chunk chunk, Arena arena,
Addr base, Addr limit, Align pageSize, BootBlock boot);
extern Res ChunkInit(Chunk chunk, Arena arena, Addr base, Addr limit,
Align pageSize, BootBlock boot);
extern void ChunkFinish(Chunk chunk);
extern Compare ChunkCompare(Tree tree, TreeKey key);
extern TreeKey ChunkKey(Tree tree);
extern Bool ChunkCacheEntryCheck(ChunkCacheEntry entry);
extern void ChunkCacheEntryInit(ChunkCacheEntry entry);
extern Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr);
/* CHUNK_OF_ADDR -- return the chunk containing an address
*
* arena and addr are evaluated multiple times.
*/
#define CHUNK_OF_ADDR(chunkReturn, arena, addr) \
(((arena)->chunkCache.base <= (addr) && (addr) < (arena)->chunkCache.limit) \
? (*(chunkReturn) = (arena)->chunkCache.chunk, TRUE) \
: ChunkOfAddr(chunkReturn, arena, addr))
extern Res ChunkNodeDescribe(Tree node, mps_lib_FILE *stream);
/* AddrPageBase -- the base of the page this address is on */
@ -186,25 +183,6 @@ extern Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr);
extern Tract TractOfBaseAddr(Arena arena, Addr addr);
extern Bool TractOfAddr(Tract *tractReturn, Arena arena, Addr addr);
/* TRACT_OF_ADDR -- return the tract containing an address */
#define TRACT_OF_ADDR(tractReturn, arena, addr) \
BEGIN \
Arena _arena = (arena); \
Addr _addr = (addr); \
Chunk _chunk; \
Index _i; \
\
if (CHUNK_OF_ADDR(&_chunk, _arena, _addr)) { \
_i = INDEX_OF_ADDR(_chunk, _addr); \
if (BTGet(_chunk->allocTable, _i)) \
*(tractReturn) = PageTract(&_chunk->pageTable[_i]); \
else \
*(tractReturn) = NULL; \
} else \
*(tractReturn) = NULL; \
END
/* INDEX_OF_ADDR -- return the index of the page containing an address
*
@ -235,15 +213,12 @@ 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
extern Bool TractFirst(Tract *tractReturn, Arena arena);
extern Bool TractNext(Tract *tractReturn, Arena arena, Addr addr);
/* TRACT_TRACT_FOR -- iterate over a range of tracts
/* TRACT_TRACT_FOR -- iterate over a range of tracts in a chunk
*
* See <design/arena-tract-iter/#if.macro>.
* Parameters arena & limit are evaluated multiple times.
@ -260,7 +235,7 @@ extern Bool TractNext(Tract *tractReturn, Arena arena, Addr addr);
(tract = NULL) /* terminate loop */))
/* TRACT_FOR -- iterate over a range of tracts
/* TRACT_FOR -- iterate over a range of tracts in a chunk
*
* See <design/arena/#tract.for>.
* Parameters arena & limit are evaluated multiple times.

92
mps/code/tree.c
View file

@ -70,8 +70,6 @@ Count TreeDebugCount(Tree tree, TreeCompare compare, TreeKeyMethod key)
}
#if 0 /* This code is not currently in use in the MPS */
/* TreeFind -- search for a node matching the key
*
* If a matching node is found, sets *treeReturn to that node and returns
@ -87,9 +85,9 @@ Compare TreeFind(Tree *treeReturn, Tree root, TreeKey key, TreeCompare compare)
Tree node, parent;
Compare cmp = CompareEQUAL;
AVERT(Tree, root);
AVER(treeReturn != NULL);
AVER(FUNCHECK(compare));
AVERT_CRITICAL(Tree, root);
AVER_CRITICAL(treeReturn != NULL);
AVER_CRITICAL(FUNCHECK(compare));
/* key is arbitrary */
parent = NULL;
@ -119,6 +117,49 @@ Compare TreeFind(Tree *treeReturn, Tree root, TreeKey key, TreeCompare compare)
}
/* TreeFindNext -- search for node containing key, or next node
*
* If there is a node that is greater than key, set *treeReturn to that
* node and return TRUE.
*
* Otherwise, key is greater than all nodes in the tree, so leave
* *treeReturn unchanged and return FALSE.
*/
Bool TreeFindNext(Tree *treeReturn, Tree root, TreeKey key, TreeCompare compare)
{
Tree node, best = NULL;
Bool result = FALSE;
AVERT(Tree, root);
AVER(treeReturn != NULL);
AVER(FUNCHECK(compare));
/* key is arbitrary */
node = root;
while (node != TreeEMPTY) {
Compare cmp = compare(node, key);
switch (cmp) {
case CompareLESS:
best = node;
result = TRUE;
node = node->left;
break;
case CompareEQUAL:
case CompareGREATER:
node = node->right;
break;
default:
NOTREACHED;
return FALSE;
}
}
*treeReturn = best;
return result;
}
/* TreeInsert -- insert a node into a tree
*
* If the key doesn't exist in the tree, inserts a node as a leaf of the
@ -134,7 +175,7 @@ Bool TreeInsert(Tree *treeReturn, Tree root, Tree node,
Compare cmp;
AVER(treeReturn != NULL);
AVER(Tree, root);
AVERT(Tree, root);
AVER(TreeCheckLeaf(node));
AVER(FUNCHECK(compare));
/* key is arbitrary */
@ -166,6 +207,8 @@ Bool TreeInsert(Tree *treeReturn, Tree root, Tree node,
}
#if 0 /* This code is currently not in use in the MPS */
/* TreeTraverseMorris -- traverse tree inorder in constant space
*
* The tree may not be accessed or modified during the traversal, and
@ -432,9 +475,6 @@ Tree TreeReverseRightSpine(Tree tree)
}
#if 0 /* This code is currently not in use in the MPS */
/* TreeToVine -- unbalance a tree into a single right spine */
Count TreeToVine(Tree *link)
@ -488,7 +528,39 @@ void TreeBalance(Tree *treeIO)
}
#endif /* not currently in use in the MPS */
/* TreeTraverseAndDelete -- traverse a tree while deleting nodes
*
* The visitor function must return TRUE to delete the current node,
* or FALSE to keep it.
*
* See <design/arena/#chunk.delete.tricky>.
*/
void TreeTraverseAndDelete(Tree *treeIO, TreeVisitor visitor,
void *closureP, Size closureS)
{
Tree *treeref = treeIO;
AVER(treeIO != NULL);
AVERT(Tree, *treeIO);
AVER(FUNCHECK(visitor));
/* closureP and closureS are arbitrary */
TreeToVine(treeIO);
while (*treeref != TreeEMPTY) {
Tree tree = *treeref; /* Current node. */
Tree *nextref = &tree->right; /* Location of pointer to next node. */
Tree next = *nextref; /* Next node. */
if ((*visitor)(tree, closureP, closureS)) {
/* Delete current node. */
*treeref = next;
} else {
/* Keep current node. */
treeref = nextref;
}
}
TreeBalance(treeIO);
}
/* C. COPYRIGHT AND LICENSE

16
mps/code/tree.h
View file

@ -42,6 +42,17 @@ typedef Compare (*TreeCompare)(Tree tree, TreeKey key);
typedef TreeKey (*TreeKeyMethod)(Tree tree);
/* When storing Addrs in a tree, it is fastest to cast the Addr
* directly to a TreeKey. This assumes that Addr and TreeKey are
* compatible, possibly breaking <design/type/#addr.use>. On an exotic
* platform where the types are not convertible, take the address of
* the variable in TreeKeyOfAddrVar, and dereference the address in
* AddrOfTreeKey.
*/
#define TreeKeyOfAddrVar(var) ((TreeKey)(var))
#define AddrOfTreeKey(key) ((Addr)(key))
/* TreeEMPTY -- the empty tree
*
* TreeEMPTY is the tree with no nodes, and hence unable to satisfy its
@ -53,6 +64,7 @@ typedef TreeKey (*TreeKeyMethod)(Tree tree);
#define TreeEMPTY ((Tree)0)
extern Bool TreeCheck(Tree tree);
extern Bool TreeCheckLeaf(Tree tree);
extern Count TreeDebugCount(Tree tree, TreeCompare compare, TreeKeyMethod key);
@ -104,6 +116,8 @@ extern Count TreeDebugCount(Tree tree, TreeCompare compare, TreeKeyMethod key);
extern Compare TreeFind(Tree *treeReturn, Tree root,
TreeKey key, TreeCompare compare);
extern Bool TreeFindNext(Tree *treeReturn, Tree root,
TreeKey key, TreeCompare compare);
extern Bool TreeInsert(Tree *treeReturn, Tree root, Tree node,
TreeKey key, TreeCompare compare);
@ -123,6 +137,8 @@ extern Tree TreeReverseRightSpine(Tree tree);
extern Count TreeToVine(Tree *treeIO);
extern void TreeBalance(Tree *treeIO);
extern void TreeTraverseAndDelete(Tree *treeIO, TreeVisitor visitor,
void *closureP, Size closureS);
#endif /* tree_h */

59
mps/design/arena.txt
View file

@ -230,6 +230,48 @@ implementations of those methods which must be overridden. Instead
each abstract method is initialized to ``NULL``.
Chunks
......
_`.chunk`: Each contiguous region of address space managed by the MPS
is represented by a *chunk*.
_`.chunk.tracts`: A chunk contains a table of tracts. See `.tract`_.
_`.chunk.lookup`: Looking of the chunk of an address is the first
step in the second-stage fix operation, and so on the critical path.
See `design.mps.critical-path`_.
.. _design.mps.critical-path: critical-path
_`.chunk.tree`: For efficient lookup, chunks are stored in a balanced
tree; ``arena->chunkTree`` points to the root of the tree. Operations
on this tree must ensure that the tree remains balanced, otherwise
performance degrades badly with many chunks.
_`.chunk.insert`: New chunks are inserted into the tree by calling
``ArenaChunkInsert()``. This calls ``TreeInsert()``, followed by
``TreeBalance()`` to ensure that the tree is balanced.
_`.chunk.delete`: There is no corresponding function
``ArenaChunkDelete()``. Instead, deletions from the chunk tree are
carried out by calling ``TreeToVine()``, iterating over the vine
(where deletion is possible, if care is taken) and then calling
``TreeBalance()`` on the remaining tree. The function
``TreeTraverseAndDelete()`` implements this.
_`.chunk.delete.justify`: This is because we don't have a function
that deletes an item from a balanced tree efficiently, and because all
functions that delete chunks do so in a loop over the chunks (so the
best we can do is O(*n*) time in any case).
_`.chunk.delete.tricky`: Deleting chunks from the chunk tree is tricky
in the virtual memory arena because ``vmChunkDestroy()`` unmaps the
memory containing the chunk, which includes the tree node. So the next
chunk must be looked up before deleting the current chunk. The function
``TreeTraverseAndDelete()`` ensures that this is done.
Tracts
......
@ -272,16 +314,20 @@ use it for any purpose.
_`.tract.field.hasSeg`: The ``hasSeg`` bit-field is a Boolean which
indicates whether the ``p`` field is being used by the segment module.
If this field is ``TRUE``, then the value of ``p`` is a ``Seg``. See
design.mps.type.bool.bitfield for why this is declared using the
`design.mps.type.bool.bitfield`_ for why this is declared using the
``BOOLFIELD`` macro.
.. _design.mps.type.bool.bitfield: type#bool.bitfield
_`.tract.field.base`: The base field contains the base address of the
memory represented by the tract.
_`.tract.field.white`: The white bit-field indicates for which traces
the tract is white (`.req.fun.trans.white`_). This information is also
stored in the segment, but is duplicated here for efficiency during a
call to ``TraceFix()`` (see design.mps.trace.fix).
call to ``TraceFix()`` (see `design.mps.trace.fix`_).
.. _design.mps.trace.fix: trace#fix
_`.tract.limit`: The limit of the tract's memory may be determined by
adding the arena grain size to the base address.
@ -291,9 +337,8 @@ design.mps.arena.tract-iter(0).
``Bool TractOfAddr(Tract *tractReturn, Arena arena, Addr addr)``
_`.tract.if.tractofaddr`: The function ``TractOfAddr()`` finds the tract
corresponding to an address in memory. (See `.req.fun.trans`_.)
_`.tract.if.tractofaddr`: The function ``TractOfAddr()`` finds the
tract corresponding to an address in memory. (See `.req.fun.trans`_.)
If ``addr`` is an address which has been allocated to some pool, then
``TractOfAddr()`` returns ``TRUE``, and sets ``*tractReturn`` to the
tract corresponding to that address. Otherwise, it returns ``FALSE``.
@ -301,10 +346,6 @@ This function is similar to ``TractOfBaseAddr()`` (see
design.mps.arena.tract-iter.if.contig-base) but serves a more general
purpose and is less efficient.
_`.tract.if.TRACT_OF_ADDR`: ``TRACT_OF_ADDR()`` is a macro version of
``TractOfAddr()``. It's provided for efficiency during a call to
``TraceFix()`` (see design.mps.trace.fix.tractofaddr).
Control pool
............

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.

21
mps/design/critical-path.txt
View file

@ -230,20 +230,21 @@ If a pointer gets past the first-stage fix filters, it is passed to
yet more pointers using information about segments before it has to
consult the pool class.
The first test applied is the "tract test". The MPS looks up the tract
containing the address in the tract table, which is a simple linear
table indexed by the address shifted -- a kind of flat page table.
The first test is to determine if the address points to a *chunk* (a
contiguous regions of address space managed by the arena). Addresses
that do not point to any chunk (for example, ambiguous references that
are not in fact pointers) are rejected immediately.
Note that if the arena has been extended, the tract table becomes less
simple, and this test may involved looking in more than one table.
This will cause a considerable slow-down in garbage collection
scanning. This is the reason that it's important to give a good
When there are many chunks (that is, when the arena has been extended
many times), this test can consume the majority of the garbage
collection time. This is the reason that it's important to give a good
estimate of the amount of address space you will ever occupy with
objects when you initialize the arena.
The pointer might not even be in the arena (and so not in any tract).
The first stage fix doesn't guarantee it. So we eliminate any pointers
not in the arena at this stage.
The second test applied is the "tract test". The MPS looks up the
tract containing the address in the tract table, which is a simple
linear table indexed by the address shifted -- a kind of flat page
table.
If the pointer is in an allocated tract, then the table also contains
a cache of the "white set" -- the set of garbage collection traces for

16
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
{
(gdb) p MVTDescribe(mvt, mps_lib_get_stdout(), 0)
MVT 0000000103FFE160 {
minSize: 8
meanSize: 42
maxSize: 8192
fragLimit: 30
reuseSize: 16384
fillSize: 8192
availLimit: 1110835
availLimit: 90931
abqOverflow: FALSE
splinter: TRUE
splinterSeg: 0000000103FEE780
splinterBase: 0000000101D7ABB8
splinterLimit: 0000000101D7B000
splinterBase: 0000000106192FF0
splinterLimit: 0000000106193000
size: 303104
allocated: 262928
available: 40176
unavailable: 0
# ... etc ...
}

5
mps/design/locus.txt
View file

@ -511,7 +511,10 @@ requested (to allow for large objects).
_`.arch.chunk`: Arenas may allocate more address space in additional
chunks, which may be disjoint from the existing chunks. Inter-chunk
space will be represented by dummy regions. There are also sentinel
regions at both ends of the address space.
regions at both ends of the address space. See
`design.mps.arena.chunk`_.
.. _design.mps.arena.chunk: arena#chunk
Overview of strategy

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/

16
mps/design/scan.txt
View file

@ -19,8 +19,8 @@ Scanned summary
...............
_`.summary.subset`: The summary of reference seens by scan
(ss.unfixedSummary) is a subset of the summary previously computed
(SegSummary).
(``ss.unfixedSummary``) is a subset of the summary previously computed
(``SegSummary()``).
There are two reasons that it is not an equality relation:
@ -34,9 +34,11 @@ There are two reasons that it is not an equality relation:
#. A write barrier hit will set the summary to ``RefSetUNIV``.
The reason that ss.unfixedSummary is always a subset of the previous
summary is due to an "optimization" which has not been made in
``TraceFix``. See impl.c.trace.fix.fixed.all.
The reason that ``ss.unfixedSummary`` is always a subset of the
previous summary is due to an "optimization" which has not been made
in ``TraceFix``. See `design.mps.trace.fix.fixed.all`_.
.. _design.mps.trace.fix.fixed.all: trace#fix.fixed.all
Partial scans
@ -54,8 +56,8 @@ partial scans of condemned segments contribute to the segment summary.
_`.clever-summary.acc`: Each time we partially scan a segment, we
accumulate the post-scan summary of the scanned objects into a field
in the group, called 'summarySoFar'. The post-scan summary is (summary
\ white) U fixed.
in the group, called ``summarySoFar``. The post-scan summary is
(summary \ white) ∪ fixed.
_`.clever-summary.acc.condemn`: The cumulative summary is only
meaningful while the segment is condemned. Otherwise it is set to

17
mps/design/seg.txt
View file

@ -63,21 +63,20 @@ Data Structure
The implementations are as follows::
typedef struct SegStruct { /* segment structure */
Sig sig; /* impl.h.misc.sig */
Sig sig; /* <code/misc.h#sig> */
SegClass class; /* segment class structure */
Tract firstTract; /* first tract of segment */
RingStruct poolRing; /* link in list of segs in pool */
Addr limit; /* limit of segment */
unsigned depth : SHIELD_DEPTH_WIDTH; /* see impl.c.shield.def.depth */
AccessSet pm : AccessMAX; /* protection mode, impl.c.shield */
AccessSet sm : AccessMAX; /* shield mode, impl.c.shield */
TraceSet grey : TRACE_MAX; /* traces for which seg is grey */
TraceSet white : TRACE_MAX; /* traces for which seg is white */
TraceSet nailed : TRACE_MAX; /* traces for which seg has nailed objects */
RankSet rankSet : RankMAX; /* ranks of references in this seg */
unsigned depth : ShieldDepthWIDTH; /* see <code/shield.c#def.depth> */
AccessSet pm : AccessLIMIT; /* protection mode, <code/shield.c> */
AccessSet sm : AccessLIMIT; /* shield mode, <code/shield.c> */
TraceSet grey : TraceLIMIT; /* traces for which seg is grey */
TraceSet white : TraceLIMIT; /* traces for which seg is white */
TraceSet nailed : TraceLIMIT; /* traces for which seg has nailed objects */
RankSet rankSet : RankLIMIT; /* ranks of references in this seg */
} SegStruct;
typedef struct GCSegStruct { /* GC segment structure */
SegStruct segStruct; /* superclass fields must come first */
RingStruct greyRing; /* link in list of grey segs */

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

140
mps/design/trace.txt
View file

@ -25,15 +25,16 @@ Introduction
Architecture
------------
_`.instance.limit`: There will be a limit on the number of traces that
can be created at any one time. This effectively limits the number of
concurrent traces. This limitation is expressed in the symbol
``TRACE_MAX``.
_`.instance.limit`: There is a limit on the number of traces that can
be created at any one time. This limits the number of concurrent
traces. This limitation is expressed in the symbol ``TraceLIMIT``.
.. note::
``TRACE_MAX`` is currently set to 1, see request.mps.160020_
"Multiple traces would not work". David Jones, 1998-06-15.
``TraceLIMIT`` is currently set to 1 as the MPS assumes in various
places that only a single trace is active at a time. See
request.mps.160020_ "Multiple traces would not work". David Jones,
1998-06-15.
.. _request.mps.160020: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/mps/160020
@ -46,26 +47,32 @@ _`.rate`: See `mail.nickb.1997-07-31.14-37 </project/mps/mail/1997/07/31/14-37/0
.. _request.epcore.160062: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/epcore/160062
_`.exact.legal`: Exact references should either point outside the
arena (to non-managed address space) or to a tract allocated to a
pool. Exact references that are to addresses which the arena has
reserved but hasn't allocated memory to are illegal (the exact
reference couldn't possibly refer to a real object). Depending on the
future semantics of ``PoolDestroy()`` we might need to adjust our
strategy here. See mail.dsm.1996-02-14.18-18 for a strategy of coping
gracefully with ``PoolDestroy()``. We check that this is the case in the
fixer. It may be sensible to make this check CRITICAL in certain
configurations.
_`.exact.legal`: Exact references must either point outside the arena
(to non-managed address space) or to a tract allocated to a pool.
Exact references that are to addresses which the arena has reserved
but hasn't allocated memory to are illegal (such a reference cannot
possibly refer to a real object, and so cannot be exact). We check
that this is the case in ``TraceFix()``.
_`.fix.fixed.all`: ``ss->fixedSummary`` is accumulated (in the fixer)
for all the pointers whether or not they are genuine references. We
could accumulate fewer pointers here; if a pointer fails the
``TractOfAddr()`` test then we know it isn't a reference, so we needn't
accumulate it into the fixed summary. The design allows this, but it
breaks a useful post-condition on scanning (if the accumulation of
``ss->fixedSummary`` was moved the accuracy of ``ss->fixedSummary``
would vary according to the "width" of the white summary). See
mail.pekka.1998-02-04.16-48 for improvement suggestions.
.. note::
Depending on the future semantics of ``PoolDestroy()`` we might
need to adjust our strategy here. See `mail.dsm.1996-02-14.18-18`_
for a strategy of coping gracefully with ``PoolDestroy()``.
.. _mail.dsm.1996-02-14.18-18: https://info.ravenbrook.com/project/mps/mail/1996/02/14/18-18/0.txt
_`.fix.fixed.all`: ``ss->fixedSummary`` is accumulated (in
``TraceFix()``) for all pointers, whether or not they are genuine
references. We could accumulate fewer pointers here; if a pointer
fails the ``TractOfAddr()`` test then we know it isn't a reference, so
we needn't accumulate it into the fixed summary. The design allows
this, but it breaks a useful post-condition on scanning (if the
accumulation of ``ss->fixedSummary`` was moved the accuracy of
``ss->fixedSummary`` would vary according to the "width" of the white
summary). See `mail.pekka.1998-02-04.16-48`_ for improvement suggestions.
.. _mail.pekka.1998-02-04.16-48: https://info.ravenbrook.com/project/mps/mail/1998/02/04/16-48/0.txt
Analysis
@ -81,6 +88,7 @@ memory for copying.
.. _request.dylan.170560: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/dylan/170560
Ideas
-----
@ -96,30 +104,56 @@ Implementation
Speed
.....
_`.fix`: The fix path is critical to garbage collection speed.
Abstractly fix is applied to all the references in the non-white heap
and all the references in the copied heap. Remembered sets cut down
the number of segments we have to scan. The zone test cuts down the
number of references we call fix on. The speed of the remainder of the
fix path is still critical to system performance. Various
modifications to and aspects of the system are concerned with
maintaining the speed along this path.
_`.fix`: The function implementing the fix operation should be called
``TraceFix()`` and this name is pervasive in the MPS and its documents
to describe this function. Nonethless, optimisation and strict
aliasing rules have meant that we need to use the external name for
it, ``_mps_fix2()``.
_`.fix.tractofaddr`: ``TractOfAddr()`` is called on every reference that
passes the zone test and is on the critical path, to determine whether
the segment is white. There is no need to examine the segment to
perform this test, since whiteness information is duplicated in
tracts, specifically to optimize this test. ``TractOfAddr()`` itself is
a simple class dispatch function (which dispatches to the arena
class's ``TractOfAddr()`` method). Inlining the dispatch and inlining
the functions called by ``VMTractOfAddr()`` makes a small but noticable
difference to the speed of the dylan compiler.
_`.fix.speed`: The fix path is critical to garbage collection speed.
Abstractly, the fix operation is applied to all references in the
non-white heap and all references in the copied heap. Remembered sets
cut down the number of segments we have to scan. The zone test cuts
down the number of references we call fix on. The speed of the
remainder of the fix path is still critical to system performance.
Various modifications to and aspects of the system are concerned with
maintaining the speed along this path. See
`design.mps.critical_path`_.
.. _design.mps.critical_path: critical_path
_`.fix.tractofaddr`: A reference that passes the zone test is then
looked up to find the tract it points to, an operation equivalent to
calling ``TractOfAddr()``.
_`.fix.tractofaddr.inline`: ``TraceFix()`` doesn't actually call
``TractOfAddr()``. Instead, it expands this operation inline (calling
``ChunkOfAddr()``, then ``INDEX_OF_ADDR()``, checking the appropriate
bit in the chunk's ``allocTable``, and finally looking up the tract in
the chunk's page table). The reason for inlining this code is that we
need to know whether the reference points to a chunk (and not just
whether it points to a tract) in order to check the `.exact.legal`_
condition.
_`.fix.whiteseg`: The reason for looking up the tract is to determine
whether the segment is white. There is no need to examine the segment
to perform this test, since whiteness information is duplicated in
tracts, specifically to optimize this test.
.. note::
Nonetheless, it is likely to be more efficient to maintain a
separate lookup table from address to white segment, rather than
indirecting through the chunk and the tract. See job003796_.
.. _job003796: http://www.ravenbrook.com/project/mps/issue/job003796/
_`.fix.noaver`: ``AVER()`` statements in the code add bulk to the code
(reducing I-cache efficacy) and add branches to the path (polluting
the branch pedictors) resulting in a slow down. Removing all the
``AVER()`` statements from the fix path improves the overall speed of
the Dylan compiler by as much as 9%.
the branch pedictors) resulting in a slow down. Replacing the
``AVER()`` statements with ``AVER_CRITICAL()`` on the critical path
improves the overall speed of the Dylan compiler by as much as 9%. See
`design.mps.critical_path`_.
_`.fix.nocopy`: ``AMCFix()`` used to copy objects by using the format's
copy method. This involved a function call (through an indirection)
@ -131,19 +165,15 @@ inlined by the C compiler. This change results in a 4–5% speed-up in
the Dylan compiler.
_`.reclaim`: Because the reclaim phase of the trace (implemented by
``TraceReclaim()``) examines every segment it is fairly time intensive.
rit's profiles presented in request.dylan.170551_ show a gap between
the two varieties variety.hi and variety.wi.
``TraceReclaim()``) examines every segment it is fairly time
intensive. Richard Tucker's profiles presented in
request.dylan.170551_ show a gap between the two varieties variety.hi
and variety.wi.
.. _request.dylan.170551: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/dylan/170551
_`.reclaim.noaver`: Converting ``AVER()`` statements in the loops of
``TraceReclaim()``, ``PoolReclaim()``, ``AMCReclaim()`` (``LOReclaim()``?
``AWLReclaim()``?) will result in a noticeable speed improvement.
.. note::
Insert actual speed improvement here, if any.
_`.reclaim.noaver`: Accordingly, reclaim methods use
``AVER_CRITICAL()`` instead of ``AVER()``.
Life cycle of a trace object

8
mps/design/type.txt
View file

@ -579,9 +579,11 @@ space as the client data.
``typedef unsigned TraceId``
_`.traceid`: A ``TraceId`` is an unsigned integer which is less than
``TRACE_MAX``. Each running trace has a different ``TraceId`` which is
used to index into tables and bitfields used to remember the state of
that trace.
``TraceLIMIT``. Each running trace has a different ``TraceId`` which
is used to index into the tables and bitfields that record the state
of that trace. See `design.mps.trace.instance.limit`_.
.. _design.mps.trace.instance.limit: trace#instance.limit
``typedef unsigned TraceSet``

57
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,
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,
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,
" Seg $P\n", (WriteFP)buffer->seg,
" rank $U\n", (WriteFU)buffer->rank,
" ", 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,
" 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,
" 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/

55
mps/example/scheme/scheme-advanced.c
View file

@ -37,6 +37,7 @@
#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <getopt.h>
#include <setjmp.h>
#include <stdarg.h>
#include <stddef.h>
@ -409,6 +410,7 @@ static void error(const char *format, ...)
if (error_handler) {
longjmp(*error_handler, 1);
} else {
fflush(stdout);
fprintf(stderr, "Fatal error during initialization: %s\n",
error_message);
abort();
@ -4003,6 +4005,7 @@ static mps_res_t obj_scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit)
break;
default:
assert(0);
fflush(stdout);
fprintf(stderr, "Unexpected object on the heap\n");
abort();
}
@ -4073,6 +4076,7 @@ static mps_addr_t obj_skip(mps_addr_t base)
break;
default:
assert(0);
fflush(stdout);
fprintf(stderr, "Unexpected object on the heap\n");
abort();
}
@ -4318,7 +4322,7 @@ static int start(int argc, char *argv[])
mps_addr_t ref;
mps_res_t res;
mps_root_t globals_root;
int exit_code;
int exit_code = EXIT_SUCCESS;
total = (size_t)0;
error_handler = &jb;
@ -4366,21 +4370,23 @@ static int start(int argc, char *argv[])
make_operator(optab[i].name, optab[i].entry,
obj_empty, obj_empty, env, op_env));
} else {
fflush(stdout);
fprintf(stderr,
"Fatal error during initialization: %s\n",
error_message);
abort();
}
if(argc >= 2) {
if (argc > 0) {
/* Non-interactive file execution */
if(setjmp(*error_handler) != 0) {
fflush(stdout);
fprintf(stderr, "%s\n", error_message);
fflush(stderr);
exit_code = EXIT_FAILURE;
} else {
load(env, op_env, make_string(strlen(argv[1]), argv[1]));
exit_code = EXIT_SUCCESS;
}
} else
for (i = 0; i < argc; ++i)
load(env, op_env, make_string(strlen(argv[i]), argv[i]));
} else {
/* Ask the MPS to tell us when it's garbage collecting so that we can
print some messages. Completely optional. */
@ -4394,12 +4400,15 @@ static int start(int argc, char *argv[])
"If you recurse too much the interpreter may crash from using too much C stack.");
for(;;) {
if(setjmp(*error_handler) != 0) {
fflush(stdout);
fprintf(stderr, "%s\n", error_message);
fflush(stderr);
}
mps_chat();
printf("%lu, %lu> ", (unsigned long)total,
(unsigned long)mps_collections(arena));
fflush(stdout);
obj = read(input);
if(obj == obj_eof) break;
obj = eval(env, op_env, obj);
@ -4409,7 +4418,6 @@ static int start(int argc, char *argv[])
}
}
puts("Bye.");
exit_code = EXIT_SUCCESS;
}
/* See comment at the end of `main` about cleaning up. */
@ -4442,6 +4450,7 @@ static mps_gen_param_s obj_gen_params[] = {
int main(int argc, char *argv[])
{
size_t arenasize = 32ul * 1024 * 1024;
mps_res_t res;
mps_chain_t obj_chain;
mps_fmt_t obj_fmt, buckets_fmt;
@ -4449,11 +4458,41 @@ int main(int argc, char *argv[])
mps_root_t reg_root;
int exit_code;
void *marker = &marker;
int ch;
while ((ch = getopt(argc, argv, "m:")) != -1)
switch (ch) {
case 'm': {
char *p;
arenasize = (unsigned)strtoul(optarg, &p, 10);
switch(toupper(*p)) {
case 'G': arenasize <<= 30; break;
case 'M': arenasize <<= 20; break;
case 'K': arenasize <<= 10; break;
case '\0': break;
default:
fprintf(stderr, "Bad arena size %s\n", optarg);
return EXIT_FAILURE;
}
}
break;
default:
fprintf(stderr,
"Usage: %s [option...] [file...]\n"
"Options:\n"
" -m n, --arena-size=n[KMG]?\n"
" Initial size of arena (default %lu).\n",
argv[0],
(unsigned long)arenasize);
return EXIT_FAILURE;
}
argc -= optind;
argv += optind;
/* Create an MPS arena. There is usually only one of these in a process.
It holds all the MPS "global" state and is where everything happens. */
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, 32 * 1024 * 1024);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, arenasize);
res = mps_arena_create_k(&arena, mps_arena_class_vm(), args);
} MPS_ARGS_END(args);
if (res != MPS_RES_OK) error("Couldn't create arena");

12
mps/example/scheme/scheme-boehm.c
View file

@ -281,6 +281,7 @@ static void error(char *format, ...)
if (error_handler) {
longjmp(*error_handler, 1);
} else {
fflush(stdout);
fprintf(stderr, "Fatal error during initialization: %s\n",
error_message);
abort();
@ -3599,6 +3600,7 @@ int main(int argc, char *argv[])
make_operator(optab[i].name, optab[i].entry,
obj_empty, obj_empty, env, op_env));
} else {
fflush(stdout);
fprintf(stderr,
"Fatal error during initialization: %s\n",
error_message);
@ -3608,18 +3610,24 @@ int main(int argc, char *argv[])
if(argc >= 2) {
/* Non-interactive file execution */
if(setjmp(*error_handler) != 0) {
fflush(stdout);
fprintf(stderr, "%s\n", error_message);
return EXIT_FAILURE;
}
load(env, op_env, argv[1]);
for (i = 1; i < argc; ++i)
load(env, op_env, argv[i]);
return EXIT_SUCCESS;
} else {
/* Interactive read-eval-print loop */
puts("Scheme Test Harness");
for(;;) {
if(setjmp(*error_handler) != 0)
if(setjmp(*error_handler) != 0) {
fflush(stdout);
fprintf(stderr, "%s\n", error_message);
fflush(stderr);
}
printf("%lu> ", (unsigned long)total);
fflush(stdout);
obj = read(input);
if(obj == obj_eof) break;
obj = eval(env, op_env, obj);

Some files were not shown because too many files have changed in this diff Show more