Eliminating issubclasspoly and replacing with compile-time constant test.

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

mps/code/mpmst.h

@@ -93,14 +93,15 @@ typedef struct mps_pool_class_s {
  * a "subclass" of the pool structure (the "outer structure") which
  * contains PoolStruct as a a field.  The outer structure holds the
  * class-specific part of the pool's state.  See <code/pool.c>,
- * <design/pool/>.  */
+ * <design/pool/>.
+ */
 
 #define PoolSig         ((Sig)0x519B0019) /* SIGnature POOL */
 
 typedef struct mps_pool_s {     /* generic structure */
   Sig sig;                      /* <design/sig/> */
-  Serial serial;                /* from arena->poolSerial */
   PoolClass class;              /* pool class structure */
+  Serial serial;                /* from arena->poolSerial */
   Arena arena;                  /* owning arena */
   RingStruct arenaRing;         /* link in list of pools in arena */
   RingStruct bufferRing;        /* allocation buffers are attached to pool */

mps/code/poolamc.c

@@ -1889,7 +1889,7 @@ static void amcWalkAll(Pool pool, FormattedObjectsVisitor f, void *p, size_t s)
   Arena arena;
   Ring ring, next, node;
 
-  AVER(IsSubclassPoly(pool->class, CLASS(AMCZPool)));
+  AVER(IsA(AMCZPool, pool));
 
   arena = PoolArena(pool);
   ring = PoolSegRing(pool);
@@ -2214,7 +2214,7 @@ static Bool AMCCheck(AMC amc)
 {
   CHECKS(AMC, amc);
   CHECKD(Pool, AMCPool(amc));
-  CHECKL(IsSubclassPoly(AMCPool(amc)->class, CLASS(AMCZPool)));
+  CHECKL(IsA(AMCZPool, AMCPool(amc)));
   CHECKL(RankSetCheck(amc->rankSet));
   CHECKD_NOSIG(Ring, &amc->genRing);
   CHECKL(BoolCheck(amc->gensBooted));

mps/code/poolams.c

@@ -1820,7 +1820,7 @@ Bool AMSCheck(AMS ams)
 {
   CHECKS(AMS, ams);
   CHECKD(Pool, AMSPool(ams));
-  CHECKL(IsSubclassPoly(AMSPool(ams)->class, CLASS(AMSPool)));
+  CHECKL(IsA(AMSPool, AMSPool(ams)));
   CHECKL(PoolAlignment(AMSPool(ams)) == AMSGrainsSize(ams, (Size)1));
   CHECKL(PoolAlignment(AMSPool(ams)) == AMSPool(ams)->format->alignment);
   CHECKD(PoolGen, &ams->pgen);

mps/code/poolmv.c

@@ -897,7 +897,7 @@ Bool MVCheck(MV mv)
 {
   CHECKS(MV, mv);
   CHECKD(Pool, MVPool(mv));
-  CHECKL(IsSubclassPoly(MVPool(mv)->class, CLASS(MVPool)));
+  CHECKL(IsA(MVPool, MVPool(mv)));
   CHECKD(MFS, &mv->blockPoolStruct);
   CHECKD(MFS, &mv->spanPoolStruct);
   CHECKL(mv->extendBy > 0);

mps/code/poolmvff.c

@@ -761,7 +761,7 @@ static Bool MVFFCheck(MVFF mvff)
 {
   CHECKS(MVFF, mvff);
   CHECKD(Pool, MVFFPool(mvff));
-  CHECKL(IsSubclassPoly(MVFFPool(mvff)->class, CLASS(MVFFPool)));
+  CHECKL(IsA(MVFFPool, MVFFPool(mvff)));
   CHECKD(LocusPref, MVFFLocusPref(mvff));
   CHECKL(mvff->extendBy >= ArenaGrainSize(PoolArena(MVFFPool(mvff))));
   CHECKL(mvff->avgSize > 0);                    /* see .arg.check */

mps/code/protocol.c

@@ -22,11 +22,11 @@ Bool InstClassCheck(InstClass class)
   CHECKL(class->name != NULL);
   CHECKL(class->level < ClassDEPTH);
   for (i = 0; i <= class->level; ++i) {
-    CHECKL(class->index[i] != 0);
-    CHECKL(class->index[i] < ClassIndexLIMIT);
+    CHECKL(class->display[i] != 0);
+    CHECKL(class->display[i] < ClassIdLIMIT);
   }
   for (i = class->level + 1; i < ClassDEPTH; ++i) {
-    CHECKL(class->index[i] == 0);
+    CHECKL(class->display[i] == 0);
   }
   return TRUE;
 }
@@ -42,23 +42,6 @@ Bool InstCheck(Inst inst)
 }
 
 
-/* ProtocolIsSubclass -- a predicate for testing subclass relationships
- *
- * A protocol class is always a subclass of itself.  This true of the
- * modulo test, so the direct equality test is just an optimisation
- * for a common case.
- *
- * "Fast Dynamic Casting"; Michael Gibbs, Bjarne
- *  Stroustrup; 2004;
- *  <http://www.stroustrup.com/fast_dynamic_casting.pdf>.
- */
-
-Bool ProtocolIsSubclass(InstClass sub, InstClass super)
-{
-  return sub->index[super->level] == super->index[super->level];
-}
-
-
 /* The class definition for the root of the hierarchy */
 
 DEFINE_CLASS(Inst, Inst, theClass)
@@ -68,9 +51,9 @@ DEFINE_CLASS(Inst, Inst, theClass)
   theClass->name = "Inst";
   theClass->superclass = theClass;
   for (i = 0; i < ClassDEPTH; ++i)
-    theClass->index[i] = 0;
+    theClass->display[i] = 0;
   theClass->level = 0;
-  theClass->index[theClass->level] = ClassIndexInst;
+  theClass->display[theClass->level] = ClassIdInst;
   AVERT(InstClass, theClass);
 }
 

mps/code/protocol.h

@@ -66,18 +66,28 @@
 #define CLASS(ident) (CLASS_ENSURE(ident)())
 
 
-/* ClassIndexEnum -- unique index for each class
+/* ClassIdEnum -- unique identifier for each class
  *
- * This defines enum constants like ClassIndexLand with a unique small
- * number for each class.
+ * This defines enum constants like ClassIdLand with a unique small
+ * number for each class -- essentially the row number in the class
+ * table.
  */
 
-#define CLASS_INDEX_ENUM(prefix, ident, kind, super) prefix ## ident,
-typedef enum ClassIndexEnum {
-  ClassIndexInvalid, /* index zero reserved for invalid classes */
-  CLASSES(CLASS_INDEX_ENUM, ClassIndex)
-  ClassIndexLIMIT
-} ClassIndexEnum;
+#define CLASS_ID_ENUM(prefix, ident, kind, super) prefix ## ident,
+typedef enum ClassIdEnum {
+  ClassIdInvalid, /* index zero reserved for invalid classes */
+  CLASSES(CLASS_ID_ENUM, ClassId)
+  ClassIdLIMIT
+} ClassIdEnum;
+
+/* ClassLevelEnum -- depth of class in hierarchy */
+
+#define CLASS_LEVEL_ENUM(prefix, ident, kind, super) prefix ## ident = prefix ## super + 1,
+typedef enum ClassLevelEnum {
+  ClassLevelNoSuper = 0, /* because everything secretly inherits from Inst */
+  CLASSES(CLASS_LEVEL_ENUM, ClassLevel)
+  ClassLevelTerminalCommaNotAllowedInC89
+} ClassLevelEnum;
 
 
 /* INHERIT_CLASS -- the standard macro for inheriting from a superclass */
@@ -90,7 +100,7 @@ typedef enum ClassIndexEnum {
     instClass->name = #_class; \
     instClass->level = instClass->superclass->level + 1; \
     AVER(instClass->level < ClassDEPTH); \
-    instClass->index[instClass->level] = ClassIndex ## _class; \
+    instClass->display[instClass->level] = ClassId ## _class; \
   END
 
 
@@ -113,7 +123,7 @@ typedef struct InstStruct {
 
 typedef const char *InstClassName;
 typedef unsigned long ProtocolTypeId;
-typedef unsigned char ClassIndex;
+typedef unsigned char ClassId;
 typedef unsigned char ClassLevel;
 #define ClassDEPTH 8            /* maximum depth of class hierarchy */
 
@@ -122,7 +132,7 @@ typedef struct InstClassStruct {
   InstClassName name;           /* human readable name such as "Land" */
   InstClass superclass;         /* pointer to direct superclass */
   ClassLevel level;             /* distance from root of class hierarchy */
-  ClassIndex index[ClassDEPTH]; /* indexes of classes at this level and above */
+  ClassId display[ClassDEPTH];  /* ids of classes at this level and above */
 } InstClassStruct;
 
 
@@ -137,15 +147,6 @@ extern Bool InstClassCheck(InstClass class);
 extern Bool InstCheck(Inst pro);
 
 
-/* ProtocolIsSubclass - use macro IsSubclass to access this.
- *
- * A predicate for testing subclass relationships.  A protocol class
- * is always a subclass of itself.
- */
-
-extern Bool ProtocolIsSubclass(InstClass sub, InstClass super);
-
-
 /* Protocol introspection interface */
 
 /* The following are macros because of the need to cast */
@@ -158,9 +159,6 @@ extern Bool ProtocolIsSubclass(InstClass sub, InstClass super);
 
 #define ClassOfPoly(inst) (MustBeA(Inst, inst)->class)
 
-#define IsSubclassPoly(sub, super) \
-   ProtocolIsSubclass((InstClass)(sub), (InstClass)(super))
-
 
 /* SUPERCLASS  - get the superclass object, given a class name
  *
@@ -187,9 +185,11 @@ CLASSES(CLASS_DECLARE_SUPER, UNUSED)
 
 #define CouldBeA(class, inst) ((INST_TYPE(class))inst)
 
+#define IsSubclass(sub, super) \
+  (((InstClass)(sub))->display[ClassLevel ## super] == ClassId ## super)
+  
 #define IsA(_class, inst) \
-  ProtocolIsSubclass(CouldBeA(Inst, inst)->class, \
-                     (InstClass)CLASS(_class))
+  IsSubclass(CouldBeA(Inst, inst)->class, _class)
 
 #define MustBeA(_class, inst) \
   CouldBeA(_class, \

mps/code/traceanc.c

@@ -723,7 +723,7 @@ void ArenaExposeRemember(Globals globals, Bool remember)
 
     do {
       base = SegBase(seg);
-      if (IsSubclassPoly(ClassOfSeg(seg), CLASS(GCSeg))) {
+      if (IsA(GCSeg, seg)) {
         if(remember) {
           RefSet summary;
 
@@ -766,7 +766,7 @@ void ArenaRestoreProtection(Globals globals)
       }
       b = SegOfAddr(&seg, arena, block->the[i].base);
       if(b && SegBase(seg) == block->the[i].base) {
-        AVER(IsSubclassPoly(ClassOfSeg(seg), CLASS(GCSeg)));
+        AVER(IsA(GCSeg, seg));
         SegSetSummary(seg, block->the[i].summary);
       } else {
         /* Either seg has gone or moved, both of which are */