Making arenas properly inherit from instances, and converting remaining method calls to use the method macro, while noting uses which are inside-out.

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

mps/code/arena.c

@@ -171,9 +171,8 @@ Bool ArenaClassCheck(ArenaClass class)
 
 Bool ArenaCheck(Arena arena)
 {
-  CHECKS(Arena, arena);
+  CHECKC(AbstractArena, arena);
   CHECKD(Globals, ArenaGlobals(arena));
-  CHECKD(ArenaClass, arena->class);
 
   CHECKL(BoolCheck(arena->poolReady));
   if (arena->poolReady) { /* <design/arena/#pool.ready> */
@@ -255,7 +254,7 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
   if (ArgPick(&arg, args, MPS_KEY_PAUSE_TIME))
     pauseTime = arg.val.d;
 
-  arena->class = class;
+  SetClassOfArena(arena, class); /* FIXME: Should call InstInit here? */
 
   arena->reserved = (Size)0;
   arena->committed = (Size)0;
@@ -385,7 +384,8 @@ Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
   EventInit();
 
   /* Do initialization.  This will call ArenaInit (see .init.caller). */
-  res = (*class->init)(&arena, class, args);
+  /* FIXME: Should call init which next-method calls ArenaAbsInit. */
+  res = class->init(&arena, class, args);
   if (res != ResOK)
     goto failInit;
 
@@ -417,7 +417,8 @@ failControlInit:
   arenaFreeLandFinish(arena);
 failFreeLandInit:
 failStripeSize:
-  (*class->finish)(arena);
+  /* FIXME: Should be taken care of by next-method calls. */
+  class->finish(arena);
 failInit:
   return res;
 }
@@ -485,7 +486,7 @@ void ArenaDestroy(Arena arena)
   arenaFreeLandFinish(arena);
 
   /* Call class-specific finishing.  This will call ArenaFinish. */
-  (*arena->class->finish)(arena);
+  Method(Arena, arena, finish)(arena);
 
   EventFinish();
 }
@@ -535,7 +536,7 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 
   res = WriteF(stream, depth, "Arena $P {\n", (WriteFP)arena,
                "  class $P (\"$S\")\n",
-               (WriteFP)arena->class, (WriteFS)arena->class->protocol.name,
+               (WriteFP)ClassOfArena(arena), (WriteFS)ClassOfArena(arena)->protocol.name,
                NULL);
   if (res != ResOK)
     return res;
@@ -573,7 +574,7 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
   if (res != ResOK)
     return res;
 
-  res = (*arena->class->describe)(arena, stream, depth);
+  res = Method(Arena, arena, describe)(arena, stream, depth);
   if (res != ResOK)
     return res;
 
@@ -806,9 +807,9 @@ static Res arenaAllocPageInChunk(Addr *baseReturn, Chunk chunk, Pool pool)
                            chunk->allocBase, chunk->pages, 1))
     return ResRESOURCE;
   
-  res = (*arena->class->pagesMarkAllocated)(arena, chunk,
-                                            basePageIndex, 1,
-                                            pool);
+  res = Method(Arena, arena, pagesMarkAllocated)(arena, chunk,
+                                                 basePageIndex, 1,
+                                                 pool);
   if (res != ResOK)
     return res;
 
@@ -849,7 +850,7 @@ static void arenaFreePage(Arena arena, Addr base, Pool pool)
 {
   AVERT(Arena, arena);
   AVERT(Pool, pool);
-  (*arena->class->free)(base, ArenaGrainSize(arena), pool);
+  Method(Arena, arena, free)(base, ArenaGrainSize(arena), pool);
 }
 
 
