From 12d4dfda1640fda49bbbc4c3b827b6e7ee2ada15 Mon Sep 17 00:00:00 2001
From: Richard Brooksby <rb@ravenbrook.com>
Date: Mon, 11 Apr 2016 18:06:47 +0100
Subject: [PATCH] Eliminating generated classof* and setclassof* functions in
 favour of checked poly macros.

Copied from Perforce
 Change: 190938
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c     |  4 ++--
 mps/code/arenacl.c   |  2 +-
 mps/code/arenavm.c   |  2 +-
 mps/code/buffer.c    | 10 +++++-----
 mps/code/cbs.c       |  2 +-
 mps/code/dbgpool.c   |  8 ++++----
 mps/code/failover.c  |  6 +++---
 mps/code/finaltest.c |  4 ++--
 mps/code/fotest.c    |  2 +-
 mps/code/freelist.c  |  2 +-
 mps/code/land.c      | 10 ++++++----
 mps/code/locus.c     |  2 +-
 mps/code/mpm.h       | 12 +-----------
 mps/code/pool.c      |  8 ++++----
 mps/code/poolabs.c   |  2 +-
 mps/code/poolamc.c   |  6 +++---
 mps/code/poolams.c   |  4 ++--
 mps/code/poolawl.c   |  4 ++--
 mps/code/poollo.c    |  4 ++--
 mps/code/poolmfs.c   |  2 +-
 mps/code/poolmrg.c   |  8 ++++----
 mps/code/poolmv.c    |  2 +-
 mps/code/poolmv2.c   |  2 +-
 mps/code/poolmvff.c  |  2 +-
 mps/code/pooln.c     |  4 ++--
 mps/code/poolsnc.c   |  8 ++++----
 mps/code/protocol.c  | 25 -------------------------
 mps/code/protocol.h  | 17 -----------------
 mps/code/seg.c       | 16 ++++++++--------
 mps/code/segsmss.c   |  4 ++--
 30 files changed, 67 insertions(+), 117 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 0f48d02cbc4..d779f73e213 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -287,7 +287,7 @@ static Res ArenaAbsInit(Arena arena, Size grainSize, ArgList args)
   if (res != ResOK)
     goto failGlobalsInit;
 
-  SetClassOfArena(arena, CLASS(AbstractArena));
+  SetClassOfPoly(arena, CLASS(AbstractArena));
   arena->sig = ArenaSig;
   AVERC(Arena, arena);
   
@@ -636,7 +636,7 @@ static Res arenaDescribeTractsInChunk(Chunk chunk, mps_lib_FILE *stream, Count d
         res = WriteF(stream, 0, " $P $U ($S)",
                      (WriteFP)pool,
                      (WriteFU)(pool->serial),
-                     (WriteFS)ClassName(ClassOfPool(pool)),
+                     (WriteFS)ClassName(ClassOfPoly(Pool, pool)),
                      NULL);
         if (res != ResOK)
           return res;
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index d7672a9d6ac..7086e08915e 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -287,7 +287,7 @@ static Res ClientArenaCreate(Arena *arenaReturn, ArgList args)
   res = NextMethod(Arena, ClientArena, init)(arena, grainSize, args);
   if (res != ResOK)
     goto failSuperInit;
-  SetClassOfArena(arena, CLASS(ClientArena));
+  SetClassOfPoly(arena, CLASS(ClientArena));
   AVER(clientArena == MustBeA(ClientArena, arena));
 
   /* have to have a valid arena before calling ChunkCreate */
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 4f2669e8a44..e14f1954554 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -557,7 +557,7 @@ static Res VMArenaCreate(Arena *arenaReturn, ArgList args)
   res = NextMethod(Arena, VMArena, init)(arena, grainSize, args);
   if (res != ResOK)
     goto failArenaInit;
-  SetClassOfArena(arena, CLASS(VMArena));
+  SetClassOfPoly(arena, CLASS(VMArena));
   AVER(vmArena == MustBeA(VMArena, arena));
   
   arena->reserved = VMReserved(vm);
diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index c31fdf63e42..fe7500b9ada 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -158,7 +158,7 @@ Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
                "Buffer $P ($U) {\n",
                (WriteFP)buffer, (WriteFU)buffer->serial,
                "  class $P (\"$S\")\n",
-               (WriteFP)ClassOfBuffer(buffer), (WriteFS)ClassName(ClassOfBuffer(buffer)),
+               (WriteFP)ClassOfPoly(Buffer, buffer), (WriteFS)ClassName(ClassOfPoly(Buffer, buffer)),
                "  Arena $P\n",       (WriteFP)buffer->arena,
                "  Pool $P\n",        (WriteFP)buffer->pool,
                "  ", buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
@@ -242,7 +242,7 @@ static Res BufferAbsInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args)
      in subclass methods. */
   buffer->serial = pool->bufferSerial; /* .trans.mod */
   ++pool->bufferSerial;
