diff --git a/mps/code/arena.c b/mps/code/arena.c index 7a109367dc2..bfffcbf450c 100644 --- a/mps/code/arena.c +++ b/mps/code/arena.c @@ -254,7 +254,8 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args) if (ArgPick(&arg, args, MPS_KEY_PAUSE_TIME)) pauseTime = arg.val.d; - SetClassOfArena(arena, class); /* FIXME: Should call InstInit here? */ + /* Superclass init */ + InstInit(&arena->instStruct); arena->reserved = (Size)0; arena->committed = (Size)0; @@ -283,6 +284,7 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args) if (res != ResOK) goto failGlobalsInit; + SetClassOfArena(arena, class); arena->sig = ArenaSig; AVERT(Arena, arena); @@ -308,6 +310,7 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args) failMFSInit: GlobalsFinish(ArenaGlobals(arena)); failGlobalsInit: + InstFinish(&arena->instStruct); return res; } @@ -434,6 +437,7 @@ void ArenaFinish(Arena arena) { PoolFinish(ArenaCBSBlockPool(arena)); arena->sig = SigInvalid; + InstFinish(&arena->instStruct); GlobalsFinish(ArenaGlobals(arena)); LocusFinish(arena); RingFinish(&arena->chunkRing); diff --git a/mps/code/buffer.c b/mps/code/buffer.c index 56bedf2b0cf..5bb0026201b 100644 --- a/mps/code/buffer.c +++ b/mps/code/buffer.c @@ -205,10 +205,13 @@ static Res BufferInit(Buffer buffer, BufferClass class, AVERT(Pool, pool); arena = PoolArena(pool); + + /* Superclass init */ + InstInit(&buffer->instStruct); + /* Initialize the buffer. See for a definition of */ /* the structure. sig and serial comes later .init.sig-serial */ buffer->arena = arena; - SetClassOfBuffer(buffer, class); buffer->pool = pool; RingInit(&buffer->poolRing); buffer->isMutator = isMutator; @@ -237,9 +240,10 @@ static Res BufferInit(Buffer buffer, BufferClass class, /* .init.sig-serial: Now the vanilla stuff is initialized, */ /* sign the buffer and give it a serial number. It can */ /* then be safely checked in subclass methods. */ - buffer->sig = BufferSig; buffer->serial = pool->bufferSerial; /* .trans.mod */ ++pool->bufferSerial; + SetClassOfBuffer(buffer, class); + buffer->sig = BufferSig; AVERT(Buffer, buffer); /* Dispatch to the buffer class method to perform any */ @@ -256,6 +260,7 @@ static Res BufferInit(Buffer buffer, BufferClass class, failInit: RingFinish(&buffer->poolRing); + InstFinish(&buffer->instStruct); buffer->sig = SigInvalid; return res; } diff --git a/mps/code/land.c b/mps/code/land.c index 68ac4275f60..fc5ee2f43ad 100644 --- a/mps/code/land.c +++ b/mps/code/land.c @@ -73,7 +73,9 @@ static Res LandAbsInit(Land land, Arena arena, Align alignment, ArgList args) AVERT(Align, alignment); UNUSED(args); - /* FIXME: Should call super init here? */ + /* Superclass init */ + InstInit(CouldBeA(Inst, land)); + land->inLand = TRUE; land->alignment = alignment; land->arena = arena; @@ -88,6 +90,7 @@ static void LandAbsFinish(Land land) { AVERC(Land, land); land->sig = SigInvalid; + InstFinish(CouldBeA(Inst, land)); } diff --git a/mps/code/pool.c b/mps/code/pool.c index 849aa042321..3868d06d2a3 100644 --- a/mps/code/pool.c +++ b/mps/code/pool.c @@ -129,7 +129,9 @@ Res PoolInit(Pool pool, Arena arena, PoolClass class, ArgList args) AVERT(PoolClass, class); globals = ArenaGlobals(arena); - SetClassOfPool(pool, class); + /* 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 */ @@ -150,11 +152,12 @@ Res PoolInit(Pool pool, Arena arena, PoolClass class, ArgList args) pool->format = NULL; pool->fix = class->fix; - /* Initialise signature last; see */ - pool->sig = PoolSig; pool->serial = globals->poolSerial; ++(globals->poolSerial); + /* Initialise signature last; see */ + SetClassOfPool(pool, class); + pool->sig = PoolSig; AVERT(Pool, pool); /* Do class-specific initialization. */ @@ -175,6 +178,7 @@ Res PoolInit(Pool pool, Arena arena, PoolClass class, ArgList args) failInit: pool->sig = SigInvalid; /* Leave arena->poolSerial incremented */ + InstFinish(CouldBeA(Inst, pool)); RingFinish(&pool->segRing); RingFinish(&pool->bufferRing); RingFinish(&pool->arenaRing); @@ -233,6 +237,7 @@ void PoolFinish(Pool pool) -- pool->format->poolCount; } pool->sig = SigInvalid; + InstFinish(CouldBeA(Inst, pool)); RingFinish(&pool->segRing); RingFinish(&pool->bufferRing); diff --git a/mps/code/protocol.c b/mps/code/protocol.c index a9ba7295936..df618da021a 100644 --- a/mps/code/protocol.c +++ b/mps/code/protocol.c @@ -32,6 +32,45 @@ Bool InstClassCheck(InstClass class) } +/* InstInit -- initialize a protocol instance + * + * Initialisation makes the instance valid, so that it will pass + * InstCheck, and the instance can be specialized to be a member of a + * subclass. + */ + +void InstInit(Inst inst) +{ + AVER(inst != NULL); /* FIXME: express intention here */ + inst->class = CLASS(Inst); + AVERC(Inst, inst); +} + + +/* InstFinish -- finish a protocol instance + * + * Finishing makes the instance invalid, so that it will fail + * InstCheck and can't be used. + * + * FIXME: It would be nice if we could use a recognizable value here, + * such as a pointer to a static invalid class. + */ + +static InstClassStruct invalidClassStruct = { + /* .sig = */ SigInvalid, + /* .name = */ "Invalid", + /* .superclass = */ &invalidClassStruct, + /* .level = */ ClassIdInvalid, + /* .display = */ {ClassIdInvalid} +}; + +void InstFinish(Inst inst) +{ + AVERC(Inst, inst); + inst->class = &invalidClassStruct; +} + + /* InstCheck -- check a protocol instance */ Bool InstCheck(Inst inst) diff --git a/mps/code/protocol.h b/mps/code/protocol.h index cb42093eccd..44f3b592794 100644 --- a/mps/code/protocol.h +++ b/mps/code/protocol.h @@ -128,6 +128,7 @@ typedef struct InstClassStruct *InstClass; typedef struct InstStruct { InstClass class; + /* Do not add permanent fields here. Introduce a subclass. */ } InstStruct; @@ -153,11 +154,10 @@ typedef struct InstClassStruct { DECLARE_CLASS(Inst, Inst); - -/* Checking functions */ - extern Bool InstClassCheck(InstClass class); extern Bool InstCheck(Inst inst); +extern void InstInit(Inst inst); +extern void InstFinish(Inst inst); /* Protocol introspection interface @@ -172,10 +172,18 @@ extern Bool InstCheck(Inst inst); #define ClassOfPoly(inst) (MustBeA(Inst, inst)->class) -/* FIXME: SetClassOfPoly should use MustBeA, but some classes are - intialized inside out at the moment. */ + +/* SetClassOfPoly -- set the class of an object + * + * This should only be used when specialising an instance to be a + * member of a subclass. Each Init function should call its + * superclass init, finally reaching InstInit, and then, once it has + * set up its fields, use SetClassOfPoly to set the class and check + * the instance with its check method. Compare with design.mps.sig. + */ + #define SetClassOfPoly(inst, _class) \ - BEGIN CouldBeA(Inst, inst)->class = (InstClass)(_class); END + BEGIN MustBeA(Inst, inst)->class = (InstClass)(_class); END /* SUPERCLASS - get the superclass object, given a class name diff --git a/mps/code/seg.c b/mps/code/seg.c index 65c90ec6026..a6da2a6f01c 100644 --- a/mps/code/seg.c +++ b/mps/code/seg.c @@ -134,7 +134,9 @@ static Res SegInit(Seg seg, SegClass class, Pool pool, Addr base, Size size, Arg AVER(SizeIsArenaGrains(size, arena)); AVERT(SegClass, class); - SetClassOfSeg(seg, class); + /* Superclass init */ + InstInit(CouldBeA(Inst, seg)); + limit = AddrAdd(base, size); seg->limit = limit; seg->rankSet = RankSetEMPTY; @@ -148,6 +150,7 @@ static Res SegInit(Seg seg, SegClass class, Pool pool, Addr base, Size size, Arg seg->queued = FALSE; seg->firstTract = NULL; + SetClassOfSeg(seg, class); seg->sig = SegSig; /* set sig now so tract checks will see it */ TRACT_FOR(tract, addr, arena, base, limit) { @@ -178,12 +181,13 @@ static Res SegInit(Seg seg, SegClass class, Pool pool, Addr base, Size size, Arg return ResOK; failInit: + seg->sig = SigInvalid; + InstFinish(CouldBeA(Inst, seg)); RingFinish(SegPoolRing(seg)); TRACT_FOR(tract, addr, arena, base, limit) { AVERT(Tract, tract); TRACT_UNSET_SEG(tract); } - seg->sig = SigInvalid; return res; } @@ -236,6 +240,7 @@ static void SegFinish(Seg seg) RingFinish(SegPoolRing(seg)); seg->sig = SigInvalid; + InstFinish(CouldBeA(Inst, seg)); /* Check that the segment is not exposed, or in the shield */ /* cache (see ). */