mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-07 20:30:32 -08:00
Code Issues Projects Releases Wiki Activity

Catch-up merge from master sources to branch/2015-08-06/config.

Browse source 
Copied from Perforce
 Change: 188146
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Gareth Rees 2015-08-14 16:35:07 +01:00
commit c2d2eacdb2
8 changed files with 136 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

100
mps/code/arena.c
View file

@ -243,10 +243,11 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
arena->sig = ArenaSig;
AVERT(Arena, arena);
/* Initialise a pool to hold the arena's CBS blocks. This pool can't be
allowed to extend itself using ArenaAlloc because it is used during
ArenaAlloc, so MFSExtendSelf is set to FALSE. Failures to extend are
handled where the Land is used. */
/* Initialise a pool to hold the CBS blocks for the arena's free
* land. This pool can't be allowed to extend itself using
* ArenaAlloc because it is used to implement ArenaAlloc, so
* MFSExtendSelf is set to FALSE. Failures to extend are handled
* where the free land is used: see arenaFreeLandInsertExtend. */
MPS_ARGS_BEGIN(piArgs) {
MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSZonedBlockStruct));
@ -258,18 +259,6 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
if (res != ResOK)
goto failMFSInit;
/* Initialise the freeLand. */
MPS_ARGS_BEGIN(liArgs) {
MPS_ARGS_ADD(liArgs, CBSBlockPool, ArenaCBSBlockPool(arena));
res = LandInit(ArenaFreeLand(arena), CBSZonedLandClassGet(), arena,
ArenaGrainSize(arena), arena, liArgs);
} MPS_ARGS_END(liArgs);
AVER(res == ResOK); /* no allocation, no failure expected */
if (res != ResOK)
goto failLandInit;
/* Note that although freeLand is initialised, it doesn't have any memory
for its blocks, so hasFreeLand remains FALSE until later. */
/* initialize the reservoir, <design/reservoir/> */
res = ReservoirInit(&arena->reservoirStruct, arena);
if (res != ResOK)
@ -279,8 +268,6 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
return ResOK;
failReservoirInit:
LandFinish(ArenaFreeLand(arena));
failLandInit:
PoolFinish(ArenaCBSBlockPool(arena));
failMFSInit:
GlobalsFinish(ArenaGlobals(arena));
@ -316,16 +303,33 @@ static Res arenaFreeLandInit(Arena arena)
AVER(!arena->hasFreeLand);
AVER(arena->primary != NULL);
/* With the primary chunk initialised we can add page memory to the freeLand
* that describes the free address space in the primary chunk. */
/* Initialise the free land. */
MPS_ARGS_BEGIN(liArgs) {
MPS_ARGS_ADD(liArgs, CBSBlockPool, ArenaCBSBlockPool(arena));
res = LandInit(ArenaFreeLand(arena), CBSZonedLandClassGet(), arena,
ArenaGrainSize(arena), arena, liArgs);
} MPS_ARGS_END(liArgs);
AVER(res == ResOK); /* no allocation, no failure expected */
if (res != ResOK)
goto failLandInit;
/* With the primary chunk initialised we can add page memory to the
* free land that describes the free address space in the primary
* chunk. */
res = ArenaFreeLandInsert(arena,
PageIndexBase(arena->primary,
arena->primary->allocBase),
arena->primary->limit);
if (res != ResOK)
return res;
goto failFreeLandInsert;
arena->hasFreeLand = TRUE;
return ResOK;
failFreeLandInsert:
LandFinish(ArenaFreeLand(arena));
failLandInit:
return res;
}
Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
@ -441,16 +445,16 @@ static void arenaMFSPageFreeVisitor(Pool pool, Addr base, Size size,
static void arenaFreeLandFinish(Arena arena)
{
/* We must tear down the freeLand before the chunks, because pages
* containing CBS blocks might be allocated in those chunks. */
AVERT(Arena, arena);
AVER(arena->hasFreeLand);
arena->hasFreeLand = FALSE;
LandFinish(ArenaFreeLand(arena));
/* The CBS block pool can't free its own memory via ArenaFree because
* that would use the freeLand. */
* that would use the free land. */
MFSFinishTracts(ArenaCBSBlockPool(arena), arenaMFSPageFreeVisitor,
UNUSED_POINTER, UNUSED_SIZE);
arena->hasFreeLand = FALSE;
LandFinish(ArenaFreeLand(arena));
}
void ArenaDestroy(Arena arena)
@ -464,6 +468,8 @@ void ArenaDestroy(Arena arena)
ControlFinish(arena);
/* We must tear down the free land before the chunks, because pages
* containing CBS blocks might be allocated in those chunks. */
arenaFreeLandFinish(arena);
/* Call class-specific finishing. This will call ArenaFinish. */
@ -854,7 +860,7 @@ static Res arenaExtendCBSBlockPool(Range pageRangeReturn, Arena arena)
return res;
MFSExtend(ArenaCBSBlockPool(arena), pageBase, ArenaGrainSize(arena));
RangeInit(pageRangeReturn, pageBase, AddrAdd(pageBase, ArenaGrainSize(arena)));
RangeInitSize(pageRangeReturn, pageBase, ArenaGrainSize(arena));
return ResOK;
}
@ -874,15 +880,19 @@ static void arenaExcludePage(Arena arena, Range pageRange)
}
/* arenaLandInsert -- add range to arena's land, maybe extending block pool
/* arenaFreeLandInsertExtend -- add range to arena's free land, maybe
* extending block pool
*
* The arena's land can't get memory in the usual way because it is
* used in the basic allocator, so we allocate pages specially.
* The arena's free land can't get memory for its block pool in the
* usual way (via ArenaAlloc), because it is the mechanism behind
* ArenaAlloc! So we extend the block pool via a back door (see
* arenaExtendCBSBlockPool).
*
* Only fails if it can't get a page for the block pool.
*/
static Res arenaLandInsert(Range rangeReturn, Arena arena, Range range)
static Res arenaFreeLandInsertExtend(Range rangeReturn, Arena arena,
Range range)
{
Res res;
@ -908,16 +918,18 @@ static Res arenaLandInsert(Range rangeReturn, Arena arena, Range range)
}
/* ArenaFreeLandInsert -- add range to arena's land, maybe stealing memory
/* arenaFreeLandInsertSteal -- add range to arena's free land, maybe
* stealing memory
*
* See arenaLandInsert. This function may only be applied to mapped
* pages and may steal them to store Land nodes if it's unable to
* allocate space for CBS blocks.
* See arenaFreeLandInsertExtend. This function may only be applied to
* mapped pages and may steal them to store Land nodes if it's unable
* to allocate space for CBS blocks.
*
* IMPORTANT: May update rangeIO.
*/
static void arenaLandInsertSteal(Range rangeReturn, Arena arena, Range rangeIO)
static void arenaFreeLandInsertSteal(Range rangeReturn, Arena arena,
Range rangeIO)
{
Res res;
@ -925,7 +937,7 @@ static void arenaLandInsertSteal(Range rangeReturn, Arena arena, Range rangeIO)
AVERT(Arena, arena);
AVERT(Range, rangeIO);
res = arenaLandInsert(rangeReturn, arena, rangeIO);
res = arenaFreeLandInsertExtend(rangeReturn, arena, rangeIO);
if (res != ResOK) {
Addr pageBase;
@ -954,7 +966,8 @@ static void arenaLandInsertSteal(Range rangeReturn, Arena arena, Range rangeIO)
}
/* ArenaFreeLandInsert -- add range to arena's land, maybe extending block pool
/* ArenaFreeLandInsert -- add range to arena's free land, maybe extending
* block pool
*
* The inserted block of address space may not abut any existing block.
* This restriction ensures that we don't coalesce chunks and allocate
@ -969,7 +982,7 @@ Res ArenaFreeLandInsert(Arena arena, Addr base, Addr limit)
AVERT(Arena, arena);
RangeInit(&range, base, limit);
res = arenaLandInsert(&oldRange, arena, &range);
res = arenaFreeLandInsertExtend(&oldRange, arena, &range);
if (res != ResOK)
return res;
@ -984,7 +997,8 @@ Res ArenaFreeLandInsert(Arena arena, Addr base, Addr limit)
}
/* ArenaFreeLandDelete -- remove range from arena's land, maybe extending block pool
/* ArenaFreeLandDelete -- remove range from arena's free land, maybe
* extending block pool
*
* This is called from ChunkFinish in order to remove address space from
* the arena.
@ -1076,7 +1090,7 @@ static Res arenaAllocFromLand(Tract *tractReturn, ZoneSet zones, Bool high,
failMark:
{
Res insertRes = arenaLandInsert(&oldRange, arena, &range);
Res insertRes = arenaFreeLandInsertExtend(&oldRange, arena, &range);
AVER(insertRes == ResOK); /* We only just deleted it. */
/* If the insert does fail, we lose some address space permanently. */
}
@ -1288,7 +1302,7 @@ void ArenaFree(Addr base, Size size, Pool pool)
RangeInit(&range, base, limit);
arenaLandInsertSteal(&oldRange, arena, &range); /* may update range */
arenaFreeLandInsertSteal(&oldRange, arena, &range); /* may update range */
(*arena->class->free)(RangeBase(&range), RangeSize(&range), pool);