-  SetClassOfBuffer(buffer, CLASS(Buffer));
+  SetClassOfPoly(buffer, CLASS(Buffer));
   buffer->sig = BufferSig;
   AVERT(Buffer, buffer);
 
@@ -361,7 +361,7 @@ void BufferDestroy(Buffer buffer)
   Size size;
   AVERT(Buffer, buffer);
   arena = buffer->arena;
-  size = ClassOfBuffer(buffer)->size;
+  size = ClassOfPoly(Buffer, buffer)->size;
   BufferFinish(buffer);
   ControlFree(arena, buffer, size);
 }
@@ -1234,7 +1234,7 @@ static Res segBufInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args)
   res = NextMethod(Buffer, SegBuf, init)(buffer, pool, isMutator, args);
   if (res != ResOK)
     return res;
-  SetClassOfBuffer(buffer, CLASS(SegBuf));
+  SetClassOfPoly(buffer, CLASS(SegBuf));
   segbuf = MustBeA(SegBuf, buffer);
 
   segbuf->seg = NULL;
@@ -1425,7 +1425,7 @@ static Res rankBufInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args)
   res = NextMethod(Buffer, RankBuf, init)(buffer, pool, isMutator, args);
   if (res != ResOK)
     return res;
-  SetClassOfBuffer(buffer, CLASS(RankBuf));
+  SetClassOfPoly(buffer, CLASS(RankBuf));
 
   BufferSetRankSet(buffer, RankSetSingle(rank));
 
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index 152c0f41325..80fb86835b0 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -230,7 +230,7 @@ static Res cbsInitComm(Land land, LandClass class,
   if (res != ResOK)
     return res;
 
-  SetClassOfLand(land, class);
+  SetClassOfPoly(land, class);
   cbs = MustBeA(CBS, land);
 
   if (ArgPick(&arg, args, CBSBlockPool))
diff --git a/mps/code/dbgpool.c b/mps/code/dbgpool.c
index 25e78f9e898..abc5a7267e0 100644
--- a/mps/code/dbgpool.c
+++ b/mps/code/dbgpool.c
@@ -154,7 +154,7 @@ static Res DebugPoolInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   if (res != ResOK)
     return res;
 
-  SetClassOfPool(pool, class);
+  SetClassOfPoly(pool, class);
   debug = DebugPoolDebugMixin(pool);
   AVER(debug != NULL);
 
@@ -228,7 +228,7 @@ static void DebugPoolFinish(Pool pool)
     SplayTreeFinish(&debug->index);
     PoolDestroy(debug->tagPool);
   }
-  class = ClassOfPool(pool);
+  class = ClassOfPoly(Pool, pool);
   SuperclassPoly(Pool, class)->finish(pool);
 }
 
@@ -411,7 +411,7 @@ static Res freeCheckAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool,
 
   AVER(aReturn != NULL);
 
-  class = ClassOfPool(pool);
+  class = ClassOfPoly(Pool, pool);
   res = SuperclassPoly(Pool, class)->alloc(&new, pool, size);
   if (res != ResOK)
     return res;
@@ -432,7 +432,7 @@ static void freeCheckFree(PoolDebugMixin debug,
   PoolClass class;
   if (debug->freeSize != 0)
     freeSplat(debug, pool, old, AddrAdd(old, size));
-  class = ClassOfPool(pool);
+  class = ClassOfPoly(Pool, pool);
   SuperclassPoly(Pool, class)->free(pool, old, size);
 }
 
diff --git a/mps/code/failover.c b/mps/code/failover.c
index 13b4be79725..3fc79ebe3a4 100644
--- a/mps/code/failover.c
+++ b/mps/code/failover.c
@@ -39,7 +39,7 @@ static Res failoverInit(Land land, Arena arena, Align alignment, ArgList args)
   if (res != ResOK)
     return res;
 
-  SetClassOfLand(land, CLASS(Failover));
+  SetClassOfPoly(land, CLASS(Failover));
   fo = MustBeA(Failover, land);
 
   ArgRequire(&arg, args, FailoverPrimary);
