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

Merge branch/2014-05-17/chunk-tree into the master sources.

Browse source 
Copied from Perforce
 Change: 186564
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Gareth Rees 2014-06-13 14:31:31 +01:00
commit e2f9ead969
26 changed files with 804 additions and 602 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

121
mps/code/arena.c
View file

@ -148,8 +148,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));
@ -206,8 +208,8 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment, ArgList args)
arena->primary = NULL;
RingInit(&arena->chunkRing);
arena->chunkTree = TreeEMPTY;
arena->chunkSerial = (Serial)0;
ChunkCacheEntryInit(&arena->chunkCache);
LocusInit(arena);
@ -307,13 +309,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)
@ -346,11 +348,13 @@ Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
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);
}
@ -391,7 +395,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);
@ -497,47 +500,68 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
}
/* arenaDescribeTractsInChunk -- describe the tracts in a chunk */
static Res arenaDescribeTractsInChunk(Chunk chunk, mps_lib_FILE *stream, Count depth)
{
Res res;
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;
Tract tract;
Bool b;
Addr oldLimit, base, limit;
Size size;
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 = ArenaAlign(arena);
if (TractBase(tract) > oldLimit) {
res = WriteF(stream, depth,
"[$P, $P) $W $U ---\n",
(WriteFP)oldLimit, (WriteFP)base,
(WriteFW)AddrOffset(oldLimit, base),
(WriteFU)AddrOffset(oldLimit, base),
NULL);
if (res != ResOK) return res;
}
res = WriteF(stream, depth,
"[$P, $P) $W $U $P ($S)\n",
(WriteFP)base, (WriteFP)limit,
(WriteFW)size, (WriteFW)size,
(WriteFP)TractPool(tract),
(WriteFS)(TractPool(tract)->class->name),
NULL);
RING_FOR(node, &arena->chunkRing, next) {
Chunk chunk = RING_ELT(Chunk, chunkRing, node);
res = arenaDescribeTractsInChunk(chunk, stream, depth);
if (res != ResOK) return res;
b = TractNext(&tract, arena, TractBase(tract));
oldLimit = limit;
}
return ResOK;
}
@ -601,6 +625,25 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
}
/* 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
@ -619,7 +662,7 @@ static Res arenaAllocPageInChunk(Addr *baseReturn, Chunk chunk, Pool pool)
AVERT(Chunk, chunk);
AVERT(Pool, pool);
arena = ChunkArena(chunk);
if (!BTFindShortResRange(&basePageIndex, &limitPageIndex,
chunk->allocTable,
chunk->allocBase, chunk->pages, 1))
@ -630,7 +673,7 @@ static Res arenaAllocPageInChunk(Addr *baseReturn, Chunk chunk, Pool pool)
pool);
if (res != ResOK)
return res;
*baseReturn = PageIndexBase(chunk, basePageIndex);
return ResOK;
}
@ -639,6 +682,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. */
@ -884,7 +931,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 @@ static Res ClientArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
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;

71
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 = ArenaAlign(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 = ArenaAlign(arena);;

91
mps/code/arenavm.c
View file

@ -401,11 +401,19 @@ static Res VMChunkInit(Chunk chunk, BootBlock boot)
/* 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 == arena->alignment);
@ -588,7 +598,6 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
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;

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)

4
mps/code/mpm.h
View file

@ -524,6 +524,7 @@ extern Ring GlobalsRememberedSummaryRing(Globals);
#define ArenaAlign(arena) ((arena)->alignment)
#define ArenaGreyRing(arena, rank) (&(arena)->greyRing[rank])
#define ArenaPoolRing(arena) (&ArenaGlobals(arena)->poolRing)
#define ArenaChunkTree(arena) RVALUE((arena)->chunkTree)
extern void ArenaEnterLock(Arena arena, Bool recursive);
extern void ArenaLeaveLock(Arena arena, Bool recursive);
@ -556,6 +557,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);
@ -620,8 +622,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)

18
mps/code/mpmst.h
View file

@ -519,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 */
@ -744,10 +732,10 @@ 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;
CBSStruct freeLandStruct;

29
mps/code/pool.c
View file

@ -645,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 = AddrAlignDown(base, ArenaAlign(arena));
alignedLimit = AddrAlignUp(limit, ArenaAlign(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;
}
*poolReturn = pool;
return TRUE;
if (havePool) {
*poolReturn = pool;
return TRUE;
} else {
return FALSE;
}
}

40
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;
@ -957,7 +972,7 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
*
* IMPORTANT: Iterating over the tree using these functions will leave
* the tree totally unbalanced, throwing away optimisations of the tree
* shape caused by previous splays. Consider using TreeTraverse instead.
* shape caused by previous splays. Consider using TreeTraverse instead.
*/
Tree SplayTreeFirst(SplayTree splay) {
@ -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);
}
@ -1009,10 +1024,9 @@ static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream,
{
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, 0, "( ", NULL);
if (res != ResOK) return res;
@ -1342,15 +1356,15 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, Count depth,
{
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, 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;

1
mps/code/splay.h
View file

@ -75,6 +75,7 @@ extern Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
Count depth, TreeDescribeMethod nodeDescribe);
extern void SplayDebugUpdate(SplayTree splay, Tree tree);
extern Count SplayDebugCount(SplayTree splay);
#endif /* splay_h */