22
mps/code/freelist.c
View file

@ -1,7 +1,7 @@
/* freelist.c: FREE LIST ALLOCATOR IMPLEMENTATION
*
* $Id$
* Copyright (c) 2013-2014 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2013-2015 Ravenbrook Limited. See end of file for license.
*
* .sources: <design/freelist/>.
*/
@ -18,11 +18,11 @@ SRCID(freelist, "$Id$");
typedef union FreelistBlockUnion {
struct {
struct FreelistBlockSmall {
FreelistBlock next; /* tagged with low bit 1 */
/* limit is (char *)this + freelistAlignment(fl) */
} small;
struct {
struct FreelistBlockLarge {
FreelistBlock next; /* not tagged (low bit 0) */
Addr limit;
} large;
@ -101,6 +101,9 @@ static Bool FreelistBlockCheck(FreelistBlock block)
CHECKL(freelistBlockNext(block) == freelistEND
|| block < freelistBlockNext(block));
CHECKL(freelistBlockIsSmall(block) || (Addr)block < block->large.limit);
/* Would like to CHECKL(!freelistBlockIsSmall(block) ||
* freelistBlockSize(fl, block) == freelistAlignment(fl)) but we
* don't have 'fl' here. This is checked in freelistBlockSetLimit. */
return TRUE;
}
@ -139,6 +142,7 @@ static void freelistBlockSetLimit(Freelist fl, FreelistBlock block, Addr limit)
} else {
AVER(size >= sizeof(block->small));
block->small.next = freelistTagSet(block->small.next);
AVER(freelistBlockSize(fl, block) == freelistAlignment(fl));
}
AVER(freelistBlockLimit(fl, block) == limit);
}
@ -170,6 +174,9 @@ Bool FreelistCheck(Freelist fl)
CHECKS(Freelist, fl);
land = FreelistLand(fl);
CHECKD(Land, land);
CHECKL(AlignCheck(FreelistMinimumAlignment));
CHECKL(sizeof(struct FreelistBlockSmall) < sizeof(struct FreelistBlockLarge));
CHECKL(sizeof(struct FreelistBlockSmall) <= freelistAlignment(fl));
/* See <design/freelist/#impl.grain.align> */
CHECKL(AlignIsAligned(freelistAlignment(fl), FreelistMinimumAlignment));
CHECKL((fl->list == freelistEND) == (fl->listSize == 0));
@ -236,12 +243,14 @@ static Size freelistSize(Land land)
* Otherwise, if next is freelistEND, make prev the last block in the list.
* Otherwise, make next follow prev in the list.
* Update the count of blocks by 'delta'.
*
* It is tempting to try to simplify this code by putting a
* FreelistBlockUnion into the FreelistStruct and so avoiding the
* special case on prev. But the problem with that idea is that we
* can't guarantee that such a sentinel would respect the isolated
* range invariant, and so it would still have to be special-cases.
* range invariant (it would have to be at a lower address than the
* first block in the free list, which the MPS has no mechanism to
* enforce), and so it would still have to be special-cased.
*/
static void freelistBlockSetPrevNext(Freelist fl, FreelistBlock prev,
@ -781,6 +790,7 @@ static Res freelistDescribe(Land land, mps_lib_FILE *stream, Count depth)
res = WriteF(stream, depth,
"Freelist $P {\n", (WriteFP)fl,
" listSize = $U\n", (WriteFU)fl->listSize,
" size = $U\n", (WriteFU)fl->size,
NULL);
b = LandIterate(land, freelistDescribeVisitor, stream, depth + 2);
@ -815,7 +825,7 @@ DEFINE_LAND_CLASS(FreelistLandClass, class)
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2013-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2013-2015 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*