@@ -260,10 +260,10 @@ static Res failoverDescribe(Land land, mps_lib_FILE *stream, Count depth)
   return WriteF(stream, depth + 2,
                 "primary = $P ($S)\n",
                 (WriteFP)fo->primary,
-                (WriteFS)ClassName(ClassOfLand(fo->primary)),
+                (WriteFS)ClassName(ClassOfPoly(Land, fo->primary)),
                 "secondary = $P ($S)\n",
                 (WriteFP)fo->secondary,
-                (WriteFS)ClassName(ClassOfLand(fo->secondary)),
+                (WriteFS)ClassName(ClassOfPoly(Land, fo->secondary)),
                 NULL);
 }
 
diff --git a/mps/code/finaltest.c b/mps/code/finaltest.c
index 91fe5471a1b..3f84e22bd2a 100644
--- a/mps/code/finaltest.c
+++ b/mps/code/finaltest.c
@@ -154,7 +154,7 @@ static void test_trees(int mode, const char *name, mps_arena_t arena,
 
   printf("---- Mode %s, pool class %s, %s trees ----\n",
          mode == ModePARK ? "PARK" : "POLL",
-         ClassName(ClassOfPool(pool)), name);
+         ClassName(ClassOfPoly(Pool, pool)), name);
   mps_arena_park(arena);
 
   /* make some trees */
@@ -210,7 +210,7 @@ static void test_trees(int mode, const char *name, mps_arena_t arena,
   }
   if (finals != object_count)
     error("Not all objects were finalized for %s in mode %s.",
-          ClassName(ClassOfPool(BufferOfAP(ap)->pool)),
+          ClassName(ClassOfPoly(Pool, BufferOfAP(ap)->pool)),
           mode == ModePOLL ? "POLL" : "PARK");
 }
 
diff --git a/mps/code/fotest.c b/mps/code/fotest.c
index d67cd841800..a84e8a92fe9 100644
--- a/mps/code/fotest.c
+++ b/mps/code/fotest.c
@@ -91,7 +91,7 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
 static void set_oom(Land land, int oom)
 {
   CBS cbs = MustBeA(CBS, land);
-  SetClassOfPool(cbs->blockPool, oom ? CLASS(OOMPool) : PoolClassMFS());
+  SetClassOfPoly(cbs->blockPool, oom ? CLASS(OOMPool) : PoolClassMFS());
 }
 
 
diff --git a/mps/code/freelist.c b/mps/code/freelist.c
index cd68e0fc2b8..bf205379e06 100644
--- a/mps/code/freelist.c
+++ b/mps/code/freelist.c
@@ -196,7 +196,7 @@ static Res freelistInit(Land land, Arena arena, Align alignment, ArgList args)
   if (res != ResOK)
     return res;
 
-  SetClassOfLand(land, CLASS(Freelist));
+  SetClassOfPoly(land, CLASS(Freelist));
   fl = MustBeA(Freelist, land);
 
   /* See <design/freelist/#impl.grain> */
diff --git a/mps/code/land.c b/mps/code/land.c
index d3a5616d29b..6cefd3031e8 100644
--- a/mps/code/land.c
+++ b/mps/code/land.c
@@ -57,10 +57,12 @@ static void landLeave(Land land)
 
 Bool LandCheck(Land land)
 {
+  LandClass class;
   /* .enter-leave.simple */
   CHECKS(Land, land);
   CHECKC(Land, land);
-  CHECKD(LandClass, ClassOfLand(land));
+  class = ClassOfPoly(Land, land);
+  CHECKD(LandClass, class);
   CHECKU(Arena, land->arena);
   CHECKL(AlignCheck(land->alignment));
   CHECKL(BoolCheck(land->inLand));
@@ -81,7 +83,7 @@ static Res LandAbsInit(Land land, Arena arena, Align alignment, ArgList args)
   land->alignment = alignment;
   land->arena = arena;
 
-  SetClassOfLand(land, CLASS(Land));
+  SetClassOfPoly(land, CLASS(Land));
   land->sig = LandSig;
   AVERC(Land, land);
   return ResOK;
@@ -164,7 +166,7 @@ void LandDestroy(Land land)
 
   AVERC(Land, land);
   arena = land->arena;
-  size = ClassOfLand(land)->size;
+  size = ClassOfPoly(Land, land)->size;
   LandFinish(land);
   ControlFree(arena, land, size);
 }
