static void segBufFinish(Inst inst)
{
Buffer buffer = MustBeA(Buffer, inst);
SegBuf segbuf = MustBeA(SegBuf, buffer);
AVER(BufferIsReset(buffer));
segbuf->sig = SigInvalid;
NextMethod(Inst, SegBuf, finish)(inst);
}
static void NFinish(Inst inst)
{
Pool pool = MustBeA(AbstractPool, inst);
PoolN poolN = MustBeA(NPool, pool);
/* Finish pool-specific structures. */
UNUSED(poolN);
NextMethod(Inst, NPool, finish)(inst);
}
static void MFSFinish(Inst inst)
{
Pool pool = MustBeA(AbstractPool, inst);
MFS mfs = MustBeA(MFSPool, pool);
MFSFinishTracts(pool, MFSTractFreeVisitor, UNUSED_POINTER);
mfs->sig = SigInvalid;
NextMethod(Inst, MFSPool, finish)(inst);
}
Bool SegBufCheck(SegBuf segbuf)
{
Buffer buffer;
CHECKS(SegBuf, segbuf);
buffer = MustBeA(Buffer, segbuf);
CHECKD(Buffer, buffer);
CHECKL(RankSetCheck(segbuf->rankSet));
if (buffer->mode & BufferModeTRANSITION) {
/* nothing to check */
} else if ((buffer->mode & BufferModeATTACHED) == 0) {
CHECKL(segbuf->seg == NULL);
} else {
/* The buffer is attached to a segment. */
CHECKL(segbuf->seg != NULL);
CHECKD(Seg, segbuf->seg);
/* To avoid recursive checking, leave it to SegCheck to make */
/* sure the buffer and segment fields tally. */
if (buffer->mode & BufferModeFLIPPED) {
/* Only buffers that allocate pointers get flipped. */
CHECKL(segbuf->rankSet != RankSetEMPTY);
}
}
return TRUE;
}
static void amstSegFinish(Inst inst)
{
Seg seg = MustBeA(Seg, inst);
AMSTSeg amstseg = MustBeA(AMSTSeg, seg);
AVERT(AMSTSeg, amstseg);
if (amstseg->next != NULL)
amstseg->next->prev = NULL;
if (amstseg->prev != NULL)
amstseg->prev->next = NULL;
amstseg->sig = SigInvalid;
/* finish the superclass fields last */
NextMethod(Inst, AMSTSeg, finish)(inst);
}
static void BufferAbsFinish(Inst inst)
{
Buffer buffer = MustBeA(Buffer, inst);
AVERT(Buffer, buffer);
AVER(BufferIsReset(buffer));
/* Detach the buffer from its owning pool and unsig it. */
RingRemove(&buffer->poolRing);
InstFinish(MustBeA(Inst, buffer));
buffer->sig = SigInvalid;
/* Finish off the generic buffer fields. */
RingFinish(&buffer->poolRing);
EVENT1(BufferFinish, buffer);
}
static Res AMSTInit(Pool pool, Arena arena, PoolClass klass, ArgList args)
{
AMST amst;
AMS ams;
Res res;
res = NextMethod(Pool, AMSTPool, init)(pool, arena, klass, args);
if (res != ResOK)
return res;
amst = CouldBeA(AMSTPool, pool);
ams = MustBeA(AMSPool, pool);
ams->segSize = AMSTSegSizePolicy;
ams->segClass = AMSTSegClassGet;
amst->failSegs = TRUE;
amst->splits = 0;
amst->merges = 0;
amst->badSplits = 0;
amst->badMerges = 0;
amst->bsplits = 0;
amst->bmerges = 0;
SetClassOfPoly(pool, CLASS(AMSTPool));
amst->sig = AMSTSig;
AVERC(AMSTPool, amst);
return ResOK;
}
static void segBufDetach(Buffer buffer)
{
SegBuf segbuf = MustBeA(SegBuf, buffer);
Seg seg = segbuf->seg;
SegUnsetBuffer(seg);
segbuf->seg = NULL;
}
static void segBufAttach(Buffer buffer, Addr base, Addr limit,
Addr init, Size size)
{
SegBuf segbuf = MustBeA(SegBuf, buffer);
Seg seg = NULL; /* suppress "may be used uninitialized" */
Arena arena;
Bool found;
/* Other parameters are consistency checked in BufferAttach */
UNUSED(init);
UNUSED(size);
arena = BufferArena(buffer);
found = SegOfAddr(&seg, arena, base);
AVER(found);
AVER(segbuf->seg == NULL);
AVER(!SegHasBuffer(seg));
AVER(SegBase(seg) <= base);
AVER(limit <= SegLimit(seg));
/* attach the buffer to the segment */
SegSetBuffer(seg, buffer);
segbuf->seg = seg;
AVERT(SegBuf, segbuf);
}
static void NBlacken(Pool pool, TraceSet traceSet, Seg seg)
{
PoolN poolN = MustBeA(NPool, pool);
AVERT(TraceSet, traceSet);
AVERT(Seg, seg);
UNUSED(poolN);
}
static void NGrey(Pool pool, Trace trace, Seg seg)
{
PoolN poolN = MustBeA(NPool, pool);
AVERT(Trace, trace);
AVERT(Seg, seg);
UNUSED(poolN);
}
void BufferFinish(Buffer buffer)
{
AVERT(Buffer, buffer);
AVER(BufferIsReady(buffer));
BufferDetach(buffer, BufferPool(buffer)); /* FIXME: Should be in BufferAbsFinish? */
Method(Inst, buffer, finish)(MustBeA(Inst, buffer));
}
static void NReclaim(Pool pool, Trace trace, Seg seg)
{
PoolN poolN = MustBeA(NPool, pool);
AVERT(Trace, trace);
AVERT(Seg, seg);
UNUSED(poolN);
/* all unmarked and white objects reclaimed */
}
static Res NAlloc(Addr *pReturn, Pool pool, Size size)
{
PoolN poolN = MustBeA(NPool, pool);
AVER(pReturn != NULL);
AVER(size > 0);
UNUSED(poolN);
return ResLIMIT; /* limit of nil blocks exceeded */
}
static void NFree(Pool pool, Addr old, Size size)
{
PoolN poolN = MustBeA(NPool, pool);
AVER(old != (Addr)0);
AVER(size > 0);
UNUSED(poolN);
NOTREACHED; /* can't allocate, should never free */
}
static Res NScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
{
PoolN poolN = MustBeA(NPool, pool);
AVER(totalReturn != NULL);
AVERT(ScanState, ss);
AVERT(Seg, seg);
UNUSED(poolN);
return ResOK;
}
/* MVTFinish -- finish an MVT pool
*/
static void MVTFinish(Inst inst)
{
Pool pool = MustBeA(AbstractPool, inst);
MVT mvt = MustBeA(MVTPool, pool);
Arena arena = PoolArena(pool);
Ring ring;
Ring node, nextNode;
AVERT(MVT, mvt);
mvt->sig = SigInvalid;
/* Free the segments in the pool */
ring = PoolSegRing(pool);
RING_FOR(node, ring, nextNode) {
/* We mustn't call MVTSegFree, because we don't know whether or not
* there was any fragmented (unavailable) space in this segment,
* and so we can't keep the accounting correct. */
SegFree(SegOfPoolRing(node));
}
static void AMSTFinish(Inst inst)
{
Pool pool = MustBeA(AbstractPool, inst);
AMST amst = MustBeA(AMSTPool, pool);
AVERT(AMST, amst);
amst->sig = SigInvalid;
printf("\nDestroying pool, having performed:\n");
printf(" %"PRIuLONGEST" splits (S)\n", (ulongest_t)amst->splits);
printf(" %"PRIuLONGEST" merges (M)\n", (ulongest_t)amst->merges);
printf(" %"PRIuLONGEST" aborted splits (B)\n", (ulongest_t)amst->badSplits);
printf(" %"PRIuLONGEST" aborted merges (D)\n", (ulongest_t)amst->badMerges);
printf(" which included:\n");
printf(" %"PRIuLONGEST" buffered splits (C)\n", (ulongest_t)amst->bsplits);
printf(" %"PRIuLONGEST" buffered merges (J)\n", (ulongest_t)amst->bmerges);
NextMethod(Inst, AMSTPool, finish)(inst);
}
void MFSFinishTracts(Pool pool, MFSTractVisitor visitor,
void *closure)
{
MFS mfs = MustBeA(MFSPool, pool);
while (mfs->tractList != NULL) {
Tract nextTract = (Tract)TractP(mfs->tractList); /* .tract.chain */
visitor(pool, TractBase(mfs->tractList), mfs->extendBy, closure);
mfs->tractList = nextTract;
}
}
static Bool AMSSegRegionIsFree(Seg seg, Addr base, Addr limit)
{
AMSSeg amsseg = MustBeA(AMSSeg, seg);
Index baseIndex = PoolIndexOfAddr(SegBase(seg), SegPool(seg), base);
if (amsseg->allocTableInUse) {
Index limitIndex = PoolIndexOfAddr(SegBase(seg), SegPool(seg), limit);
return BTIsResRange(amsseg->allocTable, baseIndex, limitIndex);
} else {
return amsseg->firstFree <= baseIndex;
}
}
static Res NWhiten(Pool pool, Trace trace, Seg seg)
{
PoolN poolN = MustBeA(NPool, pool);
AVERT(Trace, trace);
AVERT(Seg, seg);
UNUSED(poolN);
NOTREACHED; /* pool doesn't have any actions */
return ResUNIMPL;
}
static Res NFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
{
PoolN poolN = MustBeA(NPool, pool);
AVERT(ScanState, ss);
UNUSED(refIO);
AVERT(Seg, seg);
UNUSED(poolN);
NOTREACHED; /* Since we don't allocate any objects, should never */
/* be called upon to fix a reference. */
return ResFAIL;
}
static void MFSFree(Pool pool, Addr old, Size size)
{
MFS mfs = MustBeA(MFSPool, pool);
Header h;
AVER(old != (Addr)0);
AVER(size == mfs->unroundedUnitSize);
/* .freelist.fragments */
h = (Header)old;
h->next = mfs->freeList;
mfs->freeList = h;
mfs->free += mfs->unitSize;
}
static Res NBufferFill(Addr *baseReturn, Addr *limitReturn,
Pool pool, Buffer buffer, Size size)
{
PoolN poolN = MustBeA(NPool, pool);
AVER(baseReturn != NULL);
AVER(limitReturn != NULL);
AVERT(Buffer, buffer);
AVER(BufferIsReset(buffer));
AVER(size > 0);
UNUSED(poolN);
NOTREACHED; /* can't create buffers, so shouldn't fill them */
return ResUNIMPL;
}
void MFSExtend(Pool pool, Addr base, Size size)
{
MFS mfs = MustBeA(MFSPool, pool);
Tract tract;
Word i, unitsPerExtent;
Size unitSize;
Header header = NULL;
AVER(size == mfs->extendBy);
/* Ensure that the memory we're adding belongs to this pool. This is
automatic if it was allocated using ArenaAlloc, but if the memory is
being inserted from elsewhere then it must have been set up correctly. */
AVER(PoolHasAddr(pool, base));
/* .tract.chain: chain first tracts through TractP(tract) */
tract = TractOfBaseAddr(PoolArena(pool), base);
AVER(TractPool(tract) == pool);
TractSetP(tract, (void *)mfs->tractList);
mfs->tractList = tract;
/* Update accounting */
mfs->total += size;
mfs->free += size;
/* Sew together all the new empty units in the region, working down */
/* from the top so that they are in ascending order of address on the */
/* free list. */
unitSize = mfs->unitSize;
unitsPerExtent = size/unitSize;
AVER(unitsPerExtent > 0);
#define SUB(b, s, i) ((Header)AddrAdd(b, (s)*(i)))
for(i = 0; i < unitsPerExtent; ++i)
{
header = SUB(base, unitSize, unitsPerExtent-i - 1);
AVER(AddrIsAligned(header, pool->alignment));
AVER(AddrAdd((Addr)header, unitSize) <= AddrAdd(base, size));
header->next = mfs->freeList;
mfs->freeList = header;
}
#undef SUB
}
static Res MFSAlloc(Addr *pReturn, Pool pool, Size size)
{
MFS mfs = MustBeA(MFSPool, pool);
Header f;
Res res;
AVER(pReturn != NULL);
AVER(size == mfs->unroundedUnitSize);
f = mfs->freeList;
/* If the free list is empty then extend the pool with a new region. */
if(f == NULL)
{
Addr base;
/* See design.mps.bootstrap.land.sol.pool. */
if (!mfs->extendSelf)
return ResLIMIT;
/* Create a new region and attach it to the pool. */
res = ArenaAlloc(&base, LocusPrefDefault(), mfs->extendBy, pool);
if(res != ResOK)
return res;
MFSExtend(pool, base, mfs->extendBy);
/* The first unit in the region is now the head of the new free list. */
f = mfs->freeList;
}
AVER(f != NULL);
/* Detach the first free unit from the free list and return its address. */
mfs->freeList = f->next;
AVER(mfs->free >= mfs->unitSize);
mfs->free -= mfs->unitSize;
*pReturn = (Addr)f;
return ResOK;
}
static Size MFSFreeSize(Pool pool)
{
MFS mfs = MustBeA(MFSPool, pool);
return mfs->free;
}
static Size MFSTotalSize(Pool pool)
{
MFS mfs = MustBeA(MFSPool, pool);
return mfs->total;
}
static void segBufSetRankSet(Buffer buffer, RankSet rankset)
{
SegBuf segbuf = MustBeA(SegBuf, buffer);
AVERT(RankSet, rankset);
segbuf->rankSet = rankset;
}
Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
{
return Method(Inst, buffer, describe)(MustBeA(Inst, buffer), stream, depth);
}