Fixing mustbea to not return a void *.

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

mps/code/buffer.c

@@ -315,7 +315,7 @@ void BufferDetach(Buffer buffer, Pool pool)
     limit = buffer->poolLimit;
     /* Ask the owning pool to do whatever it needs to before the */
     /* buffer is detached (e.g. copy buffer state into pool state). */
-    (*ClassOfPool(pool)->bufferEmpty)(pool, buffer, init, limit);
+    Method(Pool, pool, bufferEmpty)(pool, buffer, init, limit);
     /* Use of lightweight frames must have been disabled by now */
     AVER(BufferFrameState(buffer) == BufferFrameDISABLED);
 
@@ -387,7 +387,7 @@ void BufferFinish(Buffer buffer)
 
   /* Dispatch to the buffer class method to perform any  */
   /* class-specific finishing of the buffer. */
-  (*ClassOfBuffer(buffer)->finish)(buffer);
+  Method(Buffer, buffer, finish)(buffer);
 
   /* Detach the buffer from its owning pool and unsig it. */
   RingRemove(&buffer->poolRing);
@@ -534,7 +534,7 @@ static void BufferFrameNotifyPopPending(Buffer buffer)
     buffer->ap_s.limit = buffer->poolLimit;
   }
   pool = BufferPool(buffer);
-  (*ClassOfPool(pool)->framePopPending)(pool, buffer, frame);
+  Method(Pool, pool, framePopPending)(pool, buffer, frame);
 }
 
 
@@ -563,7 +563,7 @@ Res BufferFramePush(AllocFrame *frameReturn, Buffer buffer)
     }
   }
   pool = BufferPool(buffer);
-  return (*ClassOfPool(pool)->framePush)(frameReturn, pool, buffer);
+  return Method(Pool, pool, framePush)(frameReturn, pool, buffer);
 }
 
 
@@ -577,7 +577,7 @@ Res BufferFramePop(Buffer buffer, AllocFrame frame)
   AVERT(Buffer, buffer);
   /* frame is of an abstract type & can't be checked */
   pool = BufferPool(buffer);
-  return (*ClassOfPool(pool)->framePop)(pool, buffer, frame);
+  return Method(Pool, pool, framePop)(pool, buffer, frame);
  
 }
 
@@ -717,7 +717,7 @@ Res BufferFill(Addr *pReturn, Buffer buffer, Size size)
   BufferDetach(buffer, pool);
 
   /* Ask the pool for some memory. */
-  res = (*ClassOfPool(pool)->bufferFill)(&base, &limit, pool, buffer, size);
+  res = Method(Pool, pool, bufferFill)(&base, &limit, pool, buffer, size);
   if (res != ResOK)
     return res;
 
@@ -1006,7 +1006,7 @@ void BufferRampBegin(Buffer buffer, AllocPattern pattern)
 
   pool = BufferPool(buffer);
   AVERT(Pool, pool);
-  (*ClassOfPool(pool)->rampBegin)(pool, buffer,
+  Method(Pool, pool, rampBegin)(pool, buffer,
                             pattern == &AllocPatternRampCollectAllStruct);
 }
 
@@ -1025,7 +1025,7 @@ Res BufferRampEnd(Buffer buffer)
 
   pool = BufferPool(buffer);
   AVERT(Pool, pool);
-  (*ClassOfPool(pool)->rampEnd)(pool, buffer);
+  Method(Pool, pool, rampEnd)(pool, buffer);
   return ResOK;
 }
 
@@ -1044,7 +1044,7 @@ void BufferRampReset(Buffer buffer)
   pool = BufferPool(buffer);
   AVERT(Pool, pool);
   do
-    (*ClassOfPool(pool)->rampEnd)(pool, buffer);
+    Method(Pool, pool, rampEnd)(pool, buffer);
   while(--buffer->rampCount > 0);
 }
 

mps/code/land.c

@@ -177,7 +177,7 @@ void LandFinish(Land land)
   AVERC(Land, land);
   landEnter(land);
 
-  (*ClassOfLand(land)->finish)(land);
+  Method(Land, land, finish)(land);
 }
 
 
@@ -191,7 +191,7 @@ Size LandSize(Land land)
   /* .enter-leave.simple */
   AVERC(Land, land);
 
-  return (*ClassOfLand(land)->sizeMethod)(land);
+  return Method(Land, land, sizeMethod)(land);
 }
 
 
