From 3dd201bf47b2d5224dceeecc6d30802ca01fa14f Mon Sep 17 00:00:00 2001 From: Richard Brooksby Date: Sun, 10 Apr 2016 17:49:08 +0100 Subject: [PATCH] Turning pool init methods the right way in, so that they each call the next method up the class hierarchy. Copied from Perforce Change: 190858 ServerID: perforce.ravenbrook.com --- mps/code/buffer.c | 1 + mps/code/dbgpool.c | 18 +++++---- mps/code/land.c | 1 + mps/code/mpm.h | 6 +-- mps/code/mpmst.h | 1 - mps/code/mpmtypes.h | 2 +- mps/code/pool.c | 80 ++++++---------------------------------- mps/code/poolabs.c | 89 ++++++++++++++++++++++++++++++++++++--------- mps/code/poolamc.c | 45 ++++++++++++++++------- mps/code/poolams.c | 36 +++++++++++++----- mps/code/poolams.h | 8 ++-- mps/code/poolawl.c | 25 ++++++++++--- mps/code/poollo.c | 24 ++++++++---- mps/code/poolmfs.c | 19 +++++++--- mps/code/poolmfs.h | 3 +- mps/code/poolmrg.c | 22 ++++++++--- mps/code/poolmv.c | 23 +++++++++--- mps/code/poolmv.h | 3 +- mps/code/poolmv2.c | 27 +++++++++----- mps/code/poolmvff.c | 25 ++++++++++--- mps/code/pooln.c | 27 ++++++++++++-- mps/code/pooln.h | 3 +- mps/code/poolsnc.c | 20 ++++++++-- mps/code/protocol.h | 5 ++- mps/code/seg.c | 1 + mps/code/segsmss.c | 22 +++++++---- 26 files changed, 347 insertions(+), 189 deletions(-) diff --git a/mps/code/buffer.c b/mps/code/buffer.c index 5bb0026201b..5ebf51d47d7 100644 --- a/mps/code/buffer.c +++ b/mps/code/buffer.c @@ -39,6 +39,7 @@ static void BufferFrameNotifyPopPending(Buffer buffer); Bool BufferCheck(Buffer buffer) { CHECKS(Buffer, buffer); + CHECKC(Buffer, buffer); CHECKL(buffer->serial < buffer->pool->bufferSerial); /* .trans.mod */ CHECKU(Arena, buffer->arena); CHECKU(Pool, buffer->pool); diff --git a/mps/code/dbgpool.c b/mps/code/dbgpool.c index 38bf5d6b739..af94f3308e3 100644 --- a/mps/code/dbgpool.c +++ b/mps/code/dbgpool.c @@ -127,7 +127,7 @@ static PoolDebugOptionsStruct debugPoolOptionsDefault = { "POST", 4, "DEAD", 4, }; -static Res DebugPoolInit(Pool pool, ArgList args) +static Res DebugPoolInit(Pool pool, Arena arena, PoolClass class, ArgList args) { Res res; PoolDebugOptions options = &debugPoolOptionsDefault; @@ -136,7 +136,10 @@ static Res DebugPoolInit(Pool pool, ArgList args) Size tagSize; ArgStruct arg; - AVERT(Pool, pool); + AVER(pool != NULL); + AVERT(Arena, arena); + AVERT(PoolClass, class); + AVERT(ArgList, args); if (ArgPick(&arg, args, MPS_KEY_POOL_DEBUG_OPTIONS)) options = (PoolDebugOptions)arg.val.pool_debug_options; @@ -147,10 +150,11 @@ static Res DebugPoolInit(Pool pool, ArgList args) /* not been published yet. */ tagInit = NULL; tagSize = 0; - res = SuperclassOfPool(pool)->init(pool, args); + res = SuperclassPoly(Pool, class)->init(pool, arena, class, args); if (res != ResOK) return res; + SetClassOfPool(pool, class); debug = DebugPoolDebugMixin(pool); AVER(debug != NULL); @@ -202,7 +206,7 @@ static Res DebugPoolInit(Pool pool, ArgList args) return ResOK; tagFail: - SuperclassOfPool(pool)->finish(pool); + SuperclassPoly(Pool, class)->finish(pool); AVER(res != ResOK); return res; } @@ -223,7 +227,7 @@ static void DebugPoolFinish(Pool pool) SplayTreeFinish(&debug->index); PoolDestroy(debug->tagPool); } - SuperclassOfPool(pool)->finish(pool); + SuperclassPoly(Pool, ClassOfPool(pool))->finish(pool); } @@ -404,7 +408,7 @@ static Res freeCheckAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool, AVER(aReturn != NULL); - res = SuperclassOfPool(pool)->alloc(&new, pool, size); + res = SuperclassPoly(Pool, ClassOfPool(pool))->alloc(&new, pool, size); if (res != ResOK) return res; if (debug->freeSize != 0) @@ -423,7 +427,7 @@ static void freeCheckFree(PoolDebugMixin debug, { if (debug->freeSize != 0) freeSplat(debug, pool, old, AddrAdd(old, size)); - SuperclassOfPool(pool)->free(pool, old, size); + SuperclassPoly(Pool, ClassOfPool(pool))->free(pool, old, size); } diff --git a/mps/code/land.c b/mps/code/land.c index fc5ee2f43ad..87707d8647c 100644 --- a/mps/code/land.c +++ b/mps/code/land.c @@ -59,6 +59,7 @@ Bool LandCheck(Land land) { /* .enter-leave.simple */ CHECKS(Land, land); + CHECKC(Land, land); CHECKD(LandClass, ClassOfLand(land)); CHECKU(Arena, land->arena); CHECKL(AlignCheck(land->alignment)); diff --git a/mps/code/mpm.h b/mps/code/mpm.h index 6629f2c7f2c..8e802e3ecfe 100644 --- a/mps/code/mpm.h +++ b/mps/code/mpm.h @@ -239,8 +239,8 @@ extern void PoolFreeWalk(Pool pool, FreeBlockVisitor f, void *p); extern Size PoolTotalSize(Pool pool); extern Size PoolFreeSize(Pool pool); -extern Res PoolTrivInit(Pool pool, ArgList arg); -extern void PoolTrivFinish(Pool pool); +extern Res PoolAbsInit(Pool pool, Arena arena, PoolClass class, ArgList arg); +extern void PoolAbsFinish(Pool pool); extern Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size); extern Res PoolTrivAlloc(Addr *pReturn, Pool pool, Size size); extern void PoolNoFree(Pool pool, Addr old, Size size); @@ -294,8 +294,6 @@ extern Size PoolNoSize(Pool pool); common superclass of pools is called AbstractPool, not Pool. */ #define ClassOfPool(pool) ((PoolClass)ClassOfPoly(pool)) #define SetClassOfPool SetClassOfPoly -#define SuperclassOfPool(pool) \ - ((PoolClass)InstClassSuperclassPoly(ClassOfPool(pool))) /* Abstract Pool Classes Interface -- see */ diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h index 8b0a866c265..6b5c21cec88 100644 --- a/mps/code/mpmst.h +++ b/mps/code/mpmst.h @@ -81,7 +81,6 @@ typedef struct mps_pool_class_s { PoolDebugMixinMethod debugMixin; /* find the debug mixin, if any */ PoolSizeMethod totalSize; /* total memory allocated from arena */ PoolSizeMethod freeSize; /* free memory (unused by client program) */ - Bool labelled; /* whether it has been EventLabelled */ Sig sig; /* .class.end-sig */ } PoolClassStruct; diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h index 43bd8f3b48c..1a77776fe3e 100644 --- a/mps/code/mpmtypes.h +++ b/mps/code/mpmtypes.h @@ -194,7 +194,7 @@ typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count d /* Order of types corresponds to PoolClassStruct in */ typedef void (*PoolVarargsMethod)(ArgStruct args[], va_list varargs); -typedef Res (*PoolInitMethod)(Pool pool, ArgList args); +typedef Res (*PoolInitMethod)(Pool pool, Arena arena, PoolClass class, ArgList args); typedef void (*PoolFinishMethod)(Pool pool); typedef Res (*PoolAllocMethod)(Addr *pReturn, Pool pool, Size size); typedef void (*PoolFreeMethod)(Pool pool, Addr old, Size size); diff --git a/mps/code/pool.c b/mps/code/pool.c index 3868d06d2a3..92220e3ebdf 100644 --- a/mps/code/pool.c +++ b/mps/code/pool.c @@ -81,6 +81,7 @@ Bool PoolCheck(Pool pool) { /* Checks ordered as per struct decl in */ CHECKS(Pool, pool); + CHECKC(AbstractPool, pool); /* Break modularity for checking efficiency */ CHECKL(pool->serial < ArenaGlobals(pool->arena)->poolSerial); CHECKD(PoolClass, ClassOfPool(pool)); @@ -116,73 +117,33 @@ ARG_DEFINE_KEY(INTERIOR, Bool); /* PoolInit -- initialize a pool * * Initialize the generic fields of the pool and calls class-specific - * init. See . */ + * init. See . + */ Res PoolInit(Pool pool, Arena arena, PoolClass class, ArgList args) { Res res; - Word classId; - Globals globals; - AVER(pool != NULL); - AVERT(Arena, arena); AVERT(PoolClass, class); - globals = ArenaGlobals(arena); - /* Superclass init */ - InstInit(CouldBeA(Inst, pool)); - - /* label the pool class with its name */ - if (!class->labelled) { - /* We could still get multiple labelling if multiple instances of */ - /* the pool class get created simultaneously, but it's not worth */ - /* putting another lock in the code. */ - class->labelled = TRUE; - classId = EventInternString(class->protocol.name); - /* NOTE: this breaks */ - EventLabelAddr((Addr)class, classId); - } - - pool->arena = arena; - RingInit(&pool->arenaRing); - RingInit(&pool->bufferRing); - RingInit(&pool->segRing); - pool->bufferSerial = (Serial)0; - pool->alignment = MPS_PF_ALIGN; - pool->format = NULL; - pool->fix = class->fix; - - pool->serial = globals->poolSerial; - ++(globals->poolSerial); - - /* Initialise signature last; see */ - SetClassOfPool(pool, class); - pool->sig = PoolSig; - AVERT(Pool, pool); - - /* Do class-specific initialization. */ - /* FIXME: Should be calling this first, which next-method calls PoolAbsInit. */ - res = class->init(pool, args); + res = class->init(pool, arena, class, args); if (res != ResOK) - goto failInit; + return res; + + /* FIXME: Where should this go? */ + pool->fix = ClassOfPool(pool)->fix; /* Add initialized pool to list of pools in arena. */ - RingAppend(&globals->poolRing, &pool->arenaRing); + /* FIXME: Should be in PoolAbsInit */ + RingAppend(&ArenaGlobals(arena)->poolRing, &pool->arenaRing); /* Add initialized pool to list of pools using format. */ + /* FIXME: Should be in inits of pools that use formats. */ if (pool->format) { - ++ pool->format->poolCount; + ++pool->format->poolCount; } return ResOK; - -failInit: - pool->sig = SigInvalid; /* Leave arena->poolSerial incremented */ - InstFinish(CouldBeA(Inst, pool)); - RingFinish(&pool->segRing); - RingFinish(&pool->bufferRing); - RingFinish(&pool->arenaRing); - return res; } @@ -226,24 +187,7 @@ failControlAlloc: void PoolFinish(Pool pool) { AVERT(Pool, pool); - - /* Do any class-specific finishing. */ Method(Pool, pool, finish)(pool); - - /* Detach the pool from the arena and format, and unsig it. */ - RingRemove(&pool->arenaRing); - if (pool->format) { - AVER(pool->format->poolCount > 0); - -- pool->format->poolCount; - } - pool->sig = SigInvalid; - InstFinish(CouldBeA(Inst, pool)); - - RingFinish(&pool->segRing); - RingFinish(&pool->bufferRing); - RingFinish(&pool->arenaRing); - - EVENT1(PoolFinish, pool); } diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c index 486ae312d39..4702bad4ae8 100644 --- a/mps/code/poolabs.c +++ b/mps/code/poolabs.c @@ -108,14 +108,71 @@ void PoolClassMixInCollect(PoolClass class) /* Classes */ +/* PoolAbsInit -- initialize an abstract pool instance */ + +Res PoolAbsInit(Pool pool, Arena arena, PoolClass class, ArgList args) +{ + AVER(pool != NULL); /* FIXME: express intention */ + AVERT(Arena, arena); + UNUSED(args); + UNUSED(class); /* used for debug pools only */ + + /* Superclass init */ + InstInit(CouldBeA(Inst, pool)); + + pool->arena = arena; + RingInit(&pool->arenaRing); + RingInit(&pool->bufferRing); + RingInit(&pool->segRing); + pool->bufferSerial = (Serial)0; + pool->alignment = MPS_PF_ALIGN; + pool->format = NULL; + pool->fix = PoolNoFix; + + pool->serial = ArenaGlobals(arena)->poolSerial; + ++ArenaGlobals(arena)->poolSerial; + + /* Initialise signature last; see */ + SetClassOfPool(pool, CLASS(AbstractPool)); + pool->sig = PoolSig; + AVERT(Pool, pool); + + return ResOK; +} + + +/* PoolAbsFinish -- finish an abstract pool instance */ + +void PoolAbsFinish(Pool pool) +{ + /* Detach the pool from the arena and format, and unsig it. */ + RingRemove(&pool->arenaRing); + + /* FIXME: Should be done in finish of pools that use formats */ + if (pool->format) { + AVER(pool->format->poolCount > 0); + --pool->format->poolCount; + } + + pool->sig = SigInvalid; + InstFinish(CouldBeA(Inst, pool)); + + RingFinish(&pool->segRing); + RingFinish(&pool->bufferRing); + RingFinish(&pool->arenaRing); + + EVENT1(PoolFinish, pool); +} + + DEFINE_CLASS(Pool, AbstractPool, class) { INHERIT_CLASS(&class->protocol, AbstractPool, Inst); class->size = sizeof(PoolStruct); class->attr = 0; class->varargs = ArgTrivVarargs; - class->init = PoolTrivInit; - class->finish = PoolTrivFinish; + class->init = PoolAbsInit; + class->finish = PoolAbsFinish; class->alloc = PoolNoAlloc; class->free = PoolNoFree; class->bufferFill = PoolNoBufferFill; @@ -142,8 +199,19 @@ DEFINE_CLASS(Pool, AbstractPool, class) class->debugMixin = PoolNoDebugMixin; class->totalSize = PoolNoSize; class->freeSize = PoolNoSize; - class->labelled = FALSE; class->sig = PoolClassSig; + + /* FIXME: This was moved from PoolInit, but seems odd. Should be + done for all classes? */ + /* label the pool class with its name */ + /* We could still get multiple labelling if multiple instances of */ + /* the pool class get created simultaneously, but it's not worth */ + /* putting another lock in the code. */ + { + Word classId = EventInternString(class->protocol.name); + /* NOTE: this breaks */ + EventLabelAddr((Addr)class, classId); + } } DEFINE_CLASS(Pool, AbstractBufferPool, class) @@ -176,21 +244,6 @@ DEFINE_CLASS(Pool, AbstractCollectPool, class) * See and */ - -void PoolTrivFinish(Pool pool) -{ - AVERT(Pool, pool); - NOOP; -} - -Res PoolTrivInit(Pool pool, ArgList args) -{ - AVERT(Pool, pool); - AVERT(ArgList, args); - UNUSED(args); - return ResOK; -} - Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size) { AVER(pReturn != NULL); diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c index 249606ac4b2..13d049b76a1 100644 --- a/mps/code/poolamc.c +++ b/mps/code/poolamc.c @@ -16,7 +16,8 @@ SRCID(poolamc, "$Id$"); /* AMC typedef */ -typedef struct AMCStruct *AMC; +/* FIXME: Inconsistent naming of AMCPool class and AMC types. */ +typedef struct AMCStruct *AMC, *AMCPool, *AMCZPool; /* amcGen typedef */ typedef struct amcGenStruct *amcGen; @@ -32,6 +33,7 @@ static Nailboard amcSegNailboard(Seg seg); static Bool AMCCheck(AMC amc); static Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO); DECLARE_CLASS(Pool, AMCZPool); +DECLARE_CLASS(Pool, AMCPool); DECLARE_CLASS(Buffer, amcBuf); DECLARE_CLASS(Seg, amcSeg); @@ -721,11 +723,11 @@ static void AMCVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs) * See . * Shared by AMCInit and AMCZinit. */ -static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args) +static Res amcInitComm(Pool pool, Arena arena, PoolClass class, + RankSet rankSet, ArgList args) { AMC amc; Res res; - Arena arena; Index i; size_t genArraySize; size_t genCount; @@ -734,14 +736,16 @@ static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args) Size extendBy = AMC_EXTEND_BY_DEFAULT; Size largeSize = AMC_LARGE_SIZE_DEFAULT; ArgStruct arg; + Format format; AVER(pool != NULL); - - amc = PoolAMC(pool); - arena = PoolArena(pool); - + AVERT(Arena, arena); + AVERT(ArgList, args); + AVERT(PoolClass, class); + AVER(IsSubclass(class, AMCZPool)); + ArgRequire(&arg, args, MPS_KEY_FORMAT); - pool->format = arg.val.format; + format = arg.val.format; if (ArgPick(&arg, args, MPS_KEY_CHAIN)) chain = arg.val.chain; else @@ -753,8 +757,8 @@ static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args) if (ArgPick(&arg, args, MPS_KEY_LARGE_SIZE)) largeSize = arg.val.size; - AVERT(Format, pool->format); - AVER(FormatArena(pool->format) == arena); + AVERT(Format, format); + AVER(FormatArena(format) == arena); AVERT(Chain, chain); AVER(chain->arena == arena); AVER(extendBy > 0); @@ -764,6 +768,14 @@ static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args) * unacceptable fragmentation due to the padding objects. This * assertion catches this bad case. */ AVER(largeSize >= extendBy); + + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + return res; + SetClassOfPool(pool, class); + amc = MustBeA(AMCZPool, pool); + + pool->format = format; pool->alignment = pool->format->alignment; pool->fix = AMCFix; amc->rankSet = rankSet; @@ -835,17 +847,20 @@ failGenAlloc: } ControlFree(arena, amc->gen, genArraySize); failGensAlloc: + PoolAbsFinish(pool); return res; } -static Res AMCInit(Pool pool, ArgList args) +static Res AMCInit(Pool pool, Arena arena, PoolClass class, ArgList args) { - return amcInitComm(pool, RankSetSingle(RankEXACT), args); + UNUSED(class); /* used for debug pools only */ + return amcInitComm(pool, arena, CLASS(AMCPool), RankSetSingle(RankEXACT), args); } -static Res AMCZInit(Pool pool, ArgList args) +static Res AMCZInit(Pool pool, Arena arena, PoolClass class, ArgList args) { - return amcInitComm(pool, RankSetEMPTY, args); + UNUSED(class); /* used for debug pools only */ + return amcInitComm(pool, arena, CLASS(AMCZPool), RankSetEMPTY, args); } @@ -900,6 +915,7 @@ static void AMCFinish(Pool pool) } amc->sig = SigInvalid; + PoolAbsFinish(pool); } @@ -2211,6 +2227,7 @@ ATTRIBUTE_UNUSED static Bool AMCCheck(AMC amc) { CHECKS(AMC, amc); + CHECKC(AMCZPool, amc); CHECKD(Pool, AMCPool(amc)); CHECKL(IsA(AMCZPool, AMCPool(amc))); CHECKL(RankSetCheck(amc->rankSet)); diff --git a/mps/code/poolams.c b/mps/code/poolams.c index b8241d7852c..c284f5bdaff 100644 --- a/mps/code/poolams.c +++ b/mps/code/poolams.c @@ -780,7 +780,7 @@ static void AMSDebugVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs) ARG_DEFINE_KEY(AMS_SUPPORT_AMBIGUOUS, Bool); -static Res AMSInit(Pool pool, ArgList args) +static Res AMSInit(Pool pool, Arena arena, PoolClass class, ArgList args) { Res res; Format format; @@ -789,13 +789,15 @@ static Res AMSInit(Pool pool, ArgList args) unsigned gen = AMS_GEN_DEFAULT; ArgStruct arg; - AVERT(Pool, pool); + AVER(pool != NULL); + AVERT(Arena, arena); AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ if (ArgPick(&arg, args, MPS_KEY_CHAIN)) chain = arg.val.chain; else { - chain = ArenaGlobals(PoolArena(pool))->defaultChain; + chain = ArenaGlobals(arena)->defaultChain; gen = 1; /* avoid the nursery of the default chain by default */ } if (ArgPick(&arg, args, MPS_KEY_GEN)) @@ -807,7 +809,8 @@ static Res AMSInit(Pool pool, ArgList args) /* .ambiguous.noshare: If the pool is required to support ambiguous */ /* references, the alloc and white tables cannot be shared. */ - res = AMSInitInternal(PoolAMS(pool), format, chain, gen, !supportAmbiguous); + res = AMSInitInternal(PoolAMS(pool), arena, class, + format, chain, gen, !supportAmbiguous, args); if (res == ResOK) { EVENT3(PoolInitAMS, pool, PoolArena(pool), format); } @@ -817,15 +820,23 @@ static Res AMSInit(Pool pool, ArgList args) /* AMSInitInternal -- initialize an AMS pool, given the format and the chain */ -Res AMSInitInternal(AMS ams, Format format, Chain chain, unsigned gen, - Bool shareAllocTable) +Res AMSInitInternal(AMS ams, Arena arena, PoolClass class, + Format format, Chain chain, unsigned gen, + Bool shareAllocTable, ArgList args) { Pool pool; Res res; /* Can't check ams, it's not initialized. */ pool = AMSPool(ams); - AVERT(Pool, pool); + + AVERT(Arena, arena); + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + goto failAbsInit; + SetClassOfPool(pool, CLASS(AMSPool)); + AVER(ams == MustBeA(AMSPool, pool)); + AVERT(Format, format); AVER(FormatArena(format) == PoolArena(pool)); pool->format = format; @@ -838,7 +849,7 @@ Res AMSInitInternal(AMS ams, Format format, Chain chain, unsigned gen, res = PoolGenInit(&ams->pgen, ChainGen(chain, gen), pool); if (res != ResOK) - return res; + goto failGenInit; ams->shareAllocTable = shareAllocTable; @@ -853,6 +864,11 @@ Res AMSInitInternal(AMS ams, Format format, Chain chain, unsigned gen, ams->sig = AMSSig; AVERT(AMS, ams); return ResOK; + +failGenInit: + PoolAbsFinish(pool); +failAbsInit: + return res; } @@ -869,11 +885,12 @@ void AMSFinish(Pool pool) ams = PoolAMS(pool); AVERT(AMS, ams); - (ams->segsDestroy)(ams); + ams->segsDestroy(ams); /* can't invalidate the AMS until we've destroyed all the segs */ ams->sig = SigInvalid; RingFinish(&ams->segRing); PoolGenFinish(&ams->pgen); + PoolAbsFinish(pool); } @@ -1819,6 +1836,7 @@ mps_pool_class_t mps_class_ams_debug(void) Bool AMSCheck(AMS ams) { CHECKS(AMS, ams); + CHECKC(AMSPool, ams); CHECKD(Pool, AMSPool(ams)); CHECKL(IsA(AMSPool, AMSPool(ams))); CHECKL(PoolAlignment(AMSPool(ams)) == AMSGrainsSize(ams, (Size)1)); diff --git a/mps/code/poolams.h b/mps/code/poolams.h index a7ee4df4744..ea6c82dba61 100644 --- a/mps/code/poolams.h +++ b/mps/code/poolams.h @@ -17,7 +17,8 @@ #include -typedef struct AMSStruct *AMS; +/* FIXME: Inconsistent naming of AMSPool class and AMS types. */ +typedef struct AMSStruct *AMS, *AMSPool; typedef struct AMSSegStruct *AMSSeg; @@ -166,8 +167,9 @@ typedef struct AMSSegStruct { /* the rest */ -extern Res AMSInitInternal(AMS ams, Format format, Chain chain, unsigned gen, - Bool shareAllocTable); +extern Res AMSInitInternal(AMS ams, Arena arena, PoolClass class, + Format format, Chain chain, unsigned gen, + Bool shareAllocTable, ArgList args); extern void AMSFinish(Pool pool); extern Bool AMSCheck(AMS ams); diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c index 9df4d05c41c..efa8e9d35e9 100644 --- a/mps/code/poolawl.c +++ b/mps/code/poolawl.c @@ -45,6 +45,8 @@ SRCID(poolawl, "$Id$"); +DECLARE_CLASS(Pool, AWLPool); + #define AWLSig ((Sig)0x519B7A37) /* SIGnature PooL AWL */ @@ -539,7 +541,7 @@ static Addr awlNoDependent(Addr addr) ARG_DEFINE_KEY(AWL_FIND_DEPENDENT, Fun); -static Res AWLInit(Pool pool, ArgList args) +static Res AWLInit(Pool pool, Arena arena, PoolClass class, ArgList args) { AWL awl; Format format; @@ -549,11 +551,11 @@ static Res AWLInit(Pool pool, ArgList args) ArgStruct arg; unsigned gen = AWL_GEN_DEFAULT; - /* Weak check, as half-way through initialization. */ AVER(pool != NULL); + AVERT(Arena, arena); + AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ - awl = PoolAWL(pool); - ArgRequire(&arg, args, MPS_KEY_FORMAT); format = arg.val.format; if (ArgPick(&arg, args, MPS_KEY_AWL_FIND_DEPENDENT)) @@ -561,14 +563,21 @@ static Res AWLInit(Pool pool, ArgList args) if (ArgPick(&arg, args, MPS_KEY_CHAIN)) chain = arg.val.chain; else { - chain = ArenaGlobals(PoolArena(pool))->defaultChain; + chain = ArenaGlobals(arena)->defaultChain; gen = 1; /* avoid the nursery of the default chain by default */ } if (ArgPick(&arg, args, MPS_KEY_GEN)) gen = arg.val.u; AVERT(Format, format); - AVER(FormatArena(format) == PoolArena(pool)); + AVER(FormatArena(format) == arena); + + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + goto failAbsInit; + SetClassOfPool(pool, CLASS(AWLPool)); + awl = MustBeA(AWLPool, pool); + pool->format = format; pool->alignment = format->alignment; @@ -593,6 +602,8 @@ static Res AWLInit(Pool pool, ArgList args) return ResOK; failGenInit: + PoolAbsFinish(pool); +failAbsInit: AVER(res != ResOK); return res; } @@ -623,6 +634,7 @@ static void AWLFinish(Pool pool) } awl->sig = SigInvalid; PoolGenFinish(&awl->pgen); + PoolAbsFinish(pool); } @@ -1353,6 +1365,7 @@ ATTRIBUTE_UNUSED static Bool AWLCheck(AWL awl) { CHECKS(AWL, awl); + CHECKC(AWLPool, awl); CHECKD(Pool, AWLPool(awl)); CHECKC(AWLPool, awl); CHECKL(AWLGrainsSize(awl, (Count)1) == PoolAlignment(AWLPool(awl))); diff --git a/mps/code/poollo.c b/mps/code/poollo.c index 51ee3b1cd80..1341d1a03f8 100644 --- a/mps/code/poollo.c +++ b/mps/code/poollo.c @@ -14,12 +14,15 @@ SRCID(poollo, "$Id$"); +DECLARE_CLASS(Pool, LOPool); + /* LOStruct -- leaf object pool instance structure */ #define LOSig ((Sig)0x51970B07) /* SIGnature LO POoL */ -typedef struct LOStruct *LO; +/* FIXME: Inconsistent naming of LOPool class and LO types. */ +typedef struct LOStruct *LO, *LOPool; typedef struct LOStruct { PoolStruct poolStruct; /* generic pool structure */ @@ -469,21 +472,24 @@ static void LOVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs) /* LOInit -- initialize an LO pool */ -static Res LOInit(Pool pool, ArgList args) +static Res LOInit(Pool pool, Arena arena, PoolClass class, ArgList args) { LO lo; - Arena arena; Res res; ArgStruct arg; Chain chain; unsigned gen = LO_GEN_DEFAULT; - AVERT(Pool, pool); + AVER(pool != NULL); + AVERT(Arena, arena); AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ - arena = PoolArena(pool); - - lo = PoolPoolLO(pool); + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + goto failAbsInit; + SetClassOfPool(pool, CLASS(LOPool)); + lo = MustBeA(LOPool, pool); ArgRequire(&arg, args, MPS_KEY_FORMAT); pool->format = arg.val.format; @@ -515,6 +521,8 @@ static Res LOInit(Pool pool, ArgList args) return ResOK; failGenInit: + PoolAbsFinish(pool); +failAbsInit: AVER(res != ResOK); return res; } @@ -544,6 +552,7 @@ static void LOFinish(Pool pool) PoolGenFinish(&lo->pgen); lo->sig = SigInvalid; + PoolAbsFinish(pool); } @@ -852,6 +861,7 @@ ATTRIBUTE_UNUSED static Bool LOCheck(LO lo) { CHECKS(LO, lo); + CHECKC(LOPool, lo); CHECKD(Pool, LOPool(lo)); CHECKC(LOPool, lo); CHECKL(ShiftCheck(lo->alignShift)); diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c index 1894efac1d1..96dc8d416d8 100644 --- a/mps/code/poolmfs.c +++ b/mps/code/poolmfs.c @@ -38,6 +38,8 @@ SRCID(poolmfs, "$Id$"); +DECLARE_CLASS(Pool, MFSPool); + /* ROUND -- Round up * @@ -75,17 +77,19 @@ static void MFSVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs) ARG_DEFINE_KEY(MFS_UNIT_SIZE, Size); ARG_DEFINE_KEY(MFSExtendSelf, Bool); -static Res MFSInit(Pool pool, ArgList args) +static Res MFSInit(Pool pool, Arena arena, PoolClass class, ArgList args) { Size extendBy = MFS_EXTEND_BY_DEFAULT; Bool extendSelf = TRUE; Size unitSize; MFS mfs; - Arena arena; ArgStruct arg; + Res res; AVER(pool != NULL); + AVERT(Arena, arena); AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ ArgRequire(&arg, args, MPS_KEY_MFS_UNIT_SIZE); unitSize = arg.val.size; @@ -97,9 +101,12 @@ static Res MFSInit(Pool pool, ArgList args) AVER(unitSize > 0); AVER(extendBy > 0); AVERT(Bool, extendSelf); - - mfs = PoolPoolMFS(pool); - arena = PoolArena(pool); + + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + return res; + SetClassOfPool(pool, CLASS(MFSPool)); + mfs = MustBeA(MFSPool, pool); mfs->unroundedUnitSize = unitSize; @@ -162,6 +169,7 @@ static void MFSFinish(Pool pool) MFSFinishTracts(pool, MFSTractFreeVisitor, UNUSED_POINTER); mfs->sig = SigInvalid; + PoolAbsFinish(pool); } @@ -388,6 +396,7 @@ Bool MFSCheck(MFS mfs) Arena arena; CHECKS(MFS, mfs); + CHECKC(MFSPool, mfs); CHECKD(Pool, MFSPool(mfs)); CHECKC(MFSPool, mfs); CHECKL(mfs->unitSize >= UNIT_MIN); diff --git a/mps/code/poolmfs.h b/mps/code/poolmfs.h index 70d4124cb42..5ed32421df2 100644 --- a/mps/code/poolmfs.h +++ b/mps/code/poolmfs.h @@ -31,7 +31,8 @@ #include "mpm.h" #include "mpscmfs.h" -typedef struct MFSStruct *MFS; +/* FIXME: Inconsistent naming of MFSPool class and MFS types. */ +typedef struct MFSStruct *MFS, *MFSPool; #define MFSPool(mfs) (&(mfs)->poolStruct) diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c index e3af8d94496..cbf77e86cfb 100644 --- a/mps/code/poolmrg.c +++ b/mps/code/poolmrg.c @@ -34,6 +34,8 @@ SRCID(poolmrg, "$Id$"); +DECLARE_CLASS(Pool, MRGPool); + /* Types */ @@ -131,6 +133,7 @@ ATTRIBUTE_UNUSED static Bool MRGCheck(MRG mrg) { CHECKS(MRG, mrg); + CHECKC(MRGPool, mrg); CHECKD(Pool, MRGPool(mrg)); CHECKC(MRGPool, mrg); CHECKD_NOSIG(Ring, &mrg->entryRing); @@ -625,16 +628,23 @@ static Res MRGRefSegScan(ScanState ss, MRGRefSeg refseg, MRG mrg) /* MRGInit -- init method for MRG */ -static Res MRGInit(Pool pool, ArgList args) +static Res MRGInit(Pool pool, Arena arena, PoolClass class, ArgList args) { MRG mrg; + Res res; - AVER(pool != NULL); /* Can't check more; see pool contract @@@@ */ + AVER(pool != NULL); /* FIXME: express intention */ AVERT(ArgList, args); UNUSED(args); - - mrg = PoolMRG(pool); + UNUSED(class); /* used for debug pools only */ + /* FIXME: These lines are often repeated */ + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + return res; + SetClassOfPool(pool, CLASS(MRGPool)); + mrg = MustBeA(MRGPool, pool); + RingInit(&mrg->entryRing); RingInit(&mrg->freeRing); RingInit(&mrg->refRing); @@ -642,7 +652,7 @@ static Res MRGInit(Pool pool, ArgList args) mrg->sig = MRGSig; AVERT(MRG, mrg); - EVENT3(PoolInit, pool, PoolArena(pool), ClassOfPool(pool)); + EVENT3(PoolInit, pool, PoolArena(pool), ClassOfPool(pool)); /* FIXME: Out of place? */ return ResOK; } @@ -691,6 +701,8 @@ static void MRGFinish(Pool pool) mrg->sig = SigInvalid; RingFinish(&mrg->refRing); /* */ + + PoolAbsFinish(pool); } diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c index cc671d120cc..147a583f883 100644 --- a/mps/code/poolmv.c +++ b/mps/code/poolmv.c @@ -34,6 +34,8 @@ SRCID(poolmv, "$Id$"); +DECLARE_CLASS(Pool, MVPool); + #define mvBlockPool(mv) MFSPool(&(mv)->blockPoolStruct) #define mvSpanPool(mv) MFSPool(&(mv)->spanPoolStruct) @@ -216,7 +218,7 @@ static void MVDebugVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs) /* MVInit -- init method for class MV */ -static Res MVInit(Pool pool, ArgList args) +static Res MVInit(Pool pool, Arena arena, PoolClass class, ArgList args) { Align align = MV_ALIGN_DEFAULT; Size extendBy = MV_EXTEND_BY_DEFAULT; @@ -224,10 +226,14 @@ static Res MVInit(Pool pool, ArgList args) Size maxSize = MV_MAX_SIZE_DEFAULT; Size blockExtendBy, spanExtendBy; MV mv; - Arena arena; Res res; ArgStruct arg; + AVERT(Arena, arena); + AVER(pool != NULL); /* FIXME: express intention */ + AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ + if (ArgPick(&arg, args, MPS_KEY_ALIGN)) align = arg.val.align; if (ArgPick(&arg, args, MPS_KEY_EXTEND_BY)) @@ -237,8 +243,6 @@ static Res MVInit(Pool pool, ArgList args) if (ArgPick(&arg, args, MPS_KEY_MAX_SIZE)) maxSize = arg.val.size; - arena = PoolArena(pool); - AVERT(Align, align); AVER(align <= ArenaGrainSize(arena)); AVER(extendBy > 0); @@ -247,8 +251,13 @@ static Res MVInit(Pool pool, ArgList args) AVER(maxSize > 0); AVER(extendBy <= maxSize); + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + return res; + SetClassOfPool(pool, CLASS(MVPool)); + mv = MustBeA(MVPool, pool); + pool->alignment = align; - mv = PoolMV(pool); /* At 100% fragmentation we will need one block descriptor for every other */ /* allocated block, or (extendBy/avgSize)/2 descriptors. See note 1. */ @@ -291,6 +300,7 @@ static Res MVInit(Pool pool, ArgList args) failSpanPoolInit: PoolFinish(mvBlockPool(mv)); failBlockPoolInit: + PoolAbsFinish(pool); return res; } @@ -319,6 +329,8 @@ static void MVFinish(Pool pool) PoolFinish(mvBlockPool(mv)); PoolFinish(mvSpanPool(mv)); + + PoolAbsFinish(pool); } @@ -896,6 +908,7 @@ mps_pool_class_t mps_class_mv_debug(void) Bool MVCheck(MV mv) { CHECKS(MV, mv); + CHECKC(MVPool, mv); CHECKD(Pool, MVPool(mv)); CHECKL(IsA(MVPool, MVPool(mv))); CHECKD(MFS, &mv->blockPoolStruct); diff --git a/mps/code/poolmv.h b/mps/code/poolmv.h index 01c5b9ebd73..e73de2f8967 100644 --- a/mps/code/poolmv.h +++ b/mps/code/poolmv.h @@ -20,7 +20,8 @@ #include "mpmtypes.h" #include "mpscmv.h" -typedef struct MVStruct *MV; +/* FIXME: Inconsistent naming of class MVPool and MV types. */ +typedef struct MVStruct *MV, *MVPool; extern PoolClass PoolClassMV(void); diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c index 1b584c27cd5..95ae9d3c061 100644 --- a/mps/code/poolmv2.c +++ b/mps/code/poolmv2.c @@ -29,9 +29,10 @@ SRCID(poolmv2, "$Id$"); /* Private prototypes */ -typedef struct MVTStruct *MVT; +/* FIXME: Inconstent naming of MVTPool class and MVT types. */ +typedef struct MVTStruct *MVT, *MVTPool; static void MVTVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs); -static Res MVTInit(Pool pool, ArgList arg); +static Res MVTInit(Pool pool, Arena arena, PoolClass class, ArgList arg); static Bool MVTCheck(MVT mvt); static void MVTFinish(Pool pool); static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn, @@ -216,9 +217,8 @@ ARG_DEFINE_KEY(MVT_MAX_SIZE, Size); ARG_DEFINE_KEY(MVT_RESERVE_DEPTH, Count); ARG_DEFINE_KEY(MVT_FRAG_LIMIT, double); -static Res MVTInit(Pool pool, ArgList args) +static Res MVTInit(Pool pool, Arena arena, PoolClass class, ArgList args) { - Arena arena; Size align = MVT_ALIGN_DEFAULT; Size minSize = MVT_MIN_SIZE_DEFAULT; Size meanSize = MVT_MEAN_SIZE_DEFAULT; @@ -231,12 +231,11 @@ static Res MVTInit(Pool pool, ArgList args) Res res; ArgStruct arg; - AVERT(Pool, pool); - mvt = PoolMVT(pool); - /* can't AVERT mvt, yet */ - arena = PoolArena(pool); + AVER(pool != NULL); AVERT(Arena, arena); - + AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ + if (ArgPick(&arg, args, MPS_KEY_ALIGN)) align = arg.val.align; if (ArgPick(&arg, args, MPS_KEY_MIN_SIZE)) @@ -276,6 +275,12 @@ static Res MVTInit(Pool pool, ArgList args) if (abqDepth < 3) abqDepth = 3; + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + goto failAbsInit; + SetClassOfPool(pool, CLASS(MVTPool)); + mvt = MustBeA(MVTPool, pool); + res = LandInit(MVTFreePrimary(mvt), CLASS(CBSFast), arena, align, mvt, mps_args_none); if (res != ResOK) @@ -368,6 +373,8 @@ failFreeLandInit: failFreeSecondaryInit: LandFinish(MVTFreePrimary(mvt)); failFreePrimaryInit: + PoolAbsFinish(pool); +failAbsInit: AVER(res != ResOK); return res; } @@ -379,6 +386,7 @@ ATTRIBUTE_UNUSED static Bool MVTCheck(MVT mvt) { CHECKS(MVT, mvt); + CHECKC(MVTPool, mvt); CHECKD(Pool, MVTPool(mvt)); CHECKC(MVTPool, mvt); CHECKD(CBS, &mvt->cbsStruct); @@ -439,6 +447,7 @@ static void MVTFinish(Pool pool) LandFinish(MVTFreeLand(mvt)); LandFinish(MVTFreeSecondary(mvt)); LandFinish(MVTFreePrimary(mvt)); + PoolAbsFinish(pool); } diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c index ecf1c79d9a5..d72052bcb7b 100644 --- a/mps/code/poolmvff.c +++ b/mps/code/poolmvff.c @@ -29,6 +29,8 @@ SRCID(poolmvff, "$Id$"); +DECLARE_CLASS(Pool, MVFFPool); + /* Would go in poolmvff.h if the class had any MPS-internal clients. */ extern PoolClass PoolClassMVFF(void); @@ -42,7 +44,8 @@ extern PoolClass PoolClassMVFF(void); #define MVFFSig ((Sig)0x5193FFF9) /* SIGnature MVFF */ -typedef struct MVFFStruct *MVFF; +/* FIXME: Inconsistent naming of MVFFPool class and MVFF types. */ +typedef struct MVFFStruct *MVFF, *MVFFPool; typedef struct MVFFStruct { /* MVFF pool outer structure */ PoolStruct poolStruct; /* generic structure */ LocusPrefStruct locusPrefStruct; /* the preferences for allocation */ @@ -436,7 +439,7 @@ ARG_DEFINE_KEY(MVFF_SLOT_HIGH, Bool); ARG_DEFINE_KEY(MVFF_ARENA_HIGH, Bool); ARG_DEFINE_KEY(MVFF_FIRST_FIT, Bool); -static Res MVFFInit(Pool pool, ArgList args) +static Res MVFFInit(Pool pool, Arena arena, PoolClass class, ArgList args) { Size extendBy = MVFF_EXTEND_BY_DEFAULT; Size avgSize = MVFF_AVG_SIZE_DEFAULT; @@ -446,12 +449,13 @@ static Res MVFFInit(Pool pool, ArgList args) Bool firstFit = MVFF_FIRST_FIT_DEFAULT; double spare = MVFF_SPARE_DEFAULT; MVFF mvff; - Arena arena; Res res; ArgStruct arg; - AVERT(Pool, pool); - arena = PoolArena(pool); + AVER(pool != NULL); + AVERT(Arena, arena); + AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ /* .arg: class-specific additional arguments; see */ /* */ @@ -494,7 +498,11 @@ static Res MVFFInit(Pool pool, ArgList args) AVERT(Bool, arenaHigh); AVERT(Bool, firstFit); - mvff = PoolMVFF(pool); + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + goto failAbsInit; + SetClassOfPool(pool, CLASS(MVFFPool)); + mvff = MustBeA(MVFFPool, pool); mvff->extendBy = extendBy; if (extendBy < ArenaGrainSize(arena)) @@ -565,6 +573,9 @@ failFreePrimaryInit: failTotalLandInit: PoolFinish(MVFFBlockPool(mvff)); failBlockPoolInit: + PoolAbsFinish(pool); +failAbsInit: + AVER(res != ResOK); return res; } @@ -607,6 +618,7 @@ static void MVFFFinish(Pool pool) LandFinish(MVFFFreePrimary(mvff)); LandFinish(MVFFTotalLand(mvff)); PoolFinish(MVFFBlockPool(mvff)); + PoolAbsFinish(pool); } @@ -760,6 +772,7 @@ ATTRIBUTE_UNUSED static Bool MVFFCheck(MVFF mvff) { CHECKS(MVFF, mvff); + CHECKC(MVFFPool, mvff); CHECKD(Pool, MVFFPool(mvff)); CHECKL(IsA(MVFFPool, MVFFPool(mvff))); CHECKD(LocusPref, MVFFLocusPref(mvff)); diff --git a/mps/code/pooln.c b/mps/code/pooln.c index a47b37a0344..7a01123a600 100644 --- a/mps/code/pooln.c +++ b/mps/code/pooln.c @@ -9,6 +9,8 @@ SRCID(pooln, "$Id$"); +DECLARE_CLASS(Pool, NPool); + /* PoolNStruct -- the pool structure */ @@ -30,17 +32,32 @@ typedef struct PoolNStruct { /* NInit -- init method for class N */ -static Res NInit(Pool pool, ArgList args) +static Res NInit(Pool pool, Arena arena, PoolClass class, ArgList args) { - PoolN poolN = PoolPoolN(pool); + PoolN poolN; + Res res; - UNUSED(args); - + AVER(pool != NULL); + AVERT(Arena, arena); + AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ + + /* FIXME: Reduce this boilerplate. */ + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + goto failAbsInit; + SetClassOfPool(pool, CLASS(NPool)); + poolN = MustBeA(NPool, pool); + /* Initialize pool-specific structures. */ AVERT(PoolN, poolN); EVENT3(PoolInit, pool, PoolArena(pool), ClassOfPool(pool)); return ResOK; + +failAbsInit: + AVER(res != ResOK); + return res; } @@ -55,6 +72,8 @@ static void NFinish(Pool pool) AVERT(PoolN, poolN); /* Finish pool-specific structures. */ + + PoolAbsFinish(pool); } diff --git a/mps/code/pooln.h b/mps/code/pooln.h index 36028f876d6..bb339bfced9 100644 --- a/mps/code/pooln.h +++ b/mps/code/pooln.h @@ -20,7 +20,8 @@ /* PoolN -- instance type */ -typedef struct PoolNStruct *PoolN; +/* FIXME: Inconsistent naming between NPool class and PoolN types. */ +typedef struct PoolNStruct *PoolN, *NPool; /* PoolClassN -- returns the PoolClass for the null pool class */ diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c index 8a36d6a98a9..192985c3dbb 100644 --- a/mps/code/poolsnc.c +++ b/mps/code/poolsnc.c @@ -23,6 +23,8 @@ SRCID(poolsnc, "$Id$"); +DECLARE_CLASS(Pool, SNCPool); + /* SNCStruct -- structure for an SNC pool * @@ -35,7 +37,7 @@ typedef struct SNCStruct { PoolStruct poolStruct; Seg freeSegs; Sig sig; -} SNCStruct, *SNC; +} SNCStruct, *SNC, *SNCPool; #define PoolSNC(pool) PARENT(SNCStruct, poolStruct, (pool)) #define SNCPool(snc) (&(snc)->poolStruct) @@ -364,16 +366,23 @@ static void SNCVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs) /* SNCInit -- initialize an SNC pool */ -static Res SNCInit(Pool pool, ArgList args) +static Res SNCInit(Pool pool, Arena arena, PoolClass class, ArgList args) { SNC snc; Format format; ArgStruct arg; + Res res; - /* weak check, as half-way through initialization */ AVER(pool != NULL); + AVERT(Arena, arena); + AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ - snc = PoolSNC(pool); + res = PoolAbsInit(pool, arena, class, args); + if (res != ResOK) + return res; + SetClassOfPool(pool, CLASS(SNCPool)); + snc = MustBeA(SNCPool, pool); ArgRequire(&arg, args, MPS_KEY_FORMAT); format = arg.val.format; @@ -407,6 +416,8 @@ static void SNCFinish(Pool pool) AVERT(Seg, seg); SegFree(seg); } + + PoolAbsFinish(pool); } @@ -733,6 +744,7 @@ ATTRIBUTE_UNUSED static Bool SNCCheck(SNC snc) { CHECKS(SNC, snc); + CHECKC(SNCPool, snc); CHECKD(Pool, SNCPool(snc)); CHECKL(ClassOfPool(SNCPool(snc)) == CLASS(SNCPool)); if (snc->freeSegs != NULL) { diff --git a/mps/code/protocol.h b/mps/code/protocol.h index 44f3b592794..350ce316552 100644 --- a/mps/code/protocol.h +++ b/mps/code/protocol.h @@ -167,8 +167,9 @@ extern void InstFinish(Inst inst); * . */ -#define InstClassSuperclassPoly(class) \ - (((InstClass)(class))->superclass) +/* FIXME: Would like to assert that the superclass has the right kind. */ +#define SuperclassPoly(kind, class) \ + ((CLASS_TYPE(kind))((InstClass)(class))->superclass) #define ClassOfPoly(inst) (MustBeA(Inst, inst)->class) diff --git a/mps/code/seg.c b/mps/code/seg.c index a6da2a6f01c..71a73edcbf0 100644 --- a/mps/code/seg.c +++ b/mps/code/seg.c @@ -675,6 +675,7 @@ Bool SegCheck(Seg seg) Pool pool; CHECKS(Seg, seg); + CHECKC(Seg, seg); CHECKL(TraceSetCheck(seg->white)); /* can't assume nailed is subset of white - mightn't be during whiten */ diff --git a/mps/code/segsmss.c b/mps/code/segsmss.c index 3487f0d0955..c94d1879357 100644 --- a/mps/code/segsmss.c +++ b/mps/code/segsmss.c @@ -50,7 +50,8 @@ typedef struct AMSTStruct { Sig sig; /* */ } AMSTStruct; -typedef struct AMSTStruct *AMST; +/* FIXME: Inconsistent naming between AMSTPool class and AMST types. */ +typedef struct AMSTStruct *AMST, *AMSTPool; #define PoolAMST(pool) PARENT(AMSTStruct, amsStruct, PARENT(AMSStruct, poolStruct, (pool))) #define AMST2AMS(amst) (&(amst)->amsStruct) @@ -319,7 +320,7 @@ static Res AMSTSegSizePolicy(Size *sizeReturn, /* AMSTInit -- the pool class initialization method */ -static Res AMSTInit(Pool pool, ArgList args) +static Res AMSTInit(Pool pool, Arena arena, PoolClass class, ArgList args) { AMST amst; AMS ams; Format format; @@ -328,25 +329,30 @@ static Res AMSTInit(Pool pool, ArgList args) unsigned gen = AMS_GEN_DEFAULT; ArgStruct arg; - AVERT(Pool, pool); + AVER(pool != NULL); + AVERT(Arena, arena); AVERT(ArgList, args); + UNUSED(class); /* used for debug pools only */ if (ArgPick(&arg, args, MPS_KEY_CHAIN)) chain = arg.val.chain; else { - chain = ArenaGlobals(PoolArena(pool))->defaultChain; + chain = ArenaGlobals(arena)->defaultChain; gen = 1; /* avoid the nursery of the default chain by default */ } if (ArgPick(&arg, args, MPS_KEY_GEN)) gen = arg.val.u; ArgRequire(&arg, args, MPS_KEY_FORMAT); format = arg.val.format; - - res = AMSInitInternal(PoolAMS(pool), format, chain, gen, FALSE); + + /* FIXME: Generalise to next-method call */ + res = AMSInitInternal(PoolAMS(pool), arena, class, + format, chain, gen, FALSE, args); if (res != ResOK) return res; - amst = PoolAMST(pool); - ams = PoolAMS(pool); + SetClassOfPool(pool, CLASS(AMSTPool)); + amst = MustBeA(AMSTPool, pool); + ams = MustBeA(AMSPool, pool); ams->segSize = AMSTSegSizePolicy; ams->segClass = AMSTSegClassGet; amst->failSegs = TRUE;