Adding instinit and instfinish and using them as next methods in seginit, segfinish, etc.

Copied from Perforce
 Change: 190857
 ServerID: perforce.ravenbrook.com

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

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 <code/mpmst.h> 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;
 }

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

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 <design/sig/> */
-  pool->sig = PoolSig;
   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. */
@@ -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);

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)

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

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 <code/shield.c#def.depth>). */