@@ -210,7 +210,7 @@ Res LandInsert(Range rangeReturn, Land land, Range range)
   AVER(RangeIsAligned(range, land->alignment));
   landEnter(land);
 
-  res = (*ClassOfLand(land)->insert)(rangeReturn, land, range);
+  res = Method(Land, land, insert)(rangeReturn, land, range);
 
   landLeave(land);
   return res;
@@ -232,7 +232,7 @@ Res LandDelete(Range rangeReturn, Land land, Range range)
   AVER(RangeIsAligned(range, land->alignment));
   landEnter(land);
 
-  res = (*ClassOfLand(land)->delete)(rangeReturn, land, range);
+  res = Method(Land, land, delete)(rangeReturn, land, range);
 
   landLeave(land);
   return res;
@@ -251,7 +251,7 @@ Bool LandIterate(Land land, LandVisitor visitor, void *closure)
   AVER(FUNCHECK(visitor));
   landEnter(land);
 
-  b = (*ClassOfLand(land)->iterate)(land, visitor, closure);
+  b = Method(Land, land, iterate)(land, visitor, closure);
 
   landLeave(land);
   return b;
@@ -271,7 +271,7 @@ Bool LandIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closure)
   AVER(FUNCHECK(visitor));
   landEnter(land);
 
-  b = (*ClassOfLand(land)->iterateAndDelete)(land, visitor, closure);
+  b = Method(Land, land, iterateAndDelete)(land, visitor, closure);
 
   landLeave(land);
   return b;