@@ -1095,7 +1096,7 @@ Res ArenaFreeLandAlloc(Tract *tractReturn, Arena arena, ZoneSet zones,
   baseIndex = INDEX_OF_ADDR(chunk, RangeBase(&range));
   pages = ChunkSizeToPages(chunk, RangeSize(&range));
 
-  res = (*arena->class->pagesMarkAllocated)(arena, chunk, baseIndex, pages, pool);
+  res = Method(Arena, arena, pagesMarkAllocated)(arena, chunk, baseIndex, pages, pool);
   if (res != ResOK)
     goto failMark;
 
@@ -1188,7 +1189,7 @@ void ArenaFree(Addr base, Size size, Pool pool)
 
   arenaFreeLandInsertSteal(&oldRange, arena, &range); /* may update range */
 
-  (*arena->class->free)(RangeBase(&range), RangeSize(&range), pool);
+  Method(Arena, arena, free)(RangeBase(&range), RangeSize(&range), pool);
 
   /* Freeing memory might create spare pages, but not more than this. */
   CHECKL(arena->spareCommitted <= arena->spareCommitLimit);
@@ -1230,7 +1231,7 @@ void ArenaSetSpareCommitLimit(Arena arena, Size limit)
   arena->spareCommitLimit = limit;
   if (arena->spareCommitLimit < arena->spareCommitted) {
     Size excess = arena->spareCommitted - arena->spareCommitLimit;
-    (void)arena->class->purgeSpare(arena, excess);
+    (void)Method(Arena, arena, purgeSpare)(arena, excess);
   }
 
   EVENT2(SpareCommitLimitSet, arena, limit);
@@ -1287,7 +1288,7 @@ Res ArenaSetCommitLimit(Arena arena, Size limit)
     /* Attempt to set the limit below current committed */
     if (limit >= committed - arena->spareCommitted) {
       Size excess = committed - limit;
-      (void)arena->class->purgeSpare(arena, excess);
+      (void)Method(Arena, arena, purgeSpare)(arena, excess);
       AVER(limit >= ArenaCommitted(arena));
       arena->commitLimit = limit;
       res = ResOK;
@@ -1357,7 +1358,7 @@ Res ArenaExtend(Arena arena, Addr base, Size size)
   AVER(base != (Addr)0);
   AVER(size > 0);
 
-  res = (*arena->class->extend)(arena, base, size);
+  res = Method(Arena, arena, extend)(arena, base, size);
   if (res != ResOK)
     return res;
 
@@ -1385,7 +1386,7 @@ void ArenaCompact(Arena arena, Trace trace)
 {
   AVERT(Arena, arena);
   AVERT(Trace, trace);
-  (*arena->class->compact)(arena, trace);
+  Method(Arena, arena, compact)(arena, trace);
 }
 
 static void ArenaTrivCompact(Arena arena, Trace trace)

mps/code/buffer.c

@@ -244,7 +244,8 @@ static Res BufferInit(Buffer buffer, BufferClass class,
 
   /* Dispatch to the buffer class method to perform any  */
   /* class-specific initialization of the buffer. */
-  res = (*class->init)(buffer, pool, args);
+  /* FIXME: Should call this first, which next-method calls BufferAbsInit. */
+  res = class->init(buffer, pool, args);
   if (res != ResOK)
     goto failInit;
 

mps/code/land.c

@@ -104,7 +104,7 @@ Res LandInit(Land land, LandClass class, Arena arena, Align alignment, void *own
   AVERT(LandClass, class);
   AVERT(Align, alignment);
 
-  res = (*class->init)(land, arena, alignment, args);
+  res = class->init(land, arena, alignment, args);
   if (res != ResOK)
     return res;
 

mps/code/message.c

@@ -314,6 +314,7 @@ static void MessageDelete(Message message)
 {
   AVERT(Message, message);
 
+  /* FIXME: Should be using protocol classes? */
   (*message->class->delete)(message);
 }
 

mps/code/mpm.h

@@ -484,6 +484,11 @@ extern void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena,
 DECLARE_CLASS(AbstractArena, 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) ((ArenaClass)ClassOfPoly(arena))
+#define SetClassOfArena SetClassOfPoly
+
 extern Bool ArenaCheck(Arena arena);
 extern Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args);
 extern void ArenaDestroy(Arena arena);

mps/code/mpmst.h

@@ -716,11 +716,11 @@ typedef struct ShieldStruct {
 #define ArenaSig        ((Sig)0x519A6E4A) /* SIGnature ARENA */
 
 typedef struct mps_arena_s {
+  InstStruct instStruct;
+  
   GlobalsStruct globals; /* must be first, see <design/arena/#globals> */
   Serial serial;
 
-  ArenaClass class;             /* arena class structure */
-
   Bool poolReady;               /* <design/arena/#pool.ready> */
   MVStruct controlPoolStruct;   /* <design/arena/#pool> */
 

mps/code/policy.c

@@ -76,14 +76,14 @@ Res PolicyAlloc(Tract *tractReturn, Arena arena, LocusPref pref,
 
   /* Plan C: Extend the arena, then try A and B again. */
   if (moreZones != ZoneSetEMPTY) {
-    res = arena->class->grow(arena, pref, size);
+    res = Method(Arena, arena, grow)(arena, pref, size);
     /* If we can't extend because we hit the commit limit, try purging
        some spare committed memory and try again.*/
     /* TODO: This would be a good time to *remap* VM instead of
        returning it to the OS. */
     if (res == ResCOMMIT_LIMIT) {
-      if (arena->class->purgeSpare(arena, size) >= size)
-        res = arena->class->grow(arena, pref, size);
+      if (Method(Arena, arena, purgeSpare)(arena, size) >= size)
+        res = Method(Arena, arena, grow)(arena, pref, size);
     }
     if (res == ResOK) {
       if (zones != ZoneSetEMPTY) {

mps/code/pool.c

@@ -158,7 +158,8 @@ Res PoolInit(Pool pool, Arena arena, PoolClass class, ArgList args)
   AVERT(Pool, pool);
 
   /* Do class-specific initialization. */
-  res = (*class->init)(pool, args);
+  /* FIXME: Should be calling this first, which next-method calls PoolAbsInit. */
+  res = class->init(pool, args);
   if (res != ResOK)
     goto failInit;
 

mps/code/poolamc.c

@@ -505,7 +505,6 @@ static Res AMCBufInit(Buffer buffer, Pool pool, ArgList args)
 {
   AMC amc;
   amcBuf amcbuf;
-  BufferClass superclass;
   Res res;
   Bool forHashArrays = FALSE;
   ArgStruct arg;
@@ -519,8 +518,7 @@ static Res AMCBufInit(Buffer buffer, Pool pool, ArgList args)
     forHashArrays = arg.val.b;
 
   /* call next method */
-  superclass = SUPERCLASS(Buffer, amcBuf);
-  res = (*superclass->init)(buffer, pool, args);
+  res = SUPERCLASS(Buffer, amcBuf)->init(buffer, pool, args);
   if(res != ResOK)
     return res;
 

mps/code/poolsnc.c

@@ -128,14 +128,12 @@ static Res SNCBufInit(Buffer buffer, Pool pool, ArgList args)
 {
   SNCBuf sncbuf;
   Res res;
-  BufferClass superclass;
 
   AVERT(Buffer, buffer);
   AVERT(Pool, pool);
 
   /* call next method */
-  superclass = SUPERCLASS(Buffer, SNCBuf);
-  res = (*superclass->init)(buffer, pool, args);
+  res = SUPERCLASS(Buffer, SNCBuf)->init(buffer, pool, args);
   if (res != ResOK)
     return res;
 

mps/code/seg.c

@@ -168,6 +168,7 @@ static Res SegInit(Seg seg, SegClass class, Pool pool, Addr base, Size size, Arg
   RingInit(SegPoolRing(seg));
 
   /* Class specific initialization comes last */
+  /* FIXME: Should call init which next-method calls SegAbsInit. */
   res = class->init(seg, pool, base, size, args);
   if (res != ResOK)
     goto failInit;
@@ -211,6 +212,7 @@ static void SegFinish(Seg seg)
   }
 
   /* Class specific finishing cames first */
+  /* FIXME: Should call finish which next-method calls SegAbsFinish. */
   class->finish(seg);
 
   seg->rankSet = RankSetEMPTY;
@@ -572,7 +574,7 @@ Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi)
     ShieldFlush(arena);  /* see <design/seg/#split-merge.shield> */
 
   /* Invoke class-specific methods to do the merge */
-  res = class->merge(segLo, segHi, base, mid, limit);
+  res = Method(Seg, segLo, merge)(segLo, segHi, base, mid, limit);
   if (ResOK != res)
     goto failMerge;
 
@@ -632,7 +634,7 @@ Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at)
   segNew = p;
 
   /* Invoke class-specific methods to do the split */
-  res = class->split(seg, segNew, base, at, limit);
+  res = Method(Seg, seg, split)(seg, segNew, base, at, limit);
   if (ResOK != res)
     goto failSplit;
 

mps/code/tract.c

@@ -205,7 +205,7 @@ Res ChunkInit(Chunk chunk, Arena arena, Addr base, Addr limit, Size reserved,
   pageTableSize = SizeAlignUp(pages * sizeof(PageUnion), chunk->pageSize);
   chunk->pageTablePages = pageTableSize >> pageShift;
 
-  res = (arena->class->chunkInit)(chunk, boot);
+  res = Method(Arena, arena, chunkInit)(chunk, boot);
   if (res != ResOK)
     goto failClassInit;
 
@@ -239,7 +239,7 @@ Res ChunkInit(Chunk chunk, Arena arena, Addr base, Addr limit, Size reserved,
   return ResOK;
 
 failLandInsert:
-  (arena->class->chunkFinish)(chunk);
+  Method(Arena, arena, chunkFinish)(chunk);
   /* .no-clean: No clean-ups needed past this point for boot, as we will
      discard the chunk. */
 failClassInit:
@@ -273,7 +273,7 @@ void ChunkFinish(Chunk chunk)
 
   /* Finish all other fields before class finish, because they might be */
   /* unmapped there. */
-  (*arena->class->chunkFinish)(chunk);
+  Method(Arena, arena, chunkFinish)(chunk);
 }