diff --git a/mps/code/arena.c b/mps/code/arena.c index 89abc7e0e7c..8491c1976dd 100644 --- a/mps/code/arena.c +++ b/mps/code/arena.c @@ -638,6 +638,7 @@ typedef struct ArenaAllocPageClosureStruct { Pool pool; Addr base; Chunk avoid; + Res res; } ArenaAllocPageClosureStruct, *ArenaAllocPageClosure; static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS) @@ -656,18 +657,25 @@ static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS) UNUSED(closureS); /* Already searched in arenaAllocPage. */ - if (chunk == cl->avoid) + if (chunk == cl->avoid) { + cl->res = ResRESOURCE; return TRUE; + } if (!BTFindShortResRange(&basePageIndex, &limitPageIndex, chunk->allocTable, chunk->allocBase, chunk->pages, 1)) + { + cl->res = ResRESOURCE; return TRUE; + } res = (*cl->arena->class->pagesMarkAllocated)(cl->arena, chunk, basePageIndex, 1, cl->pool); - if (res != ResOK) + if (res != ResOK) { + cl->res = res; return TRUE; + } cl->base = PageIndexBase(chunk, basePageIndex); return FALSE; @@ -685,6 +693,7 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool) closure.pool = pool; closure.base = NULL; closure.avoid = NULL; + closure.res = ResOK; /* Favour the primary chunk, because pages allocated this way aren't currently freed, and we don't want to prevent chunks being destroyed. */ @@ -697,7 +706,8 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool) arenaAllocPageInChunk, &closure, 0)) goto found; - return ResRESOURCE; + AVER(closure.res != ResOK); + return closure.res; found: AVER(closure.base != NULL); diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c index a288b420b20..58d1abce445 100644 --- a/mps/code/arenacl.c +++ b/mps/code/arenacl.c @@ -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); + /* FIXME: AVER(closureP == UNUSED_POINTER); */ + UNUSED(closureP); + /* FIXME: 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,7 +301,6 @@ failChunkCreate: static void ClientArenaFinish(Arena arena) { ClientArena clientArena; - Tree *treeref, *nextref, tree, next; clientArena = Arena2ClientArena(arena); AVERT(ClientArena, clientArena); @@ -298,9 +308,8 @@ static void ClientArenaFinish(Arena arena) /* Destroy all chunks, including the primary. See * */ arena->primary = NULL; - TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, arena->chunkTree) { - clientChunkDestroy(ChunkOfTree(tree)); - } + /* FIXME: use UNUSED_POINTER, UNUSED_SIZE instead of NULL, 0 */ + TreeTraverseAndDelete(&arena->chunkTree, clientChunkDestroy, NULL, 0); clientArena->sig = SigInvalid; diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c index 83f042e265c..800e7aeca21 100644 --- a/mps/code/arenavm.c +++ b/mps/code/arenavm.c @@ -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); + /* FIXME: AVER(closureP == UNUSED_POINTER); */ + UNUSED(closureP); + /* FIXME: 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; } @@ -589,7 +599,6 @@ static void VMArenaFinish(Arena arena) { VMArena vmArena; VM arenaVM; - Tree *treeref, *nextref, tree, next; vmArena = Arena2VMArena(arena); AVERT(VMArena, vmArena); @@ -600,9 +609,8 @@ static void VMArenaFinish(Arena arena) /* Destroy all chunks, including the primary. See * */ arena->primary = NULL; - TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, arena->chunkTree) { - vmChunkDestroy(ChunkOfTree(tree)); - } + /* FIXME: use UNUSED_POINTER, UNUSED_SIZE instead of NULL, 0 */ + TreeTraverseAndDelete(&arena->chunkTree, vmChunkDestroy, NULL, 0); /* Destroying the chunks should have purged and removed all spare pages. */ RingFinish(&vmArena->spareRing); @@ -1084,11 +1092,42 @@ 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); + /* FIXME: 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, closureP, closureS); + vmArena->contracted(arena, base, size); + return TRUE; + } else { + /* Keep this chunk. */ + return FALSE; + } +} + + static void VMCompact(Arena arena, Trace trace) { VMArena vmArena; Size vmem1; - Tree *treeref, *nextref, tree, next; vmArena = Arena2VMArena(arena); AVERT(VMArena, vmArena); @@ -1099,21 +1138,8 @@ static void VMCompact(Arena arena, Trace trace) /* Destroy chunks that are completely free, but not the primary * chunk. See * TODO: add hysteresis here. See job003815. */ - TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, arena->chunkTree) { - Chunk 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(chunk); - vmArena->contracted(arena, base, size); - } else { - /* Keep this chunk. */ - treeref = nextref; - } - } + /* FIXME: use UNUSED_SIZE instead of 0 */ + TreeTraverseAndDelete(&arena->chunkTree, vmChunkCompact, arena, 0); { Size vmem0 = trace->preTraceArenaReserved; diff --git a/mps/code/tract.c b/mps/code/tract.c index c40eb3ac784..ec159458e25 100644 --- a/mps/code/tract.c +++ b/mps/code/tract.c @@ -520,7 +520,6 @@ static Bool tractSearch(Tract *tractReturn, Arena arena, Addr addr) } } while (chunkAboveAddr(&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)) { diff --git a/mps/code/tree.c b/mps/code/tree.c index 7936383b5a9..e6dd902f3fd 100644 --- a/mps/code/tree.c +++ b/mps/code/tree.c @@ -528,6 +528,41 @@ void TreeBalance(Tree *treeIO) } +/* TreeTraverseAndDelete -- traverse a tree while deleting nodes + * + * The visitor function must return TRUE to delete the current node, + * or FALSE to keep it. + * + * See . + */ +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 * * Copyright (C) 2014 Ravenbrook Limited . diff --git a/mps/code/tree.h b/mps/code/tree.h index e7f70d8efd4..2b5636fd087 100644 --- a/mps/code/tree.h +++ b/mps/code/tree.h @@ -134,28 +134,8 @@ extern Tree TreeReverseRightSpine(Tree tree); extern Count TreeToVine(Tree *treeIO); extern void TreeBalance(Tree *treeIO); -/* TREE_TRAVERSE_AND_DELETE -- traverse a tree while deleting nodes - * - * root is an lvalue storing a pointer to the root of the tree. It is - * evaluated twice. - * treeref and nextref are variables of type Tree*. - * tree and next are variables of type Tree. - * - * In the body of the loop, tree and next are the current and next - * node respectively, and treeref and nextref are the locations where - * pointers to these nodes are stored. Nodes are deleted from the tree - * by default, or you can assign treeref = nextref in the body of the - * loop to keep the current node. - * - * See . - */ -#define TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, root) \ - for ((treeref = &(root), TreeToVine(treeref), next = TreeEMPTY); \ - (tree = *treeref) != TreeEMPTY \ - ? (nextref = &tree->right, next = *nextref, TRUE) \ - : (TreeBalance(&(root)), FALSE); \ - *treeref = next) - +extern void TreeTraverseAndDelete(Tree *treeIO, TreeVisitor visitor, + void *closureP, Size closureS); #endif /* tree_h */ diff --git a/mps/design/arena.txt b/mps/design/arena.txt index cf243e2877d..980d716f229 100644 --- a/mps/design/arena.txt +++ b/mps/design/arena.txt @@ -247,8 +247,8 @@ _`.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 macro -``TREE_TRAVERSE_AND_DELETE()`` assists with this. +``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 @@ -258,8 +258,8 @@ 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 macro -``TREE_TRAVERSE_AND_DELETE()`` helps get this right. +chunk must be looked up before deleting the current chunk. The function +``TreeTraverseAndDelete()`` ensures that this is done. Tracts