@@ -294,7 +294,7 @@ Bool LandFindFirst(Range rangeReturn, Range oldRangeReturn, Land land, Size size
   AVERT(FindDelete, findDelete);
   landEnter(land);
 
-  b = (*ClassOfLand(land)->findFirst)(rangeReturn, oldRangeReturn, land, size,
+  b = Method(Land, land, findFirst)(rangeReturn, oldRangeReturn, land, size,
                                 findDelete);
 
   landLeave(land);
@@ -318,7 +318,7 @@ Bool LandFindLast(Range rangeReturn, Range oldRangeReturn, Land land, Size size,
   AVERT(FindDelete, findDelete);
   landEnter(land);
 
-  b = (*ClassOfLand(land)->findLast)(rangeReturn, oldRangeReturn, land, size,
+  b = Method(Land, land, findLast)(rangeReturn, oldRangeReturn, land, size,
                                findDelete);
 
   landLeave(land);
@@ -342,7 +342,7 @@ Bool LandFindLargest(Range rangeReturn, Range oldRangeReturn, Land land, Size si
   AVERT(FindDelete, findDelete);
   landEnter(land);
 
-  b = (*ClassOfLand(land)->findLargest)(rangeReturn, oldRangeReturn, land, size,
+  b = Method(Land, land, findLargest)(rangeReturn, oldRangeReturn, land, size,
                                   findDelete);
 
   landLeave(land);
@@ -368,7 +368,7 @@ Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn,
   AVERT(Bool, high);
   landEnter(land);
 
-  res = (*ClassOfLand(land)->findInZones)(foundReturn, rangeReturn, oldRangeReturn,
+  res = Method(Land, land, findInZones)(foundReturn, rangeReturn, oldRangeReturn,
                                     land, size, zoneSet, high);
 
   landLeave(land);
@@ -383,7 +383,7 @@ Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn,
 
 Res LandDescribe(Land land, mps_lib_FILE *stream, Count depth)
 {
-  return (*ClassOfLand(land)->describe)(land, stream, depth);
+  return Method(Land, land, describe)(land, stream, depth);
 }
 
 

mps/code/pool.c

@@ -223,7 +223,7 @@ void PoolFinish(Pool pool)
   AVERT(Pool, pool); 
  
   /* Do any class-specific finishing. */
-  (*ClassOfPool(pool)->finish)(pool);
+  Method(Pool, pool, finish)(pool);
 
   /* Detach the pool from the arena and format, and unsig it. */
   RingRemove(&pool->arenaRing);
@@ -266,7 +266,7 @@ void PoolDestroy(Pool pool)
 BufferClass PoolDefaultBufferClass(Pool pool)
 {
   AVERT(Pool, pool);
-  return (*ClassOfPool(pool)->bufferClass)();
+  return Method(Pool, pool, bufferClass)();
 }
 
 
@@ -280,7 +280,7 @@ Res PoolAlloc(Addr *pReturn, Pool pool, Size size)
   AVERT(Pool, pool);
   AVER(size > 0);
 
-  res = (*ClassOfPool(pool)->alloc)(pReturn, pool, size);
+  res = Method(Pool, pool, alloc)(pReturn, pool, size);
   if (res != ResOK)
     return res;
   /* Make sure that the allocated address was in the pool's memory. */
@@ -311,7 +311,7 @@ void PoolFree(Pool pool, Addr old, Size size)
   AVER(AddrIsAligned(old, pool->alignment));
   AVER(PoolHasRange(pool, old, AddrAdd(old, size)));
 
-  (*ClassOfPool(pool)->free)(pool, old, size);
+  Method(Pool, pool, free)(pool, old, size);
  
   EVENT3(PoolFree, pool, old, size);
 }
@@ -327,7 +327,7 @@ Res PoolAccess(Pool pool, Seg seg, Addr addr,
   AVERT(AccessSet, mode);
   /* Can't check MutatorFaultContext as there is no check method */
 
-  return (*ClassOfPool(pool)->access)(pool, seg, addr, mode, context);
+  return Method(Pool, pool, access)(pool, seg, addr, mode, context);
 }
 
 
@@ -340,7 +340,7 @@ Res PoolWhiten(Pool pool, Trace trace, Seg seg)
   AVERT(Seg, seg);
   AVER(PoolArena(pool) == trace->arena);
   AVER(SegPool(seg) == pool);
-  return (*ClassOfPool(pool)->whiten)(pool, trace, seg);
+  return Method(Pool, pool, whiten)(pool, trace, seg);
 }
 
 void PoolGrey(Pool pool, Trace trace, Seg seg)
@@ -350,7 +350,7 @@ void PoolGrey(Pool pool, Trace trace, Seg seg)
   AVERT(Seg, seg);
   AVER(pool->arena == trace->arena);
   AVER(SegPool(seg) == pool);
-  (*ClassOfPool(pool)->grey)(pool, trace, seg);
+  Method(Pool, pool, grey)(pool, trace, seg);
 }
 
 void PoolBlacken(Pool pool, TraceSet traceSet, Seg seg)
@@ -359,7 +359,7 @@ void PoolBlacken(Pool pool, TraceSet traceSet, Seg seg)
   AVERT(TraceSet, traceSet);
   AVERT(Seg, seg);
   AVER(SegPool(seg) == pool);
-  (*ClassOfPool(pool)->blacken)(pool, traceSet, seg);
+  Method(Pool, pool, blacken)(pool, traceSet, seg);
 }
 
 
@@ -385,7 +385,7 @@ Res PoolScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   /* Should only scan segments which contain grey objects. */
   AVER(TraceSetInter(SegGrey(seg), ss->traces) != TraceSetEMPTY);
 
-  return (*ClassOfPool(pool)->scan)(totalReturn, ss, pool, seg);
+  return Method(Pool, pool, scan)(totalReturn, ss, pool, seg);
 }
 
 
@@ -442,7 +442,7 @@ void PoolReclaim(Pool pool, Trace trace, Seg seg)
   /* Should only be reclaiming segments which are still white. */
   AVER_CRITICAL(TraceSetIsMember(SegWhite(seg), trace));
 
-  (*ClassOfPool(pool)->reclaim)(pool, trace, seg);
+  Method(Pool, pool, reclaim)(pool, trace, seg);
 }
 
 
@@ -459,7 +459,7 @@ void PoolTraceEnd(Pool pool, Trace trace)
   AVERT(Trace, trace);
   AVER(pool->arena == trace->arena);
 
-  (*ClassOfPool(pool)->traceEnd)(pool, trace);
+  Method(Pool, pool, traceEnd)(pool, trace);
 }
 
 
@@ -477,7 +477,7 @@ Res PoolAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr)
   AVER(pool == SegPool(seg));
   AVER(SegBase(seg) <= addr);
   AVER(addr < SegLimit(seg));
-  return (*ClassOfPool(pool)->addrObject)(pReturn, pool, seg, addr);
+  return Method(Pool, pool, addrObject)(pReturn, pool, seg, addr);
 }
 
 