118
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,59 +1282,70 @@ 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;
if(TRACT_SEG(&seg, tract)) {
Res res;
Pool pool;
STATISTIC(++ss->segRefCount);
STATISTIC(++ss->whiteSegRefCount);
EVENT1(TraceFixSeg, seg);
EVENT0(TraceFixWhite);
pool = TractPool(tract);
res = (*ss->fix)(pool, ss, seg, &ref);
if(res != ResOK) {
/* PoolFixEmergency should never fail. */
AVER_CRITICAL(ss->fix != PoolFixEmergency);
/* Fix protocol (de facto): if Fix fails, ref must be unchanged
* Justification for this restriction:
* A: it simplifies;
* B: it's reasonable (given what may cause Fix to fail);
* C: the code (here) already assumes this: it returns without
* updating ss->fixedSummary. RHSK 2007-03-21.
*/
AVER(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));
/* 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)) {
++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);
EVENT0(TraceFixWhite);
pool = TractPool(tract);
res = (*ss->fix)(pool, ss, seg, &ref);
if (res != ResOK) {
/* PoolFixEmergency must not fail. */
AVER_CRITICAL(ss->fix != PoolFixEmergency);
/* Fix protocol (de facto): if Fix fails, ref must be unchanged
* Justification for this restriction:
* A: it simplifies;
* B: it's reasonable (given what may cause Fix to fail);
* C: the code (here) already assumes this: it returns without
* updating ss->fixedSummary. RHSK 2007-03-21.
*/
AVER_CRITICAL(ref == (Ref)*mps_ref_io);
return res;
}
done:
/* See <design/trace/#fix.fixed.all> */
ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, ref);

351
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)
{
CHECKU(Pool, TractPool(tract));
CHECKL(AddrIsAligned(TractBase(tract), ArenaAlign(TractArena(tract))));
if (TractHasPool(tract)) {
CHECKU(Pool, TractPool(tract));
CHECKL(AddrIsAligned(TractBase(tract), ArenaAlign(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), arena->alignment);
}
@ -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);
@ -215,12 +222,16 @@ Res ChunkInit(Chunk chunk, Arena arena,
PageIndexBase(chunk, chunk->allocBase),
chunk->limit);
if (res != ResOK)
goto failLandInsert;
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 @@ Res ChunkInit(Chunk chunk, Arena arena,
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);
*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;
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;
}
/* 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, arena->alignment));
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

@ -220,6 +220,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
......
@ -263,16 +305,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 alignment to the base address.
@ -282,9 +328,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``.
@ -292,10 +337,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
............

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

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

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

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

46
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>
@ -4321,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;
@ -4376,17 +4377,16 @@ static int start(int argc, char *argv[])
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. */
@ -4418,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. */
@ -4451,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;
@ -4458,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");

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

@ -3614,7 +3614,8 @@ int main(int argc, char *argv[])
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 */

3
mps/example/scheme/scheme-malloc.c
View file

@ -3611,7 +3611,8 @@ int main(int argc, char *argv[])
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 */

46
mps/example/scheme/scheme.c
View file

@ -39,6 +39,7 @@
#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <getopt.h>
#include <setjmp.h>
#include <stdarg.h>
#include <stddef.h>
@ -4249,7 +4250,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;
@ -4306,17 +4307,16 @@ static int start(int argc, char *argv[])
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. */
@ -4348,7 +4348,6 @@ static int start(int argc, char *argv[])
}
}
puts("Bye.");
exit_code = EXIT_SUCCESS;
}
/* See comment at the end of `main` about cleaning up. */
@ -4385,6 +4384,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;
@ -4392,11 +4392,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");