@@ -546,7 +548,7 @@ static Res LandAbsDescribe(Land land, mps_lib_FILE *stream, Count depth)
   if (stream == NULL)
     return ResPARAM;
   return WriteF(stream, depth,
-                "$S $P\n", (WriteFS)ClassName(ClassOfLand(land)), land,
+                "$S $P\n", (WriteFS)ClassName(ClassOfPoly(Land, land)), land,
                 "  arena $P\n", (WriteFP)land->arena,
                 "  align $U\n", (WriteFU)land->alignment,
                 "  inLand $S\n", WriteFYesNo(land->inLand),
diff --git a/mps/code/locus.c b/mps/code/locus.c
index c1c32b04a20..6d143578d82 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -706,7 +706,7 @@ Res PoolGenDescribe(PoolGen pgen, mps_lib_FILE *stream, Count depth)
                "PoolGen $P {\n", (WriteFP)pgen,
                "  pool $P ($U) \"$S\"\n",
                (WriteFP)pgen->pool, (WriteFU)pgen->pool->serial,
-               (WriteFS)ClassName(ClassOfPool(pgen->pool)),
+               (WriteFS)ClassName(ClassOfPoly(Pool, pgen->pool)),
                "  segs $U\n", (WriteFU)pgen->segs,
                "  totalSize $U\n", (WriteFU)pgen->totalSize,
                "  freeSize $U\n", (WriteFU)pgen->freeSize,
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 8a68f5597c3..18f492bc63d 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -202,7 +202,7 @@ extern Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth);
 #define PoolSegRing(pool)       (&(pool)->segRing)
 #define PoolArenaRing(pool) (&(pool)->arenaRing)
 #define PoolOfArenaRing(node) RING_ELT(Pool, arenaRing, node)
-#define PoolHasAttr(pool, Attr) ((ClassOfPool(pool)->attr & (Attr)) != 0)
+#define PoolHasAttr(pool, Attr) ((ClassOfPoly(Pool, pool)->attr & (Attr)) != 0)
 
 extern Bool PoolFormat(Format *formatReturn, Pool pool);
 
@@ -290,11 +290,6 @@ extern PoolDebugMixin PoolNoDebugMixin(Pool pool);
 extern BufferClass PoolNoBufferClass(void);
 extern Size PoolNoSize(Pool pool);
 
-/* FIXME: Would be nice to use generated functions here, but the
-   common superclass of pools is called AbstractPool, not Pool. */
-#define ClassOfPool(pool) ClassOfPoly(Pool, pool)
-#define SetClassOfPool SetClassOfPoly
-
 
 /* Abstract Pool Classes Interface -- see <code/poolabs.c> */
 extern void PoolClassMixInBuffer(PoolClass class);
@@ -482,11 +477,6 @@ extern void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena,
 DECLARE_CLASS(Arena, AbstractArena);
 extern Bool ArenaClassCheck(ArenaClass class);
 
-/* FIXME: Would be nice to use generated functions here, but the
-   common superclass of arenas is called AbstractArena, not Arena. */
-#define ClassOfArena(arena) ClassOfPoly(Arena, arena)
-#define SetClassOfArena SetClassOfPoly
-
 extern Bool ArenaCheck(Arena arena);
 extern Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args);
 extern void ArenaDestroy(Arena arena);
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 9c17f5654dc..2d32714d5d6 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -85,7 +85,7 @@ Bool PoolCheck(Pool pool)
   CHECKC(AbstractPool, pool);
   /* Break modularity for checking efficiency */
   CHECKL(pool->serial < ArenaGlobals(pool->arena)->poolSerial);
-  class = ClassOfPool(pool);
+  class = ClassOfPoly(Pool, pool);
   CHECKD(PoolClass, class);
   CHECKU(Arena, pool->arena);
   CHECKD_NOSIG(Ring, &pool->arenaRing);
@@ -133,7 +133,7 @@ Res PoolInit(Pool pool, Arena arena, PoolClass class, ArgList args)
     return res;
 
   /* FIXME: Where should this go? */
-  pool->fix = ClassOfPool(pool)->fix;
+  pool->fix = ClassOfPoly(Pool, pool)->fix;
 
   /* Add initialized pool to list of pools in arena. */
   /* FIXME: Should be in PoolAbsInit */
@@ -202,7 +202,7 @@ void PoolDestroy(Pool pool)
 
   AVERT(Pool, pool); 
   arena = pool->arena;
-  size = ClassOfPool(pool)->size;
+  size = ClassOfPoly(Pool, pool)->size;
   PoolFinish(pool);
 
   /* .space.free: Free the pool instance structure.  See .space.alloc */