@@ -490,7 +490,7 @@ void PoolWalk(Pool pool, Seg seg, FormattedObjectsVisitor f, void *p, size_t s)
   AVER(FUNCHECK(f));
   /* p and s are arbitrary values, hence can't be checked. */
 
-  (*ClassOfPool(pool)->walk)(pool, seg, f, p, s);
+  Method(Pool, pool, walk)(pool, seg, f, p, s);
 }
 
 
@@ -505,7 +505,7 @@ void PoolFreeWalk(Pool pool, FreeBlockVisitor f, void *p)
   AVER(FUNCHECK(f));
   /* p is arbitrary, hence can't be checked. */
 
-  (*ClassOfPool(pool)->freewalk)(pool, f, p);
+  Method(Pool, pool, freewalk)(pool, f, p);
 }
 
 
@@ -515,7 +515,7 @@ Size PoolTotalSize(Pool pool)
 {
   AVERT(Pool, pool);
 
-  return (*ClassOfPool(pool)->totalSize)(pool);
+  return Method(Pool, pool, totalSize)(pool);
 }
 
 
@@ -525,7 +525,7 @@ Size PoolFreeSize(Pool pool)
 {
   AVERT(Pool, pool);
 
-  return (*ClassOfPool(pool)->freeSize)(pool);
+  return Method(Pool, pool, freeSize)(pool);
 }
 
 
@@ -557,7 +557,7 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
       return res;
   }
 
-  res = (*ClassOfPool(pool)->describe)(pool, stream, depth + 2);
+  res = Method(Pool, pool, describe)(pool, stream, depth + 2);
   if (res != ResOK)
     return res;
 

mps/code/protocol.h

@@ -160,20 +160,19 @@ extern Bool InstClassCheck(InstClass class);
 extern Bool InstCheck(Inst inst);
 
 
-/* Protocol introspection interface */
-
-/* The following are macros because of the need to cast */
-/* subtypes of InstClass. Nevertheless they are named */
-/* as functions. See <design/protocol/#introspect.c-lang> */
-
+/* Protocol introspection interface
+ *
+ * The following are macros because of the need to cast subtypes of
+ * InstClass. Nevertheless they are named as functions. See
+ * <design/protocol/#introspect.c-lang>.
+ */
 
 #define InstClassSuperclassPoly(class) \
   (((InstClass)(class))->superclass)
 
-/* FIXME: Try MustBeA here. */
-#define ClassOfPoly(inst) (CouldBeA(Inst, inst)->class)
+#define ClassOfPoly(inst) (MustBeA(Inst, inst)->class)
 #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
@@ -208,14 +207,13 @@ CLASSES(CLASS_DECLARE_SUPER, UNUSED)
   IsSubclass(CouldBeA(Inst, inst)->class, _class)
 
 #define MustBeA(_class, inst) \
-  CouldBeA(_class, \
-           (inst) != NULL && \
-           CouldBeA(Inst, inst)->class != NULL && \
-           IsA(_class, inst) ? \
-           inst : \
-           mps_lib_assert_fail_expr(MPS_FILE, __LINE__, \
-                                    "MustBeA " #_class ": " #inst, \
-                                    inst))
+  ((inst) != NULL && \
+   CouldBeA(Inst, inst)->class != NULL && \
+   IsA(_class, inst) ? \
+   CouldBeA(_class, inst) : \
+   CouldBeA(_class, mps_lib_assert_fail_expr(MPS_FILE, __LINE__, \
+                                             "MustBeA " #_class ": " #inst, \
+                                             inst)))
 
 /* ClassOf* -- get the class of an instance */
 
@@ -234,6 +232,19 @@ CLASSES(CLASS_DECLARE_CLASSOF, ClassOf)
 CLASSES(CLASS_DECLARE_SETCLASSOF, SetClassOf)
 
 
+/* Method -- method call
+ *
+ * FIXME: This isn't a very nice way to do this, but there's an
+ * inconsistency in the naming of the classes at the top of the kinds.
+ * The top of the Pool kind is called AbstractPool not Pool, making it
+ * hard to use MustBeA to get to the pool kind and its methods.  This
+ * isn't *wrong*, so there should be another way to safely get from
+ * class to kind.
+ */
+
+#define Method(class, inst, meth) (ClassOf ## class(inst)->meth)
+
+
 #endif /* protocol_h */