mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 18:40:39 -08:00
Code Issues Projects Releases Wiki Activity

Eliminating generated classof* and setclassof* functions in favour of checked poly macros.

Browse source 
Copied from Perforce
 Change: 190938
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Richard Brooksby 2016-04-11 18:06:47 +01:00
parent 8d776db4f2
commit ef6e2970ca
30 changed files with 67 additions and 117 deletions
Download patch file Download diff file Expand all files Collapse all files

4
mps/code/arena.c
View file

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

2
mps/code/arenacl.c
View file

@ -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 */

2
mps/code/arenavm.c
View file

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

10
mps/code/buffer.c
View file

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

2
mps/code/cbs.c
View file

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

8
mps/code/dbgpool.c
View file

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

6
mps/code/failover.c
View file

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

4
mps/code/finaltest.c
View file

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

2
mps/code/fotest.c
View file

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

2
mps/code/freelist.c
View file

@ -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> */

10
mps/code/land.c
View file

@ -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),

2
mps/code/locus.c
View file

@ -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,

12
mps/code/mpm.h
View file

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

8
mps/code/pool.c
View file

@ -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,

2
mps/code/poolabs.c
View file

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

6
mps/code/poolamc.c
View file

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

4
mps/code/poolams.c
View file

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

4
mps/code/poolawl.c
View file

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

4
mps/code/poollo.c
View file

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

2
mps/code/poolmfs.c
View file

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

8
mps/code/poolmrg.c
View file

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

2
mps/code/poolmv.c
View file

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

2
mps/code/poolmv2.c
View file

@ -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,

2
mps/code/poolmvff.c
View file

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

4
mps/code/pooln.c
View file

@ -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:

8
mps/code/poolsnc.c
View file

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

25
mps/code/protocol.c
View file

@ -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/>.

17
mps/code/protocol.h
View file

@ -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

16
mps/code/seg.c
View file

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

4
mps/code/segsmss.c
View file

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