@@ -493,7 +493,7 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   res = WriteF(stream, depth,
                "Pool $P ($U) {\n", (WriteFP)pool, (WriteFU)pool->serial,
                "  class $P (\"$S\")\n",
-               (WriteFP)ClassOfPool(pool), (WriteFS)ClassName(ClassOfPool(pool)),
+               (WriteFP)ClassOfPoly(Pool, pool), (WriteFS)ClassName(ClassOfPoly(Pool, pool)),
                "  arena $P ($U)\n",
                (WriteFP)pool->arena, (WriteFU)pool->arena->serial,
                "  alignment $W\n", (WriteFW)pool->alignment,
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index 53d9969f5d6..7929ef66348 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -133,7 +133,7 @@ Res PoolAbsInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   ++ArenaGlobals(arena)->poolSerial;
 
   /* Initialise signature last; see <design/sig/> */
-  SetClassOfPool(pool, CLASS(AbstractPool));
+  SetClassOfPoly(pool, CLASS(AbstractPool));
   pool->sig = PoolSig;
   AVERT(Pool, pool);
 
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index b6aecf9a6cd..132ff5d7c15 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -140,7 +140,7 @@ static Res AMCSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
   res = NextMethod(Seg, amcSeg, init)(seg, pool, base, size, args);
   if(res != ResOK)
     return res;
-  SetClassOfSeg(seg, CLASS(amcSeg));
+  SetClassOfPoly(seg, CLASS(amcSeg));
   amcseg = MustBeA(amcSeg, seg);
 
   amcseg->gen = amcgen;
@@ -497,7 +497,7 @@ static Res AMCBufInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args)
   res = NextMethod(Buffer, amcBuf, init)(buffer, pool, isMutator, args);
   if(res != ResOK)
     return res;
