mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Turning pool init methods the right way in, so that they each call the next method up the class hierarchy.

Browse source 
Copied from Perforce
 Change: 190858
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Richard Brooksby 2016-04-10 17:49:08 +01:00
parent 907494aa56
commit d303ed0aeb
26 changed files with 347 additions and 189 deletions
Download patch file Download diff file Expand all files Collapse all files

1
mps/code/buffer.c
View file

@ -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);

18
mps/code/dbgpool.c
View file

@ -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);
}

1
mps/code/land.c
View file

@ -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));

6
mps/code/mpm.h
View file

@ -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 <code/poolabs.c> */

1
mps/code/mpmst.h
View file

@ -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;

2
mps/code/mpmtypes.h
View file

@ -194,7 +194,7 @@ typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count d
/* Order of types corresponds to PoolClassStruct in <code/mpmst.h> */
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);

80
mps/code/pool.c
View file

@ -81,6 +81,7 @@ Bool PoolCheck(Pool pool)
{
/* Checks ordered as per struct decl in <code/mpmst.h#pool> */
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 <design/pool/#align>. */
* init. See <design/pool/#align>.
*/
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 <design/type/#addr.use> */
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 <design/sig/> */
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);
}

89
mps/code/poolabs.c
View file

@ -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 <design/sig/> */
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 <design/type/#addr.use> */
EventLabelAddr((Addr)class, classId);
}
}
DEFINE_CLASS(Pool, AbstractBufferPool, class)
@ -176,21 +244,6 @@ DEFINE_CLASS(Pool, AbstractCollectPool, class)
* See <design/pool/#no> and <design/pool/#triv>
*/
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);

45
mps/code/poolamc.c
View file

@ -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 <design/poolamc/#init>.
* 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));

36
mps/code/poolams.c
View file

@ -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));

8
mps/code/poolams.h
View file

@ -17,7 +17,8 @@
#include <stdarg.h>
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);

25
mps/code/poolawl.c
View file

@ -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)));

24
mps/code/poollo.c
View file

@ -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));

19
mps/code/poolmfs.c
View file

@ -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);

3
mps/code/poolmfs.h
View file

@ -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)

22
mps/code/poolmrg.c
View file

@ -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);
/* <design/poolmrg/#trans.no-finish> */
PoolAbsFinish(pool);
}

23
mps/code/poolmv.c
View file

@ -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);

3
mps/code/poolmv.h
View file

@ -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);

27
mps/code/poolmv2.c
View file

@ -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);
}

25
mps/code/poolmvff.c
View file

@ -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 */
/* <design/poolmvff/#method.init> */
@ -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));

27
mps/code/pooln.c
View file

@ -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);
}

3
mps/code/pooln.h
View file

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

20
mps/code/poolsnc.c
View file

@ -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) {

5
mps/code/protocol.h
View file

@ -167,8 +167,9 @@ extern void InstFinish(Inst inst);
* <design/protocol/#introspect.c-lang>.
*/
#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)

1
mps/code/seg.c
View file

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

22
mps/code/segsmss.c
View file

@ -50,7 +50,8 @@ typedef struct AMSTStruct {
Sig sig; /* <design/pool/#outer-structure.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;