-  SetClassOfBuffer(buffer, CLASS(amcBuf));
+  SetClassOfPoly(buffer, CLASS(amcBuf));
   amcbuf = MustBeA(amcBuf, buffer);
 
   if (BufferIsMutator(buffer)) {
@@ -738,7 +738,7 @@ static Res amcInitComm(Pool pool, Arena arena, PoolClass class,
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     return res;
-  SetClassOfPool(pool, class);
+  SetClassOfPoly(pool, class);
   amc = MustBeA(AMCZPool, pool);
 
   pool->format = format;
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index 639e6ddc8bd..d0e4a0eb3dc 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -226,7 +226,7 @@ static Res AMSSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
   res = NextMethod(Seg, AMSSeg, init)(seg, pool, base, size, args);
   if (res != ResOK)
     goto failNextMethod;
-  SetClassOfSeg(seg, CLASS(AMSSeg));
+  SetClassOfPoly(seg, CLASS(AMSSeg));
   amsseg = MustBeA(AMSSeg, seg);
 
   AVERT(Pool, pool);
@@ -825,7 +825,7 @@ Res AMSInitInternal(AMS ams, Arena arena, PoolClass class,
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     goto failAbsInit;
-  SetClassOfPool(pool, CLASS(AMSPool));
+  SetClassOfPoly(pool, CLASS(AMSPool));
   AVER(ams == MustBeA(AMSPool, pool));
   
   AVERT(Format, format);
diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c
index 2406ee27691..e91af01e52a 100644
--- a/mps/code/poolawl.c
+++ b/mps/code/poolawl.c
@@ -198,7 +198,7 @@ static Res AWLSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
   res = NextMethod(Seg, AWLSeg, init)(seg, pool, base, size, args);
   if (res != ResOK)
     goto failSuperInit;
-  SetClassOfSeg(seg, CLASS(AWLSeg));
+  SetClassOfPoly(seg, CLASS(AWLSeg));
   awlseg = MustBeA(AWLSeg, seg);
 
   AVERT(Pool, pool);
@@ -574,7 +574,7 @@ static Res AWLInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     goto failAbsInit;
-  SetClassOfPool(pool, CLASS(AWLPool));
+  SetClassOfPoly(pool, CLASS(AWLPool));
   awl = MustBeA(AWLPool, pool);
   
   pool->format = format;
diff --git a/mps/code/poollo.c b/mps/code/poollo.c
index 65aad7c79c3..75d1bebe7e1 100644
--- a/mps/code/poollo.c
+++ b/mps/code/poollo.c
@@ -113,7 +113,7 @@ static Res loSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
   res = NextMethod(Seg, LOSeg, init)(seg, pool, base, size, args);
   if(res != ResOK)
     goto failSuperInit;
-  SetClassOfSeg(seg, CLASS(LOSeg));
+  SetClassOfPoly(seg, CLASS(LOSeg));
   loseg = MustBeA(LOSeg, seg);
 
   arena = PoolArena(pool);
@@ -485,7 +485,7 @@ static Res LOInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     goto failAbsInit;
-  SetClassOfPool(pool, CLASS(LOPool));
+  SetClassOfPoly(pool, CLASS(LOPool));
   lo = MustBeA(LOPool, pool);
 
   ArgRequire(&arg, args, MPS_KEY_FORMAT);
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index 96dc8d416d8..6b344f9f78f 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -105,7 +105,7 @@ static Res MFSInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     return res;
-  SetClassOfPool(pool, CLASS(MFSPool));
+  SetClassOfPoly(pool, CLASS(MFSPool));
   mfs = MustBeA(MFSPool, pool);
 
   mfs->unroundedUnitSize = unitSize;
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index 9118752d311..fb06b8a4bab 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -230,7 +230,7 @@ static Res MRGLinkSegInit(Seg seg, Pool pool, Addr base, Size size,
   res = NextMethod(Seg, MRGLinkSeg, init)(seg, pool, base, size, args);
   if (res != ResOK)
     return res;
-  SetClassOfSeg(seg, CLASS(MRGLinkSeg));
+  SetClassOfPoly(seg, CLASS(MRGLinkSeg));
   linkseg = MustBeA(MRGLinkSeg, seg);
 
   AVERT(Pool, pool);
@@ -270,7 +270,7 @@ static Res MRGRefSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
   res = NextMethod(Seg, MRGRefSeg, init)(seg, pool, base, size, args);
   if (res != ResOK)
     return res;
-  SetClassOfSeg(seg, CLASS(MRGRefSeg));
+  SetClassOfPoly(seg, CLASS(MRGRefSeg));
   refseg = MustBeA(MRGRefSeg, seg);
 
   AVERT(Pool, pool);
@@ -639,7 +639,7 @@ static Res MRGInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     return res;
-  SetClassOfPool(pool, CLASS(MRGPool));
+  SetClassOfPoly(pool, CLASS(MRGPool));
   mrg = MustBeA(MRGPool, pool);
  
   RingInit(&mrg->entryRing);
@@ -649,7 +649,7 @@ static Res MRGInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   mrg->sig = MRGSig;
 
   AVERT(MRG, mrg);
-  EVENT3(PoolInit, pool, PoolArena(pool), ClassOfPool(pool)); /* FIXME: Out of place? */
+  EVENT3(PoolInit, pool, PoolArena(pool), ClassOfPoly(Pool, pool)); /* FIXME: Out of place? */
   return ResOK;
 }
 
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 147a583f883..71ee91a83ac 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -254,7 +254,7 @@ static Res MVInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     return res;
-  SetClassOfPool(pool, CLASS(MVPool));
+  SetClassOfPoly(pool, CLASS(MVPool));
   mv = MustBeA(MVPool, pool);
 
   pool->alignment = align;
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index 95ae9d3c061..8404c90d796 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -278,7 +278,7 @@ static Res MVTInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     goto failAbsInit;
-  SetClassOfPool(pool, CLASS(MVTPool));
+  SetClassOfPoly(pool, CLASS(MVTPool));
   mvt = MustBeA(MVTPool, pool);
 
   res = LandInit(MVTFreePrimary(mvt), CLASS(CBSFast), arena, align, mvt,
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index d72052bcb7b..45c5990f1f7 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -501,7 +501,7 @@ static Res MVFFInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     goto failAbsInit;
-  SetClassOfPool(pool, CLASS(MVFFPool));
+  SetClassOfPoly(pool, CLASS(MVFFPool));
   mvff = MustBeA(MVFFPool, pool);
 
   mvff->extendBy = extendBy;
diff --git a/mps/code/pooln.c b/mps/code/pooln.c
index 1774ceb3b01..ac06e1f2fc0 100644
--- a/mps/code/pooln.c
+++ b/mps/code/pooln.c
@@ -46,13 +46,13 @@ static Res NInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     goto failAbsInit;
-  SetClassOfPool(pool, CLASS(NPool));
+  SetClassOfPoly(pool, CLASS(NPool));
   poolN = MustBeA(NPool, pool);
   
   /* Initialize pool-specific structures. */
 
   AVERT(PoolN, poolN);
-  EVENT3(PoolInit, pool, PoolArena(pool), ClassOfPool(pool));
+  EVENT3(PoolInit, pool, PoolArena(pool), ClassOfPoly(Pool, pool));
   return ResOK;
 
 failAbsInit:
diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c
index 672e9aa5b43..80aca4dbb46 100644
--- a/mps/code/poolsnc.c
+++ b/mps/code/poolsnc.c
@@ -122,7 +122,7 @@ static Res SNCBufInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args)
   res = NextMethod(Buffer, SNCBuf, init)(buffer, pool, isMutator, args);
   if (res != ResOK)
     return res;
-  SetClassOfBuffer(buffer, CLASS(SNCBuf));
+  SetClassOfPoly(buffer, CLASS(SNCBuf));
   sncbuf = MustBeA(SNCBuf, buffer);
 
   sncbuf->topseg = NULL;
@@ -208,7 +208,7 @@ static Res sncSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
   res = NextMethod(Seg, SNCSeg, init)(seg, pool, base, size, args);
   if (res != ResOK)
     return res;
-  SetClassOfSeg(seg, CLASS(SNCSeg));
+  SetClassOfPoly(seg, CLASS(SNCSeg));
   sncseg = MustBeA(SNCSeg, seg);
 
   AVERT(Pool, pool);
@@ -356,7 +356,7 @@ static Res SNCInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   res = PoolAbsInit(pool, arena, class, args);
   if (res != ResOK)
     return res;
-  SetClassOfPool(pool, CLASS(SNCPool));
+  SetClassOfPoly(pool, CLASS(SNCPool));
   snc = MustBeA(SNCPool, pool);
 
   ArgRequire(&arg, args, MPS_KEY_FORMAT);
@@ -721,7 +721,7 @@ static Bool SNCCheck(SNC snc)
   CHECKS(SNC, snc);
   CHECKC(SNCPool, snc);
   CHECKD(Pool, SNCPool(snc));
-  CHECKL(ClassOfPool(SNCPool(snc)) == CLASS(SNCPool));
+  CHECKL(ClassOfPoly(Pool, SNCPool(snc)) == CLASS(SNCPool));
   if (snc->freeSegs != NULL) {
     CHECKD(Seg, snc->freeSegs);
   }
diff --git a/mps/code/protocol.c b/mps/code/protocol.c
index b83289d1cd7..47c68468955 100644
--- a/mps/code/protocol.c
+++ b/mps/code/protocol.c
@@ -93,31 +93,6 @@ DEFINE_CLASS(Inst, Inst, theClass)
 }
 
 
-/* ClassOf* -- get the class of an instance */
-
-#define CLASS_DEFINE_CLASSOF(prefix, ident, kind, super) \
-  CLASS_TYPE(kind) (prefix ## ident)(struct INST_STRUCT(ident) *inst) \
-  { \
-    /* extern Bool INST_CHECK(ident)(struct INST_STRUCT(ident) *inst); */ \
-    /* AVERC(ident, inst); */ \
-    return (CLASS_TYPE(kind))CouldBeA(Inst, inst)->class; \
-  }
-
-CLASSES(CLASS_DEFINE_CLASSOF, ClassOf)
-
-
-/* SetClassOf -- set the class of an instance */
-
-#define CLASS_DEFINE_SETCLASSOF(prefix, ident, kind, super) \
-  void (prefix ## ident)(struct INST_STRUCT(ident) *inst, CLASS_TYPE(kind) class) \
-  { \
-    AVERT(CLASS_TYPE(kind), class); \
-    MustBeA(Inst, inst)->class = (InstClass)class; \
-  }
-
-CLASSES(CLASS_DEFINE_SETCLASSOF, SetClassOf)
-
-
 /* C. COPYRIGHT AND LICENSE
  *
  * Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
diff --git a/mps/code/protocol.h b/mps/code/protocol.h
index c07df95b803..42583a57a4f 100644
--- a/mps/code/protocol.h
+++ b/mps/code/protocol.h
@@ -248,23 +248,6 @@ extern void InstFinish(Inst inst);
 			   inst))
 
 
-/* ClassOf* -- get the class of an instance */
-
-#define CLASS_DECLARE_CLASSOF(prefix, ident, kind, super) \
-  struct INST_STRUCT(ident); \
-  extern CLASS_TYPE(kind) (prefix ## ident)(struct INST_STRUCT(ident) *inst);
-
-CLASSES(CLASS_DECLARE_CLASSOF, ClassOf)
-
-
-/* SetClassOf -- set the class of an instance */
-
-#define CLASS_DECLARE_SETCLASSOF(prefix, ident, kind, super) \
-  void (prefix ## ident)(struct INST_STRUCT(ident) *inst, CLASS_TYPE(kind) class);
-
-CLASSES(CLASS_DECLARE_SETCLASSOF, SetClassOf)
-
-
 /* Method -- method call
  *
  * FIXME: This isn't a very nice way to do this, but there's an
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 108265f223d..719cda81110 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -106,7 +106,7 @@ void SegFree(Seg seg)
   AVERT(Arena, arena);
   base = SegBase(seg);
   size = SegSize(seg);
-  structSize = ClassOfSeg(seg)->size;
+  structSize = ClassOfPoly(Seg, seg)->size;
 
   SegFinish(seg);
   ControlFree(arena, seg, structSize);
@@ -148,7 +148,7 @@ static Res SegAbsInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
   seg->queued = FALSE;
   seg->firstTract = NULL;
   RingInit(SegPoolRing(seg));
-  SetClassOfSeg(seg, CLASS(Seg));
+  SetClassOfPoly(seg, CLASS(Seg));
   
   TRACT_FOR(tract, addr, arena, base, limit) {
     AVERT(Tract, tract);
@@ -369,7 +369,7 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
                "Segment $P [$A,$A) {\n", (WriteFP)seg,
                (WriteFA)SegBase(seg), (WriteFA)SegLimit(seg),
                "  class $P (\"$S\")\n",
-               (WriteFP)ClassOfSeg(seg), (WriteFS)ClassName(ClassOfSeg(seg)),
+               (WriteFP)ClassOfPoly(Seg, seg), (WriteFS)ClassName(ClassOfPoly(Seg, seg)),
                "  pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
                "  depth $U\n", seg->depth,
@@ -562,8 +562,8 @@ Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi)
   AVER(NULL != mergedSegReturn);
   AVERT(Seg, segLo);
   AVERT(Seg, segHi);
-  class = ClassOfSeg(segLo);
-  AVER(ClassOfSeg(segHi) == class);
+  class = ClassOfPoly(Seg, segLo);
+  AVER(ClassOfPoly(Seg, segHi) == class);
   AVER(SegPool(segLo) == SegPool(segHi));
   base = SegBase(segLo);
   mid = SegLimit(segLo);
@@ -611,7 +611,7 @@ Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at)
   AVER(NULL != segLoReturn);
   AVER(NULL != segHiReturn);
   AVERT(Seg, seg);
-  class = ClassOfSeg(seg);
+  class = ClassOfPoly(Seg, seg);
   arena = PoolArena(SegPool(seg));
   base = SegBase(seg);
   limit = SegLimit(seg);
@@ -978,7 +978,7 @@ static Res segTrivSplit(Seg seg, Seg segHi,
   }
   AVER(addr == segHi->limit);
 
-  SetClassOfSeg(segHi, ClassOfSeg(seg));
+  SetClassOfPoly(segHi, ClassOfPoly(Seg, seg));
   segHi->sig = SegSig;
   AVERT(Seg, segHi);
 
@@ -1066,7 +1066,7 @@ static Res gcSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
   res = NextMethod(Seg, GCSeg, init)(seg, pool, base, size, args);
   if (ResOK != res)
     return res;
-  SetClassOfSeg(seg, CLASS(GCSeg));
+  SetClassOfPoly(seg, CLASS(GCSeg));
   gcseg = MustBeA(GCSeg, seg);
 
   gcseg->summary = RefSetEMPTY;
diff --git a/mps/code/segsmss.c b/mps/code/segsmss.c
index e82f2c6285a..eacd05ce013 100644
--- a/mps/code/segsmss.c
+++ b/mps/code/segsmss.c
@@ -122,7 +122,7 @@ static Res amstSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
   res = NextMethod(Seg, AMSTSeg, init)(seg, pool, base, size, args);
   if (res != ResOK)
     return res;
-  SetClassOfSeg(seg, CLASS(AMSTSeg));
+  SetClassOfPoly(seg, CLASS(AMSTSeg));
   amstseg = MustBeA(AMSTSeg, seg);
 
   AVERT(Pool, pool);
@@ -343,7 +343,7 @@ static Res AMSTInit(Pool pool, Arena arena, PoolClass class, ArgList args)
                         format, chain, gen, FALSE, args);
   if (res != ResOK)
     return res;
-  SetClassOfPool(pool, CLASS(AMSTPool));
+  SetClassOfPoly(pool, CLASS(AMSTPool));
   amst = MustBeA(AMSTPool, pool);
   ams = MustBeA(AMSPool, pool);
   ams->segSize = AMSTSegSizePolicy;