diff --git a/mps/Makefile.in b/mps/Makefile.in index 71673c67db3..cdefe0890ea 100644 --- a/mps/Makefile.in +++ b/mps/Makefile.in @@ -71,7 +71,7 @@ make-install-dirs: install: @INSTALL_TARGET@ test-make-build: - $(MAKE) $(TARGET_OPTS) testci testratio + $(MAKE) $(TARGET_OPTS) testci testratio testscheme $(MAKE) -C code -f anan$(MPS_BUILD_NAME).gmk VARIETY=cool clean testansi $(MAKE) -C code -f anan$(MPS_BUILD_NAME).gmk VARIETY=cool CFLAGS="-DCONFIG_POLL_NONE" clean testpollnone diff --git a/mps/code/amcssth.c b/mps/code/amcssth.c index 3ce82054931..d914427eb46 100644 --- a/mps/code/amcssth.c +++ b/mps/code/amcssth.c @@ -120,13 +120,17 @@ typedef struct closure_s { static void *kid_thread(void *arg) { void *marker = ▮ - mps_thr_t thread; + mps_thr_t thread1, thread2; mps_root_t reg_root; mps_ap_t ap; closure_t cl = arg; - die(mps_thread_reg(&thread, (mps_arena_t)arena), "thread_reg"); - die(mps_root_create_thread(®_root, arena, thread, marker), + /* Register the thread twice to check this is supported -- see + * + */ + die(mps_thread_reg(&thread1, arena), "thread_reg"); + die(mps_thread_reg(&thread2, arena), "thread_reg"); + die(mps_root_create_thread(®_root, arena, thread1, marker), "root_create"); die(mps_ap_create(&ap, cl->pool, mps_rank_exact()), "BufferCreate(fooey)"); @@ -136,7 +140,8 @@ static void *kid_thread(void *arg) mps_ap_destroy(ap); mps_root_destroy(reg_root); - mps_thread_dereg(thread); + mps_thread_dereg(thread2); + mps_thread_dereg(thread1); return NULL; } diff --git a/mps/code/apss.c b/mps/code/apss.c index fbe58f249df..6efcf8a1e8d 100644 --- a/mps/code/apss.c +++ b/mps/code/apss.c @@ -1,7 +1,7 @@ /* apss.c: AP MANUAL ALLOC STRESS TEST * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. */ @@ -77,11 +77,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options, /* allocate a load of objects */ for (i=0; i= sizeof(ps[i])) *ps[i] = 1; /* Write something, so it gets swap. */ @@ -121,10 +122,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options, } /* allocate some new objects */ for (i=testSetSIZE/2; i. + * Copyright (c) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/arena.c b/mps/code/arena.c index 3fc69afc30f..a3301521fae 100644 --- a/mps/code/arena.c +++ b/mps/code/arena.c @@ -43,8 +43,8 @@ static void ArenaTrivCompact(Arena arena, Trace trace); static void arenaFreePage(Arena arena, Addr base, Pool pool); static void arenaFreeLandFinish(Arena arena); static Res ArenaAbsInit(Arena arena, Size grainSize, ArgList args); -static void ArenaAbsFinish(Arena arena); -static Res ArenaAbsDescribe(Arena arena, mps_lib_FILE *stream, Count depth); +static void ArenaAbsFinish(Inst inst); +static Res ArenaAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth); static void ArenaNoFree(Addr base, Size size, Pool pool) @@ -106,11 +106,12 @@ DEFINE_CLASS(Inst, ArenaClass, klass) DEFINE_CLASS(Arena, AbstractArena, klass) { - INHERIT_CLASS(&klass->protocol, AbstractArena, Inst); + INHERIT_CLASS(&klass->instClassStruct, AbstractArena, Inst); + klass->instClassStruct.finish = ArenaAbsFinish; + klass->instClassStruct.describe = ArenaAbsDescribe; klass->size = sizeof(ArenaStruct); klass->varargs = ArgTrivVarargs; klass->init = ArenaAbsInit; - klass->finish = ArenaAbsFinish; klass->create = ArenaNoCreate; klass->destroy = ArenaNoDestroy; klass->purgeSpare = ArenaNoPurgeSpare; @@ -120,7 +121,6 @@ DEFINE_CLASS(Arena, AbstractArena, klass) klass->chunkInit = ArenaNoChunkInit; klass->chunkFinish = ArenaNoChunkFinish; klass->compact = ArenaTrivCompact; - klass->describe = ArenaAbsDescribe; klass->pagesMarkAllocated = ArenaNoPagesMarkAllocated; klass->sig = ArenaClassSig; } @@ -130,11 +130,10 @@ DEFINE_CLASS(Arena, AbstractArena, klass) Bool ArenaClassCheck(ArenaClass klass) { - CHECKD(InstClass, &klass->protocol); + CHECKD(InstClass, &klass->instClassStruct); CHECKL(klass->size >= sizeof(ArenaStruct)); CHECKL(FUNCHECK(klass->varargs)); CHECKL(FUNCHECK(klass->init)); - CHECKL(FUNCHECK(klass->finish)); CHECKL(FUNCHECK(klass->create)); CHECKL(FUNCHECK(klass->destroy)); CHECKL(FUNCHECK(klass->purgeSpare)); @@ -144,7 +143,6 @@ Bool ArenaClassCheck(ArenaClass klass) CHECKL(FUNCHECK(klass->chunkInit)); CHECKL(FUNCHECK(klass->chunkFinish)); CHECKL(FUNCHECK(klass->compact)); - CHECKL(FUNCHECK(klass->describe)); CHECKL(FUNCHECK(klass->pagesMarkAllocated)); CHECKS(ArenaClass, klass); return TRUE; @@ -406,19 +404,15 @@ failInit: } -/* ArenaAbsFinish -- finish the generic part of the arena - * - * .finish.caller: Unlike PoolFinish, this is called by the class finish - * methods, not the generic Destroy. This is because the class is - * responsible for deallocating the descriptor. - */ +/* ArenaAbsFinish -- finish the generic part of the arena */ -static void ArenaAbsFinish(Arena arena) +static void ArenaAbsFinish(Inst inst) { + Arena arena = MustBeA(AbstractArena, inst); AVERC(Arena, arena); PoolFinish(ArenaCBSBlockPool(arena)); arena->sig = SigInvalid; - InstFinish(MustBeA(Inst, arena)); + NextMethod(Inst, AbstractArena, finish)(inst); GlobalsFinish(ArenaGlobals(arena)); LocusFinish(arena); RingFinish(ArenaChunkRing(arena)); @@ -510,8 +504,9 @@ void ControlFinish(Arena arena) /* ArenaDescribe -- describe the arena */ -static Res ArenaAbsDescribe(Arena arena, mps_lib_FILE *stream, Count depth) +static Res ArenaAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Arena arena = CouldBeA(AbstractArena, inst); Res res; if (!TESTC(AbstractArena, arena)) @@ -565,7 +560,7 @@ static Res ArenaAbsDescribe(Arena arena, mps_lib_FILE *stream, Count depth) Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth) { - return Method(Arena, arena, describe)(arena, stream, depth); + return Method(Inst, arena, describe)(MustBeA(Inst, arena), stream, depth); } diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c index bc139e23857..72e8c4af386 100644 --- a/mps/code/arenacl.c +++ b/mps/code/arenacl.c @@ -311,7 +311,7 @@ static Res ClientArenaCreate(Arena *arenaReturn, ArgList args) return ResOK; failChunkCreate: - NextMethod(Arena, ClientArena, finish)(arena); + NextMethod(Inst, ClientArena, finish)(MustBeA(Inst, arena)); failSuperInit: AVER(res != ResOK); return res; @@ -336,7 +336,7 @@ static void ClientArenaDestroy(Arena arena) AVER(arena->reserved == 0); AVER(arena->committed == 0); - NextMethod(Arena, ClientArena, finish)(arena); /* */ + NextMethod(Inst, ClientArena, finish)(MustBeA(Inst, arena)); } diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c index e6b53931b49..0168b4b6ed8 100644 --- a/mps/code/arenavm.c +++ b/mps/code/arenavm.c @@ -187,17 +187,18 @@ static Bool VMArenaCheck(VMArena vmArena) /* VMArenaDescribe -- describe the VMArena */ -static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth) +static Res VMArenaDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { - Res res; + Arena arena = CouldBeA(AbstractArena, inst); VMArena vmArena = CouldBeA(VMArena, arena); + Res res; if (!TESTC(VMArena, vmArena)) return ResPARAM; if (stream == NULL) return ResPARAM; - res = NextMethod(Arena, VMArena, describe)(arena, stream, depth); + res = NextMethod(Inst, VMArena, describe)(inst, stream, depth); if (res != ResOK) return res; @@ -502,6 +503,7 @@ static Res vmArenaChunkSize(Size *chunkSizeReturn, VMArena vmArena, Size size) overhead = 0; do { chunkSize = size + overhead; + AVER(SizeIsAligned(chunkSize, grainSize)); /* See .overhead.chunk-struct. */ overhead = SizeAlignUp(sizeof(VMChunkStruct), MPS_PF_ALIGN); @@ -632,15 +634,18 @@ static Res VMArenaCreate(Arena *arenaReturn, ArgList args) goto failChunkCreate; #if defined(AVER_AND_CHECK_ALL) - /* Check that the computation of the chunk size in vmArenaChunkSize - * was correct, now that we have the actual chunk for comparison. */ + /* Check the computation of the chunk size in vmArenaChunkSize, now + * that we have the actual chunk for comparison. Note that + * vmArenaChunkSize computes the smallest size with a given number + * of usable bytes -- the actual chunk may be one grain larger. */ { Size usableSize, computedChunkSize; usableSize = AddrOffset(PageIndexBase(chunk, chunk->allocBase), chunk->limit); res = vmArenaChunkSize(&computedChunkSize, vmArena, usableSize); AVER(res == ResOK); - AVER(computedChunkSize == ChunkSize(chunk)); + AVER(computedChunkSize == ChunkSize(chunk) + || computedChunkSize + grainSize == ChunkSize(chunk)); } #endif @@ -662,7 +667,7 @@ static Res VMArenaCreate(Arena *arenaReturn, ArgList args) return ResOK; failChunkCreate: - NextMethod(Arena, VMArena, finish)(arena); + NextMethod(Inst, VMArena, finish)(MustBeA(Inst, arena)); failArenaInit: VMUnmap(vm, VMBase(vm), VMLimit(vm)); failVMMap: @@ -697,7 +702,7 @@ static void VMArenaDestroy(Arena arena) vmArena->sig = SigInvalid; - NextMethod(Arena, VMArena, finish)(arena); /* */ + NextMethod(Inst, VMArena, finish)(MustBeA(Inst, arena)); /* Copy VM descriptor to stack-local storage so that we can continue * using the descriptor after the VM has been unmapped. */ @@ -1191,6 +1196,7 @@ mps_res_t mps_arena_vm_growth(mps_arena_t mps_arena, DEFINE_CLASS(Arena, VMArena, klass) { INHERIT_CLASS(klass, VMArena, AbstractArena); + klass->instClassStruct.describe = VMArenaDescribe; klass->size = sizeof(VMArenaStruct); klass->varargs = VMArenaVarargs; klass->create = VMArenaCreate; @@ -1201,7 +1207,6 @@ DEFINE_CLASS(Arena, VMArena, klass) klass->chunkInit = VMChunkInit; klass->chunkFinish = VMChunkFinish; klass->compact = VMCompact; - klass->describe = VMArenaDescribe; klass->pagesMarkAllocated = VMPagesMarkAllocated; } diff --git a/mps/code/buffer.c b/mps/code/buffer.c index 779d31e448b..1595421c171 100644 --- a/mps/code/buffer.c +++ b/mps/code/buffer.c @@ -1,7 +1,7 @@ /* buffer.c: ALLOCATION BUFFER IMPLEMENTATION * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .purpose: This is (part of) the implementation of allocation buffers. * Several macros which also form part of the implementation are in @@ -119,54 +119,47 @@ Bool BufferCheck(Buffer buffer) * * See for structure definitions. */ -Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth) +static Res BufferAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Buffer buffer = CouldBeA(Buffer, inst); Res res; - BufferClass klass; if (!TESTC(Buffer, buffer)) return ResPARAM; if (stream == NULL) return ResPARAM; - klass = ClassOfPoly(Buffer, buffer); - - res = WriteF(stream, depth, - "Buffer $P ($U) {\n", - (WriteFP)buffer, (WriteFU)buffer->serial, - " class $P (\"$S\")\n", - (WriteFP)klass, (WriteFS)ClassName(klass), - " Arena $P\n", (WriteFP)buffer->arena, - " Pool $P\n", (WriteFP)buffer->pool, - " ", buffer->isMutator ? "Mutator" : "Internal", " Buffer\n", - " mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n", - (WriteFC)((buffer->mode & BufferModeTRANSITION) ? 't' : '_'), - (WriteFC)((buffer->mode & BufferModeLOGGED) ? 'l' : '_'), - (WriteFC)((buffer->mode & BufferModeFLIPPED) ? 'f' : '_'), - (WriteFC)((buffer->mode & BufferModeATTACHED) ? 'a' : '_'), - " fillSize $UKb\n", (WriteFU)(buffer->fillSize / 1024), - " emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024), - " alignment $W\n", (WriteFW)buffer->alignment, - " base $A\n", (WriteFA)buffer->base, - " initAtFlip $A\n", (WriteFA)buffer->initAtFlip, - " init $A\n", (WriteFA)buffer->ap_s.init, - " alloc $A\n", (WriteFA)buffer->ap_s.alloc, - " limit $A\n", (WriteFA)buffer->ap_s.limit, - " poolLimit $A\n", (WriteFA)buffer->poolLimit, - " alignment $W\n", (WriteFW)buffer->alignment, - " rampCount $U\n", (WriteFU)buffer->rampCount, - NULL); + res = NextMethod(Inst, Buffer, describe)(inst, stream, depth); if (res != ResOK) return res; - res = Method(Buffer, buffer, describe)(buffer, stream, depth + 2); - if (res != ResOK) - return res; + return WriteF(stream, depth + 2, + "serial $U\n", (WriteFU)buffer->serial, + "Arena $P\n", (WriteFP)buffer->arena, + "Pool $P\n", (WriteFP)buffer->pool, + buffer->isMutator ? "Mutator" : "Internal", " Buffer\n", + "mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n", + (WriteFC)((buffer->mode & BufferModeTRANSITION) ? 't' : '_'), + (WriteFC)((buffer->mode & BufferModeLOGGED) ? 'l' : '_'), + (WriteFC)((buffer->mode & BufferModeFLIPPED) ? 'f' : '_'), + (WriteFC)((buffer->mode & BufferModeATTACHED) ? 'a' : '_'), + "fillSize $UKb\n", (WriteFU)(buffer->fillSize / 1024), + "emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024), + "alignment $W\n", (WriteFW)buffer->alignment, + "base $A\n", (WriteFA)buffer->base, + "initAtFlip $A\n", (WriteFA)buffer->initAtFlip, + "init $A\n", (WriteFA)buffer->ap_s.init, + "alloc $A\n", (WriteFA)buffer->ap_s.alloc, + "limit $A\n", (WriteFA)buffer->ap_s.limit, + "poolLimit $A\n", (WriteFA)buffer->poolLimit, + "alignment $W\n", (WriteFW)buffer->alignment, + "rampCount $U\n", (WriteFU)buffer->rampCount, + NULL); +} - res = WriteF(stream, depth, "} Buffer $P ($U)\n", - (WriteFP)buffer, (WriteFU)buffer->serial, - NULL); - return res; +Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth) +{ + return Method(Inst, buffer, describe)(MustBeA(Inst, buffer), stream, depth); } @@ -340,8 +333,9 @@ void BufferDestroy(Buffer buffer) /* BufferFinish -- finish an allocation buffer */ -static void BufferAbsFinish(Buffer buffer) +static void BufferAbsFinish(Inst inst) { + Buffer buffer = MustBeA(Buffer, inst); AVERT(Buffer, buffer); AVER(BufferIsReset(buffer)); @@ -361,9 +355,9 @@ void BufferFinish(Buffer buffer) AVERT(Buffer, buffer); AVER(BufferIsReady(buffer)); - BufferDetach(buffer, BufferPool(buffer)); + BufferDetach(buffer, BufferPool(buffer)); /* FIXME: Should be in BufferAbsFinish? */ - Method(Buffer, buffer, finish)(buffer); + Method(Inst, buffer, finish)(MustBeA(Inst, buffer)); } @@ -493,7 +487,7 @@ Res BufferReserve(Addr *pReturn, Buffer buffer, Size size) AVERT(Buffer, buffer); AVER(size > 0); AVER(SizeIsAligned(size, BufferPool(buffer)->alignment)); - AVER(BufferIsReady(buffer)); + AVER(BufferIsReady(buffer)); /* */ /* Is there enough room in the unallocated portion of the buffer to */ /* satisfy the request? If so, just increase the alloc marker and */ @@ -1006,36 +1000,20 @@ static void bufferNoReassignSeg(Buffer buffer, Seg seg) } -/* bufferTrivDescribe -- basic Buffer describe method */ - -static Res bufferTrivDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth) -{ - if (!TESTT(Buffer, buffer)) - return ResFAIL; - if (stream == NULL) - return ResFAIL; - UNUSED(depth); - /* dispatching function does it all */ - return ResOK; -} - - /* BufferClassCheck -- check the consistency of a BufferClass */ Bool BufferClassCheck(BufferClass klass) { - CHECKD(InstClass, &klass->protocol); + CHECKD(InstClass, &klass->instClassStruct); CHECKL(klass->size >= sizeof(BufferStruct)); CHECKL(FUNCHECK(klass->varargs)); CHECKL(FUNCHECK(klass->init)); - CHECKL(FUNCHECK(klass->finish)); CHECKL(FUNCHECK(klass->attach)); CHECKL(FUNCHECK(klass->detach)); CHECKL(FUNCHECK(klass->seg)); CHECKL(FUNCHECK(klass->rankSet)); CHECKL(FUNCHECK(klass->setRankSet)); CHECKL(FUNCHECK(klass->reassignSeg)); - CHECKL(FUNCHECK(klass->describe)); CHECKS(BufferClass, klass); return TRUE; } @@ -1052,14 +1030,14 @@ DEFINE_CLASS(Inst, BufferClass, klass) DEFINE_CLASS(Buffer, Buffer, klass) { - INHERIT_CLASS(&klass->protocol, Buffer, Inst); + INHERIT_CLASS(&klass->instClassStruct, Buffer, Inst); + klass->instClassStruct.finish = BufferAbsFinish; + klass->instClassStruct.describe = BufferAbsDescribe; klass->size = sizeof(BufferStruct); klass->varargs = ArgTrivVarargs; klass->init = BufferAbsInit; - klass->finish = BufferAbsFinish; klass->attach = bufferTrivAttach; klass->detach = bufferTrivDetach; - klass->describe = bufferTrivDescribe; klass->seg = bufferNoSeg; klass->rankSet = bufferTrivRankSet; klass->setRankSet = bufferNoSetRankSet; @@ -1130,12 +1108,13 @@ static Res segBufInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args) /* segBufFinish -- SegBuf finish method */ -static void segBufFinish(Buffer buffer) +static void segBufFinish(Inst inst) { + Buffer buffer = MustBeA(Buffer, inst); SegBuf segbuf = MustBeA(SegBuf, buffer); AVER(BufferIsReset(buffer)); segbuf->sig = SigInvalid; - NextMethod(Buffer, SegBuf, finish)(buffer); + NextMethod(Inst, SegBuf, finish)(inst); } @@ -1157,7 +1136,7 @@ static void segBufAttach(Buffer buffer, Addr base, Addr limit, found = SegOfAddr(&seg, arena, base); AVER(found); AVER(segbuf->seg == NULL); - AVER(SegBuffer(seg) == NULL); + AVER(!SegHasBuffer(seg)); AVER(SegBase(seg) <= base); AVER(limit <= SegLimit(seg)); @@ -1174,11 +1153,8 @@ static void segBufAttach(Buffer buffer, Addr base, Addr limit, static void segBufDetach(Buffer buffer) { SegBuf segbuf = MustBeA(SegBuf, buffer); - Seg seg; - - seg = segbuf->seg; - AVER(seg != NULL); - SegSetBuffer(seg, NULL); + Seg seg = segbuf->seg; + SegUnsetBuffer(seg); segbuf->seg = NULL; } @@ -1232,8 +1208,9 @@ static void segBufReassignSeg(Buffer buffer, Seg seg) /* segBufDescribe -- describe method for SegBuf */ -static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth) +static Res segBufDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Buffer buffer = CouldBeA(Buffer, inst); SegBuf segbuf = CouldBeA(SegBuf, buffer); Res res; @@ -1242,15 +1219,14 @@ static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth) if (stream == NULL) return ResPARAM; - /* Describe the superclass fields first via next-method call */ - res = NextMethod(Buffer, SegBuf, describe)(buffer, stream, depth); + res = NextMethod(Inst, SegBuf, describe)(inst, stream, depth); if (res != ResOK) return res; return WriteF(stream, depth + 2, - "Seg $P\n", (WriteFP)segbuf->seg, - "rankSet $U\n", (WriteFU)segbuf->rankSet, - NULL); + "Seg $P\n", (WriteFP)segbuf->seg, + "rankSet $U\n", (WriteFU)segbuf->rankSet, + NULL); } @@ -1262,12 +1238,12 @@ static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth) DEFINE_CLASS(Buffer, SegBuf, klass) { INHERIT_CLASS(klass, SegBuf, Buffer); + klass->instClassStruct.finish = segBufFinish; + klass->instClassStruct.describe = segBufDescribe; klass->size = sizeof(SegBufStruct); klass->init = segBufInit; - klass->finish = segBufFinish; klass->attach = segBufAttach; klass->detach = segBufDetach; - klass->describe = segBufDescribe; klass->seg = segBufSeg; klass->rankSet = segBufRankSet; klass->setRankSet = segBufSetRankSet; @@ -1333,7 +1309,7 @@ DEFINE_CLASS(Buffer, RankBuf, klass) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/cbs.c b/mps/code/cbs.c index c081ed61610..16c6b63d1bc 100644 --- a/mps/code/cbs.c +++ b/mps/code/cbs.c @@ -1,7 +1,7 @@ /* cbs.c: COALESCING BLOCK STRUCTURE IMPLEMENTATION * * $Id$ - * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .intro: This is a portable implementation of coalescing block * structures. @@ -289,8 +289,9 @@ static Res cbsInitZoned(Land land, Arena arena, Align alignment, ArgList args) * See . */ -static void cbsFinish(Land land) +static void cbsFinish(Inst inst) { + Land land = MustBeA(Land, inst); CBS cbs = MustBeA(CBS, land); METER_EMIT(&cbs->treeSearch); @@ -301,7 +302,7 @@ static void cbsFinish(Land land) if (cbs->ownPool) PoolDestroy(cbsBlockPool(cbs)); - NextMethod(Land, CBS, finish)(land); + NextMethod(Inst, CBS, finish)(inst); } @@ -441,6 +442,9 @@ static void cbsBlockInsert(CBS cbs, CBSBlock block) * * .insert.alloc: Will only allocate a block if the range does not * abut an existing range. + * + * .insert.critical: In manual-allocation-bound programs using MVFF + * this is on the critical path. */ static Res cbsInsert(Range rangeReturn, Land land, Range range) @@ -454,9 +458,9 @@ static Res cbsInsert(Range rangeReturn, Land land, Range range) Bool leftMerge, rightMerge; Size oldSize; - AVER(rangeReturn != NULL); - AVERT(Range, range); - AVER(RangeIsAligned(range, LandAlignment(land))); + AVER_CRITICAL(rangeReturn != NULL); + AVERT_CRITICAL(Range, range); + AVER_CRITICAL(RangeIsAligned(range, LandAlignment(land))); base = RangeBase(range); limit = RangeLimit(range); @@ -526,14 +530,14 @@ static Res cbsInsert(Range rangeReturn, Land land, Range range) cbsBlockInsert(cbs, block); } - AVER(newBase <= base); - AVER(newLimit >= limit); + AVER_CRITICAL(newBase <= base); + AVER_CRITICAL(newLimit >= limit); RangeInit(rangeReturn, newBase, newLimit); return ResOK; fail: - AVER(res != ResOK); + AVER_CRITICAL(res != ResOK); return res; } @@ -1089,8 +1093,9 @@ fail: * See . */ -static Res cbsDescribe(Land land, mps_lib_FILE *stream, Count depth) +static Res cbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Land land = CouldBeA(Land, inst); CBS cbs = CouldBeA(CBS, land); Res res; Res (*describe)(Tree, mps_lib_FILE *); @@ -1100,7 +1105,7 @@ static Res cbsDescribe(Land land, mps_lib_FILE *stream, Count depth) if (stream == NULL) return ResPARAM; - res = NextMethod(Land, CBS, describe)(land, stream, depth); + res = NextMethod(Inst, CBS, describe)(inst, stream, depth); if (res != ResOK) return res; @@ -1133,9 +1138,10 @@ static Res cbsDescribe(Land land, mps_lib_FILE *stream, Count depth) DEFINE_CLASS(Land, CBS, klass) { INHERIT_CLASS(klass, CBS, Land); + klass->instClassStruct.describe = cbsDescribe; + klass->instClassStruct.finish = cbsFinish; klass->size = sizeof(CBSStruct); klass->init = cbsInit; - klass->finish = cbsFinish; klass->sizeMethod = cbsSize; klass->insert = cbsInsert; klass->delete = cbsDelete; @@ -1145,7 +1151,6 @@ DEFINE_CLASS(Land, CBS, klass) klass->findLast = cbsFindLast; klass->findLargest = cbsFindLargest; klass->findInZones = cbsFindInZones; - klass->describe = cbsDescribe; } DEFINE_CLASS(Land, CBSFast, klass) @@ -1163,7 +1168,7 @@ DEFINE_CLASS(Land, CBSZoned, klass) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk index b61c48a1e0e..b65ca3d025a 100644 --- a/mps/code/comm.gmk +++ b/mps/code/comm.gmk @@ -73,9 +73,9 @@ endif # EXTRA TARGETS # # Don't build mpseventsql by default (might not have sqlite3 installed), -# but do build mpseventcnv and mpseventtxt. +# but do build mpseventcnv, mpseventpy and mpseventtxt. -EXTRA_TARGETS ?= mpseventcnv mpseventtxt +EXTRA_TARGETS ?= mpseventcnv mpseventpy mpseventtxt # @@ -332,8 +332,7 @@ RATIO=$$(awk "BEGIN{print int(100 * $$TIME_HOT / $$TIME_RASH)}"); \ printf "Performance ratio (hot/rash) for $(2): %d%%\n" $$RATIO endef -.PHONY: testratio -testratio: +testratio: phony $(MAKE) -f $(PFM).gmk VARIETY=hot djbench gcbench $(MAKE) -f $(PFM).gmk VARIETY=rash djbench gcbench $(call ratio,gcbench,amc) @@ -354,6 +353,12 @@ $(PFM)/$(VARIETY)/testmmqa: (cd ../test && $(MMQA) runset testsets/passing) +# == Toy Scheme interpreter == + +testscheme: phony + $(MAKE) -C ../example/scheme test + + # These convenience targets allow one to type "make foo" to build target # foo in selected varieties (or none, for the latter rule). @@ -572,6 +577,9 @@ $(PFM)/$(VARIETY)/zmess: $(PFM)/$(VARIETY)/zmess.o \ $(PFM)/$(VARIETY)/mpseventcnv: $(PFM)/$(VARIETY)/eventcnv.o \ $(PFM)/$(VARIETY)/mps.a +$(PFM)/$(VARIETY)/mpseventpy: $(PFM)/$(VARIETY)/eventpy.o \ + $(PFM)/$(VARIETY)/mps.a + $(PFM)/$(VARIETY)/mpseventtxt: $(PFM)/$(VARIETY)/eventtxt.o \ $(PFM)/$(VARIETY)/mps.a diff --git a/mps/code/commpost.nmk b/mps/code/commpost.nmk index 0917fe86431..2e5a999744c 100644 --- a/mps/code/commpost.nmk +++ b/mps/code/commpost.nmk @@ -1,7 +1,7 @@ # commpost.nmk: SECOND COMMON FRAGMENT FOR PLATFORMS USING NMAKE -*- makefile -*- # # $Id$ -# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. +# Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. # # DESCRIPTION # @@ -315,6 +315,9 @@ $(PFM)\$(VARIETY)\ztfm.exe: $(PFM)\$(VARIETY)\ztfm.obj \ $(PFM)\$(VARIETY)\mpseventcnv.exe: $(PFM)\$(VARIETY)\eventcnv.obj \ $(PFM)\$(VARIETY)\mps.lib +$(PFM)\$(VARIETY)\mpseventpy.exe: $(PFM)\$(VARIETY)\eventpy.obj \ + $(PFM)\$(VARIETY)\mps.lib + $(PFM)\$(VARIETY)\mpseventtxt.exe: $(PFM)\$(VARIETY)\eventtxt.obj \ $(PFM)\$(VARIETY)\mps.lib @@ -335,6 +338,9 @@ $(PFM)\$(VARIETY)\replaysw.obj: $(PFM)\$(VARIETY)\replay.obj $(PFM)\$(VARIETY)\mpseventcnv.obj: $(PFM)\$(VARIETY)\eventcnv.obj copy $** $@ >nul: +$(PFM)\$(VARIETY)\mpseventpy.obj: $(PFM)\$(VARIETY)\eventpy.obj + copy $** $@ >nul: + $(PFM)\$(VARIETY)\mpseventtxt.obj: $(PFM)\$(VARIETY)\eventtxt.obj copy $** $@ >nul: @@ -385,7 +391,7 @@ $(PFM)\$(VARIETY)\sqlite3.obj: # C. COPYRIGHT AND LICENSE # -# Copyright (C) 2001-2014 Ravenbrook Limited . +# Copyright (c) 2001-2016 Ravenbrook Limited . # All rights reserved. This is an open source license. Contact # Ravenbrook for commercial licensing options. # diff --git a/mps/code/commpre.nmk b/mps/code/commpre.nmk index 7141d83dd2e..8a79096f42c 100644 --- a/mps/code/commpre.nmk +++ b/mps/code/commpre.nmk @@ -105,7 +105,7 @@ TEST_TARGETS=\ # Stand-alone programs go in EXTRA_TARGETS if they should always be # built, or in OPTIONAL_TARGETS if they should only be built if -EXTRA_TARGETS=mpseventcnv.exe mpseventtxt.exe +EXTRA_TARGETS=mpseventcnv.exe mpseventpy.exe mpseventtxt.exe OPTIONAL_TARGETS=mpseventsql.exe # This target records programs that we were once able to build but diff --git a/mps/code/config.h b/mps/code/config.h index 7c329f1a8ad..5e20c33c4c3 100644 --- a/mps/code/config.h +++ b/mps/code/config.h @@ -617,6 +617,29 @@ #endif +/* POSIX thread extensions configuration -- see */ + +#if defined(MPS_OS_LI) || defined(MPS_OS_FR) + +/* PTHREADEXT_SIGSUSPEND -- signal used to suspend a thread + * See + */ +#if defined(CONFIG_PTHREADEXT_SIGSUSPEND) +#define PTHREADEXT_SIGSUSPEND CONFIG_PTHREADEXT_SIGSUSPEND +#else +#define PTHREADEXT_SIGSUSPEND SIGXFSZ +#endif + +/* PTHREADEXT_SIGRESUME -- signal used to resume a thread + * See + */ +#if defined(CONFIG_PTHREADEXT_SIGRESUME) +#define PTHREADEXT_SIGRESUME CONFIG_PTHREADEXT_SIGRESUME +#else +#define PTHREADEXT_SIGRESUME SIGXCPU +#endif + +#endif /* Tracer Configuration -- see */ diff --git a/mps/code/dbgpool.c b/mps/code/dbgpool.c index 8068dc64b97..b2e7bdb433d 100644 --- a/mps/code/dbgpool.c +++ b/mps/code/dbgpool.c @@ -1,7 +1,7 @@ /* dbgpool.c: POOL DEBUG MIXIN * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * * .source: design.mps.object-debug @@ -206,7 +206,7 @@ static Res DebugPoolInit(Pool pool, Arena arena, PoolClass klass, ArgList args) return ResOK; tagFail: - SuperclassPoly(Pool, klass)->finish(pool); + SuperclassPoly(Inst, klass)->finish(MustBeA(Inst, pool)); AVER(res != ResOK); return res; } @@ -214,8 +214,9 @@ tagFail: /* DebugPoolFinish -- finish method for a debug pool */ -static void DebugPoolFinish(Pool pool) +static void DebugPoolFinish(Inst inst) { + Pool pool = MustBeA(AbstractPool, inst); PoolDebugMixin debug; PoolClass klass; @@ -229,7 +230,7 @@ static void DebugPoolFinish(Pool pool) PoolDestroy(debug->tagPool); } klass = ClassOfPoly(Pool, pool); - SuperclassPoly(Pool, klass)->finish(pool); + SuperclassPoly(Inst, klass)->finish(inst); } @@ -523,7 +524,7 @@ static void fenceFree(PoolDebugMixin debug, { Size alignedFenceSize, alignedSize; - ASSERT(fenceCheck(debug, pool, old, size), "fencepost check on free"); + ASSERT(fenceCheck(debug, pool, old, size), "fencepost check on free"); /* */ alignedFenceSize = SizeAlignUp(debug->fenceSize, PoolAlignment(pool)); alignedSize = SizeAlignUp(size, PoolAlignment(pool)); @@ -738,7 +739,7 @@ void DebugPoolFreeCheck(Pool pool, Addr base, Addr limit) AVERT(PoolDebugMixin, debug); if (debug->freeSize != 0) ASSERT(freeCheck(debug, pool, base, limit), - "free space corrupted on release"); + "free space corrupted on release"); /* */ } } @@ -775,8 +776,8 @@ void DebugPoolCheckFreeSpace(Pool pool) void PoolClassMixInDebug(PoolClass klass) { /* Can't check klass because it's not initialized yet */ + klass->instClassStruct.finish = DebugPoolFinish; klass->init = DebugPoolInit; - klass->finish = DebugPoolFinish; klass->alloc = DebugPoolAlloc; klass->free = DebugPoolFree; } @@ -784,7 +785,7 @@ void PoolClassMixInDebug(PoolClass klass) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/event.c b/mps/code/event.c index 0a15e064db3..e2825b5334f 100644 --- a/mps/code/event.c +++ b/mps/code/event.c @@ -205,17 +205,17 @@ void EventInit(void) if (!eventInited) { EventKind kind; for (kind = 0; kind < EventKindLIMIT; ++kind) { - AVER(EventLast[kind] == NULL); - AVER(EventWritten[kind] == NULL); - EventLast[kind] = EventWritten[kind] = EventBuffer[kind] + EventBufferSIZE; + AVER(EventLast[kind] == NULL); + AVER(EventWritten[kind] == NULL); + EventLast[kind] = EventWritten[kind] = EventBuffer[kind] + EventBufferSIZE; } eventInited = TRUE; EventKindControl = (Word)mps_lib_telemetry_control(); EventInternSerial = (Serial)1; /* 0 is reserved */ (void)EventInternString(MPSVersion()); /* emit version */ EVENT7(EventInit, EVENT_VERSION_MAJOR, EVENT_VERSION_MEDIAN, - EVENT_VERSION_MINOR, EventCodeMAX, EventNameMAX, MPS_WORD_WIDTH, - mps_clocks_per_sec()); + EVENT_VERSION_MINOR, EventCodeMAX, EventNameMAX, MPS_WORD_WIDTH, + mps_clocks_per_sec()); /* flush these initial events to get the first ClockSync out. */ EventSync(); } @@ -520,7 +520,7 @@ extern void EventDump(mps_lib_FILE *stream) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/eventpy.c b/mps/code/eventpy.c new file mode 100644 index 00000000000..23d14c5f63c --- /dev/null +++ b/mps/code/eventpy.c @@ -0,0 +1,103 @@ +/* eventpy.c: GENERATE PYTHON INTERFACE TO EVENTS + * + * $Id$ + * Copyright (c) 2016 Ravenbrook Limited. See end of file for license. + * + * This command-line program emits Python data structures that can be + * used to parse an event stream in text format (as output by the + * mpseventcnv program). + */ + +#include /* printf, puts */ + +#include "event.h" + +int main(int argc, char *argv[]) +{ + UNUSED(argc); + UNUSED(argv); + + puts("from collections import namedtuple"); + + printf("__version__ = %d, %d, %d\n", EVENT_VERSION_MAJOR, + EVENT_VERSION_MEDIAN, EVENT_VERSION_MINOR); + + puts("EventKind = namedtuple('EventKind', 'name code doc')"); + puts("class kind:"); +#define ENUM(_, NAME, DOC) \ + printf(" " #NAME " = EventKind('" #NAME "', %d, \"%s\")\n", \ + EventKind ## NAME, DOC); + EventKindENUM(ENUM, _); +#undef ENUM + + puts("kinds = {"); +#define ENUM(_, NAME, _1) \ + printf(" %d: kind." #NAME ",\n", EventKind ## NAME); + EventKindENUM(ENUM, _); +#undef ENUM + puts("}"); + + puts("EventParam = namedtuple('EventParam', 'sort, name')"); + puts("Event = namedtuple('Event', 'name code always kind params')"); + puts("class event:"); +#define EVENT_PARAM(X, INDEX, SORT, NAME) \ + puts(" EventParam('" #SORT "', '" #NAME "'),"); +#define EVENT_DEFINE(X, NAME, CODE, ALWAYS, KIND) \ + printf(" " #NAME " = Event('" #NAME "', %d, %s, kind." #KIND ", [\n", \ + CODE, ALWAYS ? "True" : "False"); \ + EVENT_ ## NAME ## _PARAMS(EVENT_PARAM, X); \ + puts(" ]);"); + EVENT_LIST(EVENT_DEFINE, 0); +#undef EVENT + + puts("events = {"); +#define EVENT_ITEM(X, NAME, CODE, ALWAYS, KIND) \ + printf(" %d: event." #NAME ",\n", CODE); + EVENT_LIST(EVENT_ITEM, 0); +#undef EVENT + puts("}"); + + return 0; +} + + +/* C. COPYRIGHT AND LICENSE + * + * Copyright (c) 2016 Ravenbrook Limited . + * All rights reserved. This is an open source license. Contact + * Ravenbrook for commercial licensing options. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are + * met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * 3. Redistributions in any form must be accompanied by information on how + * to obtain complete source code for this software and any accompanying + * software that uses this software. The source code must either be + * included in the distribution or be available for no more than the cost + * of distribution plus a nominal fee, and must be freely redistributable + * under reasonable conditions. For an executable file, complete source + * code means the source code for all modules it contains. It does not + * include source code for modules or files that typically accompany the + * major components of the operating system on which the executable file + * runs. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS + * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED + * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR + * PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF + * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON + * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ diff --git a/mps/code/failover.c b/mps/code/failover.c index a48a6d04f66..94b6b17b2fc 100644 --- a/mps/code/failover.c +++ b/mps/code/failover.c @@ -52,11 +52,12 @@ static Res failoverInit(Land land, Arena arena, Align alignment, ArgList args) } -static void failoverFinish(Land land) +static void failoverFinish(Inst inst) { + Land land = MustBeA(Land, inst); Failover fo = MustBeA(Failover, land); fo->sig = SigInvalid; - NextMethod(Land, Failover, finish)(land); + NextMethod(Inst, Failover, finish)(inst); } @@ -240,8 +241,9 @@ static Bool failoverFindInZones(Bool *foundReturn, Range rangeReturn, Range oldR } -static Res failoverDescribe(Land land, mps_lib_FILE *stream, Count depth) +static Res failoverDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Land land = CouldBeA(Land, inst); Failover fo = CouldBeA(Failover, land); LandClass primaryClass, secondaryClass; Res res; @@ -251,7 +253,7 @@ static Res failoverDescribe(Land land, mps_lib_FILE *stream, Count depth) if (stream == NULL) return ResPARAM; - res = NextMethod(Land, Failover, describe)(land, stream, depth); + res = NextMethod(Inst, Failover, describe)(inst, stream, depth); if (res != ResOK) return res; @@ -272,9 +274,10 @@ static Res failoverDescribe(Land land, mps_lib_FILE *stream, Count depth) DEFINE_CLASS(Land, Failover, klass) { INHERIT_CLASS(klass, Failover, Land); + klass->instClassStruct.describe = failoverDescribe; + klass->instClassStruct.finish = failoverFinish; klass->size = sizeof(FailoverStruct); klass->init = failoverInit; - klass->finish = failoverFinish; klass->sizeMethod = failoverSize; klass->insert = failoverInsert; klass->delete = failoverDelete; @@ -283,7 +286,6 @@ DEFINE_CLASS(Land, Failover, klass) klass->findLast = failoverFindLast; klass->findLargest = failoverFindLargest; klass->findInZones = failoverFindInZones; - klass->describe = failoverDescribe; } diff --git a/mps/code/format.c b/mps/code/format.c index fadeadce489..b9c4a59fb14 100644 --- a/mps/code/format.c +++ b/mps/code/format.c @@ -1,7 +1,7 @@ /* format.c: OBJECT FORMATS * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (c) 2002 Global Graphics Software. * * DESIGN @@ -168,7 +168,7 @@ Res FormatCreate(Format *formatReturn, Arena arena, ArgList args) void FormatDestroy(Format format) { AVERT(Format, format); - AVER(format->poolCount == 0); + AVER(format->poolCount == 0); /* */ RingRemove(&format->arenaRing); @@ -250,7 +250,7 @@ Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/fotest.c b/mps/code/fotest.c index 33ec227b19a..262414bacf7 100644 --- a/mps/code/fotest.c +++ b/mps/code/fotest.c @@ -1,7 +1,7 @@ /* fotest.c: FAIL-OVER TEST * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * * This tests fail-over behaviour in low memory situations. The MVFF @@ -10,9 +10,8 @@ * request due to running out of memory, they fall back to a Freelist * (which has zero memory overhead, at some cost in performance). * - * This is a white box test: it patches the class of the CBS's - * internal block pool (MFS) with a pointer to a dummy class whose - * alloc() method always returns ResMEMORY. + * This is a white box test: it monkey-patches the MFS pool's alloc + * method with a method that always returns a memory error code. */ @@ -36,40 +35,6 @@ #define testLOOPS 10 -/* Accessors for the CBS used to implement a pool. */ - -extern Land _mps_mvff_cbs(Pool); -extern Land _mps_mvt_cbs(Pool); - - -/* "OOM" pool class -- dummy alloc/free pool class whose alloc() - * method always fails and whose free method does nothing. */ - -static Res oomAlloc(Addr *pReturn, Pool pool, Size size) -{ - UNUSED(pReturn); - UNUSED(pool); - UNUSED(size); - switch (rnd() % 3) { - case 0: - return ResRESOURCE; - case 1: - return ResMEMORY; - default: - return ResCOMMIT_LIMIT; - } -} - -DECLARE_CLASS(Pool, OOMPool, AbstractPool); -DEFINE_CLASS(Pool, OOMPool, klass) -{ - INHERIT_CLASS(klass, OOMPool, AbstractPool); - klass->alloc = oomAlloc; - klass->free = PoolTrivFree; - klass->size = sizeof(PoolStruct); -} - - /* make -- allocate one object */ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size) @@ -86,19 +51,44 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size) } -/* set_oom -- set blockPool of CBS to OOM or MFS according to argument. */ +/* The original alloc method on the MFS pool. */ +static PoolAllocMethod mfs_alloc; -static void set_oom(Land land, int oom) + +/* oomAlloc -- allocation function that always fails + * + * Returns a randomly chosen memory error code. + */ + +static Res oomAlloc(Addr *pReturn, Pool pool, Size size) { - CBS cbs = MustBeA(CBS, land); - SetClassOfPoly(cbs->blockPool, oom ? CLASS(OOMPool) : PoolClassMFS()); + MFS mfs = MustBeA(MFSPool, pool); + UNUSED(pReturn); + UNUSED(size); + if (mfs->extendSelf) { + /* This is the MFS block pool belonging to the CBS belonging to + * the MVFF or MVT pool under test, so simulate a failure to + * enforce the fail-over behaviour. */ + switch (rnd() % 3) { + case 0: + return ResRESOURCE; + case 1: + return ResMEMORY; + default: + return ResCOMMIT_LIMIT; + } + } else { + /* This is the MFS block pool belonging to the arena's free land, + * so succeed here (see job004041). */ + return mfs_alloc(pReturn, pool, size); + } } /* stress -- create an allocation point and allocate in it */ static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t), - mps_align_t alignment, mps_pool_t pool, Land cbs) + mps_align_t alignment, mps_pool_t pool) { mps_res_t res = MPS_RES_OK; mps_ap_t ap; @@ -110,11 +100,12 @@ static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t), /* allocate a load of objects */ for (i=0; i= sizeof(ps[i])) *ps[i] = 1; /* Write something, so it gets swap. */ } @@ -140,15 +131,17 @@ static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t), } /* allocate some new objects */ for (i=testSetSIZE/2; i. + * Copyright (c) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/freelist.c b/mps/code/freelist.c index 7a58032f508..c4dba60d7ed 100644 --- a/mps/code/freelist.c +++ b/mps/code/freelist.c @@ -212,12 +212,13 @@ static Res freelistInit(Land land, Arena arena, Align alignment, ArgList args) } -static void freelistFinish(Land land) +static void freelistFinish(Inst inst) { + Land land = MustBeA(Land, inst); Freelist fl = MustBeA(Freelist, land); fl->sig = SigInvalid; fl->list = freelistEND; - NextMethod(Land, Freelist, finish)(land); + NextMethod(Inst, Freelist, finish)(inst); } @@ -745,8 +746,9 @@ static Bool freelistDescribeVisitor(Land land, Range range, } -static Res freelistDescribe(Land land, mps_lib_FILE *stream, Count depth) +static Res freelistDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Land land = CouldBeA(Land, inst); Freelist fl = CouldBeA(Freelist, land); Res res; Bool b; @@ -757,7 +759,7 @@ static Res freelistDescribe(Land land, mps_lib_FILE *stream, Count depth) if (stream == NULL) return ResPARAM; - res = NextMethod(Land, Freelist, describe)(land, stream, depth); + res = NextMethod(Inst, Freelist, describe)(inst, stream, depth); if (res != ResOK) return res; @@ -779,9 +781,10 @@ static Res freelistDescribe(Land land, mps_lib_FILE *stream, Count depth) DEFINE_CLASS(Land, Freelist, klass) { INHERIT_CLASS(klass, Freelist, Land); + klass->instClassStruct.describe = freelistDescribe; + klass->instClassStruct.finish = freelistFinish; klass->size = sizeof(FreelistStruct); klass->init = freelistInit; - klass->finish = freelistFinish; klass->sizeMethod = freelistSize; klass->insert = freelistInsert; klass->delete = freelistDelete; @@ -791,7 +794,6 @@ DEFINE_CLASS(Land, Freelist, klass) klass->findLast = freelistFindLast; klass->findLargest = freelistFindLargest; klass->findInZones = freelistFindInZones; - klass->describe = freelistDescribe; } diff --git a/mps/code/global.c b/mps/code/global.c index fa2eb684c5b..02b2f04928e 100644 --- a/mps/code/global.c +++ b/mps/code/global.c @@ -1,7 +1,7 @@ /* global.c: ARENA-GLOBAL INTERFACES * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * * .sources: See . design.mps.thread-safety is relevant @@ -188,7 +188,8 @@ Bool GlobalsCheck(Globals arenaGlobals) CHECKL(RingCheck(&arenaRing)); CHECKL(BoolCheck(arena->emergency)); - /* There can only be an emergency when a trace is busy. */ + /* .emergency.invariant: There can only be an emergency when a trace + * is busy. */ CHECKL(!arena->emergency || arena->busyTraces != TraceSetEMPTY); if (arenaGlobals->defaultChain != NULL) @@ -463,12 +464,12 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals) * and so RingCheck dereferences a pointer into that unmapped memory * and we get a crash instead of an assertion. See job000652. */ - AVER(RingIsSingle(&arena->formatRing)); - AVER(RingIsSingle(&arena->chainRing)); + AVER(RingIsSingle(&arena->formatRing)); /* */ + AVER(RingIsSingle(&arena->chainRing)); /* */ AVER(RingIsSingle(&arena->messageRing)); - AVER(RingIsSingle(&arena->threadRing)); + AVER(RingIsSingle(&arena->threadRing)); /* */ AVER(RingIsSingle(&arena->deadRing)); - AVER(RingIsSingle(&arenaGlobals->rootRing)); + AVER(RingIsSingle(&arenaGlobals->rootRing)); /* */ for(rank = RankMIN; rank < RankLIMIT; ++rank) AVER(RingIsSingle(&arena->greyRing[rank])); @@ -478,7 +479,7 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals) * 2. arena->controlPoolStruct.blockPoolStruct * 3. arena->controlPoolStruct.spanPoolStruct */ - AVER(RingLength(&arenaGlobals->poolRing) == 4); + AVER(RingLength(&arenaGlobals->poolRing) == 4); /* */ } @@ -1066,7 +1067,7 @@ Bool ArenaEmergency(Arena arena) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/land.c b/mps/code/land.c index 3d2bb84bdec..f6b86d092c2 100644 --- a/mps/code/land.c +++ b/mps/code/land.c @@ -1,7 +1,7 @@ /* land.c: LAND (COLLECTION OF ADDRESS RANGES) IMPLEMENTATION * * $Id$ - * Copyright (c) 2014-2015 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2014-2016 Ravenbrook Limited. See end of file for license. * * .design: */ @@ -90,11 +90,12 @@ static Res LandAbsInit(Land land, Arena arena, Align alignment, ArgList args) return ResOK; } -static void LandAbsFinish(Land land) +static void LandAbsFinish(Inst inst) { + Land land = MustBeA(Land, inst); AVERC(Land, land); land->sig = SigInvalid; - InstFinish(CouldBeA(Inst, land)); + NextMethod(Inst, Land, finish)(inst); } @@ -183,19 +184,22 @@ void LandFinish(Land land) AVERC(Land, land); landEnter(land); - Method(Land, land, finish)(land); + Method(Inst, land, finish)(MustBeA(Inst, land)); } /* LandSize -- return the total size of ranges in land * * See + * + * .size.critical: In manual-allocation-bound programs using MVFF this + * is on the critical path. */ Size LandSize(Land land) { /* .enter-leave.simple */ - AVERC(Land, land); + AVERC_CRITICAL(Land, land); return Method(Land, land, sizeMethod)(land); } @@ -204,17 +208,20 @@ Size LandSize(Land land) /* LandInsert -- insert range of addresses into land * * See + * + * .insert.critical: In manual-allocation-bound programs using MVFF + * this is on the critical path. */ Res LandInsert(Range rangeReturn, Land land, Range range) { Res res; - AVER(rangeReturn != NULL); - AVERC(Land, land); - AVERT(Range, range); - AVER(RangeIsAligned(range, land->alignment)); - AVER(!RangeIsEmpty(range)); + AVER_CRITICAL(rangeReturn != NULL); + AVERC_CRITICAL(Land, land); + AVERT_CRITICAL(Range, range); + AVER_CRITICAL(RangeIsAligned(range, land->alignment)); + AVER_CRITICAL(!RangeIsEmpty(range)); landEnter(land); res = Method(Land, land, insert)(rangeReturn, land, range); @@ -249,13 +256,16 @@ Res LandDelete(Range rangeReturn, Land land, Range range) /* LandIterate -- iterate over isolated ranges of addresses in land * * See + * + * .iterate.critical: In manual-allocation-bound programs using MVFF + * this is on the critical path. */ Bool LandIterate(Land land, LandVisitor visitor, void *closure) { Bool b; - AVERC(Land, land); - AVER(FUNCHECK(visitor)); + AVERC_CRITICAL(Land, land); + AVER_CRITICAL(FUNCHECK(visitor)); landEnter(land); b = Method(Land, land, iterate)(land, visitor, closure); @@ -274,8 +284,8 @@ Bool LandIterate(Land land, LandVisitor visitor, void *closure) Bool LandIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closure) { Bool b; - AVERC(Land, land); - AVER(FUNCHECK(visitor)); + AVERC_CRITICAL(Land, land); + AVER_CRITICAL(FUNCHECK(visitor)); landEnter(land); b = Method(Land, land, iterateAndDelete)(land, visitor, closure); @@ -390,7 +400,7 @@ Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Res LandDescribe(Land land, mps_lib_FILE *stream, Count depth) { - return Method(Land, land, describe)(land, stream, depth); + return Method(Inst, land, describe)(MustBeA(Inst, land), stream, depth); } @@ -426,12 +436,15 @@ static Bool landFlushVisitor(Bool *deleteReturn, Land land, Range range, /* LandFlush -- move ranges from src to dest * * See + * + * .flush.critical: In manual-allocation-bound programs using MVFF + * this is on the critical path. */ Bool LandFlush(Land dest, Land src) { - AVERC(Land, dest); - AVERC(Land, src); + AVERC_CRITICAL(Land, dest); + AVERC_CRITICAL(Land, src); return LandIterateAndDelete(src, landFlushVisitor, dest); } @@ -441,17 +454,15 @@ Bool LandFlush(Land dest, Land src) Bool LandClassCheck(LandClass klass) { - CHECKL(InstClassCheck(&klass->protocol)); + CHECKL(InstClassCheck(&klass->instClassStruct)); CHECKL(klass->size >= sizeof(LandStruct)); CHECKL(FUNCHECK(klass->init)); - CHECKL(FUNCHECK(klass->finish)); CHECKL(FUNCHECK(klass->insert)); CHECKL(FUNCHECK(klass->delete)); CHECKL(FUNCHECK(klass->findFirst)); CHECKL(FUNCHECK(klass->findLast)); CHECKL(FUNCHECK(klass->findLargest)); CHECKL(FUNCHECK(klass->findInZones)); - CHECKL(FUNCHECK(klass->describe)); CHECKS(LandClass, klass); return TRUE; } @@ -543,8 +554,9 @@ static Res landNoFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRang return ResUNIMPL; } -static Res LandAbsDescribe(Land land, mps_lib_FILE *stream, Count depth) +static Res LandAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Land land = CouldBeA(Land, inst); LandClass klass; Res res; @@ -553,7 +565,7 @@ static Res LandAbsDescribe(Land land, mps_lib_FILE *stream, Count depth) if (stream == NULL) return ResPARAM; - res = InstDescribe(CouldBeA(Inst, land), stream, depth); + res = NextMethod(Inst, Land, describe)(inst, stream, depth); if (res != ResOK) return res; @@ -574,11 +586,12 @@ DEFINE_CLASS(Inst, LandClass, klass) DEFINE_CLASS(Land, Land, klass) { - INHERIT_CLASS(&klass->protocol, Land, Inst); + INHERIT_CLASS(&klass->instClassStruct, Land, Inst); + klass->instClassStruct.describe = LandAbsDescribe; + klass->instClassStruct.finish = LandAbsFinish; klass->size = sizeof(LandStruct); klass->init = LandAbsInit; klass->sizeMethod = landNoSize; - klass->finish = LandAbsFinish; klass->insert = landNoInsert; klass->delete = landNoDelete; klass->iterate = landNoIterate; @@ -587,14 +600,13 @@ DEFINE_CLASS(Land, Land, klass) klass->findLast = landNoFind; klass->findLargest = landNoFind; klass->findInZones = landNoFindInZones; - klass->describe = LandAbsDescribe; klass->sig = LandClassSig; } /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2014-2015 Ravenbrook Limited . + * Copyright (C) 2014-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/lockix.c b/mps/code/lockix.c index c982bf0cb17..d43e458f430 100644 --- a/mps/code/lockix.c +++ b/mps/code/lockix.c @@ -1,7 +1,7 @@ /* lockix.c: RECURSIVE LOCKS FOR POSIX SYSTEMS * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .posix: The implementation uses a POSIX interface, and should be reusable * for many Unix-like operating systems. @@ -122,7 +122,7 @@ void (LockClaim)(Lock lock) res = pthread_mutex_lock(&lock->mut); /* pthread_mutex_lock will error if we own the lock already. */ - AVER(res == 0); + AVER(res == 0); /* */ /* This should be the first claim. Now we own the mutex */ /* it is ok to check this. */ @@ -245,7 +245,7 @@ void (LockReleaseGlobal)(void) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/lockli.c b/mps/code/lockli.c index 0dc98fb8a25..a3369abda90 100644 --- a/mps/code/lockli.c +++ b/mps/code/lockli.c @@ -1,7 +1,7 @@ /* lockli.c: RECURSIVE LOCKS FOR POSIX SYSTEMS * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .linux: This implementation currently just supports LinuxThreads * (platform MPS_OS_LI), Single Unix i/f. @@ -136,7 +136,7 @@ void (LockClaim)(Lock lock) res = pthread_mutex_lock(&lock->mut); /* pthread_mutex_lock will error if we own the lock already. */ - AVER(res == 0); + AVER(res == 0); /* */ /* This should be the first claim. Now we own the mutex */ /* it is ok to check this. */ @@ -259,7 +259,7 @@ void (LockReleaseGlobal)(void) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/lockw3.c b/mps/code/lockw3.c index 53da970aed2..daf2473d4e3 100644 --- a/mps/code/lockw3.c +++ b/mps/code/lockw3.c @@ -1,7 +1,7 @@ /* lockw3.c: RECURSIVE LOCKS IN WIN32 * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .design: These are implemented using critical sections. * See the section titled "Synchronization functions" in the Groups @@ -75,7 +75,7 @@ void (LockClaim)(Lock lock) EnterCriticalSection(&lock->cs); /* This should be the first claim. Now we are inside the * critical section it is ok to check this. */ - AVER(lock->claims == 0); + AVER(lock->claims == 0); /* */ lock->claims = 1; } @@ -158,7 +158,7 @@ void (LockReleaseGlobal)(void) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/locus.c b/mps/code/locus.c index 3a61d9a9c69..a93fb72f0ae 100644 --- a/mps/code/locus.c +++ b/mps/code/locus.c @@ -401,7 +401,7 @@ void ChainDestroy(Chain chain) size_t i; AVERT(Chain, chain); - AVER(chain->activeTraces == TraceSetEMPTY); + AVER(chain->activeTraces == TraceSetEMPTY); /* */ arena = chain->arena; genCount = chain->genCount; diff --git a/mps/code/mpm.c b/mps/code/mpm.c index f49f05bb517..71072b67c9d 100644 --- a/mps/code/mpm.c +++ b/mps/code/mpm.c @@ -1,7 +1,7 @@ /* mpm.c: GENERAL MPM SUPPORT * * $Id$ - * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .purpose: Miscellaneous support for the implementation of the MPM * and pool classes. @@ -711,7 +711,7 @@ static Bool quickSorted(void *array[], Count length, void QuickSort(void *array[], Count length, QuickSortCompare compare, void *closure, - SortStruct *sortStruct) + SortStruct *sortStruct) { Index left, right, sp, lo, hi, leftLimit, rightBase; void *pivot, *temp; @@ -770,15 +770,15 @@ void QuickSort(void *array[], Count length, for later. */ AVER_CRITICAL(sp < sizeof sortStruct->stack / sizeof sortStruct->stack[0]); if (leftLimit - left < right - rightBase) { - sortStruct->stack[sp].left = rightBase; - sortStruct->stack[sp].right = right; - ++sp; - right = leftLimit; + sortStruct->stack[sp].left = rightBase; + sortStruct->stack[sp].right = right; + ++sp; + right = leftLimit; } else { - sortStruct->stack[sp].left = left; - sortStruct->stack[sp].right = leftLimit; - ++sp; - left = rightBase; + sortStruct->stack[sp].left = left; + sortStruct->stack[sp].right = leftLimit; + ++sp; + left = rightBase; } } @@ -799,7 +799,7 @@ void QuickSort(void *array[], Count length, /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mpm.h b/mps/code/mpm.h index fee8500f9e2..9f5f3365fa4 100644 --- a/mps/code/mpm.h +++ b/mps/code/mpm.h @@ -1,7 +1,7 @@ /* mpm.h: MEMORY POOL MANAGER DEFINITIONS * * $Id$ - * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * * .trans.bufferinit: The Buffer data structure has an Init field and @@ -177,8 +177,8 @@ extern Word RandomWord(void); typedef Compare QuickSortCompare(void *left, void *right, void *closure); extern void QuickSort(void *array[], Count length, - QuickSortCompare compare, void *closure, - SortStruct *sortStruct); + QuickSortCompare compare, void *closure, + SortStruct *sortStruct); /* Version Determination @@ -238,7 +238,7 @@ extern Size PoolTotalSize(Pool pool); extern Size PoolFreeSize(Pool pool); extern Res PoolAbsInit(Pool pool, Arena arena, PoolClass klass, ArgList arg); -extern void PoolAbsFinish(Pool pool); +extern void PoolAbsFinish(Inst inst); extern Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size); extern Res PoolTrivAlloc(Addr *pReturn, Pool pool, Size size); extern void PoolNoFree(Pool pool, Addr old, Size size); @@ -251,7 +251,7 @@ extern void PoolNoBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit); extern void PoolTrivBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit); -extern Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream, Count depth); +extern Res PoolAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth); extern Res PoolNoTraceBegin(Pool pool, Trace trace); extern Res PoolTrivTraceBegin(Pool pool, Trace trace); extern Res PoolNoAccess(Pool pool, Seg seg, Addr addr, @@ -670,10 +670,13 @@ extern void SegSetRankSet(Seg seg, RankSet rankSet); extern void SegSetRankAndSummary(Seg seg, RankSet rankSet, RefSet summary); extern Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi); extern Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at); +extern Res SegAbsDescribe(Inst seg, mps_lib_FILE *stream, Count depth); extern Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth); extern void SegSetSummary(Seg seg, RefSet summary); -extern Buffer SegBuffer(Seg seg); +extern Bool SegHasBuffer(Seg seg); +extern Bool SegBuffer(Buffer *bufferReturn, Seg seg); extern void SegSetBuffer(Seg seg, Buffer buffer); +extern void SegUnsetBuffer(Seg seg); extern Addr SegBufferScanLimit(Seg seg); extern Bool SegCheck(Seg seg); extern Bool GCSegCheck(GCSeg gcseg); @@ -1018,7 +1021,7 @@ DECLARE_CLASS(Land, Land, Inst); /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c index 31616425a65..2e1d9f970c0 100644 --- a/mps/code/mpmss.c +++ b/mps/code/mpmss.c @@ -1,7 +1,7 @@ /* mpmss.c: MPM STRESS TEST * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. */ @@ -57,11 +57,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options, /* allocate a load of objects */ for (i=0; i= sizeof(ps[i])) *ps[i] = 1; /* Write something, so it gets swap. */ @@ -93,10 +94,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options, } /* allocate some new objects */ for (i=testSetSIZE/2; i. + * Copyright (c) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h index 106b71a0694..04c19f63e92 100644 --- a/mps/code/mpmst.h +++ b/mps/code/mpmst.h @@ -49,12 +49,11 @@ #define PoolClassSig ((Sig)0x519C7A55) /* SIGnature pool CLASS */ typedef struct mps_pool_class_s { - InstClassStruct protocol; + InstClassStruct instClassStruct; size_t size; /* size of outer structure */ Attr attr; /* attributes */ PoolVarargsMethod varargs; /* convert deprecated varargs into keywords */ PoolInitMethod init; /* initialize the pool descriptor */ - PoolFinishMethod finish; /* finish the pool descriptor */ PoolAllocMethod alloc; /* allocate memory from pool */ PoolFreeMethod free; /* free memory to pool */ PoolBufferFillMethod bufferFill; /* out-of-line reserve */ @@ -76,7 +75,6 @@ typedef struct mps_pool_class_s { PoolWalkMethod walk; /* walk over a segment */ PoolFreeWalkMethod freewalk; /* walk over free blocks */ PoolBufferClassMethod bufferClass; /* default BufferClass of pool */ - PoolDescribeMethod describe; /* describe the contents of the pool */ PoolDebugMixinMethod debugMixin; /* find the debug mixin, if any */ PoolSizeMethod totalSize; /* total memory allocated from arena */ PoolSizeMethod freeSize; /* free memory (unused by client program) */ @@ -218,18 +216,17 @@ typedef struct mps_message_s { #define SegClassSig ((Sig)0x5195E9C7) /* SIGnature SEG CLass */ typedef struct SegClassStruct { - InstClassStruct protocol; + InstClassStruct instClassStruct; size_t size; /* size of outer structure */ SegInitMethod init; /* initialize the segment */ - SegFinishMethod finish; /* finish the segment */ SegSetSummaryMethod setSummary; /* set the segment summary */ SegBufferMethod buffer; /* get the segment buffer */ SegSetBufferMethod setBuffer; /* set the segment buffer */ + SegUnsetBufferMethod unsetBuffer; /* unset the segment buffer */ SegSetGreyMethod setGrey; /* change greyness of segment */ SegSetWhiteMethod setWhite; /* change whiteness of segment */ SegSetRankSetMethod setRankSet; /* change rank set of segment */ SegSetRankSummaryMethod setRankSummary; /* change rank set & summary */ - SegDescribeMethod describe; /* describe the contents of the seg */ SegMergeMethod merge; /* merge two adjacent segments */ SegSplitMethod split; /* split a segment into two */ Sig sig; /* .class.end-sig */ @@ -306,14 +303,12 @@ typedef struct LocusPrefStruct { /* locus placement preferences */ #define BufferClassSig ((Sig)0x519B0FC7) /* SIGnature BUFfer CLass */ typedef struct BufferClassStruct { - InstClassStruct protocol; + InstClassStruct instClassStruct; size_t size; /* size of outer structure */ BufferVarargsMethod varargs; /* parse obsolete varargs */ BufferInitMethod init; /* initialize the buffer */ - BufferFinishMethod finish; /* finish the buffer */ BufferAttachMethod attach; /* attach the buffer */ BufferDetachMethod detach; /* detach the buffer */ - BufferDescribeMethod describe;/* describe the contents of the buffer */ BufferSegMethod seg; /* seg of buffer */ BufferRankSetMethod rankSet; /* rank set of buffer */ BufferSetRankSetMethod setRankSet; /* change rank set of buffer */ @@ -495,11 +490,10 @@ typedef struct TraceStruct { #define ArenaClassSig ((Sig)0x519A6C1A) /* SIGnature ARena CLAss */ typedef struct mps_arena_class_s { - InstClassStruct protocol; + InstClassStruct instClassStruct; size_t size; /* size of outer structure */ ArenaVarargsMethod varargs; ArenaInitMethod init; - ArenaFinishMethod finish; ArenaCreateMethod create; ArenaDestroyMethod destroy; ArenaPurgeSpareMethod purgeSpare; @@ -509,7 +503,6 @@ typedef struct mps_arena_class_s { ArenaChunkInitMethod chunkInit; ArenaChunkFinishMethod chunkFinish; ArenaCompactMethod compact; - ArenaDescribeMethod describe; ArenaPagesMarkAllocatedMethod pagesMarkAllocated; Sig sig; } ArenaClassStruct; @@ -574,11 +567,10 @@ typedef struct GlobalsStruct { #define LandClassSig ((Sig)0x5197A4DC) /* SIGnature LAND Class */ typedef struct LandClassStruct { - InstClassStruct protocol; + InstClassStruct instClassStruct; size_t size; /* size of outer structure */ LandSizeMethod sizeMethod; /* total size of ranges in land */ LandInitMethod init; /* initialize the land */ - LandFinishMethod finish; /* finish the land */ LandInsertMethod insert; /* insert a range into the land */ LandDeleteMethod delete; /* delete a range from the land */ LandIterateMethod iterate; /* iterate over ranges in the land */ @@ -587,7 +579,6 @@ typedef struct LandClassStruct { LandFindMethod findLast; /* find last range of given size */ LandFindMethod findLargest; /* find largest range */ LandFindInZonesMethod findInZones; /* find first range of given size in zone set */ - LandDescribeMethod describe; /* describe the land */ Sig sig; /* .class.end-sig */ } LandClassStruct; @@ -694,7 +685,9 @@ typedef struct SortStruct { typedef struct ShieldStruct { Sig sig; /* design.mps.sig */ - Bool inside; /* design.mps.shield.def.inside */ + BOOLFIELD(inside); /* design.mps.shield.def.inside */ + BOOLFIELD(suspended); /* mutator suspended? */ + BOOLFIELD(queuePending); /* queue insertion pending? */ Seg *queue; /* queue of unsynced segs */ Count length; /* number of elements in shield queue */ Index next; /* next free element in shield queue */ @@ -702,7 +695,6 @@ typedef struct ShieldStruct { Count depth; /* sum of depths of all segs */ Count unsynced; /* number of unsynced segments */ Count holds; /* number of holds */ - Bool suspended; /* mutator suspended? */ SortStruct sortStruct; /* workspace for queue sort */ } ShieldStruct; diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h index 5d8070eaa46..d1180ea9a8d 100644 --- a/mps/code/mpmtypes.h +++ b/mps/code/mpmtypes.h @@ -114,7 +114,6 @@ typedef void (*ArenaVarargsMethod)(ArgStruct args[], va_list varargs); typedef Res (*ArenaCreateMethod)(Arena *arenaReturn, ArgList args); typedef void (*ArenaDestroyMethod)(Arena arena); typedef Res (*ArenaInitMethod)(Arena arena, Size grainSize, ArgList args); -typedef void (*ArenaFinishMethod)(Arena arena); typedef Size (*ArenaPurgeSpareMethod)(Arena arena, Size size); typedef Res (*ArenaExtendMethod)(Arena arena, Addr base, Size size); typedef Res (*ArenaGrowMethod)(Arena arena, LocusPref pref, Size size); @@ -122,7 +121,6 @@ typedef void (*ArenaFreeMethod)(Addr base, Size size, Pool pool); typedef Res (*ArenaChunkInitMethod)(Chunk chunk, BootBlock boot); typedef void (*ArenaChunkFinishMethod)(Chunk chunk); typedef void (*ArenaCompactMethod)(Arena arena, Trace trace); -typedef Res (*ArenaDescribeMethod)(Arena arena, mps_lib_FILE *stream, Count depth); typedef Res (*ArenaPagesMarkAllocatedMethod)(Arena arena, Chunk chunk, Index baseIndex, Count pages, Pool pool); @@ -153,16 +151,15 @@ typedef void (*FreeBlockVisitor)(Addr base, Addr limit, Pool pool, void *p); typedef Res (*SegInitMethod)(Seg seg, Pool pool, Addr base, Size size, ArgList args); -typedef void (*SegFinishMethod)(Seg seg); typedef void (*SegSetGreyMethod)(Seg seg, TraceSet grey); typedef void (*SegSetWhiteMethod)(Seg seg, TraceSet white); typedef void (*SegSetRankSetMethod)(Seg seg, RankSet rankSet); typedef void (*SegSetRankSummaryMethod)(Seg seg, RankSet rankSet, RefSet summary); typedef void (*SegSetSummaryMethod)(Seg seg, RefSet summary); -typedef Buffer (*SegBufferMethod)(Seg seg); +typedef Bool (*SegBufferMethod)(Buffer *bufferReturn, Seg seg); typedef void (*SegSetBufferMethod)(Seg seg, Buffer buffer); -typedef Res (*SegDescribeMethod)(Seg seg, mps_lib_FILE *stream, Count depth); +typedef void (*SegUnsetBufferMethod)(Seg seg); typedef Res (*SegMergeMethod)(Seg seg, Seg segHi, Addr base, Addr mid, Addr limit); typedef Res (*SegSplitMethod)(Seg seg, Seg segHi, @@ -172,7 +169,6 @@ typedef Res (*SegSplitMethod)(Seg seg, Seg segHi, typedef void (*BufferVarargsMethod)(ArgStruct args[], va_list varargs); typedef Res (*BufferInitMethod)(Buffer buffer, Pool pool, Bool isMutator, ArgList args); -typedef void (*BufferFinishMethod)(Buffer buffer); typedef void (*BufferAttachMethod)(Buffer buffer, Addr base, Addr limit, Addr init, Size size); typedef void (*BufferDetachMethod)(Buffer buffer); @@ -180,7 +176,6 @@ typedef Seg (*BufferSegMethod)(Buffer buffer); typedef RankSet (*BufferRankSetMethod)(Buffer buffer); typedef void (*BufferSetRankSetMethod)(Buffer buffer, RankSet rankSet); typedef void (*BufferReassignSegMethod)(Buffer buffer, Seg seg); -typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count depth); /* Pool*Method -- see */ @@ -189,7 +184,6 @@ typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count d typedef void (*PoolVarargsMethod)(ArgStruct args[], va_list varargs); typedef Res (*PoolInitMethod)(Pool pool, Arena arena, PoolClass klass, ArgList args); -typedef void (*PoolFinishMethod)(Pool pool); typedef Res (*PoolAllocMethod)(Addr *pReturn, Pool pool, Size size); typedef void (*PoolFreeMethod)(Pool pool, Addr old, Size size); typedef Res (*PoolBufferFillMethod)(Addr *baseReturn, Addr *limitReturn, @@ -222,7 +216,6 @@ typedef void (*PoolWalkMethod)(Pool pool, Seg seg, FormattedObjectsVisitor f, void *v, size_t s); typedef void (*PoolFreeWalkMethod)(Pool pool, FreeBlockVisitor f, void *p); typedef BufferClass (*PoolBufferClassMethod)(void); -typedef Res (*PoolDescribeMethod)(Pool pool, mps_lib_FILE *stream, Count depth); typedef PoolDebugMixin (*PoolDebugMixinMethod)(Pool pool); typedef Size (*PoolSizeMethod)(Pool pool); @@ -255,7 +248,6 @@ typedef struct TraceMessageStruct *TraceMessage; /* trace end */ /* Land*Method -- see */ typedef Res (*LandInitMethod)(Land land, Arena arena, Align alignment, ArgList args); -typedef void (*LandFinishMethod)(Land land); typedef Size (*LandSizeMethod)(Land land); typedef Res (*LandInsertMethod)(Range rangeReturn, Land land, Range range); typedef Res (*LandDeleteMethod)(Range rangeReturn, Land land, Range range); @@ -265,7 +257,6 @@ typedef Bool (*LandIterateMethod)(Land land, LandVisitor visitor, void *closure) typedef Bool (*LandIterateAndDeleteMethod)(Land land, LandDeleteVisitor visitor, void *closure); typedef Bool (*LandFindMethod)(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete); typedef Res (*LandFindInZonesMethod)(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high); -typedef Res (*LandDescribeMethod)(Land land, mps_lib_FILE *stream, Count depth); /* CONSTANTS */ diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c index 2bc48179b3a..9ae6fcbfa97 100644 --- a/mps/code/mpsi.c +++ b/mps/code/mpsi.c @@ -1,7 +1,7 @@ /* mpsi.c: MEMORY POOL SYSTEM C INTERFACE LAYER * * $Id$ - * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (c) 2002 Global Graphics Software. * * .purpose: This code bridges between the MPS interface to C, @@ -745,16 +745,16 @@ mps_res_t mps_alloc(mps_addr_t *p_o, mps_pool_t pool, size_t size) Addr p; Res res; - AVER(TESTT(Pool, pool)); + AVER_CRITICAL(TESTT(Pool, pool)); arena = PoolArena(pool); ArenaEnter(arena); ArenaPoll(ArenaGlobals(arena)); /* .poll */ - AVER(p_o != NULL); - AVERT(Pool, pool); - AVER(size > 0); + AVER_CRITICAL(p_o != NULL); + AVERT_CRITICAL(Pool, pool); + AVER_CRITICAL(size > 0); /* Note: class may allow unaligned size, see */ /* . */ /* Rest ignored, see .varargs. */ @@ -787,13 +787,13 @@ void mps_free(mps_pool_t pool, mps_addr_t p, size_t size) { Arena arena; - AVER(TESTT(Pool, pool)); + AVER_CRITICAL(TESTT(Pool, pool)); arena = PoolArena(pool); ArenaEnter(arena); - AVERT(Pool, pool); - AVER(size > 0); + AVERT_CRITICAL(Pool, pool); + AVER_CRITICAL(size > 0); /* Note: class may allow unaligned size, see */ /* . */ @@ -1060,7 +1060,7 @@ mps_res_t mps_ap_fill(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size) AVER(p_o != NULL); AVERT(Buffer, buf); AVER(size > 0); - AVER(SizeIsAligned(size, BufferPool(buf)->alignment)); + AVER(SizeIsAligned(size, BufferPool(buf)->alignment)); /* */ res = BufferFill(&p, buf, size); @@ -2141,7 +2141,7 @@ void _mps_args_set_key(mps_arg_s args[MPS_ARGS_MAX], unsigned i, /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mpsicv.c b/mps/code/mpsicv.c index d026f2cd684..d1a9759a3b8 100644 --- a/mps/code/mpsicv.c +++ b/mps/code/mpsicv.c @@ -1,7 +1,7 @@ /* mpsicv.c: MPSI COVERAGE TEST * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (c) 2002 Global Graphics Software. */ @@ -338,7 +338,8 @@ static void *test(void *arg, size_t s) mps_arena_t arena; mps_fmt_t format; mps_chain_t chain; - mps_root_t exactRoot, ambigRoot, singleRoot, fmtRoot; + mps_root_t exactAreaRoot, exactTableRoot, ambigAreaRoot, ambigTableRoot, + singleRoot, fmtRoot; unsigned long i; /* Leave arena clamped until we have allocated this many objects. is 0 when arena has not been clamped. */ @@ -386,14 +387,29 @@ static void *test(void *arg, size_t s) ambigRoots[j] = rnd_addr(); } - die(mps_root_create_table_masked(&exactRoot, arena, + die(mps_root_create_area_tagged(&exactAreaRoot, arena, + mps_rank_exact(), (mps_rm_t)0, + &exactRoots[0], + &exactRoots[exactRootsCOUNT / 2], + mps_scan_area_tagged, + MPS_WORD_CONST(1), 0), + "root_create_area_tagged(exact)"); + die(mps_root_create_table_masked(&exactTableRoot, arena, mps_rank_exact(), (mps_rm_t)0, - &exactRoots[0], exactRootsCOUNT, + &exactRoots[exactRootsCOUNT / 2], + (exactRootsCOUNT + 1) / 2, MPS_WORD_CONST(1)), - "root_create_table(exact)"); - die(mps_root_create_table(&ambigRoot, arena, + "root_create_table_masked(exact)"); + die(mps_root_create_area(&ambigAreaRoot, arena, + mps_rank_ambig(), (mps_rm_t)0, + &ambigRoots[0], + &ambigRoots[ambigRootsCOUNT / 2], + mps_scan_area, NULL), + "root_create_area(ambig)"); + die(mps_root_create_table(&ambigTableRoot, arena, mps_rank_ambig(), (mps_rm_t)0, - &ambigRoots[0], ambigRootsCOUNT), + &ambigRoots[ambigRootsCOUNT / 2], + (ambigRootsCOUNT + 1) / 2), "root_create_table(ambig)"); obj = objNULL; @@ -519,8 +535,10 @@ static void *test(void *arg, size_t s) mps_ap_destroy(ap); mps_root_destroy(fmtRoot); mps_root_destroy(singleRoot); - mps_root_destroy(exactRoot); - mps_root_destroy(ambigRoot); + mps_root_destroy(exactAreaRoot); + mps_root_destroy(exactTableRoot); + mps_root_destroy(ambigAreaRoot); + mps_root_destroy(ambigTableRoot); mps_pool_destroy(amcpool); mps_chain_destroy(chain); mps_fmt_destroy(format); @@ -551,15 +569,25 @@ int main(int argc, char *argv[]) } MPS_ARGS_END(args); die(mps_thread_reg(&thread, arena), "thread_reg"); - if (rnd() % 2) { + switch (rnd() % 3) { + default: + case 0: die(mps_root_create_reg(®_root, arena, mps_rank_ambig(), (mps_rm_t)0, thread, &mps_stack_scan_ambig, marker, (size_t)0), "root_create_reg"); - } else { + break; + case 1: die(mps_root_create_thread(®_root, arena, thread, marker), "root_create_thread"); + break; + case 2: + die(mps_root_create_thread_scanned(®_root, arena, mps_rank_ambig(), + (mps_rm_t)0, thread, mps_scan_area, + NULL, marker), + "root_create_thread"); + break; } mps_tramp(&r, test, arena, 0); @@ -574,7 +602,7 @@ int main(int argc, char *argv[]) /* C. COPYRIGHT AND LICENSE * - * Copyright (c) 2001-2014 Ravenbrook Limited . + * Copyright (c) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mv2test.c b/mps/code/mv2test.c index 4670abbf076..a47a520af7f 100644 --- a/mps/code/mv2test.c +++ b/mps/code/mv2test.c @@ -1,7 +1,7 @@ /* mv2test.c: POOLMVT STRESS TEST * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. */ #include @@ -102,13 +102,15 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align, /* allocate a load of objects */ for(i=0; i. + * Copyright (c) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/pool.c b/mps/code/pool.c index 85c904d88aa..58b5dce91e1 100644 --- a/mps/code/pool.c +++ b/mps/code/pool.c @@ -1,7 +1,7 @@ /* pool.c: POOL IMPLEMENTATION * * $Id$ - * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2001 Global Graphics Software. * * DESIGN @@ -37,13 +37,12 @@ SRCID(pool, "$Id$"); Bool PoolClassCheck(PoolClass klass) { - CHECKD(InstClass, &klass->protocol); + CHECKD(InstClass, &klass->instClassStruct); CHECKL(klass->size >= sizeof(PoolStruct)); CHECKL(AttrCheck(klass->attr)); CHECKL(!(klass->attr & AttrMOVINGGC) || (klass->attr & AttrGC)); CHECKL(FUNCHECK(klass->varargs)); CHECKL(FUNCHECK(klass->init)); - CHECKL(FUNCHECK(klass->finish)); CHECKL(FUNCHECK(klass->alloc)); CHECKL(FUNCHECK(klass->free)); CHECKL(FUNCHECK(klass->bufferFill)); @@ -65,24 +64,23 @@ Bool PoolClassCheck(PoolClass klass) CHECKL(FUNCHECK(klass->walk)); CHECKL(FUNCHECK(klass->freewalk)); CHECKL(FUNCHECK(klass->bufferClass)); - CHECKL(FUNCHECK(klass->describe)); CHECKL(FUNCHECK(klass->debugMixin)); CHECKL(FUNCHECK(klass->totalSize)); CHECKL(FUNCHECK(klass->freeSize)); /* Check that pool classes overide sets of related methods. */ - CHECKL((klass->init == PoolAbsInit) == (klass->finish == PoolAbsFinish)); + CHECKL((klass->init == PoolAbsInit) == + (klass->instClassStruct.finish == PoolAbsFinish)); CHECKL((klass->bufferFill == PoolNoBufferFill) == - (klass->bufferEmpty == PoolNoBufferEmpty)); + (klass->bufferEmpty == PoolNoBufferEmpty)); CHECKL((klass->framePush == PoolNoFramePush) == - (klass->framePop == PoolNoFramePop)); + (klass->framePop == PoolNoFramePop)); CHECKL((klass->rampBegin == PoolNoRampBegin) == - (klass->rampEnd == PoolNoRampEnd)); + (klass->rampEnd == PoolNoRampEnd)); /* Check that pool classes that set attributes also override the methods they imply. */ - /* .check.ams.walk: Can't enforce this one until job003738 is resolved. */ - /* CHECKL(((klass->attr & AttrFMT) == 0) == (klass->walk == PoolNoWalk)); */ + CHECKL(((klass->attr & AttrFMT) == 0) == (klass->walk == PoolNoWalk)); if (klass != &CLASS_STATIC(AbstractCollectPool)) { CHECKL(((klass->attr & AttrGC) == 0) == (klass->fix == PoolNoFix)); CHECKL(((klass->attr & AttrGC) == 0) == (klass->fixEmergency == PoolNoFix)); @@ -197,7 +195,7 @@ failControlAlloc: void PoolFinish(Pool pool) { AVERT(Pool, pool); - Method(Pool, pool, finish)(pool); + Method(Inst, pool, finish)(MustBeA(Inst, pool)); } @@ -227,22 +225,24 @@ BufferClass PoolDefaultBufferClass(Pool pool) } -/* PoolAlloc -- allocate a block of memory from a pool */ +/* PoolAlloc -- allocate a block of memory from a pool + * + * .alloc.critical: In manual-allocation-bound programs this is on the + * critical path. + */ Res PoolAlloc(Addr *pReturn, Pool pool, Size size) { Res res; - AVER(pReturn != NULL); - AVERT(Pool, pool); - AVER(size > 0); + AVER_CRITICAL(pReturn != NULL); + AVERT_CRITICAL(Pool, pool); + AVER_CRITICAL(size > 0); 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. */ - /* .hasaddr.critical: The PoolHasAddr check is expensive, and in */ - /* allocation-bound programs this is on the critical path. */ AVER_CRITICAL(PoolHasAddr(pool, *pReturn)); /* All allocations should be aligned to the pool's alignment */ AVER_CRITICAL(AddrIsAligned(*pReturn, pool->alignment)); @@ -257,16 +257,20 @@ Res PoolAlloc(Addr *pReturn, Pool pool, Size size) } -/* PoolFree -- deallocate a block of memory allocated from the pool */ +/* PoolFree -- deallocate a block of memory allocated from the pool + * + * .free.critical: In manual-allocation-bound programs this is on the + * critical path. + */ void PoolFree(Pool pool, Addr old, Size size) { - AVERT(Pool, pool); - AVER(old != NULL); + AVERT_CRITICAL(Pool, pool); + AVER_CRITICAL(old != NULL); /* The pool methods should check that old is in pool. */ - AVER(size > 0); - AVER(AddrIsAligned(old, pool->alignment)); - AVER(PoolHasRange(pool, old, AddrAdd(old, size))); + AVER_CRITICAL(size > 0); + AVER_CRITICAL(AddrIsAligned(old, pool->alignment)); + AVER_CRITICAL(PoolHasRange(pool, old, AddrAdd(old, size))); Method(Pool, pool, free)(pool, old, size); @@ -490,51 +494,7 @@ Size PoolFreeSize(Pool pool) Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth) { - Res res; - Ring node, nextNode; - PoolClass klass; - - if (!TESTC(AbstractPool, pool)) - return ResPARAM; - if (stream == NULL) - return ResPARAM; - - klass = ClassOfPoly(Pool, pool); - - res = WriteF(stream, depth, - "Pool $P ($U) {\n", (WriteFP)pool, (WriteFU)pool->serial, - " class $P (\"$S\")\n", - (WriteFP)klass, (WriteFS)ClassName(klass), - " arena $P ($U)\n", - (WriteFP)pool->arena, (WriteFU)pool->arena->serial, - " alignment $W\n", (WriteFW)pool->alignment, - NULL); - if (res != ResOK) - return res; - if (NULL != pool->format) { - res = FormatDescribe(pool->format, stream, depth + 2); - if (res != ResOK) - return res; - } - - res = Method(Pool, pool, describe)(pool, stream, depth + 2); - if (res != ResOK) - return res; - - RING_FOR(node, &pool->bufferRing, nextNode) { - Buffer buffer = RING_ELT(Buffer, poolRing, node); - res = BufferDescribe(buffer, stream, depth + 2); - if (res != ResOK) - return res; - } - - res = WriteF(stream, depth, - "} Pool $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial, - NULL); - if (res != ResOK) - return res; - - return ResOK; + return Method(Inst, pool, describe)(MustBeA(Inst, pool), stream, depth); } @@ -640,8 +600,8 @@ Bool PoolHasRange(Pool pool, Addr base, Addr limit) Arena arena; Bool managed; - AVERT(Pool, pool); - AVER(base < limit); + AVERT_CRITICAL(Pool, pool); + AVER_CRITICAL(base < limit); arena = PoolArena(pool); managed = PoolOfRange(&rangePool, arena, base, limit); @@ -651,7 +611,7 @@ Bool PoolHasRange(Pool pool, Addr base, Addr limit) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c index 8f1f1831d62..d8475b893a6 100644 --- a/mps/code/poolabs.c +++ b/mps/code/poolabs.c @@ -154,8 +154,10 @@ Res PoolAbsInit(Pool pool, Arena arena, PoolClass klass, ArgList args) /* PoolAbsFinish -- finish an abstract pool instance */ -void PoolAbsFinish(Pool pool) +void PoolAbsFinish(Inst inst) { + Pool pool = MustBeA(AbstractPool, inst); + /* Detach the pool from the arena and format, and unsig it. */ RingRemove(PoolArenaRing(pool)); @@ -184,12 +186,13 @@ DEFINE_CLASS(Inst, PoolClass, klass) DEFINE_CLASS(Pool, AbstractPool, klass) { - INHERIT_CLASS(&klass->protocol, AbstractPool, Inst); + INHERIT_CLASS(&klass->instClassStruct, AbstractPool, Inst); + klass->instClassStruct.describe = PoolAbsDescribe; + klass->instClassStruct.finish = PoolAbsFinish; klass->size = sizeof(PoolStruct); klass->attr = 0; klass->varargs = ArgTrivVarargs; klass->init = PoolAbsInit; - klass->finish = PoolAbsFinish; klass->alloc = PoolNoAlloc; klass->free = PoolNoFree; klass->bufferFill = PoolNoBufferFill; @@ -211,7 +214,6 @@ DEFINE_CLASS(Pool, AbstractPool, klass) klass->walk = PoolNoWalk; klass->freewalk = PoolTrivFreeWalk; klass->bufferClass = PoolNoBufferClass; - klass->describe = PoolTrivDescribe; klass->debugMixin = PoolNoDebugMixin; klass->totalSize = PoolNoSize; klass->freeSize = PoolNoSize; @@ -353,13 +355,44 @@ void PoolTrivBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit) } -Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream, Count depth) +Res PoolAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { - AVERT(Pool, pool); - AVER(stream != NULL); - return WriteF(stream, depth, - "No class-specific description available.\n", - NULL); + Pool pool = CouldBeA(AbstractPool, inst); + Res res; + Ring node, nextNode; + + if (!TESTC(AbstractPool, pool)) + return ResPARAM; + if (stream == NULL) + return ResPARAM; + + res = InstDescribe(CouldBeA(Inst, pool), stream, depth); + if (res != ResOK) + return res; + + res = WriteF(stream, depth + 2, + "serial $U\n", (WriteFU)pool->serial, + "arena $P ($U)\n", + (WriteFP)pool->arena, (WriteFU)pool->arena->serial, + "alignment $W\n", (WriteFW)pool->alignment, + NULL); + if (res != ResOK) + return res; + + if (pool->format != NULL) { + res = FormatDescribe(pool->format, stream, depth + 2); + if (res != ResOK) + return res; + } + + RING_FOR(node, &pool->bufferRing, nextNode) { + Buffer buffer = RING_ELT(Buffer, poolRing, node); + res = BufferDescribe(buffer, stream, depth + 2); + if (res != ResOK) + return res; + } + + return ResOK; } diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c index b76339fb737..e880141c5ed 100644 --- a/mps/code/poolamc.c +++ b/mps/code/poolamc.c @@ -198,8 +198,7 @@ static void AMCSegSketch(Seg seg, char *pbSketch, size_t cbSketch) pbSketch[2] = 'W'; /* White */ } - buffer = SegBuffer(seg); - if(buffer == NULL) { + if (!SegBuffer(&buffer, seg)) { pbSketch[3] = '_'; } else { Bool mut = BufferIsMutator(buffer); @@ -235,24 +234,26 @@ static void AMCSegSketch(Seg seg, char *pbSketch, size_t cbSketch) * * See . */ -static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) +static Res AMCSegDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + amcSeg amcseg = CouldBeA(amcSeg, inst); + Seg seg = CouldBeA(Seg, amcseg); Res res; - amcSeg amcseg = CouldBeA(amcSeg, seg); Pool pool; Addr i, p, base, limit, init; Align step; Size row; char abzSketch[5]; + Buffer buffer; - if(!TESTC(amcSeg, amcseg)) + if (!TESTC(amcSeg, amcseg)) return ResPARAM; - if(stream == NULL) + if (stream == NULL) return ResPARAM; /* Describe the superclass fields first via next-method call */ - res = NextMethod(Seg, amcSeg, describe)(seg, stream, depth); - if(res != ResOK) + res = NextMethod(Inst, amcSeg, describe)(inst, stream, depth); + if (res != ResOK) return res; pool = SegPool(seg); @@ -263,16 +264,9 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) p = AddrAdd(base, pool->format->headerSize); limit = SegLimit(seg); - res = WriteF(stream, depth, - "AMC seg $P [$A,$A){\n", - (WriteFP)seg, (WriteFA)base, (WriteFA)limit, - NULL); - if(res != ResOK) - return res; - - if(amcSegHasNailboard(seg)) { + if (amcSegHasNailboard(seg)) { res = WriteF(stream, depth + 2, "Boarded\n", NULL); - } else if(SegNailed(seg) == TraceSetEMPTY) { + } else if (SegNailed(seg) == TraceSetEMPTY) { res = WriteF(stream, depth + 2, "Mobile\n", NULL); } else { res = WriteF(stream, depth + 2, "Stuck\n", NULL); @@ -282,32 +276,32 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) res = WriteF(stream, depth + 2, "Map: *===:object @+++:nails bbbb:buffer\n", NULL); - if(res != ResOK) + if (res != ResOK) return res; - if(SegBuffer(seg) != NULL) - init = BufferGetInit(SegBuffer(seg)); + if (SegBuffer(&buffer, seg)) + init = BufferGetInit(buffer); else init = limit; - for(i = base; i < limit; i = AddrAdd(i, row)) { + for (i = base; i < limit; i = AddrAdd(i, row)) { Addr j; char c; res = WriteF(stream, depth + 2, "$A ", (WriteFA)i, NULL); - if(res != ResOK) + if (res != ResOK) return res; /* @@@@ This misses a header-sized pad at the end. */ - for(j = i; j < AddrAdd(i, row); j = AddrAdd(j, step)) { - if(j >= limit) + for (j = i; j < AddrAdd(i, row); j = AddrAdd(j, step)) { + if (j >= limit) c = ' '; /* if seg is not a whole number of print rows */ - else if(j >= init) + else if (j >= init) c = 'b'; else { Bool nailed = amcSegHasNailboard(seg) && NailboardGet(amcSegNailboard(seg), j); - if(j == p) { + if (j == p) { c = (nailed ? '@' : '*'); p = (pool->format->skip)(p); } else { @@ -315,12 +309,12 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) } } res = WriteF(stream, 0, "$C", (WriteFC)c, NULL); - if(res != ResOK) + if (res != ResOK) return res; } res = WriteF(stream, 0, "\n", NULL); - if(res != ResOK) + if (res != ResOK) return res; } @@ -329,10 +323,6 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) if(res != ResOK) return res; - res = WriteF(stream, depth, "} AMC Seg $P\n", (WriteFP)seg, NULL); - if(res != ResOK) - return res; - return ResOK; } @@ -343,9 +333,9 @@ DEFINE_CLASS(Seg, amcSeg, klass) { INHERIT_CLASS(klass, amcSeg, GCSeg); SegClassMixInNoSplitMerge(klass); /* no support for this (yet) */ + klass->instClassStruct.describe = AMCSegDescribe; klass->size = sizeof(amcSegStruct); klass->init = AMCSegInit; - klass->describe = AMCSegDescribe; } @@ -520,11 +510,12 @@ static Res AMCBufInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args) /* AMCBufFinish -- Finish an amcBuf */ -static void AMCBufFinish(Buffer buffer) +static void AMCBufFinish(Inst inst) { + Buffer buffer = MustBeA(Buffer, inst); amcBuf amcbuf = MustBeA(amcBuf, buffer); amcbuf->sig = SigInvalid; - NextMethod(Buffer, amcBuf, finish)(buffer); + NextMethod(Inst, amcBuf, finish)(inst); } @@ -533,9 +524,9 @@ static void AMCBufFinish(Buffer buffer) DEFINE_CLASS(Buffer, amcBuf, klass) { INHERIT_CLASS(klass, amcBuf, SegBuf); + klass->instClassStruct.finish = AMCBufFinish; klass->size = sizeof(amcBufStruct); klass->init = AMCBufInit; - klass->finish = AMCBufFinish; } @@ -810,7 +801,7 @@ failGenAlloc: } ControlFree(arena, amc->gen, genArraySize); failGensAlloc: - PoolAbsFinish(pool); + NextMethod(Inst, AMCZPool, finish)(MustBeA(Inst, pool)); return res; } @@ -835,8 +826,9 @@ static Res AMCZInit(Pool pool, Arena arena, PoolClass klass, ArgList args) * * See . */ -static void AMCFinish(Pool pool) +static void AMCFinish(Inst inst) { + Pool pool = MustBeA(AbstractPool, inst); AMC amc = MustBeA(AMCZPool, pool); Ring ring; Ring node, nextNode; @@ -879,7 +871,8 @@ static void AMCFinish(Pool pool) } amc->sig = SigInvalid; - PoolAbsFinish(pool); + + NextMethod(Inst, AMCZPool, finish)(inst); } @@ -1119,8 +1112,7 @@ static Res AMCWhiten(Pool pool, Trace trace, Seg seg) AVERT(Trace, trace); - buffer = SegBuffer(seg); - if(buffer != NULL) { + if (SegBuffer(&buffer, seg)) { AVERT(Buffer, buffer); if(!BufferIsMutator(buffer)) { /* forwarding buffer */ @@ -1269,6 +1261,7 @@ static Res amcScanNailedOnce(Bool *totalReturn, Bool *moreReturn, Addr p, limit; Nailboard board; Res res; + Buffer buffer; EVENT3(AMCScanBegin, amc, seg, ss); /* TODO: consider using own event */ @@ -1277,8 +1270,8 @@ static Res amcScanNailedOnce(Bool *totalReturn, Bool *moreReturn, NailboardClearNewNails(board); p = SegBase(seg); - while(SegBuffer(seg) != NULL) { - limit = BufferScanLimit(SegBuffer(seg)); + while (SegBuffer(&buffer, seg)) { + limit = BufferScanLimit(buffer); if(p >= limit) { AVER(p == limit); goto returnGood; @@ -1361,6 +1354,7 @@ static Res AMCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) Format format; AMC amc = MustBeA(AMCZPool, pool); Res res; + Buffer buffer; AVER(totalReturn != NULL); AVERT(ScanState, ss); @@ -1377,8 +1371,8 @@ static Res AMCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) base = AddrAdd(SegBase(seg), format->headerSize); /* */ - while(SegBuffer(seg) != NULL) { - limit = AddrAdd(BufferScanLimit(SegBuffer(seg)), + while (SegBuffer(&buffer, seg)) { + limit = AddrAdd(BufferScanLimit(buffer), format->headerSize); if(base >= limit) { /* @@@@ Are we sure we don't need scan the rest of the */ @@ -1746,11 +1740,11 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg) /* Free the seg if we can; fixes .nailboard.limitations.middle. */ if(preservedInPlaceCount == 0 - && (SegBuffer(seg) == NULL) + && (!SegHasBuffer(seg)) && (SegNailed(seg) == TraceSetEMPTY)) { /* We may not free a buffered seg. */ - AVER(SegBuffer(seg) == NULL); + AVER(!SegHasBuffer(seg)); PoolGenFree(pgen, seg, 0, SegSize(seg), 0, MustBeA(amcSeg, seg)->deferred); } @@ -1793,7 +1787,7 @@ static void AMCReclaim(Pool pool, Trace trace, Seg seg) /* We may not free a buffered seg. (But all buffered + condemned */ /* segs should have been nailed anyway). */ - AVER(SegBuffer(seg) == NULL); + AVER(!SegHasBuffer(seg)); STATISTIC(trace->reclaimSize += SegSize(seg)); @@ -1911,6 +1905,7 @@ static Res AMCAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr) Res res; Arena arena; Addr base, limit; /* range of objects on segment */ + Buffer buffer; AVER(pReturn != NULL); AVERT(Pool, pool); @@ -1921,7 +1916,7 @@ static Res AMCAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr) arena = PoolArena(pool); base = SegBase(seg); - if (SegBuffer(seg) != NULL) { + if (SegBuffer(&buffer, seg)) { /* We use BufferGetInit here (and not BufferScanLimit) because we * want to be able to find objects that have been allocated and * committed since the last flip. These objects lie between the @@ -1933,7 +1928,7 @@ static Res AMCAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr) * *must* point inside a live object and we stop skipping once we * have found it. The init pointer serves this purpose. */ - limit = BufferGetInit(SegBuffer(seg)); + limit = BufferGetInit(buffer); } else { limit = SegLimit(seg); } @@ -1985,24 +1980,22 @@ static Size AMCFreeSize(Pool pool) * * See . */ -static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth) + +static Res AMCDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { - Res res; + Pool pool = CouldBeA(AbstractPool, inst); AMC amc = CouldBeA(AMCZPool, pool); + Res res; Ring node, nextNode; const char *rampmode; - if(!TESTC(AMCZPool, amc)) + if (!TESTC(AMCZPool, amc)) return ResPARAM; - if(stream == NULL) + if (stream == NULL) return ResPARAM; - res = WriteF(stream, depth, - (amc->rankSet == RankSetEMPTY) ? "AMCZ" : "AMC", - " $P {\n", (WriteFP)amc, " pool $P ($U)\n", - (WriteFP)pool, (WriteFU)pool->serial, - NULL); - if(res != ResOK) + res = NextMethod(Inst, AMCZPool, describe)(inst, stream, depth); + if (res != ResOK) return res; switch(amc->rampMode) { @@ -2029,20 +2022,16 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth) return res; } - if(0) { + if (0) { /* SegDescribes */ RING_FOR(node, &pool->segRing, nextNode) { Seg seg = RING_ELT(Seg, poolRing, node); - res = AMCSegDescribe(seg, stream, depth + 2); + res = SegDescribe(seg, stream, depth + 2); if(res != ResOK) return res; } } - res = WriteF(stream, depth, "} AMC $P\n", (WriteFP)amc, NULL); - if(res != ResOK) - return res; - return ResOK; } @@ -2054,11 +2043,12 @@ DEFINE_CLASS(Pool, AMCZPool, klass) INHERIT_CLASS(klass, AMCZPool, AbstractSegBufPool); PoolClassMixInFormat(klass); PoolClassMixInCollect(klass); + klass->instClassStruct.describe = AMCDescribe; + klass->instClassStruct.finish = AMCFinish; klass->size = sizeof(AMCStruct); klass->attr |= AttrMOVINGGC; klass->varargs = AMCVarargs; klass->init = AMCZInit; - klass->finish = AMCFinish; klass->bufferFill = AMCBufferFill; klass->bufferEmpty = AMCBufferEmpty; klass->whiten = AMCWhiten; @@ -2072,7 +2062,6 @@ DEFINE_CLASS(Pool, AMCZPool, klass) klass->bufferClass = amcBufClassGet; klass->totalSize = AMCTotalSize; klass->freeSize = AMCFreeSize; - klass->describe = AMCDescribe; } diff --git a/mps/code/poolams.c b/mps/code/poolams.c index d30733c86f3..e1ae41749cc 100644 --- a/mps/code/poolams.c +++ b/mps/code/poolams.c @@ -260,7 +260,7 @@ static Res AMSSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args) return ResOK; failCreateTables: - NextMethod(Seg, AMSSeg, finish)(seg); + NextMethod(Inst, AMSSeg, finish)(MustBeA(Inst, seg)); failNextMethod: AVER(res != ResOK); return res; @@ -269,19 +269,15 @@ failNextMethod: /* AMSSegFinish -- Finish method for AMS segments */ -static void AMSSegFinish(Seg seg) +static void AMSSegFinish(Inst inst) { - AMSSeg amsseg; - AMS ams; - Arena arena; + Seg seg = MustBeA(Seg, inst); + AMSSeg amsseg = MustBeA(AMSSeg, seg); + AMS ams = amsseg->ams; + Arena arena = PoolArena(AMSPool(ams)); - AVERT(Seg, seg); - amsseg = Seg2AMSSeg(seg); AVERT(AMSSeg, amsseg); - ams = amsseg->ams; - AVERT(AMS, ams); - arena = PoolArena(AMSPool(ams)); - AVER(SegBuffer(seg) == NULL); + AVER(!SegHasBuffer(seg)); /* keep the destructions in step with AMSSegInit failure cases */ amsDestroyTables(ams, amsseg->allocTable, amsseg->nongreyTable, @@ -290,7 +286,7 @@ static void AMSSegFinish(Seg seg) amsseg->sig = SigInvalid; /* finish the superclass fields last */ - NextMethod(Seg, AMSSeg, finish)(seg); + NextMethod(Inst, AMSSeg, finish)(inst); } @@ -498,44 +494,42 @@ failCreateTablesLo: /* AMSSegDescribe -- describe an AMS segment */ -#define WRITE_BUFFER_LIMIT(stream, seg, i, buffer, accessor, code) \ +#define WRITE_BUFFER_LIMIT(i, accessor, code) \ BEGIN \ - if ((buffer) != NULL \ - && (i) == AMS_ADDR_INDEX(seg, accessor(buffer))) { \ + if (hasBuffer && (i) == AMS_ADDR_INDEX(seg, accessor(buffer))) { \ Res _res = WriteF(stream, 0, code, NULL); \ if (_res != ResOK) return _res; \ } \ END -static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) +static Res AMSSegDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + AMSSeg amsseg = CouldBeA(AMSSeg, inst); + Seg seg = CouldBeA(Seg, amsseg); Res res; - AMSSeg amsseg; - Buffer buffer; /* the segment's buffer, if it has one */ + Buffer buffer; + Bool hasBuffer; Index i; - if (!TESTT(Seg, seg)) - return ResFAIL; + if (!TESTC(AMSSeg, amsseg)) + return ResPARAM; if (stream == NULL) - return ResFAIL; - amsseg = Seg2AMSSeg(seg); - if (!TESTT(AMSSeg, amsseg)) - return ResFAIL; + return ResPARAM; /* Describe the superclass fields first via next-method call */ - res = NextMethod(Seg, AMSSeg, describe)(seg, stream, depth); + res = NextMethod(Inst, AMSSeg, describe)(inst, stream, depth); if (res != ResOK) return res; - buffer = SegBuffer(seg); + hasBuffer = SegBuffer(&buffer, seg); - res = WriteF(stream, depth, - " AMS $P\n", (WriteFP)amsseg->ams, - " grains $W\n", (WriteFW)amsseg->grains, - " freeGrains $W\n", (WriteFW)amsseg->freeGrains, - " buffferedGrains $W\n", (WriteFW)amsseg->bufferedGrains, - " newGrains $W\n", (WriteFW)amsseg->newGrains, - " oldGrains $W\n", (WriteFW)amsseg->oldGrains, + res = WriteF(stream, depth + 2, + "AMS $P\n", (WriteFP)amsseg->ams, + "grains $W\n", (WriteFW)amsseg->grains, + "freeGrains $W\n", (WriteFW)amsseg->freeGrains, + "buffferedGrains $W\n", (WriteFW)amsseg->bufferedGrains, + "newGrains $W\n", (WriteFW)amsseg->newGrains, + "oldGrains $W\n", (WriteFW)amsseg->oldGrains, NULL); if (res != ResOK) return res; @@ -570,9 +564,9 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) return res; } - WRITE_BUFFER_LIMIT(stream, seg, i, buffer, BufferBase, "["); - WRITE_BUFFER_LIMIT(stream, seg, i, buffer, BufferGetInit, "|"); - WRITE_BUFFER_LIMIT(stream, seg, i, buffer, BufferAlloc, ">"); + WRITE_BUFFER_LIMIT(i, BufferBase, "["); + WRITE_BUFFER_LIMIT(i, BufferGetInit, "|"); + WRITE_BUFFER_LIMIT(i, BufferAlloc, ">"); if (AMS_ALLOCED(seg, i)) { if (amsseg->colourTablesInUse) { @@ -592,8 +586,8 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) if (res != ResOK) return res; - WRITE_BUFFER_LIMIT(stream, seg, i+1, buffer, BufferScanLimit, "<"); - WRITE_BUFFER_LIMIT(stream, seg, i+1, buffer, BufferLimit, "]"); + WRITE_BUFFER_LIMIT(i+1, BufferScanLimit, "<"); + WRITE_BUFFER_LIMIT(i+1, BufferLimit, "]"); } return ResOK; @@ -605,12 +599,12 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) DEFINE_CLASS(Seg, AMSSeg, klass) { INHERIT_CLASS(klass, AMSSeg, GCSeg); + klass->instClassStruct.describe = AMSSegDescribe; + klass->instClassStruct.finish = AMSSegFinish; klass->size = sizeof(AMSSegStruct); klass->init = AMSSegInit; - klass->finish = AMSSegFinish; klass->merge = AMSSegMerge; klass->split = AMSSegSplit; - klass->describe = AMSSegDescribe; AVERT(SegClass, klass); } @@ -707,7 +701,7 @@ static void AMSSegsDestroy(AMS ams) RING_FOR(node, ring, next) { Seg seg = SegOfPoolRing(node); AMSSeg amsseg = Seg2AMSSeg(seg); - AVER(SegBuffer(seg) == NULL); + AVER(!SegHasBuffer(seg)); AVERT(AMSSeg, amsseg); AVER(amsseg->ams == ams); AVER(amsseg->bufferedGrains == 0); @@ -813,7 +807,7 @@ static Res AMSInit(Pool pool, Arena arena, PoolClass klass, ArgList args) return ResOK; failGenInit: - PoolAbsFinish(pool); + NextMethod(Inst, AMSPool, finish)(MustBeA(Inst, pool)); failAbsInit: return res; } @@ -824,12 +818,11 @@ failAbsInit: * Destroys all the segs in the pool. Can't invalidate the AMS until * we've destroyed all the segments, as it may be checked. */ -void AMSFinish(Pool pool) +void AMSFinish(Inst inst) { - AMS ams; + Pool pool = MustBeA(AbstractPool, inst); + AMS ams = MustBeA(AMSPool, pool); - AVERT(Pool, pool); - ams = PoolAMS(pool); AVERT(AMS, ams); ams->segsDestroy(ams); @@ -837,7 +830,8 @@ void AMSFinish(Pool pool) ams->sig = SigInvalid; PoolGenFinish(ams->pgen); ams->pgen = NULL; - PoolAbsFinish(pool); + + NextMethod(Inst, AMSPool, finish)(inst); } @@ -938,7 +932,7 @@ static Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn, AVERT_CRITICAL(AMSSeg, amsseg); if (amsseg->freeGrains >= AMSGrains(ams, size)) { if (SegRankSet(seg) == rankSet - && SegBuffer(seg) == NULL + && !SegHasBuffer(seg) /* Can't use a white or grey segment, see d.m.p.fill.colour. */ && SegWhite(seg) == TraceSetEMPTY && SegGrey(seg) == TraceSetEMPTY) @@ -1113,8 +1107,7 @@ static Res AMSWhiten(Pool pool, Trace trace, Seg seg) amsseg->allocTableInUse = TRUE; } - buffer = SegBuffer(seg); - if (buffer != NULL) { /* */ + if (SegBuffer(&buffer, seg)) { /* */ Index scanLimitIndex, limitIndex; scanLimitIndex = AMS_ADDR_INDEX(seg, BufferScanLimit(buffer)); limitIndex = AMS_ADDR_INDEX(seg, BufferLimit(buffer)); @@ -1182,6 +1175,7 @@ static Res amsIterate(Seg seg, AMSObjectFunction f, void *closure) Index i; Addr p, next, limit; Buffer buffer; + Bool hasBuffer; AVERT(Seg, seg); AVERT(AMSObjectFunction, f); @@ -1201,16 +1195,15 @@ static Res amsIterate(Seg seg, AMSObjectFunction f, void *closure) p = SegBase(seg); limit = SegLimit(seg); - buffer = SegBuffer(seg); + hasBuffer = SegBuffer(&buffer, seg); while (p < limit) { /* loop over the objects in the segment */ - if (buffer != NULL - && p == BufferScanLimit(buffer) && p != BufferLimit(buffer)) { + if (hasBuffer && p == BufferScanLimit(buffer) && p != BufferLimit(buffer)) { /* skip buffer */ next = BufferLimit(buffer); AVER(AddrIsAligned(next, alignment)); } else { - AVER((buffer == NULL) + AVER(!hasBuffer || (p < BufferScanLimit(buffer)) || (p >= BufferLimit(buffer))); /* not in the buffer */ @@ -1465,7 +1458,7 @@ static Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO) case RankFINAL: case RankWEAK: AVER_CRITICAL(AddrIsAligned(base, PoolAlignment(pool))); - AVER_CRITICAL(AMS_ALLOCED(seg, i)); + AVER_CRITICAL(AMS_ALLOCED(seg, i)); /* */ if (AMS_IS_WHITE(seg, i)) { ss->wasMarked = FALSE; if (ss->rank == RankWEAK) { /* then splat the reference */ @@ -1610,7 +1603,7 @@ static void AMSReclaim(Pool pool, Trace trace, Seg seg) amsseg->colourTablesInUse = FALSE; SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace)); - if (amsseg->freeGrains == grains && SegBuffer(seg) == NULL) { + if (amsseg->freeGrains == grains && !SegHasBuffer(seg)) { /* No survivors */ AVER(amsseg->bufferedGrains == 0); PoolGenFree(ams->pgen, seg, @@ -1622,6 +1615,66 @@ static void AMSReclaim(Pool pool, Trace trace, Seg seg) } +/* AMSWalk -- walk formatted objects in AMC pool */ + +static void AMSWalk(Pool pool, Seg seg, FormattedObjectsVisitor f, + void *p, size_t s) +{ + AMS ams; + AMSSeg amsseg; + Addr object, base, limit; + Format format; + + AVERT(Pool, pool); + AVERT(Seg, seg); + AVER(FUNCHECK(f)); + /* p and s are arbitrary closures and can't be checked */ + + ams = PoolAMS(pool); + AVERT(AMS, ams); + amsseg = Seg2AMSSeg(seg); + AVERT(AMSSeg, amsseg); + + format = pool->format; + + base = SegBase(seg); + object = base; + limit = SegLimit(seg); + + while (object < limit) { + /* object is a slight misnomer because it might point to a free grain */ + Addr next; + Index i; + Buffer buffer; + + if (SegBuffer(&buffer, seg)) { + if (object == BufferScanLimit(buffer) + && BufferScanLimit(buffer) != BufferLimit(buffer)) { + /* skip over buffered area */ + object = BufferLimit(buffer); + continue; + } + /* since we skip over the buffered area we are always */ + /* either before the buffer, or after it, never in it */ + AVER(object < BufferGetInit(buffer) || BufferLimit(buffer) <= object); + } + i = AMS_ADDR_INDEX(seg, object); + if (!AMS_ALLOCED(seg, i)) { + /* This grain is free */ + object = AddrAdd(object, PoolAlignment(pool)); + continue; + } + object = AddrAdd(object, format->headerSize); + next = format->skip(object); + next = AddrSub(next, format->headerSize); + AVER(AddrIsAligned(next, PoolAlignment(pool))); + if (!amsseg->colourTablesInUse || !AMS_IS_WHITE(seg, i)) + (*f)(object, pool->format, pool, p, s); + object = next; + } +} + + /* AMSFreeWalk -- free block walking method of the pool class */ static void AMSFreeWalk(Pool pool, FreeBlockVisitor f, void *p) @@ -1672,25 +1725,25 @@ static Size AMSFreeSize(Pool pool) * * Iterates over the segments, describing all of them. */ -static Res AMSDescribe(Pool pool, mps_lib_FILE *stream, Count depth) + +static Res AMSDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { - AMS ams; + Pool pool = CouldBeA(AbstractPool, inst); + AMS ams = CouldBeA(AMSPool, pool); Ring ring, node, nextNode; Res res; - if (!TESTT(Pool, pool)) - return ResFAIL; - ams = PoolAMS(pool); - if (!TESTT(AMS, ams)) - return ResFAIL; + if (!TESTC(AMSPool, ams)) + return ResPARAM; if (stream == NULL) - return ResFAIL; + return ResPARAM; - res = WriteF(stream, depth, - "AMS $P {\n", (WriteFP)ams, - " pool $P ($U)\n", - (WriteFP)pool, (WriteFU)pool->serial, - " grain shift $U\n", (WriteFU)ams->grainShift, + res = NextMethod(Inst, AMSPool, describe)(inst, stream, depth); + if (res != ResOK) + return res; + + res = WriteF(stream, depth + 2, + "grain shift $U\n", (WriteFU)ams->grainShift, NULL); if (res != ResOK) return res; @@ -1709,10 +1762,6 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream, Count depth) return res; } - res = WriteF(stream, depth, "} AMS $P\n",(WriteFP)ams, NULL); - if (res != ResOK) - return res; - return ResOK; } @@ -1726,10 +1775,11 @@ DEFINE_CLASS(Pool, AMSPool, klass) { INHERIT_CLASS(klass, AMSPool, AbstractCollectPool); PoolClassMixInFormat(klass); + klass->instClassStruct.describe = AMSDescribe; + klass->instClassStruct.finish = AMSFinish; klass->size = sizeof(AMSStruct); klass->varargs = AMSVarargs; klass->init = AMSInit; - klass->finish = AMSFinish; klass->bufferClass = RankBufClassGet; klass->bufferFill = AMSBufferFill; klass->bufferEmpty = AMSBufferEmpty; @@ -1739,12 +1789,10 @@ DEFINE_CLASS(Pool, AMSPool, klass) klass->fix = AMSFix; klass->fixEmergency = AMSFix; klass->reclaim = AMSReclaim; - /* TODO: job003738. See also impl.c.pool.check.ams.walk. */ - klass->walk = PoolNoWalk; + klass->walk = AMSWalk; klass->freewalk = AMSFreeWalk; klass->totalSize = AMSTotalSize; klass->freeSize = AMSFreeSize; - klass->describe = AMSDescribe; AVERT(PoolClass, klass); } diff --git a/mps/code/poolams.h b/mps/code/poolams.h index e1c6999bdbe..1bd60e7900d 100644 --- a/mps/code/poolams.h +++ b/mps/code/poolams.h @@ -169,7 +169,7 @@ typedef struct AMSSegStruct { extern Res AMSInitInternal(AMS ams, Arena arena, PoolClass klass, Chain chain, unsigned gen, Bool shareAllocTable, ArgList args); -extern void AMSFinish(Pool pool); +extern void AMSFinish(Inst inst); extern Bool AMSCheck(AMS ams); extern Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg); diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c index 36b101f5392..4f0392018cf 100644 --- a/mps/code/poolawl.c +++ b/mps/code/poolawl.c @@ -240,7 +240,7 @@ failControlAllocAlloc: failControlAllocScanned: ControlFree(arena, awlseg->mark, tableSize); failControlAllocMark: - NextMethod(Seg, AWLSeg, finish)(seg); + NextMethod(Inst, AWLSeg, finish)(MustBeA(Inst, seg)); failSuperInit: AVER(res != ResOK); return res; @@ -249,8 +249,9 @@ failSuperInit: /* AWLSegFinish -- Finish method for AWL segments */ -static void AWLSegFinish(Seg seg) +static void AWLSegFinish(Inst inst) { + Seg seg = MustBeA(Seg, inst); AWLSeg awlseg = MustBeA(AWLSeg, seg); Pool pool = SegPool(seg); AWL awl = MustBeA(AWLPool, pool); @@ -269,7 +270,7 @@ static void AWLSegFinish(Seg seg) awlseg->sig = SigInvalid; /* finish the superclass fields last */ - NextMethod(Seg, AWLSeg, finish)(seg); + NextMethod(Inst, AWLSeg, finish)(inst); } @@ -279,9 +280,9 @@ DEFINE_CLASS(Seg, AWLSeg, klass) { INHERIT_CLASS(klass, AWLSeg, GCSeg); SegClassMixInNoSplitMerge(klass); /* no support for this (yet) */ + klass->instClassStruct.finish = AWLSegFinish; klass->size = sizeof(AWLSegStruct); klass->init = AWLSegInit; - klass->finish = AWLSegFinish; } @@ -571,7 +572,7 @@ static Res AWLInit(Pool pool, Arena arena, PoolClass klass, ArgList args) return ResOK; failGenInit: - PoolAbsFinish(pool); + NextMethod(Inst, AWLPool, finish)(MustBeA(Inst, pool)); failAbsInit: AVER(res != ResOK); return res; @@ -580,8 +581,9 @@ failAbsInit: /* AWLFinish -- finish an AWL pool */ -static void AWLFinish(Pool pool) +static void AWLFinish(Inst inst) { + Pool pool = MustBeA(AbstractPool, inst); AWL awl = MustBeA(AWLPool, pool); Ring ring, node, nextNode; @@ -589,7 +591,7 @@ static void AWLFinish(Pool pool) RING_FOR(node, ring, nextNode) { Seg seg = SegOfPoolRing(node); AWLSeg awlseg = MustBeA(AWLSeg, seg); - AVER(SegBuffer(seg) == NULL); + AVER(!SegHasBuffer(seg)); AVERT(AWLSeg, awlseg); AVER(awlseg->bufferedGrains == 0); PoolGenFree(awl->pgen, seg, @@ -600,7 +602,8 @@ static void AWLFinish(Pool pool) } awl->sig = SigInvalid; PoolGenFinish(awl->pgen); - PoolAbsFinish(pool); + + NextMethod(Inst, AWLPool, finish)(inst); } @@ -627,7 +630,7 @@ static Res AWLBufferFill(Addr *baseReturn, Addr *limitReturn, /* Only try to allocate in the segment if it is not already */ /* buffered, and has the same ranks as the buffer. */ - if (SegBuffer(seg) == NULL + if (!SegHasBuffer(seg) && SegRankSet(seg) == BufferRankSet(buffer) && AWLGrainsSize(awl, awlseg->freeGrains) >= size && AWLSegAlloc(&base, &limit, awlseg, awl, size)) @@ -715,7 +718,7 @@ static Res AWLWhiten(Pool pool, Trace trace, Seg seg) { AWL awl = MustBeA(AWLPool, pool); AWLSeg awlseg = MustBeA(AWLSeg, seg); - Buffer buffer = SegBuffer(seg); + Buffer buffer; Count agedGrains, uncondemnedGrains; /* All parameters checked by generic PoolWhiten. */ @@ -724,7 +727,7 @@ static Res AWLWhiten(Pool pool, Trace trace, Seg seg) /* see */ AVER(SegWhite(seg) == TraceSetEMPTY); - if(buffer == NULL) { + if (!SegBuffer(&buffer, seg)) { awlRangeWhiten(awlseg, 0, awlseg->grains); uncondemnedGrains = (Count)0; } else { @@ -782,6 +785,8 @@ static void AWLRangeGrey(AWLSeg awlseg, Index base, Index limit) static void AWLGrey(Pool pool, Trace trace, Seg seg) { + Buffer buffer; + AVERT(Pool, pool); AVERT(Trace, trace); AVERT(Seg, seg); @@ -791,9 +796,8 @@ static void AWLGrey(Pool pool, Trace trace, Seg seg) AWLSeg awlseg = MustBeA(AWLSeg, seg); SegSetGrey(seg, TraceSetAdd(SegGrey(seg), trace)); - if (SegBuffer(seg) != NULL) { + if (SegBuffer(&buffer, seg)) { Addr base = SegBase(seg); - Buffer buffer = SegBuffer(seg); AWLRangeGrey(awlseg, 0, @@ -867,7 +871,7 @@ static Res awlScanSinglePass(Bool *anyScannedReturn, AWL awl = MustBeA(AWLPool, pool); AWLSeg awlseg = MustBeA(AWLSeg, seg); Arena arena = PoolArena(pool); - Buffer buffer = SegBuffer(seg); + Buffer buffer; Format format = pool->format; Addr base = SegBase(seg); Addr limit = SegLimit(seg); @@ -880,7 +884,7 @@ static Res awlScanSinglePass(Bool *anyScannedReturn, *anyScannedReturn = FALSE; p = base; - if (buffer != NULL && BufferScanLimit(buffer) != BufferLimit(buffer)) + if (SegBuffer(&buffer, seg) && BufferScanLimit(buffer) != BufferLimit(buffer)) bufferScanLimit = BufferScanLimit(buffer); else bufferScanLimit = limit; @@ -1028,7 +1032,8 @@ static void AWLReclaim(Pool pool, Trace trace, Seg seg) AWL awl = MustBeA(AWLPool, pool); AWLSeg awlseg = MustBeA(AWLSeg, seg); Addr base = SegBase(seg); - Buffer buffer = SegBuffer(seg); + Buffer buffer; + Bool hasBuffer = SegBuffer(&buffer, seg); Format format = pool->format; Count reclaimedGrains = (Count)0; Count preservedInPlaceCount = (Count)0; @@ -1047,7 +1052,7 @@ static void AWLReclaim(Pool pool, Trace trace, Seg seg) continue; } p = awlAddrOfIndex(base, awl, i); - if (buffer != NULL + if (hasBuffer && p == BufferScanLimit(buffer) && BufferScanLimit(buffer) != BufferLimit(buffer)) { @@ -1086,7 +1091,7 @@ static void AWLReclaim(Pool pool, Trace trace, Seg seg) GenDescSurvived(awl->pgen->gen, trace, 0, preservedInPlaceSize); SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace)); - if (awlseg->freeGrains == awlseg->grains && buffer == NULL) { + if (awlseg->freeGrains == awlseg->grains && !hasBuffer) { /* No survivors */ AVER(awlseg->bufferedGrains == 0); PoolGenFree(awl->pgen, seg, @@ -1159,9 +1164,9 @@ static void AWLWalk(Pool pool, Seg seg, FormattedObjectsVisitor f, /* free grain */ Addr next; Index i; + Buffer buffer; - if (SegBuffer(seg) != NULL) { - Buffer buffer = SegBuffer(seg); + if (SegBuffer(&buffer, seg)) { if (object == BufferScanLimit(buffer) && BufferScanLimit(buffer) != BufferLimit(buffer)) { /* skip over buffered area */ @@ -1215,10 +1220,10 @@ DEFINE_CLASS(Pool, AWLPool, klass) { INHERIT_CLASS(klass, AWLPool, AbstractCollectPool); PoolClassMixInFormat(klass); + klass->instClassStruct.finish = AWLFinish; klass->size = sizeof(AWLPoolStruct); klass->varargs = AWLVarargs; klass->init = AWLInit; - klass->finish = AWLFinish; klass->bufferClass = RankBufClassGet; klass->bufferFill = AWLBufferFill; klass->bufferEmpty = AWLBufferEmpty; diff --git a/mps/code/poollo.c b/mps/code/poollo.c index 73faa69950c..e2c6d5834cf 100644 --- a/mps/code/poollo.c +++ b/mps/code/poollo.c @@ -61,7 +61,7 @@ typedef struct LOSegStruct { /* forward decls */ static Res loSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args); -static void loSegFinish(Seg seg); +static void loSegFinish(Inst inst); static Count loSegGrains(LOSeg loseg); @@ -71,9 +71,9 @@ DEFINE_CLASS(Seg, LOSeg, klass) { INHERIT_CLASS(klass, LOSeg, GCSeg); SegClassMixInNoSplitMerge(klass); + klass->instClassStruct.finish = loSegFinish; klass->size = sizeof(LOSegStruct); klass->init = loSegInit; - klass->finish = loSegFinish; } @@ -143,7 +143,7 @@ static Res loSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args) failAllocTable: ControlFree(arena, loseg->mark, tablebytes); failMarkTable: - NextMethod(Seg, LOSeg, finish)(seg); + NextMethod(Inst, LOSeg, finish)(MustBeA(Inst, seg)); failSuperInit: AVER(res != ResOK); return res; @@ -152,8 +152,9 @@ failSuperInit: /* loSegFinish -- Finish method for LO segments */ -static void loSegFinish(Seg seg) +static void loSegFinish(Inst inst) { + Seg seg = MustBeA(Seg, inst); LOSeg loseg = MustBeA(LOSeg, seg); Pool pool = SegPool(seg); Arena arena = PoolArena(pool); @@ -167,7 +168,7 @@ static void loSegFinish(Seg seg) ControlFree(arena, loseg->alloc, tablesize); ControlFree(arena, loseg->mark, tablesize); - NextMethod(Seg, LOSeg, finish)(seg); + NextMethod(Inst, LOSeg, finish)(inst); } @@ -231,7 +232,7 @@ static Bool loSegFindFree(Addr *bReturn, Addr *lReturn, AVER(agrains <= loseg->freeGrains); AVER(size <= SegSize(seg)); - if(SegBuffer(seg) != NULL) + if (SegHasBuffer(seg)) /* Don't bother trying to allocate from a buffered segment */ return FALSE; @@ -312,11 +313,12 @@ static void loSegReclaim(LOSeg loseg, Trace trace) */ p = base; while(p < limit) { - Buffer buffer = SegBuffer(seg); + Buffer buffer; + Bool hasBuffer = SegBuffer(&buffer, seg); Addr q; Index i; - if(buffer != NULL) { + if (hasBuffer) { marked = TRUE; if (p == BufferScanLimit(buffer) && BufferScanLimit(buffer) != BufferLimit(buffer)) { @@ -402,9 +404,9 @@ static void LOWalk(Pool pool, Seg seg, FormattedObjectsVisitor f, Addr object = loAddrOfIndex(base, lo, i); Addr next; Index j; + Buffer buffer; - if(SegBuffer(seg) != NULL) { - Buffer buffer = SegBuffer(seg); + if (SegBuffer(&buffer, seg)) { if(object == BufferScanLimit(buffer) && BufferScanLimit(buffer) != BufferLimit(buffer)) { /* skip over buffered area */ @@ -500,7 +502,7 @@ static Res LOInit(Pool pool, Arena arena, PoolClass klass, ArgList args) return ResOK; failGenInit: - PoolAbsFinish(pool); + NextMethod(Inst, LOPool, finish)(MustBeA(Inst, pool)); failAbsInit: AVER(res != ResOK); return res; @@ -509,15 +511,16 @@ failAbsInit: /* LOFinish -- finish an LO pool */ -static void LOFinish(Pool pool) +static void LOFinish(Inst inst) { + Pool pool = MustBeA(AbstractPool, inst); LO lo = MustBeA(LOPool, pool); Ring node, nextNode; RING_FOR(node, &pool->segRing, nextNode) { Seg seg = SegOfPoolRing(node); LOSeg loseg = MustBeA(LOSeg, seg); - AVER(SegBuffer(seg) == NULL); + AVER(!SegHasBuffer(seg)); AVERT(LOSeg, loseg); AVER(loseg->bufferedGrains == 0); PoolGenFree(lo->pgen, seg, @@ -529,7 +532,8 @@ static void LOFinish(Pool pool) PoolGenFinish(lo->pgen); lo->sig = SigInvalid; - PoolAbsFinish(pool); + + NextMethod(Inst, LOPool, finish)(inst); } @@ -657,8 +661,7 @@ static Res LOWhiten(Pool pool, Trace trace, Seg seg) grains = loSegGrains(loseg); /* Whiten allocated objects; leave free areas black. */ - buffer = SegBuffer(seg); - if (buffer != NULL) { + if (SegBuffer(&buffer, seg)) { Addr base = SegBase(seg); Index scanLimitIndex = loIndexOfAddr(base, lo, BufferScanLimit(buffer)); Index limitIndex = loIndexOfAddr(base, lo, BufferLimit(buffer)); @@ -783,10 +786,10 @@ DEFINE_CLASS(Pool, LOPool, klass) INHERIT_CLASS(klass, LOPool, AbstractSegBufPool); PoolClassMixInFormat(klass); PoolClassMixInCollect(klass); + klass->instClassStruct.finish = LOFinish; klass->size = sizeof(LOStruct); klass->varargs = LOVarargs; klass->init = LOInit; - klass->finish = LOFinish; klass->bufferFill = LOBufferFill; klass->bufferEmpty = LOBufferEmpty; klass->whiten = LOWhiten; diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c index 62b5d45e0b6..9a9b104bd08 100644 --- a/mps/code/poolmfs.c +++ b/mps/code/poolmfs.c @@ -1,7 +1,7 @@ /* poolmfs.c: MANUAL FIXED SMALL UNIT POOL * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * This is the implementation of the MFS pool class. * @@ -39,10 +39,6 @@ SRCID(poolmfs, "$Id$"); -typedef MFS MFSPool; -DECLARE_CLASS(Pool, MFSPool, AbstractPool); - - /* ROUND -- Round up * * Rounds n up to the nearest multiple of unit. @@ -153,14 +149,16 @@ static void MFSTractFreeVisitor(Pool pool, Addr base, Size size, } -static void MFSFinish(Pool pool) +static void MFSFinish(Inst inst) { + Pool pool = MustBeA(AbstractPool, inst); MFS mfs = MustBeA(MFSPool, pool); MFSFinishTracts(pool, MFSTractFreeVisitor, UNUSED_POINTER); mfs->sig = SigInvalid; - PoolAbsFinish(pool); + + NextMethod(Inst, MFSPool, finish)(inst); } @@ -306,8 +304,9 @@ static Size MFSFreeSize(Pool pool) } -static Res MFSDescribe(Pool pool, mps_lib_FILE *stream, Count depth) +static Res MFSDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Pool pool = CouldBeA(AbstractPool, inst); MFS mfs = CouldBeA(MFSPool, pool); Res res; @@ -316,35 +315,35 @@ static Res MFSDescribe(Pool pool, mps_lib_FILE *stream, Count depth) if (stream == NULL) return ResPARAM; - res = WriteF(stream, depth, - "unroundedUnitSize $W\n", (WriteFW)mfs->unroundedUnitSize, - "extendBy $W\n", (WriteFW)mfs->extendBy, - "extendSelf $S\n", WriteFYesNo(mfs->extendSelf), - "unitSize $W\n", (WriteFW)mfs->unitSize, - "freeList $P\n", (WriteFP)mfs->freeList, - "total $W\n", (WriteFW)mfs->total, - "free $W\n", (WriteFW)mfs->free, - "tractList $P\n", (WriteFP)mfs->tractList, - NULL); + res = NextMethod(Inst, MFSPool, describe)(inst, stream, depth); if (res != ResOK) return res; - return ResOK; + return WriteF(stream, depth + 2, + "unroundedUnitSize $W\n", (WriteFW)mfs->unroundedUnitSize, + "extendBy $W\n", (WriteFW)mfs->extendBy, + "extendSelf $S\n", WriteFYesNo(mfs->extendSelf), + "unitSize $W\n", (WriteFW)mfs->unitSize, + "freeList $P\n", (WriteFP)mfs->freeList, + "total $W\n", (WriteFW)mfs->total, + "free $W\n", (WriteFW)mfs->free, + "tractList $P\n", (WriteFP)mfs->tractList, + NULL); } DEFINE_CLASS(Pool, MFSPool, klass) { INHERIT_CLASS(klass, MFSPool, AbstractPool); + klass->instClassStruct.describe = MFSDescribe; + klass->instClassStruct.finish = MFSFinish; klass->size = sizeof(MFSStruct); klass->varargs = MFSVarargs; klass->init = MFSInit; - klass->finish = MFSFinish; klass->alloc = MFSAlloc; klass->free = MFSFree; klass->totalSize = MFSTotalSize; klass->freeSize = MFSFreeSize; - klass->describe = MFSDescribe; } @@ -386,7 +385,7 @@ Bool MFSCheck(MFS mfs) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolmfs.h b/mps/code/poolmfs.h index 70d4124cb42..e17054140c6 100644 --- a/mps/code/poolmfs.h +++ b/mps/code/poolmfs.h @@ -2,7 +2,7 @@ * * $Id$ * - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * The MFS pool is used to manage small fixed-size chunks of memory. It * stores control structures in the memory it manages, rather than to one @@ -32,6 +32,8 @@ #include "mpscmfs.h" typedef struct MFSStruct *MFS; +typedef MFS MFSPool; +DECLARE_CLASS(Pool, MFSPool, AbstractPool); #define MFSPool(mfs) (&(mfs)->poolStruct) @@ -55,7 +57,7 @@ extern void MFSFinishTracts(Pool pool, MFSTractVisitor visitor, /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c index d2b66a1c20f..d378889f1f3 100644 --- a/mps/code/poolmrg.c +++ b/mps/code/poolmrg.c @@ -637,8 +637,9 @@ static Res MRGInit(Pool pool, Arena arena, PoolClass klass, ArgList args) /* MRGFinish -- finish a MRG pool */ -static void MRGFinish(Pool pool) +static void MRGFinish(Inst inst) { + Pool pool = MustBeA(AbstractPool, inst); MRG mrg = MustBeA(MRGPool, pool); Ring node, nextNode; @@ -676,7 +677,7 @@ static void MRGFinish(Pool pool) RingFinish(&mrg->refRing); /* */ - PoolAbsFinish(pool); + NextMethod(Inst, MRGPool, finish)(inst); } @@ -770,8 +771,10 @@ Res MRGDeregister(Pool pool, Ref obj) * This could be improved by implementing MRGSegDescribe * and having MRGDescribe iterate over all the pool's segments. */ -static Res MRGDescribe(Pool pool, mps_lib_FILE *stream, Count depth) + +static Res MRGDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Pool pool = CouldBeA(AbstractPool, inst); MRG mrg = CouldBeA(MRGPool, pool); Arena arena; Ring node, nextNode; @@ -783,20 +786,25 @@ static Res MRGDescribe(Pool pool, mps_lib_FILE *stream, Count depth) if (stream == NULL) return ResPARAM; + res = NextMethod(Inst, MRGPool, describe)(inst, stream, depth); + if (res != ResOK) + return res; + + res = WriteF(stream, depth + 2, "extendBy $W\n", (WriteFW)mrg->extendBy, NULL); + if (res != ResOK) + return res; + + res = WriteF(stream, depth + 2, "Entry queue:\n", NULL); + if (res != ResOK) + return res; arena = PoolArena(pool); - res = WriteF(stream, depth, "extendBy $W\n", (WriteFW)mrg->extendBy, NULL); - if (res != ResOK) - return res; - res = WriteF(stream, depth, "Entry queue:\n", NULL); - if (res != ResOK) - return res; RING_FOR(node, &mrg->entryRing, nextNode) { Bool outsideShield = !ArenaShield(arena)->inside; refPart = MRGRefPartOfLink(linkOfRing(node), arena); if (outsideShield) { ShieldEnter(arena); } - res = WriteF(stream, depth, "at $A Ref $A\n", + res = WriteF(stream, depth + 2, "at $A Ref $A\n", (WriteFA)refPart, (WriteFA)MRGRefPartRef(arena, refPart), NULL); if (outsideShield) { @@ -834,13 +842,13 @@ static Res MRGScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) DEFINE_CLASS(Pool, MRGPool, klass) { INHERIT_CLASS(klass, MRGPool, AbstractPool); + klass->instClassStruct.describe = MRGDescribe; + klass->instClassStruct.finish = MRGFinish; klass->size = sizeof(MRGStruct); klass->init = MRGInit; - klass->finish = MRGFinish; klass->grey = PoolTrivGrey; klass->blacken = PoolTrivBlacken; klass->scan = MRGScan; - klass->describe = MRGDescribe; } diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c index e1d4a19fe27..863e884623d 100644 --- a/mps/code/poolmv.c +++ b/mps/code/poolmv.c @@ -1,7 +1,7 @@ /* poolmv.c: MANUAL VARIABLE POOL * * $Id$ - * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * * **** RESTRICTION: This pool may not allocate from the arena control @@ -305,21 +305,20 @@ static Res MVInit(Pool pool, Arena arena, PoolClass klass, ArgList args) failSpanPoolInit: PoolFinish(mvBlockPool(mv)); failBlockPoolInit: - PoolAbsFinish(pool); + NextMethod(Inst, MVPool, finish)(MustBeA(Inst, pool)); return res; } /* MVFinish -- finish method for class MV */ -static void MVFinish(Pool pool) +static void MVFinish(Inst inst) { - MV mv; + Pool pool = MustBeA(AbstractPool, inst); + MV mv = MustBeA(MVPool, pool); Ring spans, node = NULL, nextNode; /* gcc whinge stop */ MVSpan span; - AVERT(Pool, pool); - mv = PoolMV(pool); AVERT(MV, mv); /* Destroy all the spans attached to the pool. */ @@ -335,7 +334,7 @@ static void MVFinish(Pool pool) PoolFinish(mvBlockPool(mv)); PoolFinish(mvSpanPool(mv)); - PoolAbsFinish(pool); + NextMethod(Inst, MVPool, finish)(inst); } @@ -733,44 +732,46 @@ static Size MVTotalSize(Pool pool) static Size MVFreeSize(Pool pool) { - MV mv; - Size size = 0; - Ring node, next; + MV mv = MustBeA(MVPool, pool); - AVERT(Pool, pool); - mv = PoolMV(pool); - AVERT(MV, mv); - - RING_FOR(node, &mv->spans, next) { - MVSpan span = RING_ELT(MVSpan, spans, node); - AVERT(MVSpan, span); - size += span->free; +#if defined(AVER_AND_CHECK_ALL) + { + Size size = 0; + Ring node, next; + RING_FOR(node, &mv->spans, next) { + MVSpan span = RING_ELT(MVSpan, spans, node); + AVERT(MVSpan, span); + size += span->free; + } + AVER(size == mv->free); } +#endif - AVER(size == mv->free + mv->lost); - return size; + return mv->free + mv->lost; } -static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth) +static Res MVDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Pool pool = CouldBeA(AbstractPool, inst); + MV mv = CouldBeA(MVPool, pool); Res res; - MV mv; MVSpan span; Align step; Size length; char c; Ring spans, node = NULL, nextNode; /* gcc whinge stop */ - if (!TESTT(Pool, pool)) - return ResFAIL; - mv = PoolMV(pool); - if (!TESTT(MV, mv)) - return ResFAIL; + if (!TESTC(MVPool, mv)) + return ResPARAM; if (stream == NULL) - return ResFAIL; + return ResPARAM; - res = WriteF(stream, depth, + res = NextMethod(Inst, MVPool, describe)(inst, stream, depth); + if (res != ResOK) + return res; + + res = WriteF(stream, depth + 2, "blockPool $P ($U)\n", (WriteFP)mvBlockPool(mv), (WriteFU)mvBlockPool(mv)->serial, "spanPool $P ($U)\n", @@ -781,7 +782,8 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth) "free $W\n", (WriteFP)mv->free, "lost $W\n", (WriteFP)mv->lost, NULL); - if(res != ResOK) return res; + if(res != ResOK) + return res; step = pool->alignment; length = 0x40 * step; @@ -791,11 +793,11 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth) Addr i, j; MVBlock block; span = RING_ELT(MVSpan, spans, node); - res = WriteF(stream, depth, "MVSpan $P {\n", (WriteFP)span, NULL); + res = WriteF(stream, depth + 2, "MVSpan $P {\n", (WriteFP)span, NULL); if (res != ResOK) return res; - res = WriteF(stream, depth + 2, + res = WriteF(stream, depth + 4, "span $P\n", (WriteFP)span, "tract $P\n", (WriteFP)span->tract, "free $W\n", (WriteFW)span->free, @@ -815,7 +817,7 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth) block = span->blocks; for(i = span->base.base; i < span->limit.limit; i = AddrAdd(i, length)) { - res = WriteF(stream, depth + 2, "$A ", (WriteFA)i, NULL); + res = WriteF(stream, depth + 4, "$A ", (WriteFA)i, NULL); if (res != ResOK) return res; @@ -847,7 +849,7 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth) if (res != ResOK) return res; } - res = WriteF(stream, depth, "} MVSpan $P\n", (WriteFP)span, NULL); + res = WriteF(stream, depth + 2, "} MVSpan $P\n", (WriteFP)span, NULL); if (res != ResOK) return res; } @@ -862,15 +864,15 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth) DEFINE_CLASS(Pool, MVPool, klass) { INHERIT_CLASS(klass, MVPool, AbstractBufferPool); + klass->instClassStruct.describe = MVDescribe; + klass->instClassStruct.finish = MVFinish; klass->size = sizeof(MVStruct); klass->varargs = MVVarargs; klass->init = MVInit; - klass->finish = MVFinish; klass->alloc = MVAlloc; klass->free = MVFree; klass->totalSize = MVTotalSize; klass->freeSize = MVFreeSize; - klass->describe = MVDescribe; } @@ -927,7 +929,7 @@ Bool MVCheck(MV mv) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c index b11f6b65762..9e25fd05120 100644 --- a/mps/code/poolmv2.c +++ b/mps/code/poolmv2.c @@ -1,7 +1,7 @@ /* poolmv2.c: MANUAL VARIABLE-SIZED TEMPORAL POOL * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .purpose: A manual-variable pool designed to take advantage of * placement according to predicted deathtime. @@ -33,12 +33,12 @@ typedef struct MVTStruct *MVT; static void MVTVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs); static Res MVTInit(Pool pool, Arena arena, PoolClass klass, ArgList arg); static Bool MVTCheck(MVT mvt); -static void MVTFinish(Pool pool); +static void MVTFinish(Inst inst); static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn, Pool pool, Buffer buffer, Size minSize); static void MVTBufferEmpty(Pool pool, Buffer buffer, Addr base, Addr limit); static void MVTFree(Pool pool, Addr base, Size size); -static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth); +static Res MVTDescribe(Inst inst, mps_lib_FILE *stream, Count depth); static Size MVTTotalSize(Pool pool); static Size MVTFreeSize(Pool pool); static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size); @@ -139,16 +139,16 @@ typedef struct MVTStruct DEFINE_CLASS(Pool, MVTPool, klass) { INHERIT_CLASS(klass, MVTPool, AbstractBufferPool); + klass->instClassStruct.describe = MVTDescribe; + klass->instClassStruct.finish = MVTFinish; klass->size = sizeof(MVTStruct); klass->varargs = MVTVarargs; klass->init = MVTInit; - klass->finish = MVTFinish; klass->free = MVTFree; klass->bufferFill = MVTBufferFill; klass->bufferEmpty = MVTBufferEmpty; klass->totalSize = MVTTotalSize; klass->freeSize = MVTFreeSize; - klass->describe = MVTDescribe; } /* Macros */ @@ -376,7 +376,7 @@ failFreeLandInit: failFreeSecondaryInit: LandFinish(MVTFreePrimary(mvt)); failFreePrimaryInit: - PoolAbsFinish(pool); + NextMethod(Inst, MVTPool, finish)(MustBeA(Inst, pool)); failAbsInit: AVER(res != ResOK); return res; @@ -421,18 +421,15 @@ static Bool MVTCheck(MVT mvt) /* MVTFinish -- finish an MVT pool */ -static void MVTFinish(Pool pool) +static void MVTFinish(Inst inst) { - MVT mvt; - Arena arena; + Pool pool = MustBeA(AbstractPool, inst); + MVT mvt = MustBeA(MVTPool, pool); + Arena arena = PoolArena(pool); Ring ring; Ring node, nextNode; - AVERT(Pool, pool); - mvt = PoolMVT(pool); AVERT(MVT, mvt); - arena = PoolArena(pool); - AVERT(Arena, arena); mvt->sig = SigInvalid; @@ -450,7 +447,8 @@ static void MVTFinish(Pool pool) LandFinish(MVTFreeLand(mvt)); LandFinish(MVTFreeSecondary(mvt)); LandFinish(MVTFreePrimary(mvt)); - PoolAbsFinish(pool); + + NextMethod(Inst, MVTPool, finish)(inst); } @@ -1023,36 +1021,37 @@ static Size MVTFreeSize(Pool pool) /* MVTDescribe -- describe an MVT pool */ -static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth) +static Res MVTDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Pool pool = CouldBeA(AbstractPool, inst); + MVT mvt = CouldBeA(MVTPool, pool); Res res; - MVT mvt; - if (!TESTT(Pool, pool)) - return ResFAIL; - mvt = PoolMVT(pool); - if (!TESTT(MVT, mvt)) - return ResFAIL; + if (!TESTC(MVTPool, mvt)) + return ResPARAM; if (stream == NULL) return ResFAIL; - res = WriteF(stream, depth, - "MVT $P {\n", (WriteFP)mvt, - " minSize: $U\n", (WriteFU)mvt->minSize, - " meanSize: $U\n", (WriteFU)mvt->meanSize, - " maxSize: $U\n", (WriteFU)mvt->maxSize, - " fragLimit: $U\n", (WriteFU)mvt->fragLimit, - " reuseSize: $U\n", (WriteFU)mvt->reuseSize, - " fillSize: $U\n", (WriteFU)mvt->fillSize, - " availLimit: $U\n", (WriteFU)mvt->availLimit, - " abqOverflow: $S\n", WriteFYesNo(mvt->abqOverflow), - " splinter: $S\n", WriteFYesNo(mvt->splinter), - " splinterBase: $A\n", (WriteFA)mvt->splinterBase, - " splinterLimit: $A\n", (WriteFU)mvt->splinterLimit, - " size: $U\n", (WriteFU)mvt->size, - " allocated: $U\n", (WriteFU)mvt->allocated, - " available: $U\n", (WriteFU)mvt->available, - " unavailable: $U\n", (WriteFU)mvt->unavailable, + res = NextMethod(Inst, MVTPool, describe)(inst, stream, depth); + if (res != ResOK) + return res; + + res = WriteF(stream, depth + 2, + "minSize: $U\n", (WriteFU)mvt->minSize, + "meanSize: $U\n", (WriteFU)mvt->meanSize, + "maxSize: $U\n", (WriteFU)mvt->maxSize, + "fragLimit: $U\n", (WriteFU)mvt->fragLimit, + "reuseSize: $U\n", (WriteFU)mvt->reuseSize, + "fillSize: $U\n", (WriteFU)mvt->fillSize, + "availLimit: $U\n", (WriteFU)mvt->availLimit, + "abqOverflow: $S\n", WriteFYesNo(mvt->abqOverflow), + "splinter: $S\n", WriteFYesNo(mvt->splinter), + "splinterBase: $A\n", (WriteFA)mvt->splinterBase, + "splinterLimit: $A\n", (WriteFU)mvt->splinterLimit, + "size: $U\n", (WriteFU)mvt->size, + "allocated: $U\n", (WriteFU)mvt->allocated, + "available: $U\n", (WriteFU)mvt->available, + "unavailable: $U\n", (WriteFU)mvt->unavailable, NULL); if (res != ResOK) return res; @@ -1103,8 +1102,7 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth) METER_WRITE(mvt->exceptionSplinters, stream, depth + 2); METER_WRITE(mvt->exceptionReturns, stream, depth + 2); - res = WriteF(stream, depth, "} MVT $P\n", (WriteFP)mvt, NULL); - return res; + return ResOK; } @@ -1353,23 +1351,9 @@ static Bool MVTCheckFit(Addr base, Addr limit, Size min, Arena arena) } -/* Return the CBS of an MVT pool for the benefit of fotest.c. */ - -extern Land _mps_mvt_cbs(Pool); -Land _mps_mvt_cbs(Pool pool) { - MVT mvt; - - AVERT(Pool, pool); - mvt = PoolMVT(pool); - AVERT(MVT, mvt); - - return MVTFreePrimary(mvt); -} - - /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c index 5269f233a3e..5264004a6a4 100644 --- a/mps/code/poolmvff.c +++ b/mps/code/poolmvff.c @@ -1,7 +1,7 @@ /* poolmvff.c: First Fit Manual Variable Pool * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * * .purpose: This is a pool class for manually managed objects of @@ -297,7 +297,11 @@ static Res mvffFindFree(Range rangeReturn, MVFF mvff, Size size, } -/* MVFFAlloc -- Allocate a block */ +/* MVFFAlloc -- Allocate a block + * + * .alloc.critical: In manual-allocation-bound programs this is on the + * critical path. + */ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size) { @@ -307,11 +311,11 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size) LandFindMethod findMethod; FindDelete findDelete; - AVER(aReturn != NULL); - AVERT(Pool, pool); + AVER_CRITICAL(aReturn != NULL); + AVERT_CRITICAL(Pool, pool); mvff = PoolMVFF(pool); - AVERT(MVFF, mvff); - AVER(size > 0); + AVERT_CRITICAL(MVFF, mvff); + AVER_CRITICAL(size > 0); size = SizeAlignUp(size, PoolAlignment(pool)); findMethod = mvff->firstFit ? LandFindFirst : LandFindLast; @@ -321,13 +325,17 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size) if (res != ResOK) return res; - AVER(RangeSize(&range) == size); + AVER_CRITICAL(RangeSize(&range) == size); *aReturn = RangeBase(&range); return ResOK; } -/* MVFFFree -- free the given block */ +/* MVFFFree -- free the given block + * + * .free.critical: In manual-allocation-bound programs this is on the + * critical path. + */ static void MVFFFree(Pool pool, Addr old, Size size) { @@ -335,18 +343,18 @@ static void MVFFFree(Pool pool, Addr old, Size size) RangeStruct range, coalescedRange; MVFF mvff; - AVERT(Pool, pool); + AVERT_CRITICAL(Pool, pool); mvff = PoolMVFF(pool); - AVERT(MVFF, mvff); + AVERT_CRITICAL(MVFF, mvff); - AVER(old != (Addr)0); - AVER(AddrIsAligned(old, PoolAlignment(pool))); - AVER(size > 0); + AVER_CRITICAL(old != (Addr)0); + AVER_CRITICAL(AddrIsAligned(old, PoolAlignment(pool))); + AVER_CRITICAL(size > 0); RangeInitSize(&range, old, SizeAlignUp(size, PoolAlignment(pool))); res = LandInsert(&coalescedRange, MVFFFreeLand(mvff), &range); /* Insertion must succeed because it fails over to a Freelist. */ - AVER(res == ResOK); + AVER_CRITICAL(res == ResOK); MVFFReduce(mvff); } @@ -578,7 +586,7 @@ failFreePrimaryInit: failTotalLandInit: PoolFinish(MVFFBlockPool(mvff)); failBlockPoolInit: - PoolAbsFinish(pool); + NextMethod(Inst, MVFFPool, finish)(MustBeA(Inst, pool)); failAbsInit: AVER(res != ResOK); return res; @@ -604,13 +612,12 @@ static Bool mvffFinishVisitor(Bool *deleteReturn, Land land, Range range, return TRUE; } -static void MVFFFinish(Pool pool) +static void MVFFFinish(Inst inst) { - MVFF mvff; + Pool pool = MustBeA(AbstractPool, inst); + MVFF mvff = MustBeA(MVFFPool, pool); Bool b; - AVERT(Pool, pool); - mvff = PoolMVFF(pool); AVERT(MVFF, mvff); mvff->sig = SigInvalid; @@ -623,7 +630,7 @@ static void MVFFFinish(Pool pool) LandFinish(MVFFFreePrimary(mvff)); LandFinish(MVFFTotalLand(mvff)); PoolFinish(MVFFBlockPool(mvff)); - PoolAbsFinish(pool); + NextMethod(Inst, MVFFPool, finish)(inst); } @@ -671,28 +678,27 @@ static Size MVFFFreeSize(Pool pool) /* MVFFDescribe -- describe an MVFF pool */ -static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream, Count depth) +static Res MVFFDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Pool pool = CouldBeA(AbstractPool, inst); + MVFF mvff = CouldBeA(MVFFPool, pool); Res res; - MVFF mvff; - if (!TESTT(Pool, pool)) - return ResFAIL; - mvff = PoolMVFF(pool); - if (!TESTT(MVFF, mvff)) - return ResFAIL; + if (!TESTC(MVFFPool, mvff)) + return ResPARAM; if (stream == NULL) - return ResFAIL; + return ResPARAM; - res = WriteF(stream, depth, - "MVFF $P {\n", (WriteFP)mvff, - " pool $P ($U)\n", - (WriteFP)pool, (WriteFU)pool->serial, - " extendBy $W\n", (WriteFW)mvff->extendBy, - " avgSize $W\n", (WriteFW)mvff->avgSize, - " firstFit $U\n", (WriteFU)mvff->firstFit, - " slotHigh $U\n", (WriteFU)mvff->slotHigh, - " spare $D\n", (WriteFD)mvff->spare, + res = NextMethod(Inst, MVFFPool, describe)(inst, stream, depth); + if (res != ResOK) + return res; + + res = WriteF(stream, depth + 2, + "extendBy $W\n", (WriteFW)mvff->extendBy, + "avgSize $W\n", (WriteFW)mvff->avgSize, + "firstFit $U\n", (WriteFU)mvff->firstFit, + "slotHigh $U\n", (WriteFU)mvff->slotHigh, + "spare $D\n", (WriteFD)mvff->spare, NULL); if (res != ResOK) return res; @@ -716,8 +722,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream, Count depth) if (res != ResOK) return res; - res = WriteF(stream, depth, "} MVFF $P\n", (WriteFP)mvff, NULL); - return res; + return ResOK; } @@ -725,17 +730,17 @@ DEFINE_CLASS(Pool, MVFFPool, klass) { INHERIT_CLASS(klass, MVFFPool, AbstractPool); PoolClassMixInBuffer(klass); + klass->instClassStruct.describe = MVFFDescribe; + klass->instClassStruct.finish = MVFFFinish; klass->size = sizeof(MVFFStruct); klass->varargs = MVFFVarargs; klass->init = MVFFInit; - klass->finish = MVFFFinish; klass->alloc = MVFFAlloc; klass->free = MVFFFree; klass->bufferFill = MVFFBufferFill; klass->bufferEmpty = MVFFBufferEmpty; klass->totalSize = MVFFTotalSize; klass->freeSize = MVFFFreeSize; - klass->describe = MVFFDescribe; } @@ -799,23 +804,9 @@ static Bool MVFFCheck(MVFF mvff) } -/* Return the CBS of an MVFF pool for the benefit of fotest.c. */ - -extern Land _mps_mvff_cbs(Pool); -Land _mps_mvff_cbs(Pool pool) { - MVFF mvff; - - AVERT(Pool, pool); - mvff = PoolMVFF(pool); - AVERT(MVFF, mvff); - - return MVFFFreePrimary(mvff); -} - - /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/pooln.c b/mps/code/pooln.c index 66986dafc0d..eb501244b24 100644 --- a/mps/code/pooln.c +++ b/mps/code/pooln.c @@ -65,14 +65,15 @@ failAbsInit: /* NFinish -- finish method for class N */ -static void NFinish(Pool pool) +static void NFinish(Inst inst) { + Pool pool = MustBeA(AbstractPool, inst); PoolN poolN = MustBeA(NPool, pool); /* Finish pool-specific structures. */ UNUSED(poolN); - PoolAbsFinish(pool); + NextMethod(Inst, NPool, finish)(inst); } @@ -139,12 +140,17 @@ static void NBufferEmpty(Pool pool, Buffer buffer, /* NDescribe -- describe method for class N */ -static Res NDescribe(Pool pool, mps_lib_FILE *stream, Count depth) +static Res NDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { - PoolN poolN = MustBeA(NPool, pool); + Pool pool = CouldBeA(AbstractPool, inst); + PoolN poolN = CouldBeA(NPool, pool); + Res res; - UNUSED(stream); /* TODO: should output something here */ - UNUSED(depth); + res = NextMethod(Inst, NPool, describe)(inst, stream, depth); + if (res != ResOK) + return res; + + /* This is where you'd output some information about pool fields. */ UNUSED(poolN); return ResOK; @@ -251,10 +257,11 @@ static void NTraceEnd(Pool pool, Trace trace) DEFINE_CLASS(Pool, NPool, klass) { INHERIT_CLASS(klass, NPool, AbstractPool); + klass->instClassStruct.describe = NDescribe; + klass->instClassStruct.finish = NFinish; klass->size = sizeof(PoolNStruct); klass->attr |= AttrGC; klass->init = NInit; - klass->finish = NFinish; klass->alloc = NAlloc; klass->free = NFree; klass->bufferFill = NBufferFill; @@ -267,7 +274,6 @@ DEFINE_CLASS(Pool, NPool, klass) klass->fixEmergency = NFix; klass->reclaim = NReclaim; klass->traceEnd = NTraceEnd; - klass->describe = NDescribe; AVERT(PoolClass, klass); } diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c index db0cb5f6173..18cb3f8481d 100644 --- a/mps/code/poolsnc.c +++ b/mps/code/poolsnc.c @@ -138,8 +138,9 @@ static Res SNCBufInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args) /* SNCBufFinish -- Finish an SNCBuf */ -static void SNCBufFinish(Buffer buffer) +static void SNCBufFinish(Inst inst) { + Buffer buffer = MustBeA(Buffer, inst); SNCBuf sncbuf = MustBeA(SNCBuf, buffer); SNC snc = MustBeA(SNCPool, BufferPool(buffer)); @@ -148,7 +149,7 @@ static void SNCBufFinish(Buffer buffer) sncbuf->sig = SigInvalid; - NextMethod(Buffer, SNCBuf, finish)(buffer); + NextMethod(Inst, SNCBuf, finish)(inst); } @@ -157,9 +158,9 @@ static void SNCBufFinish(Buffer buffer) DEFINE_CLASS(Buffer, SNCBuf, klass) { INHERIT_CLASS(klass, SNCBuf, RankBuf); + klass->instClassStruct.finish = SNCBufFinish; klass->size = sizeof(SNCBufStruct); klass->init = SNCBufInit; - klass->finish = SNCBufFinish; } @@ -380,13 +381,12 @@ static Res SNCInit(Pool pool, Arena arena, PoolClass klass, ArgList args) /* SNCFinish -- finish an SNC pool */ -static void SNCFinish(Pool pool) +static void SNCFinish(Inst inst) { - SNC snc; + Pool pool = MustBeA(AbstractPool, inst); + SNC snc = MustBeA(SNCPool, pool); Ring ring, node, nextNode; - AVERT(Pool, pool); - snc = PoolSNC(pool); AVERT(SNC, snc); ring = &pool->segRing; @@ -396,7 +396,7 @@ static void SNCFinish(Pool pool) SegFree(seg); } - PoolAbsFinish(pool); + NextMethod(Inst, SNCPool, finish)(inst); } @@ -560,14 +560,15 @@ static Res SNCFramePop(Pool pool, Buffer buf, AllocFrame frame) Arena arena; Seg seg = NULL; /* suppress "may be used uninitialized" */ Bool foundSeg; + Buffer segBuf; arena = PoolArena(pool); addr = (Addr)frame; foundSeg = SegOfAddr(&seg, arena, addr); - AVER(foundSeg); + AVER(foundSeg); /* */ AVER(SegPool(seg) == pool); - if (SegBuffer(seg) == buf) { + if (SegBuffer(&segBuf, seg) && segBuf == buf) { /* don't need to change the segment - just the alloc pointers */ AVER(addr <= BufferScanLimit(buf)); /* check direction of pop */ BufferSetAllocAddr(buf, addr); @@ -668,10 +669,10 @@ DEFINE_CLASS(Pool, SNCPool, klass) { INHERIT_CLASS(klass, SNCPool, AbstractScanPool); PoolClassMixInFormat(klass); + klass->instClassStruct.finish = SNCFinish; klass->size = sizeof(SNCStruct); klass->varargs = SNCVarargs; klass->init = SNCInit; - klass->finish = SNCFinish; klass->bufferFill = SNCBufferFill; klass->bufferEmpty = SNCBufferEmpty; klass->scan = SNCScan; diff --git a/mps/code/protocol.c b/mps/code/protocol.c index 84f8002f506..1f3a648975c 100644 --- a/mps/code/protocol.c +++ b/mps/code/protocol.c @@ -47,6 +47,11 @@ static void InstClassInitInternal(InstClass klass) klass->level = 0; klass->display[klass->level] = CLASS_ID(Inst); + /* Generic methods */ + klass->describe = InstDescribe; + klass->finish = InstFinish; + klass->init = InstInit; + /* We can't call CLASS(InstClass) here because it causes a loop back to here, so we have to tie this knot specially. */ klass->instStruct.klass = &CLASS_STATIC(InstClass); @@ -70,6 +75,9 @@ Bool InstClassCheck(InstClass klass) for (i = klass->level + 1; i < ClassDEPTH; ++i) { CHECKL(klass->display[i] == NULL); } + CHECKL(FUNCHECK(klass->describe)); + CHECKL(FUNCHECK(klass->finish)); + CHECKL(FUNCHECK(klass->init)); return TRUE; } @@ -101,7 +109,10 @@ static InstClassStruct invalidClassStruct = { /* .name = */ "Invalid", /* .superclass = */ &invalidClassStruct, /* .level = */ 0, - /* .display = */ {(ClassId)&invalidClassStruct} + /* .display = */ {(ClassId)&invalidClassStruct}, + /* .describe = */ NULL, + /* .finish = */ NULL, + /* .init = */ NULL, }; void InstFinish(Inst inst) @@ -143,8 +154,8 @@ Res InstDescribe(Inst inst, mps_lib_FILE *stream, Count depth) klass = ClassOfPoly(Inst, inst); return WriteF(stream, depth, - "$S $P\n", (WriteFS)ClassName(klass), inst, - NULL); + "$S $P\n", (WriteFS)ClassName(klass), inst, + NULL); } diff --git a/mps/code/protocol.h b/mps/code/protocol.h index 071e31e7a7d..6e569486d48 100644 --- a/mps/code/protocol.h +++ b/mps/code/protocol.h @@ -117,13 +117,13 @@ typedef void *ClassId; LockClaimGlobalRecursive(); \ if (CLASS_GUARDIAN(className) == FALSE) { \ CLASS_INIT(className)(klass); \ - /* Prevent infinite regress. */ \ - if (CLASS_ID(className) != CLASS_ID(InstClass) && \ - CLASS_ID(className) != CLASS_ID(Inst)) \ + /* Prevent infinite regress. */ \ + if (CLASS_ID(className) != CLASS_ID(InstClass) && \ + CLASS_ID(className) != CLASS_ID(Inst)) \ SetClassOfPoly(klass, CLASS(KIND_CLASS(kind))); \ AVER(CLASS_CHECK(kind)(klass)); \ CLASS_GUARDIAN(className) = TRUE; \ - ClassRegister(MustBeA(InstClass, klass)); \ + ClassRegister(MustBeA(InstClass, klass)); \ } \ LockReleaseGlobalRecursive(); \ } \ @@ -177,6 +177,9 @@ typedef struct InstStruct { typedef const char *ClassName; typedef unsigned char ClassLevel; +typedef Res (*DescribeMethod)(Inst inst, mps_lib_FILE *stream, Count depth); +typedef void (*InstInitMethod)(Inst inst); +typedef void (*FinishMethod)(Inst inst); #define ClassDEPTH 8 /* maximum depth of class hierarchy */ #define InstClassSig ((Sig)0x519B1452) /* SIGnature Protocol INST */ @@ -188,6 +191,9 @@ typedef struct InstClassStruct { InstClass superclass; /* pointer to direct superclass */ ClassLevel level; /* distance from root of class hierarchy */ ClassId display[ClassDEPTH]; /* classes at this level and above */ + DescribeMethod describe; /* write a debugging description */ + FinishMethod finish; /* finish instance */ + InstInitMethod init; /* base init method */ } InstClassStruct; enum {ClassLevelNoSuper = -1}; @@ -248,15 +254,15 @@ extern void ClassRegister(InstClass klass); #define MustBeA(_class, inst) \ CouldBeA(_class, \ - AVERPC(IsNonNullAndA(_class, inst), \ - "MustBeA " #_class ": " #inst, \ - inst)) + AVERPC(IsNonNullAndA(_class, inst), \ + "MustBeA " #_class ": " #inst, \ + inst)) #define MustBeA_CRITICAL(_class, inst) \ CouldBeA(_class, \ - AVERPC_CRITICAL(IsNonNullAndA(_class, inst), \ - "MustBeA " #_class ": " #inst, \ - inst)) + AVERPC_CRITICAL(IsNonNullAndA(_class, inst), \ + "MustBeA " #_class ": " #inst, \ + inst)) /* Protocol introspection interface diff --git a/mps/code/protxc.c b/mps/code/protxc.c index 7e8f230d061..f955e438286 100644 --- a/mps/code/protxc.c +++ b/mps/code/protxc.c @@ -1,7 +1,7 @@ /* protxc.c: PROTECTION EXCEPTION HANDLER FOR OS X MACH * * $Id$ - * Copyright (c) 2013-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2013-2016 Ravenbrook Limited. See end of file for license. * * This is the protection exception handling code for OS X using the * Mach interface (not pthreads). @@ -292,7 +292,7 @@ static void *protCatchThread(void *p) { extern void ProtThreadRegister(Bool setup) { kern_return_t kr; - mach_msg_type_number_t old_exception_count; + mach_msg_type_number_t old_exception_count = 1; exception_mask_t old_exception_masks; exception_behavior_t behavior; mach_port_t old_exception_ports; @@ -338,7 +338,8 @@ extern void ProtThreadRegister(Bool setup) mach_error("ERROR: MPS thread_swap_exception_ports", kr); /* .trans.must */ AVER(old_exception_masks == EXC_MASK_BAD_ACCESS); AVER(old_exception_count == 1); - AVER(old_exception_ports == MACH_PORT_NULL); /* .assume.only-port */ + AVER(old_exception_ports == MACH_PORT_NULL + || old_exception_ports == protExcPort); /* .assume.only-port */ } @@ -401,7 +402,7 @@ void ProtSetup(void) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2013-2014 Ravenbrook Limited . + * Copyright (C) 2013-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/pthrdext.c b/mps/code/pthrdext.c index 59d5899c326..19f39c0b470 100644 --- a/mps/code/pthrdext.c +++ b/mps/code/pthrdext.c @@ -1,7 +1,7 @@ /* pthreadext.c: POSIX THREAD EXTENSIONS * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .purpose: Provides extension to Pthreads. * @@ -28,15 +28,6 @@ SRCID(pthreadext, "$Id$"); -/* PTHREADEXT_SIGSUSPEND, PTHREADEXT_SIGRESUME -- signals used - * - * See - */ - -#define PTHREADEXT_SIGSUSPEND SIGXFSZ -#define PTHREADEXT_SIGRESUME SIGXCPU - - /* Static data initialized on first use of the module * See .* */ @@ -366,7 +357,7 @@ unlock: /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/root.c b/mps/code/root.c index c241430ab63..e6322a60d9b 100644 --- a/mps/code/root.c +++ b/mps/code/root.c @@ -129,6 +129,14 @@ Bool RootCheck(Root root) scan. */ break; + case RootTHREAD: + CHECKD_NOSIG(Thread, root->the.thread.thread); /* */ + CHECKL(FUNCHECK(root->the.thread.scan_area)); + /* Can't check anything about closure as it could mean anything to + scan_area. */ + /* Can't check anything about stackCold. */ + break; + case RootTHREAD_TAGGED: CHECKD_NOSIG(Thread, root->the.thread.thread); /* */ CHECKL(FUNCHECK(root->the.thread.scan_area)); diff --git a/mps/code/sacss.c b/mps/code/sacss.c index d85b3ae5073..59550490910 100644 --- a/mps/code/sacss.c +++ b/mps/code/sacss.c @@ -1,7 +1,7 @@ /* sacss.c: SAC MANUAL ALLOC STRESS TEST * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. */ @@ -74,11 +74,12 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align, /* allocate a load of objects */ for (i = 0; i < testSetSIZE; ++i) { + mps_addr_t obj; ss[i] = (*size)(i); - - res = make((mps_addr_t *)&ps[i], sac, ss[i]); + res = make(&obj, sac, ss[i]); if (res != MPS_RES_OK) return res; + ps[i] = obj; if (ss[i] >= sizeof(ps[i])) *ps[i] = 1; /* Write something, so it gets swap. */ } @@ -113,17 +114,19 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align, } /* allocate some new objects */ for (i=testSetSIZE/2; i. + * Copyright (c) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/seg.c b/mps/code/seg.c index e3786ebb053..eb2c5c37a39 100644 --- a/mps/code/seg.c +++ b/mps/code/seg.c @@ -127,8 +127,7 @@ static Res SegAbsInit(Seg seg, Pool pool, Addr base, Size size, ArgList args) AVER(SizeIsArenaGrains(size, arena)); AVERT(ArgList, args); - /* Superclass init */ - InstInit(CouldBeA(Inst, seg)); + NextMethod(Inst, Seg, init)(CouldBeA(Inst, seg)); limit = AddrAdd(base, size); seg->limit = limit; @@ -187,8 +186,9 @@ static Res SegInit(Seg seg, SegClass klass, Pool pool, Addr base, Size size, Arg /* SegFinish -- finish a segment */ -static void SegAbsFinish(Seg seg) +static void SegAbsFinish(Inst inst) { + Seg seg = MustBeA(Seg, inst); Arena arena; Addr addr, limit; Tract tract; @@ -241,7 +241,7 @@ static void SegAbsFinish(Seg seg) static void SegFinish(Seg seg) { AVERC(Seg, seg); - Method(Seg, seg, finish)(seg); + Method(Inst, seg, finish)(MustBeA(Inst, seg)); } @@ -327,12 +327,21 @@ void SegSetRankAndSummary(Seg seg, RankSet rankSet, RefSet summary) } -/* SegBuffer -- return the buffer of a segment */ +/* SegHasBuffer -- segment has a buffer? */ -Buffer SegBuffer(Seg seg) +Bool SegHasBuffer(Seg seg) +{ + Buffer buffer; + return SegBuffer(&buffer, seg); +} + + +/* SegBuffer -- get the buffer of a segment */ + +Bool SegBuffer(Buffer *bufferReturn, Seg seg) { AVERT_CRITICAL(Seg, seg); /* .seg.critical */ - return Method(Seg, seg, buffer)(seg); + return Method(Seg, seg, buffer)(bufferReturn, seg); } @@ -341,12 +350,20 @@ Buffer SegBuffer(Seg seg) void SegSetBuffer(Seg seg, Buffer buffer) { AVERT(Seg, seg); - if (buffer != NULL) - AVERT(Buffer, buffer); + AVERT(Buffer, buffer); Method(Seg, seg, setBuffer)(seg, buffer); } +/* SegUnsetBuffer -- remove the buffer from a segment */ + +void SegUnsetBuffer(Seg seg) +{ + AVERT(Seg, seg); + Method(Seg, seg, unsetBuffer)(seg); +} + + /* SegBufferScanLimit -- limit of scannable objects in segment */ Addr SegBufferScanLimit(Seg seg) @@ -356,8 +373,7 @@ Addr SegBufferScanLimit(Seg seg) AVERT(Seg, seg); - buf = SegBuffer(seg); - if (buf == NULL) { + if (!SegBuffer(&buf, seg)) { /* Segment is unbuffered: entire segment scannable */ limit = SegLimit(seg); } else { @@ -370,61 +386,58 @@ Addr SegBufferScanLimit(Seg seg) /* SegDescribe -- describe a segment */ -Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) +Res SegAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + Seg seg = CouldBeA(Seg, inst); Res res; Pool pool; - SegClass klass; if (!TESTC(Seg, seg)) return ResPARAM; if (stream == NULL) return ResPARAM; - pool = SegPool(seg); - klass = ClassOfPoly(Seg, seg); + res = NextMethod(Inst, Seg, describe)(inst, stream, depth); + if (res != ResOK) + return res; - res = WriteF(stream, depth, - "Segment $P [$A,$A) {\n", (WriteFP)seg, - (WriteFA)SegBase(seg), (WriteFA)SegLimit(seg), - " class $P (\"$S\")\n", - (WriteFP)klass, (WriteFS)ClassName(klass), - " pool $P ($U)\n", - (WriteFP)pool, (WriteFU)pool->serial, - " depth $U\n", seg->depth, - " pm", + pool = SegPool(seg); + + res = WriteF(stream, depth + 2, + "base $A\n", (WriteFA)SegBase(seg), + "limit $A\n", (WriteFA)SegLimit(seg), + "pool $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial, + "depth $U\n", seg->depth, + "pm", seg->pm == AccessSetEMPTY ? " EMPTY" : "", seg->pm & AccessREAD ? " READ" : "", seg->pm & AccessWRITE ? " WRITE" : "", "\n", - " sm", + "sm", seg->sm == AccessSetEMPTY ? " EMPTY" : "", seg->sm & AccessREAD ? " READ" : "", seg->sm & AccessWRITE ? " WRITE" : "", "\n", - " grey $B\n", (WriteFB)seg->grey, - " white $B\n", (WriteFB)seg->white, - " nailed $B\n", (WriteFB)seg->nailed, - " rankSet", + "grey $B\n", (WriteFB)seg->grey, + "white $B\n", (WriteFB)seg->white, + "nailed $B\n", (WriteFB)seg->nailed, + "rankSet", seg->rankSet == RankSetEMPTY ? " EMPTY" : "", BS_IS_MEMBER(seg->rankSet, RankAMBIG) ? " AMBIG" : "", BS_IS_MEMBER(seg->rankSet, RankEXACT) ? " EXACT" : "", BS_IS_MEMBER(seg->rankSet, RankFINAL) ? " FINAL" : "", BS_IS_MEMBER(seg->rankSet, RankWEAK) ? " WEAK" : "", + "\n", NULL); if (res != ResOK) return res; - res = Method(Seg, seg, describe)(seg, stream, depth + 2); - if (res != ResOK) - return res; + return ResOK; +} - res = WriteF(stream, 0, "\n", NULL); - if (res != ResOK) - return res; - - res = WriteF(stream, depth, "} Segment $P\n", (WriteFP)seg, NULL); - return res; +Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) +{ + return Method(Inst, seg, describe)(MustBeA(Inst, seg), stream, depth); } @@ -626,6 +639,7 @@ Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at) Arena arena; Res res; void *p; + Buffer buffer; AVER(NULL != segLoReturn); AVER(NULL != segHiReturn); @@ -641,7 +655,7 @@ Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at) /* Can only split a buffered segment if the entire buffer is below * the split point. */ - AVER(SegBuffer(seg) == NULL || BufferLimit(SegBuffer(seg)) <= at); + AVER(!SegBuffer(&buffer, seg) || BufferLimit(buffer) <= at); if (seg->queued) ShieldFlush(arena); /* see */ @@ -823,11 +837,12 @@ static void segNoSetRankSummary(Seg seg, RankSet rankSet, RefSet summary) /* segNoBuffer -- non-method to return the buffer of a segment */ -static Buffer segNoBuffer(Seg seg) +static Bool segNoBuffer(Buffer *bufferReturn, Seg seg) { AVERT(Seg, seg); + AVER(bufferReturn != NULL); NOTREACHED; - return NULL; + return FALSE; } @@ -836,8 +851,16 @@ static Buffer segNoBuffer(Seg seg) static void segNoSetBuffer(Seg seg, Buffer buffer) { AVERT(Seg, seg); - if (buffer != NULL) - AVERT(Buffer, buffer); + AVERT(Buffer, buffer); + NOTREACHED; +} + + +/* segNoSetBuffer -- non-method to set the buffer of a segment */ + +static void segNoUnsetBuffer(Seg seg) +{ + AVERT(Seg, seg); NOTREACHED; } @@ -1006,39 +1029,6 @@ static Res segTrivSplit(Seg seg, Seg segHi, } -/* segTrivDescribe -- Basic Seg description method */ - -static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream, Count depth) -{ - Res res; - - if (!TESTT(Seg, seg)) - return ResFAIL; - if (stream == NULL) - return ResFAIL; - - res = WriteF(stream, depth, - "shield depth $U\n", (WriteFU)seg->depth, - "protection mode: ", - (SegPM(seg) & AccessREAD) ? "" : "!", "READ", " ", - (SegPM(seg) & AccessWRITE) ? "" : "!", "WRITE", "\n", - "shield mode: ", - (SegSM(seg) & AccessREAD) ? "" : "!", "READ", " ", - (SegSM(seg) & AccessWRITE) ? "" : "!", "WRITE", "\n", - "ranks:", - RankSetIsMember(seg->rankSet, RankAMBIG) ? " ambiguous" : "", - RankSetIsMember(seg->rankSet, RankEXACT) ? " exact" : "", - RankSetIsMember(seg->rankSet, RankFINAL) ? " final" : "", - RankSetIsMember(seg->rankSet, RankWEAK) ? " weak" : "", - "\n", - "white $B\n", (WriteFB)seg->white, - "grey $B\n", (WriteFB)seg->grey, - "nailed $B\n", (WriteFB)seg->nailed, - NULL); - return res; -} - - /* Class GCSeg -- Segment class with GC support */ @@ -1103,14 +1093,10 @@ static Res gcSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args) /* gcSegFinish -- finish a GC segment */ -static void gcSegFinish(Seg seg) +static void gcSegFinish(Inst inst) { - GCSeg gcseg; - - AVERT(Seg, seg); - gcseg = SegGCSeg(seg); - AVERT(GCSeg, gcseg); - AVER(&gcseg->segStruct == seg); + Seg seg = MustBeA(Seg, inst); + GCSeg gcseg = MustBeA(GCSeg, seg); if (SegGrey(seg) != TraceSetEMPTY) { RingRemove(&gcseg->greyRing); @@ -1121,13 +1107,13 @@ static void gcSegFinish(Seg seg) gcseg->sig = SigInvalid; /* Don't leave a dangling buffer allocating into hyperspace. */ - AVER(gcseg->buffer == NULL); + AVER(gcseg->buffer == NULL); /* */ RingFinish(&gcseg->greyRing); RingFinish(&gcseg->genRing); /* finish the superclass fields last */ - NextMethod(Seg, GCSeg, finish)(seg); + NextMethod(Inst, GCSeg, finish)(inst); } @@ -1381,7 +1367,7 @@ static void gcSegSetRankSummary(Seg seg, RankSet rankSet, RefSet summary) /* gcSegBuffer -- GCSeg method to return the buffer of a segment */ -static Buffer gcSegBuffer(Seg seg) +static Bool gcSegBuffer(Buffer *bufferReturn, Seg seg) { GCSeg gcseg; @@ -1390,7 +1376,12 @@ static Buffer gcSegBuffer(Seg seg) AVERT_CRITICAL(GCSeg, gcseg); /* .seg.method.check */ AVER_CRITICAL(&gcseg->segStruct == seg); - return gcseg->buffer; + if (gcseg->buffer != NULL) { + *bufferReturn = gcseg->buffer; + return TRUE; + } + + return FALSE; } @@ -1411,6 +1402,15 @@ static void gcSegSetBuffer(Seg seg, Buffer buffer) } +/* gcSegUnsetBuffer -- GCSeg method to remove the buffer from a segment */ + +static void gcSegUnsetBuffer(Seg seg) +{ + GCSeg gcseg = MustBeA_CRITICAL(GCSeg, seg); /* .seg.method.check */ + gcseg->buffer = NULL; +} + + /* gcSegMerge -- GCSeg merge method * * .buffer: Can't merge two segments both with buffers. @@ -1554,34 +1554,31 @@ failSuper: /* gcSegDescribe -- GCSeg description method */ -static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) +static Res gcSegDescribe(Inst inst, mps_lib_FILE *stream, Count depth) { + GCSeg gcseg = CouldBeA(GCSeg, inst); Res res; - GCSeg gcseg; - if (!TESTT(Seg, seg)) - return ResFAIL; + if (!TESTC(GCSeg, gcseg)) + return ResPARAM; if (stream == NULL) - return ResFAIL; - gcseg = SegGCSeg(seg); - if (!TESTT(GCSeg, gcseg)) - return ResFAIL; + return ResPARAM; /* Describe the superclass fields first via next-method call */ - res = NextMethod(Seg, GCSeg, describe)(seg, stream, depth); + res = NextMethod(Inst, GCSeg, describe)(inst, stream, depth); if (res != ResOK) return res; - res = WriteF(stream, depth, + res = WriteF(stream, depth + 2, "summary $W\n", (WriteFW)gcseg->summary, NULL); if (res != ResOK) return res; if (gcseg->buffer == NULL) { - res = WriteF(stream, depth, "buffer: NULL\n", NULL); + res = WriteF(stream, depth + 2, "buffer: NULL\n", NULL); } else { - res = BufferDescribe(gcseg->buffer, stream, depth); + res = BufferDescribe(gcseg->buffer, stream, depth + 2); } if (res != ResOK) return res; @@ -1594,17 +1591,15 @@ static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth) Bool SegClassCheck(SegClass klass) { - CHECKD(InstClass, &klass->protocol); + CHECKD(InstClass, &klass->instClassStruct); CHECKL(klass->size >= sizeof(SegStruct)); CHECKL(FUNCHECK(klass->init)); - CHECKL(FUNCHECK(klass->finish)); CHECKL(FUNCHECK(klass->setGrey)); CHECKL(FUNCHECK(klass->setWhite)); CHECKL(FUNCHECK(klass->setRankSet)); CHECKL(FUNCHECK(klass->setRankSummary)); CHECKL(FUNCHECK(klass->merge)); CHECKL(FUNCHECK(klass->split)); - CHECKL(FUNCHECK(klass->describe)); CHECKS(SegClass, klass); return TRUE; } @@ -1619,20 +1614,21 @@ DEFINE_CLASS(Inst, SegClass, klass) DEFINE_CLASS(Seg, Seg, klass) { - INHERIT_CLASS(&klass->protocol, Seg, Inst); + INHERIT_CLASS(&klass->instClassStruct, Seg, Inst); + klass->instClassStruct.describe = SegAbsDescribe; + klass->instClassStruct.finish = SegAbsFinish; klass->size = sizeof(SegStruct); klass->init = SegAbsInit; - klass->finish = SegAbsFinish; klass->setSummary = segNoSetSummary; klass->buffer = segNoBuffer; - klass->setBuffer = segNoSetBuffer; + klass->setBuffer = segNoSetBuffer; + klass->unsetBuffer = segNoUnsetBuffer; klass->setGrey = segNoSetGrey; klass->setWhite = segNoSetWhite; klass->setRankSet = segNoSetRankSet; klass->setRankSummary = segNoSetRankSummary; klass->merge = segTrivMerge; klass->split = segTrivSplit; - klass->describe = segTrivDescribe; klass->sig = SegClassSig; AVERT(SegClass, klass); } @@ -1645,19 +1641,20 @@ typedef SegClassStruct GCSegClassStruct; DEFINE_CLASS(Seg, GCSeg, klass) { INHERIT_CLASS(klass, GCSeg, Seg); + klass->instClassStruct.describe = gcSegDescribe; + klass->instClassStruct.finish = gcSegFinish; klass->size = sizeof(GCSegStruct); klass->init = gcSegInit; - klass->finish = gcSegFinish; klass->setSummary = gcSegSetSummary; klass->buffer = gcSegBuffer; - klass->setBuffer = gcSegSetBuffer; + klass->setBuffer = gcSegSetBuffer; + klass->unsetBuffer = gcSegUnsetBuffer; klass->setGrey = gcSegSetGrey; klass->setWhite = gcSegSetWhite; klass->setRankSet = gcSegSetRankSet; klass->setRankSummary = gcSegSetRankSummary; klass->merge = gcSegMerge; klass->split = gcSegSplit; - klass->describe = gcSegDescribe; AVERT(SegClass, klass); } diff --git a/mps/code/segsmss.c b/mps/code/segsmss.c index 5e0e63d4510..2e3fa32297a 100644 --- a/mps/code/segsmss.c +++ b/mps/code/segsmss.c @@ -141,12 +141,11 @@ static Res amstSegInit(Seg seg, Pool pool, Addr base, Size size, ArgList args) /* amstSegFinish -- Finish method for AMST segments */ -static void amstSegFinish(Seg seg) +static void amstSegFinish(Inst inst) { - AMSTSeg amstseg; + Seg seg = MustBeA(Seg, inst); + AMSTSeg amstseg = MustBeA(AMSTSeg, seg); - AVERT(Seg, seg); - amstseg = Seg2AMSTSeg(seg); AVERT(AMSTSeg, amstseg); if (amstseg->next != NULL) @@ -156,7 +155,7 @@ static void amstSegFinish(Seg seg) amstseg->sig = SigInvalid; /* finish the superclass fields last */ - NextMethod(Seg, AMSTSeg, finish)(seg); + NextMethod(Inst, AMSTSeg, finish)(inst); } @@ -269,9 +268,9 @@ failSuper: DEFINE_CLASS(Seg, AMSTSeg, klass) { INHERIT_CLASS(klass, AMSTSeg, AMSSeg); + klass->instClassStruct.finish = amstSegFinish; klass->size = sizeof(AMSTSegStruct); klass->init = amstSegInit; - klass->finish = amstSegFinish; klass->split = amstSegSplit; klass->merge = amstSegMerge; AVERT(SegClass, klass); @@ -345,14 +344,15 @@ static Res AMSTInit(Pool pool, Arena arena, PoolClass klass, ArgList args) /* AMSTFinish -- the pool class finish method */ -static void AMSTFinish(Pool pool) +static void AMSTFinish(Inst inst) { - AMST amst; + Pool pool = MustBeA(AbstractPool, inst); + AMST amst = MustBeA(AMSTPool, pool); - AVERT(Pool, pool); - amst = PoolAMST(pool); AVERT(AMST, amst); + amst->sig = SigInvalid; + printf("\nDestroying pool, having performed:\n"); printf(" %"PRIuLONGEST" splits (S)\n", (ulongest_t)amst->splits); printf(" %"PRIuLONGEST" merges (M)\n", (ulongest_t)amst->merges); @@ -362,8 +362,7 @@ static void AMSTFinish(Pool pool) printf(" %"PRIuLONGEST" buffered splits (C)\n", (ulongest_t)amst->bsplits); printf(" %"PRIuLONGEST" buffered merges (J)\n", (ulongest_t)amst->bmerges); - AMSFinish(pool); - amst->sig = SigInvalid; + NextMethod(Inst, AMSTPool, finish)(inst); } @@ -536,9 +535,9 @@ static Res AMSTBufferFill(Addr *baseReturn, Addr *limitReturn, if (SegLimit(seg) == limit && SegBase(seg) == base) { if (amstseg->prev != NULL) { Seg segLo = AMSTSeg2Seg(amstseg->prev); - if (SegBuffer(segLo) == NULL && - SegGrey(segLo) == SegGrey(seg) && - SegWhite(segLo) == SegWhite(seg)) { + if (!SegHasBuffer(segLo) && + SegGrey(segLo) == SegGrey(seg) && + SegWhite(segLo) == SegWhite(seg)) { /* .merge */ Seg mergedSeg; Res mres; @@ -599,10 +598,11 @@ static void AMSTStressBufferedSeg(Seg seg, Buffer buffer) AMST amst; Arena arena; Addr limit; + Buffer segBuf; AVERT(Seg, seg); AVERT(Buffer, buffer); - AVER(SegBuffer(seg) == buffer); + AVER(SegBuffer(&segBuf, seg) && segBuf == buffer); amstseg = Seg2AMSTSeg(seg); AVERT(AMSTSeg, amstseg); limit = BufferLimit(buffer); @@ -651,9 +651,9 @@ static void AMSTStressBufferedSeg(Seg seg, Buffer buffer) DEFINE_CLASS(Pool, AMSTPool, klass) { INHERIT_CLASS(klass, AMSTPool, AMSPool); + klass->instClassStruct.finish = AMSTFinish; klass->size = sizeof(AMSTStruct); klass->init = AMSTInit; - klass->finish = AMSTFinish; klass->bufferFill = AMSTBufferFill; } diff --git a/mps/code/shield.c b/mps/code/shield.c index 64ab135ff1e..6ec0405f612 100644 --- a/mps/code/shield.c +++ b/mps/code/shield.c @@ -18,6 +18,8 @@ SRCID(shield, "$Id$"); void ShieldInit(Shield shield) { shield->inside = FALSE; + shield->suspended = FALSE; + shield->queuePending = FALSE; shield->queue = NULL; shield->length = 0; shield->next = 0; @@ -25,7 +27,6 @@ void ShieldInit(Shield shield) shield->depth = 0; shield->unsynced = 0; shield->holds = 0; - shield->suspended = FALSE; shield->sig = ShieldSig; } @@ -64,11 +65,10 @@ static Bool SegIsSynced(Seg seg); Bool ShieldCheck(Shield shield) { CHECKS(Shield, shield); - CHECKL(BoolCheck(shield->inside)); + /* Can't check Boolean bitfields */ CHECKL(shield->queue == NULL || shield->length > 0); CHECKL(shield->limit <= shield->length); CHECKL(shield->next <= shield->limit); - CHECKL(BoolCheck(shield->suspended)); /* The mutator is not suspended while outside the shield (design.mps.shield.inv.outside.running). */ @@ -78,9 +78,6 @@ Bool ShieldCheck(Shield shield) (design.mps.shield.inv.unsynced.suspended). */ CHECKL(shield->unsynced == 0 || shield->suspended); - /* If any segment is exposed, the mutator is suspended. */ - CHECKL(shield->depth == 0 || shield->suspended); - /* The total depth is zero while outside the shield (design.mps.shield.inv.outside.depth). */ CHECKL(shield->inside || shield->depth == 0); @@ -90,7 +87,7 @@ Bool ShieldCheck(Shield shield) /* Every unsynced segment should be on the queue, because we have to remember to sync it before we return to the mutator. */ - CHECKL(shield->limit >= shield->unsynced); + CHECKL(shield->limit + shield->queuePending >= shield->unsynced); /* The mutator is suspeneded if there are any holds. */ CHECKL(shield->holds == 0 || shield->suspended); @@ -100,18 +97,15 @@ Bool ShieldCheck(Shield shield) 16. */ #if defined(AVER_AND_CHECK_ALL) { - Count depth = 0; Count unsynced = 0; Index i; for (i = 0; i < shield->limit; ++i) { Seg seg = shield->queue[i]; CHECKD(Seg, seg); - depth += SegDepth(seg); if (!SegIsSynced(seg)) ++unsynced; } - CHECKL(depth == shield->depth); - CHECKL(unsynced == shield->unsynced); + CHECKL(unsynced + shield->queuePending == shield->unsynced); } #endif @@ -409,7 +403,7 @@ static void shieldFlushEntries(Shield shield) QuickSort((void *)shield->queue, shield->limit, shieldQueueEntryCompare, UNUSED_POINTER, - &shield->sortStruct); + &shield->sortStruct); mode = AccessSetEMPTY; limit = NULL; @@ -539,9 +533,14 @@ static void shieldQueue(Arena arena, Seg seg) void (ShieldRaise)(Arena arena, Seg seg, AccessSet mode) { + Shield shield; + SHIELD_AVERT(Arena, arena); SHIELD_AVERT(Seg, seg); AVERT(AccessSet, mode); + shield = ArenaShield(arena); + AVER(!shield->queuePending); + shield->queuePending = TRUE; /* design.mps.shield.inv.prot.shield preserved */ shieldSetSM(ArenaShield(arena), seg, BS_UNION(SegSM(seg), mode)); @@ -549,6 +548,7 @@ void (ShieldRaise)(Arena arena, Seg seg, AccessSet mode) /* Ensure design.mps.shield.inv.unsynced.suspended and design.mps.shield.inv.unsynced.depth */ shieldQueue(arena, seg); + shield->queuePending = FALSE; /* Check queue and segment consistency. */ AVERT(Arena, arena); @@ -619,6 +619,7 @@ static void shieldDebugCheck(Arena arena) Shield shield; Seg seg; Count queued = 0; + Count depth = 0; AVERT(Arena, arena); shield = ArenaShield(arena); @@ -626,6 +627,7 @@ static void shieldDebugCheck(Arena arena) if (SegFirst(&seg, arena)) do { + depth += SegDepth(seg); if (shield->limit == 0) { AVER(!seg->queued); AVER(SegIsSynced(seg)); @@ -638,6 +640,7 @@ static void shieldDebugCheck(Arena arena) } } while(SegNext(&seg, arena, seg)); + AVER(depth == shield->depth); AVER(queued == shield->limit); } #endif diff --git a/mps/code/splay.c b/mps/code/splay.c index 0030b4aee65..2ec56398532 100644 --- a/mps/code/splay.c +++ b/mps/code/splay.c @@ -1,7 +1,7 @@ /* splay.c: SPLAY TREE IMPLEMENTATION * * $Id$ - * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .purpose: Splay trees are used to manage potentially unbounded * collections of ordered things. In the MPS these are usually @@ -509,9 +509,9 @@ static Compare SplaySplitRev(SplayStateStruct *stateReturn, Tree middle, leftLast, rightFirst; Compare cmp; - AVERT(SplayTree, splay); - AVER(FUNCHECK(compare)); - AVER(!SplayTreeIsEmpty(splay)); + AVERT_CRITICAL(SplayTree, splay); + AVER_CRITICAL(FUNCHECK(compare)); + AVER_CRITICAL(!SplayTreeIsEmpty(splay)); leftLast = TreeEMPTY; rightFirst = TreeEMPTY; @@ -633,8 +633,8 @@ static void SplayAssembleRev(SplayTree splay, SplayState state) { Tree left, right; - AVERT(SplayTree, splay); - AVER(state->middle != TreeEMPTY); + AVERT_CRITICAL(SplayTree, splay); + AVER_CRITICAL(state->middle != TreeEMPTY); left = TreeLeft(state->middle); left = SplayUpdateRightSpine(splay, state->leftLast, left); @@ -1394,7 +1394,7 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, Count depth, /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/trace.c b/mps/code/trace.c index 29ae4f63db0..f171604049c 100644 --- a/mps/code/trace.c +++ b/mps/code/trace.c @@ -759,12 +759,14 @@ static void traceDestroyCommon(Trace trace) EVENT1(TraceDestroy, trace); + /* Hopefully the trace reclaimed some memory, so clear any emergency. + * Do this before removing the trace from busyTraces, to avoid + * violating . */ + ArenaSetEmergency(trace->arena, FALSE); + trace->sig = SigInvalid; trace->arena->busyTraces = TraceSetDel(trace->arena->busyTraces, trace); trace->arena->flippedTraces = TraceSetDel(trace->arena->flippedTraces, trace); - - /* Hopefully the trace reclaimed some memory, so clear any emergency. */ - ArenaSetEmergency(trace->arena, FALSE); } @@ -1139,7 +1141,7 @@ static Res traceScanSegRes(TraceSet ts, Rank rank, Arena arena, Seg seg) /* .verify.segsummary: were the seg contents, as found by this * scan, consistent with the recorded SegSummary? */ - AVER(RefSetSub(ScanStateUnfixedSummary(ss), SegSummary(seg))); + AVER(RefSetSub(ScanStateUnfixedSummary(ss), SegSummary(seg))); /* */ /* Write barrier deferral -- see design.mps.write-barrier.deferral. */ /* Did the segment refer to the white set? */ @@ -1334,7 +1336,7 @@ mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io) if (!BTGet(chunk->allocTable, i)) { /* Reference points into a chunk but not to an allocated tract. * See */ - AVER_CRITICAL(ss->rank < RankEXACT); + AVER_CRITICAL(ss->rank < RankEXACT); /* */ goto done; } diff --git a/mps/code/tract.c b/mps/code/tract.c index 45fbb668c94..badd7615da0 100644 --- a/mps/code/tract.c +++ b/mps/code/tract.c @@ -1,7 +1,7 @@ /* tract.c: PAGE TABLES * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * .ullagepages: Pages whose page index is < allocBase are recorded as * free but never allocated as alloc starts searching after the tables. @@ -60,8 +60,8 @@ Bool TractCheck(Tract tract) void TractInit(Tract tract, Pool pool, Addr base) { - AVER(tract != NULL); - AVERT(Pool, pool); + AVER_CRITICAL(tract != NULL); + AVERT_CRITICAL(Pool, pool); tract->pool.pool = pool; tract->base = base; @@ -456,11 +456,11 @@ void PageAlloc(Chunk chunk, Index pi, Pool pool) Addr base; Page page; - AVERT(Chunk, chunk); - AVER(pi >= chunk->allocBase); - AVER(pi < chunk->pages); - AVER(!BTGet(chunk->allocTable, pi)); - AVERT(Pool, pool); + AVERT_CRITICAL(Chunk, chunk); + AVER_CRITICAL(pi >= chunk->allocBase); + AVER_CRITICAL(pi < chunk->pages); + AVER_CRITICAL(!BTGet(chunk->allocTable, pi)); + AVERT_CRITICAL(Pool, pool); page = ChunkPage(chunk, pi); tract = PageTract(page); @@ -476,9 +476,9 @@ void PageInit(Chunk chunk, Index pi) { Page page; - AVERT(Chunk, chunk); - AVER(pi < chunk->pages); - + AVERT_CRITICAL(Chunk, chunk); + AVER_CRITICAL(pi < chunk->pages); + page = ChunkPage(chunk, pi); BTRes(chunk->allocTable, pi); @@ -504,7 +504,7 @@ void PageFree(Chunk chunk, Index pi) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/walkt0.c b/mps/code/walkt0.c index 70cb6ce6882..1515a9357cb 100644 --- a/mps/code/walkt0.c +++ b/mps/code/walkt0.c @@ -238,7 +238,7 @@ int main(int argc, char *argv[]) test(arena, mps_class_amc()); test(arena, mps_class_amcz()); - /* TODO: test(arena, mps_class_ams()); -- see job003738 */ + test(arena, mps_class_ams()); test(arena, mps_class_awl()); test(arena, mps_class_lo()); test(arena, mps_class_snc()); diff --git a/mps/design/arena.txt b/mps/design/arena.txt index 426e6d6da4f..eb6c74e5dfd 100644 --- a/mps/design/arena.txt +++ b/mps/design/arena.txt @@ -202,12 +202,6 @@ arguments to ``mps_arena_create_k()`` are class-dependent. .. _design.mps.protocol: protocol -_`.class.init`: However, the generic ``ArenaInit()`` is called from the -class-specific method, rather than vice versa, because the method is -responsible for allocating the memory for the arena descriptor and the -arena lock in the first place. Likewise, ``ArenaFinish()`` is called -from the finish method. - _`.class.fields`: The ``grainSize`` (for allocation and freeing) and ``zoneShift`` (for computing zone sizes and what zone an address is in) fields in the arena are the responsibility of the each class, and @@ -567,9 +561,10 @@ _`.ld`: The ``historyStruct`` contains fields used to maintain a history of garbage collection and in particular object motion in order to implement location dependency. -_`.ld.epoch`: The ``epoch`` is the "current epoch". This is the -number of 'flips' of traces in the arena since the arena was created. -From the mutator's point of view locations change atomically at flip. +_`.ld.epoch`: The ``epoch`` is the "current epoch". This is the number +of "flips" of traces, in which objects might have moved, in the arena +since it was created. From the mutator's point of view, locations +change atomically at flip. _`.ld.history`: The ``history`` is a circular buffer of ``LDHistoryLENGTH`` elements of type ``RefSet``. These are the @@ -619,7 +614,7 @@ Document History Copyright and License --------------------- -Copyright © 2001-2014 Ravenbrook Limited . +Copyright © 2001-2016 Ravenbrook Limited . All rights reserved. This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/buffer.txt b/mps/design/buffer.txt index a15a63c76f0..5e2b002fd41 100644 --- a/mps/design/buffer.txt +++ b/mps/design/buffer.txt @@ -212,13 +212,6 @@ class-specific behaviour. _`.replay.init`: The ``init()`` method should emit a ``BufferInit`` event (if there aren't any extra parameters, `` = ""``). -``typedef void (*BufferFinishMethod)(Buffer buffer)`` - -_`.class.method.finish`: ``finish()`` is a class-specific finish -method called from ``BufferFinish()``. Client-defined methods must -call their superclass method (via a next-method call) after performing -any class-specific behaviour. - ``typedef void (*BufferAttachMethod)(Buffer buffer, Addr base, Addr limit, Addr init, Size size)`` _`.class.method.attach`: ``attach()`` is a class-specific method @@ -256,13 +249,6 @@ setter method which sets the rank set of a buffer. It is called from ``BufferSetRankSet()``. Clients should not need to define their own methods for this. -``typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count depth)`` - -_`.class.method.describe`: ``describe()`` is a class-specific method -called to describe a buffer, via ``BufferDescribe()``. Client-defined -methods must call their superclass method (via a next-method call) -before describing any class-specific state. - Logging ------- diff --git a/mps/design/check.txt b/mps/design/check.txt index 2cf5bf091c6..7f89027c5b4 100644 --- a/mps/design/check.txt +++ b/mps/design/check.txt @@ -122,6 +122,18 @@ reference this tag. The structure could be considered for addition to ``mpmst.h``. +Common assertions +----------------- + +_`.common`: Some assertions are commonly triggered by mistakes in the +:term:`client program`. These are listed in the section "Common +assertions and their causes" in the MPS Reference, together with an +explanation of their likely cause, and advice for fixing the problem. +To assist with keeping the MPS Reference up to date, these assertions +are marked with a cross-reference to this tag. When you update the +assertion, you must also update the MPS Reference. + + Document History ---------------- @@ -138,7 +150,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited . +Copyright © 2013-2016 Ravenbrook Limited . All rights reserved. This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/config.txt b/mps/design/config.txt index 544b9a61ed1..458ccdfe890 100644 --- a/mps/design/config.txt +++ b/mps/design/config.txt @@ -550,6 +550,16 @@ happen if requested explicitly via ``mps_arena_collect()`` or ``mps_arena_step()``, but it also means that protection is not needed, and so shield operations can be replaced with no-ops in ``mpm.h``. +_`.opt.signal.suspend`: ``CONFIG_PTHREADEXT_SIGSUSPEND`` names the +signal used to suspend a thread, on platforms using the POSIX thread +extensions module. See design.pthreadext.impl.signals_. + +.. _design.pthreadext.impl.signals: pthreadext#impl.signals + +_`.opt.signal.resume`: ``CONFIG_PTHREADEXT_SIGRESUME`` names the +signal used to resume a thread, on platforms using the POSIX thread +extensions module. See design.pthreadext.impl.signals_. + To document ----------- diff --git a/mps/design/diag.txt b/mps/design/diag.txt index 90918307a6c..f4da8c41724 100644 --- a/mps/design/diag.txt +++ b/mps/design/diag.txt @@ -78,7 +78,7 @@ There are two mechanism for getting diagnostic output: 0x00007fff83e42d46 in __kill () (gdb) frame 12 #12 0x000000010000b1fc in MVTFree (pool=0x103ffe160, base=0x101dfd000, size=5024) at poolmv2.c:711 - 711 Res res = CBSInsert(MVTCBS(mvt), base, limit); + 711 Res res = CBSInsert(MVTCBS(mvt), base, limit); (gdb) p MVTDescribe(mvt, mps_lib_get_stdout(), 0) MVT 0000000103FFE160 { minSize: 8 @@ -238,7 +238,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited . +Copyright © 2013-2016 Ravenbrook Limited . All rights reserved. This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/index.txt b/mps/design/index.txt index e486020574d..decfb0fe66d 100644 --- a/mps/design/index.txt +++ b/mps/design/index.txt @@ -213,20 +213,20 @@ References Document History ---------------- -- 2002-05-23 RB_ Created empty catalogue based on P4DTI design document catalogue. -- 2002-06-07 RB_ Added a bunch of design documents referenced by the source code. -- 2002-06-21 NB_ Remove P4DTI reference, which doesn't fit here. Maybe one day we'll have a corporate design document procedure. -- 2002-06-24 RB_ Added fix, object-debug, thread-manager, and thread-safety. -- 2007-02-08 RHSK Added message-gc and shield. -- 2007-06-12 RHSK Added cstyle. -- 2007-06-28 RHSK Added diag. -- 2008-12-04 RHSK Added tests. -- 2008-12-10 RHSK Correct description of message-gc: gc begin or end. -- 2012-09-14 RB_ Added link to critical-path -- 2013-05-10 RB_ Fixed link to sig and added guide.hex.trans -- 2013-05-22 GDR_ Add link to keyword-arguments. -- 2013-05-25 RB_ Replacing "cstyle" with reworked "guide.impl.c.format". -- 2013-06-07 RB_ Converting to reST_. Linking to [RB_2002-06-18]_. +- 2002-05-23 RB_ Created empty catalogue based on P4DTI design document catalogue. +- 2002-06-07 RB_ Added a bunch of design documents referenced by the source code. +- 2002-06-21 NB_ Remove P4DTI reference, which doesn't fit here. Maybe one day we'll have a corporate design document procedure. +- 2002-06-24 RB_ Added fix, object-debug, thread-manager, and thread-safety. +- 2007-02-08 RHSK Added message-gc and shield. +- 2007-06-12 RHSK Added cstyle. +- 2007-06-28 RHSK Added diag. +- 2008-12-04 RHSK Added tests. +- 2008-12-10 RHSK Correct description of message-gc: gc begin or end. +- 2012-09-14 RB_ Added link to critical-path +- 2013-05-10 RB_ Fixed link to sig and added guide.hex.trans +- 2013-05-22 GDR_ Add link to keyword-arguments. +- 2013-05-25 RB_ Replacing "cstyle" with reworked "guide.impl.c.format". +- 2013-06-07 RB_ Converting to reST_. Linking to [RB_2002-06-18]_. - 2014-01-29 RB_ The arena no longer manages generation zonesets. - 2014-01-17 GDR_ Add abq, nailboard, range. - 2016-03-22 RB_ Add write-barier. diff --git a/mps/design/prot.txt b/mps/design/prot.txt index 0cdd8d38fcd..a3ff8e35a38 100644 --- a/mps/design/prot.txt +++ b/mps/design/prot.txt @@ -55,11 +55,11 @@ write-protected segment. See ``TraceSegAccess()``.) Design ------ -_`.sol.sync`: If memory protection is not available, only way to meet -`.req.consistent`_, is ensure that no protection is required, -essentially by running the collector until it has no more incremental -work to do. (This makes it impossible to meet real-time requirements -on pause times, but may be the best that can be done.) +_`.sol.sync`: If memory protection is not available, the only way to +meet `.req.consistent`_ is to ensure that no protection is required, +by running the collector until it has no more incremental work to do. +(This makes it impossible to meet real-time requirements on pause +times, but may be the best that can be done.) _`.sol.fault.handle`: The protection module handles protection faults by decoding the context of the fault (see @@ -165,7 +165,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited . +Copyright © 2013-2016 Ravenbrook Limited . All rights reserved. This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/protocol.txt b/mps/design/protocol.txt index 8b6735effc9..f3ed7246896 100644 --- a/mps/design/protocol.txt +++ b/mps/design/protocol.txt @@ -90,8 +90,8 @@ describes it, like this:: _`.overview.prefix`: We make use of the fact that we can cast between structures with common prefixes, or between structures and their first -members, to provide dynamic typing and subtyping (see [K&R_1998]_, -A.8.3). +members, to provide dynamic typing and subtyping (see +[Kernighan_1988]_, A.8.3). _`.overview.method`: The ``InstClassStruct`` it itself at the start of a class structure contains pointers to functions that can be called to @@ -129,21 +129,21 @@ class is extended, it becomes a member of a different kind. Kinds allow subtype checking to be applied to classes as well as instances, to determine whether methods are available. :: - instance class kind + instance class kind (e.g. CBS) (e.g. CBSClass) (e.g. LandClassClass) - .----------. .----------. .----------. + .----------. .----------. .----------. | class |----->| class |----->| class |-->InstClassClass - ------------ ------------ ------------ - | ... | | sig | | sig | - ------------ ------------ ------------ - | ... | | name | | name | - ------------ ------------ ------------ - | ... | |superclass|-. |superclass|-->InstClassClass - ------------ ------------ | ------------ - | | | ... | | | ... | - | - | - LandClass<-' + ------------ ------------ ------------ + | ... | | sig | | sig | + ------------ ------------ ------------ + | ... | | name | | name | + ------------ ------------ ------------ + | ... | |superclass|-. |superclass|-->InstClassClass + ------------ ------------ | ------------ + | | | ... | | | ... | + | + | + LandClass<-' _`.overview.sig.inherit`: Instances (and therefore classes) will @@ -490,7 +490,7 @@ anti-method to clean-up a subsequent failure. :: static Res AMSSegInit(Seg seg, Pool pool, Addr base, Size size, - ArgList args) + ArgList args) { AMS ams = MustBeA(AMSPool, pool); Arena arena = PoolArena(pool); @@ -500,7 +500,7 @@ anti-method to clean-up a subsequent failure. :: /* Initialize the superclass fields first via next-method call */ res = NextMethod(Seg, AMSSeg, init)(seg, pool, base, size, args); if (res != ResOK) - goto failNextMethod; + goto failNextMethod; amsseg = CouldBeA(AMSSeg, seg); amsseg->grains = size >> ams->grainShift; @@ -511,10 +511,10 @@ anti-method to clean-up a subsequent failure. :: amsseg->ambiguousFixes = FALSE; res = amsCreateTables(ams, &amsseg->allocTable, - &amsseg->nongreyTable, &amsseg->nonwhiteTable, - arena, amsseg->grains); + &amsseg->nongreyTable, &amsseg->nonwhiteTable, + arena, amsseg->grains); if (res != ResOK) - goto failCreateTables; + goto failCreateTables; /* start off using firstFree, see */ amsseg->allocTableInUse = FALSE; @@ -524,7 +524,7 @@ anti-method to clean-up a subsequent failure. :: amsseg->ams = ams; RingInit(&amsseg->segRing); RingAppend((ams->allocRing)(ams, SegRankSet(seg), size), - &amsseg->segRing); + &amsseg->segRing); SetClassOfPoly(seg, CLASS(AMSSeg)); amsseg->sig = AMSSegSig; @@ -575,6 +575,8 @@ level. The level is statically defined using enum constants, and the id is the address of the canonical class object, so the test is fast and simple. +.. _RB: http://www.ravenbrook.com/consultants/rb/ + A. References ------------- @@ -582,14 +584,14 @@ A. References .. [Cohen_1991] "Type-Extension Type Tests Can Be Performed In Constant Time"; Norman H Cohen; IBM Thomas J Watson Research Center; ACM Transactions on Programming Languages and Systems, - Vol. 13 No. 4, pp626-629; 1991-10. + Vol. 13 No. 4, pp. 626-629; 1991-10. .. [Gibbs_2004] "Fast Dynamic Casting"; Michael Gibbs, Bjarne Stroustrup; 2004; . -.. [K&R_1988] "The C Programming language 2nd Edition"; - Brian W. Kernighan, Dennis M. Ritchie; 1998. +.. [Kernighan_1988] "The C Programming language 2nd Edition"; Brian W. + Kernighan, Dennis M. Ritchie; 1988. B. Document History @@ -612,7 +614,6 @@ B. Document History - 2016-04-19 RB_ Miscellaneous clean-up in response to review by GDR_. -.. _RB: http://www.ravenbrook.com/consultants/rb/ .. _GDR: http://www.ravenbrook.com/consultants/gdr/ diff --git a/mps/design/pthreadext.txt b/mps/design/pthreadext.txt index b2d886b75a5..2f05c7413c9 100644 --- a/mps/design/pthreadext.txt +++ b/mps/design/pthreadext.txt @@ -324,10 +324,17 @@ likely to be generated and/or handled by other parts of the application and so should not be used (for example, ``SIGSEGV``). Some implementations of PThreads use some signals for themselves, so they may not be used; for example, LinuxThreads uses ``SIGUSR1`` and -``SIGUSR2`` for its own purposes. The design abstractly names the -signals ``PTHREADEXT_SIGSUSPEND`` and ``PTHREAD_SIGRESUME``, so that -they may be easily mapped to appropriate real signal values. Candidate -choices are ``SIGXFSZ`` and ``SIGPWR``. +``SIGUSR2`` for its own purposes, and so do popular tools like +Valgrind that we would like to be compatible with the MPS. The design +therefore abstractly names the signals ``PTHREADEXT_SIGSUSPEND`` and +``PTHREAD_SIGRESUME``, so that they may be easily mapped to +appropriate real signal values. Candidate choices are ``SIGXFSZ`` and +``SIGXCPU``. + +_`.impl.signals.config`: The identity of the signals used to suspend +and resume threads can be configured at compilation time using the +preprocessor constants ``CONFIG_PTHREADEXT_SIGSUSPEND`` and +``CONFIG_PTHREADEXT_SIGRESUME`` respectively. Attachments @@ -368,7 +375,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited . +Copyright © 2013-2016 Ravenbrook Limited . All rights reserved. This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/strategy.txt b/mps/design/strategy.txt index 99a49ca6bd3..d27831ad0e5 100644 --- a/mps/design/strategy.txt +++ b/mps/design/strategy.txt @@ -542,11 +542,13 @@ clock time when the MPS was entered; ``moreWork`` and ``tracedWork`` are the results of the last call to ``TracePoll()``. _`.policy.poll.impl`: The implementation keep doing work until either -the maximum pause time is exceeded (see design.mps.arena.pause-time_), +the maximum pause time is exceeded (see `design.mps.arena.pause-time`_), or there is no more work to do. Then it schedules the next collection so that there is approximately one call to ``TracePoll()`` for every ``ArenaPollALLOCTIME`` bytes of allocation. +.. _design.mps.arena.pause-time: arena#pause-time + References ---------- diff --git a/mps/example/scheme/scheme-advanced.c b/mps/example/scheme/scheme-advanced.c index 707390b2962..49672f6a0a3 100644 --- a/mps/example/scheme/scheme-advanced.c +++ b/mps/example/scheme/scheme-advanced.c @@ -1,6 +1,6 @@ /* scheme.c -- SCHEME INTERPRETER EXAMPLE FOR THE MEMORY POOL SYSTEM * - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * This is a toy interpreter for a subset of the Scheme programming * language . @@ -4330,8 +4330,8 @@ static int start(int argc, char *argv[]) topic/root. */ symtab = NULL; res = mps_root_create_area(&symtab_root, arena, mps_rank_exact(), 0, - &symtab, &symtab + 1, - mps_scan_area, NULL); + &symtab, &symtab + 1, + mps_scan_area, NULL); if(res != MPS_RES_OK) error("Couldn't register symtab root"); /* The symbol table is strong-key weak-value. */ @@ -4619,7 +4619,7 @@ int main(int argc, char *argv[]) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c index 4a10b5c9b10..1ba280c7d59 100644 --- a/mps/example/scheme/scheme.c +++ b/mps/example/scheme/scheme.c @@ -1,6 +1,6 @@ /* scheme.c -- SCHEME INTERPRETER EXAMPLE FOR THE MEMORY POOL SYSTEM * - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * * This is a toy interpreter for a subset of the Scheme programming * language . @@ -776,8 +776,8 @@ static void rehash(void) { that both copies are updated atomically to the mutator (this interpreter). */ res = mps_root_create_area(&symtab_root, arena, mps_rank_exact(), 0, - symtab, symtab + symtab_size, - mps_scan_area, NULL); + symtab, symtab + symtab_size, + mps_scan_area, NULL); if(res != MPS_RES_OK) error("Couldn't register new symtab root"); for(i = 0; i < old_symtab_size; ++i) @@ -4262,7 +4262,7 @@ static int start(int argc, char *argv[]) assertion failures). See topic/root. */ res = mps_root_create_area(&symtab_root, arena, mps_rank_exact(), 0, symtab, symtab + symtab_size, - mps_scan_area, NULL); + mps_scan_area, NULL); if(res != MPS_RES_OK) error("Couldn't register symtab root"); error_handler = &jb; @@ -4507,7 +4507,7 @@ int main(int argc, char *argv[]) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/manual/build.txt b/mps/manual/build.txt index b462f013ea9..c2aa184997f 100644 --- a/mps/manual/build.txt +++ b/mps/manual/build.txt @@ -136,17 +136,16 @@ well: Platform OS Architecture Compiler Makefile ========== ========= ============= ============ ================= ``fri3gc`` FreeBSD IA-32 GCC ``fri3gc.gmk`` -``fri6gc`` FreeBSD x86_64 GCC ``fri6gc.gmk`` ``fri3ll`` FreeBSD IA-32 Clang ``fri3ll.gmk`` +``fri6gc`` FreeBSD x86_64 GCC ``fri6gc.gmk`` ``fri6ll`` FreeBSD x86_64 Clang ``fri6ll.gmk`` ``lii3gc`` Linux IA-32 GCC ``lii3gc.gmk`` ``lii6gc`` Linux x86_64 GCC ``lii6gc.gmk`` ``lii6ll`` Linux x86_64 Clang ``lii6ll.gmk`` -``xci3ll`` Mac OS X IA-32 Clang ``mps.xcodeproj`` -``xci6ll`` Mac OS X x86_64 Clang ``mps.xcodeproj`` -``xci3gc`` Mac OS X IA-32 GCC (legacy) ``xci3gc.gmk`` ``w3i3mv`` Windows IA-32 Microsoft C ``w3i3mv.nmk`` ``w3i6mv`` Windows x86_64 Microsoft C ``w3i6mv.nmk`` +``xci3ll`` Mac OS X IA-32 Clang ``mps.xcodeproj`` +``xci6ll`` Mac OS X x86_64 Clang ``mps.xcodeproj`` ========== ========= ============= ============ ================= Historically, the MPS worked on a much wider variety of platforms, and diff --git a/mps/manual/source/extensions/mps/designs.py b/mps/manual/source/extensions/mps/designs.py index 18149092a19..ff532d63a92 100644 --- a/mps/manual/source/extensions/mps/designs.py +++ b/mps/manual/source/extensions/mps/designs.py @@ -32,7 +32,7 @@ TYPES = ''' mode = re.compile(r'\.\. mode: .*\n') prefix = re.compile(r'^:Tag: ([a-z][a-z.0-9-]*[a-z0-9])$', re.MULTILINE) -rst_tag = re.compile(r'^:(?:Author|Date|Status|Revision|Copyright|Organization|Format|Index terms):.*?$\n', re.MULTILINE | re.IGNORECASE) +rst_tag = re.compile(r'^:(?:Author|Date|Status|Revision|Copyright|Organization|Format|Index terms|Readership):.*?$\n', re.MULTILINE | re.IGNORECASE) mps_tag = re.compile(r'_`\.([a-z][A-Za-z.0-9_-]*[A-Za-z0-9])`:') mps_ref = re.compile(r'`(\.[a-z][A-Za-z.0-9_-]*[A-Za-z0-9])`_(?: )?') funcdef = re.compile(r'^``([^`]*\([^`]*\))``$', re.MULTILINE) @@ -61,10 +61,10 @@ def secnum_sub(m): # .. [THVV_1995] Tom Van Vleck. 1995. "`Structure Marking `__". citation = re.compile( r''' - ^\.\.\s+(?P\[.*?\])\s* - "(?P[^"]*?)"\s* - ;\s*(?P<author>[^;]*?)\s* - (?:;\s*(?P<organization>[^;]*?)\s*)? + ^\.\.\s+(?P<ref>\[[^\n\]]+\])\s* + "(?P<title>[^"]+?)"\s* + ;\s*(?P<author>[^;]+?)\s* + (?:;\s*(?P<organization>[^;]+?)\s*)? ;\s*(?P<date>[0-9-]+)\s* (?:;\s*<\s*(?P<url>[^>]*?)\s*>\s*)? \. @@ -72,21 +72,19 @@ citation = re.compile( re.VERBOSE | re.MULTILINE | re.IGNORECASE | re.DOTALL ) def citation_sub(m): - groups = m.groupdict() - for key in groups: - if groups[key]: - groups[key] = re.sub(r'\s+', ' ', groups[key]) - result = '.. {ref} {author}.'.format(**groups) - if groups.get('organization'): - result += ' {organization}.'.format(**groups) - result += ' {date}.'.format(**groups) - if groups.get('url'): - result += ' "`{title} <{url}>`__".'.format(**groups) + groups = {k: re.sub(r'\s+', ' ', v) for k, v in m.groupdict().items() if v} + fmt = '.. {ref} {author}.' + if 'organization' in groups: + fmt += ' {organization}.' + fmt += ' {date}.' + if 'url' in groups: + fmt += ' "`{title} <{url}>`__".' else: - result += ' "{title}".'.format(**groups) - return result + fmt += ' "{title}".' + return fmt.format(**groups) -index = re.compile(r'^:Index\s+terms:(.*$\n(?:[ \t]+.*$\n)*)', re.MULTILINE | re.IGNORECASE) +index = re.compile(r'^:Index\s+terms:(.*$\n(?:[ \t]+.*$\n)*)', + re.MULTILINE | re.IGNORECASE) # <http://sphinx-doc.org/markup/misc.html#directive-index> index_term = re.compile(r'^\s*(\w+):\s*(.*?)\s*$', re.MULTILINE) diff --git a/mps/manual/source/guide/advanced.rst b/mps/manual/source/guide/advanced.rst index b56edf14fa4..c7cc53af363 100644 --- a/mps/manual/source/guide/advanced.rst +++ b/mps/manual/source/guide/advanced.rst @@ -141,9 +141,9 @@ releasing the resource (here, the Scheme function But this raises the possibility that a port will be closed twice: once via ``close-input-port`` and a second time via finalization. So it's -necessary to make ports robust against be closed multiple times. The -toy Scheme interpreter does so by setting ``stream`` to ``NULL``: this -ensures that the file handle won't be closed more than once. +necessary to make ports robust against being closed multiple times. +The toy Scheme interpreter does so by setting ``stream`` to ``NULL``: +this ensures that the file handle won't be closed more than once. .. code-block:: c :emphasize-lines: 6 diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst index 966519ba536..20125b9e0ba 100644 --- a/mps/manual/source/release.rst +++ b/mps/manual/source/release.rst @@ -26,16 +26,40 @@ Interface changes #. Allocation frames are no longer deprecated. See :ref:`topic-frame`. +#. On Linux and FreeBSD, it is now possible to configure the signals + used to suspend and resume threads. See :ref:`topic-thread-signal`. + Other changes ............. +#. It is now possible to register a thread with the MPS multiple times + on OS X, thus supporting the use case where a program that does not + use the MPS is calling into MPS-using code from multiple threads. + (This was already supported on other platforms.) See job003559_. + + .. _job003559: https://www.ravenbrook.com/project/mps/issue/job003559/ + +#. The function :c:func:`mps_arena_formatted_objects_walk` walks the + formatted objects in all pools. Previously this was not implemented + for :ref:`pool-ams` pools. See job003738_. + + .. _job003738: https://www.ravenbrook.com/project/mps/issue/job003738/ + #. Objects in :ref:`pool-snc` pools are no longer scanned after their :term:`allocation frame` is popped, and so do not keep objects in automatically managed pools alive. See job003883_. .. _job003883: https://www.ravenbrook.com/project/mps/issue/job003883/ +#. When the MPS collects a set of :term:`generations`, it + :term:`condemns` only the :term:`blocks` in those generations. + Previously, it also condemned blocks that happened to share a + region of memory with blocks currently or formerly allocated in + those generations. See job004000_. + + .. _job004000: https://www.ravenbrook.com/project/mps/issue/job004000/ + #. Memory in :term:`allocation points` no longer contributes to the decision to start a collection, avoid wasted work repeatedly collecting generations with very small capacities. See job004007_. @@ -47,6 +71,20 @@ Other changes .. _job004011: https://www.ravenbrook.com/project/mps/issue/job004011/ +#. Roots created by :c:func:`mps_root_create_thread_scanned` no longer + cause an assertion failure. See job004036_. + + .. _job004036: https://www.ravenbrook.com/project/mps/issue/job004036/ + +#. The MPS test suite now compiles and passes with GCC 6.1. See job004037_. + + .. _job004037: https://www.ravenbrook.com/project/mps/issue/job004037/ + +#. The MPS no longer passes an uninitialized variable to + :c:func:`thread_swap_exception_ports` on OS X. See job004040_. + + .. _job004040: https://www.ravenbrook.com/project/mps/issue/job004040/ + .. _release-notes-1.115: @@ -123,6 +161,14 @@ Interface changes #. The :ref:`pool-snc` pool class now implements :c:func:`mps_pool_total_size` and :c:func:`mps_pool_free_size`. +#. The (undocumented) reservoir functions + :c:func:`mps_ap_fill_with_reservoir_permit`, + :c:func:`mps_reservoir_available`, :c:func:`mps_reservoir_limit`, + :c:func:`mps_reservoir_limit_set`, and + :c:func:`mps_reserve_with_reservoir_permit`, together with the + ``has_reservoir_permit`` arguments to :c:func:`mps_sac_alloc` and + :c:func:`MPS_SAC_ALLOC_FAST` are now deprecated. + Other changes ............. diff --git a/mps/manual/source/topic/allocation.rst b/mps/manual/source/topic/allocation.rst index 445f9c4583e..08f33d08771 100644 --- a/mps/manual/source/topic/allocation.rst +++ b/mps/manual/source/topic/allocation.rst @@ -45,6 +45,20 @@ Manual allocation unaligned, it will be rounded up to the pool's :term:`alignment` (unless the pool documentation says otherwise). + .. note:: + + It is tempting to call :c:func:`mps_alloc` with a cast from + the desired pointer type to ``mps_addr_t *``, like this:: + + my_object *obj; + res = mps_alloc((mps_addr_t *)&obj, pool, sizeof *obj); + if (res != MPS_RES_OK) + error(...); + + but this is :term:`type punning`, and its behaviour is not + defined in ANSI/ISO Standard C. See :ref:`topic-interface-pun` + for more details. + .. c:function:: void mps_free(mps_pool_t pool, mps_addr_t addr, size_t size) diff --git a/mps/manual/source/topic/arena.rst b/mps/manual/source/topic/arena.rst index c5782c75c99..f1386781572 100644 --- a/mps/manual/source/topic/arena.rst +++ b/mps/manual/source/topic/arena.rst @@ -15,8 +15,10 @@ An arena is an object that encapsulates the state of the Memory Pool System, and tells it where to get the memory it manages. You typically start a session with the MPS by creating an arena with :c:func:`mps_arena_create_k` and end the session by destroying it with -:c:func:`mps_arena_destroy`. The only function you might need to call -before making an arena is :c:func:`mps_telemetry_control`. +:c:func:`mps_arena_destroy`. The only functions you might need to call +before making an arena are :term:`telemetry system` functions like +:c:func:`mps_telemetry_set` and the :term:`plinth` function +:c:func:`mps_lib_assert_fail_install`. Before destroying an arena, you must first destroy all objects and data in it, as usual for abstract data types in the MPS. If you can't diff --git a/mps/manual/source/topic/cache.rst b/mps/manual/source/topic/cache.rst index d4446d7a97b..1d722049776 100644 --- a/mps/manual/source/topic/cache.rst +++ b/mps/manual/source/topic/cache.rst @@ -285,26 +285,34 @@ Allocation interface .. note:: - There's also a macro :c:func:`MPS_SAC_ALLOC_FAST` that does - the same thing. The macro is faster, but generates more code - and does less checking. + 1. There's also a macro :c:func:`MPS_SAC_ALLOC_FAST` that does + the same thing. The macro is faster, but generates more + code and does less checking. - .. note:: + 2. The :term:`client program` is responsible for synchronizing + the access to the cache, but if the cache decides to access + the pool, the MPS will properly synchronize with any other + :term:`threads` that might be accessing the same pool. - The :term:`client program` is responsible for synchronizing - the access to the cache, but if the cache decides to access - the pool, the MPS will properly synchronize with any other - :term:`threads` that might be accessing the same - pool. + 3. Blocks allocated through a segregated allocation cache + should only be freed through a segregated allocation cache + with the same class structure. Calling :c:func:`mps_free` + on them can cause :term:`memory leaks`, because the size of + the block might be larger than you think. Naturally, the + cache must also be attached to the same pool. - .. note:: + 4. It is tempting to call :c:func:`mps_sac_alloc` with a cast + from the desired pointer type to ``mps_addr_t *``, like + this:: - Blocks allocated through a segregated allocation cache should - only be freed through a segregated allocation cache with the - same class structure. Calling :c:func:`mps_free` on them can - cause :term:`memory leaks`, because the size of - the block might be larger than you think. Naturally, the cache - must also be attached to the same pool. + my_object *obj; + res = mps_alloc((mps_addr_t *)&obj, sac, sizeof *obj, 0); + if (res != MPS_RES_OK) + error(...); + + but this is :term:`type punning`, and its behaviour is not + defined in ANSI/ISO Standard C. See + :ref:`topic-interface-pun` for more details. .. c:function:: MPS_SAC_ALLOC_FAST(mps_res_t res_v, mps_addr_t *p_v, mps_sac_t sac, size_t size, mps_bool_t has_reservoir_permit) diff --git a/mps/manual/source/topic/deprecated.rst b/mps/manual/source/topic/deprecated.rst index 2bdced17215..95da1a44d90 100644 --- a/mps/manual/source/topic/deprecated.rst +++ b/mps/manual/source/topic/deprecated.rst @@ -25,6 +25,15 @@ supported interface. Deprecated in version 1.115 ........................... +.. c:function:: mps_res_t mps_ap_fill_with_reservoir_permit(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size) + + .. deprecated:: + + Identical to :c:func:`mps_ap_fill`, which should be used + instead. Formerly, this function gave the MPS permission to + draw on the ‘low-memory reservoir’, but this no longer exists. + + .. c:type:: typedef mps_pool_class_t mps_class_t .. deprecated:: @@ -118,6 +127,41 @@ Deprecated in version 1.115 is the sum of allocated space and free space. +.. c:function:: mps_res_t mps_reserve_with_reservoir_permit(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size) + + .. deprecated:: + + Identical to :c:func:`mps_reserve`, which should be used + instead. Formerly, this function gave the MPS permission to + draw on the ‘low-memory reservoir’, but this no longer + exists. + + +.. c:function:: void mps_reservoir_limit_set(mps_arena_t arena, size_t size) + + .. deprecated:: + + Has no effect. Formerly, it updated the recommended size of + the ‘low-memory reservoir’, but this no longer exists. + + +.. c:function:: size_t mps_reservoir_limit(mps_arena_t arena) + + .. deprecated:: + + Returns zero. Formerly, it returned the recommended size of + the ‘low-memory reservoir’, but this no longer exists. + + +.. c:function:: size_t mps_reservoir_available(mps_arena_t arena) + + .. deprecated:: + + Returns zero. Formerly, it returned the size of the available + memory in the ‘low-memory reservoir’, but this no longer + exists. + + .. c:function:: mps_res_t mps_root_create_reg(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_thr_t thr, mps_reg_scan_t reg_scan, void *p, size_t s) .. deprecated:: @@ -274,16 +318,15 @@ Deprecated in version 1.115 .. c:function:: mps_res_t mps_root_create_table_masked(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_addr_t *base, size_t count, mps_word_t mask) .. deprecated:: - - This function is equivalent to:: + + Use :c:func:`mps_root_create_area_tagged` instead, passing + zero for the ``pattern`` argument. This function is equivalent + to:: mps_root_create_area_tagged(root_o, arena, rank, rm, base, base + size, mps_scan_area_tagged, mask, 0) - - Use :c:func:`mps_root_create_area_masked` instead, passing - zero for the ``pattern`` argument. Register a :term:`root` that consists of a vector of :term:`tagged references` whose pattern is zero. @@ -323,18 +366,12 @@ Deprecated in version 1.115 :ref:`topic-scanning`. - .. note:: - - :term:`Client programs` are not expected to - write scanning functions of this type. The built-in MPS - function :c:func:`mps_stack_scan_ambig` must be used. - .. c:function:: mps_reg_scan_t mps_stack_scan_ambig .. deprecated:: - Use :c:func:`mps_root_create_thread` instead, passing + Use :c:func:`mps_root_create_thread_tagged` instead, passing ``sizeof(mps_word_t) - 1`` for the ``mask`` argument, and ``0`` for the ``pattern`` argument. diff --git a/mps/manual/source/topic/error.rst b/mps/manual/source/topic/error.rst index 796edda1699..b47e24858e5 100644 --- a/mps/manual/source/topic/error.rst +++ b/mps/manual/source/topic/error.rst @@ -286,7 +286,7 @@ this documentation. It is necessary to call :c:func:`mps_fmt_destroy` first. -``global.c: RingIsSingle(&arena->rootRing)`` +``global.c: RingIsSingle(&arenaGlobals->rootRing)`` The client program called :c:func:`mps_arena_destroy` without destroying all the :term:`roots` belonging to the arena. @@ -300,7 +300,7 @@ this documentation. It is necessary to call :c:func:`mps_thread_dereg` first. -``global.c: RingLength(&arenaGlobals->poolRing) == 5`` +``global.c: RingLength(&arenaGlobals->poolRing) == 4`` The client program called :c:func:`mps_arena_destroy` without destroying all the :term:`pools` belonging to the arena. diff --git a/mps/manual/source/topic/finalization.rst b/mps/manual/source/topic/finalization.rst index 7edadb9e3cc..c0648599ab2 100644 --- a/mps/manual/source/topic/finalization.rst +++ b/mps/manual/source/topic/finalization.rst @@ -194,7 +194,7 @@ Cautions are finalized is to maintain a table of :term:`weak references (1)` to all such objects. The weak references don't prevent the objects from being finalized, but you can iterate - over the list at an appropriate point and finalize any + over the table at an appropriate point and finalize any remaining objects yourself. #. Not all :term:`pool classes` support finalization. In general, only diff --git a/mps/manual/source/topic/format.rst b/mps/manual/source/topic/format.rst index ec1f707aea3..ccf6c27ec65 100644 --- a/mps/manual/source/topic/format.rst +++ b/mps/manual/source/topic/format.rst @@ -243,11 +243,12 @@ Cautions a. call library code; - b. perform a non-local exit (for example, by calling ``longjmp``); + b. perform a non-local exit (for example, by throwing an exception, + or calling :c:func:`longjmp`); - c. call any functions in the MPS other than the fix functions - (:c:func:`mps_fix`, :c:func:`MPS_FIX1`, :c:func:`MPS_FIX12`, and - :c:func:`MPS_FIX2`). + c. call any functions or macros in the MPS other than the fix + macros :c:func:`MPS_FIX1`, :c:func:`MPS_FIX12`, and + :c:func:`MPS_FIX2`. It's permissible to call other functions in the client program, but see :c:func:`MPS_FIX_CALL` for a restriction on passing the @@ -368,7 +369,7 @@ Format methods object format has a non-zero :c:macro:`MPS_KEY_FMT_HEADER_SIZE`. - .. note:: + .. note:: The MPS will ask for padding objects of any size aligned to the pool alignment, no matter what size objects the pool diff --git a/mps/manual/source/topic/index.rst b/mps/manual/source/topic/index.rst index 3f2cb2863bf..b3139c16fb6 100644 --- a/mps/manual/source/topic/index.rst +++ b/mps/manual/source/topic/index.rst @@ -30,4 +30,4 @@ Reference platform porting deprecated - + security diff --git a/mps/manual/source/topic/location.rst b/mps/manual/source/topic/location.rst index fa928756a69..aa70a071683 100644 --- a/mps/manual/source/topic/location.rst +++ b/mps/manual/source/topic/location.rst @@ -77,8 +77,8 @@ the function :c:func:`mps_ld_reset`. .. note:: - This means that it is not possible to statically create a location - dependency that has been reset. + It is not possible to statically create a location dependency that + has been reset. You can call :c:func:`mps_ld_reset` at any later point to clear all dependencies from the structure. For example, this is normally done diff --git a/mps/manual/source/topic/platform.rst b/mps/manual/source/topic/platform.rst index 15873d27af4..b075ea71e94 100644 --- a/mps/manual/source/topic/platform.rst +++ b/mps/manual/source/topic/platform.rst @@ -142,14 +142,7 @@ Platform interface IA-32 processor architecture, and the GCC compiler. -.. c:macro:: MPS_PF_FRI6GC - - A :term:`C` preprocessor macro that indicates, if defined, that - the :term:`platform` consists of the FreeBSD operating system, the - x86-64 processor architecture, and the GCC compiler. - - -.. c:macro:: MPS_PF_FRI3GC +.. c:macro:: MPS_PF_FRI3LL A :term:`C` preprocessor macro that indicates, if defined, that the :term:`platform` consists of the FreeBSD operating system, the @@ -158,6 +151,13 @@ Platform interface .. c:macro:: MPS_PF_FRI6GC + A :term:`C` preprocessor macro that indicates, if defined, that + the :term:`platform` consists of the FreeBSD operating system, the + x86-64 processor architecture, and the GCC compiler. + + +.. c:macro:: MPS_PF_FRI6LL + A :term:`C` preprocessor macro that indicates, if defined, that the :term:`platform` consists of the FreeBSD operating system, the x86-64 processor architecture, and the Clang/LLVM compiler. @@ -220,6 +220,13 @@ Platform interface IA-32 processor architecture, and the Clang/LLVM compiler. +.. c:macro:: MPS_PF_XCI6GC + + A :term:`C` preprocessor macro that indicates, if defined, that + the :term:`platform` consists of the OS X operating system, the + x86-64 processor architecture, and the GCC compiler. + + .. c:macro:: MPS_PF_XCI6LL A :term:`C` preprocessor macro that indicates, if defined, that @@ -373,6 +380,7 @@ Platform Status ``w3ppmv`` *Not supported* ``xci3gc`` *Not supported* ``xci3ll`` Supported +``xci6gc`` *Not supported* ``xci6ll`` Supported ``xcppgc`` *Not supported* ========== ======================= diff --git a/mps/manual/source/topic/plinth.rst b/mps/manual/source/topic/plinth.rst index f771f6c1c31..e138cb60347 100644 --- a/mps/manual/source/topic/plinth.rst +++ b/mps/manual/source/topic/plinth.rst @@ -468,8 +468,8 @@ Library module A :term:`plinth` function to supply a default value for the :term:`telemetry filter` from the environment. See - :c:func:`mps_telemetry_control` for more information on the - significant of the value. + :envvar:`MPS_TELEMETRY_CONTROL` for more information on the + significance of the value. Returns the default value of the telemetry filter, as derived from the environment. It is recommended that the environment be diff --git a/mps/manual/source/topic/porting.rst b/mps/manual/source/topic/porting.rst index 0d04c04f3a4..571e7dc9b09 100644 --- a/mps/manual/source/topic/porting.rst +++ b/mps/manual/source/topic/porting.rst @@ -66,9 +66,8 @@ usable. There is a generic implementation in ``protan.c``, which can't provide memory protection, so it forces memory to be scanned until - that there is no further need to protect it. This means it can't - support incremental collection, and has no control over pause - times. + there is no further need to protect it. This means it can't support + incremental collection, and has no control over pause times. #. The **protection mutator context** module figures out what the :term:`mutator` was doing when it caused a :term:`protection diff --git a/mps/manual/source/topic/security.rst b/mps/manual/source/topic/security.rst new file mode 100644 index 00000000000..c9294e834a5 --- /dev/null +++ b/mps/manual/source/topic/security.rst @@ -0,0 +1,64 @@ +.. index:: + single: security issues + +.. _topic-security: + +Security issues +=============== + +This chapter describes security issues that may be present when using +the MPS. + + +.. index:: + pair: security issues; predictable address space layout + single: address space; predictable layout + +Predictable address space layout +-------------------------------- + +The MPS acquires :term:`address space` using the operating system's +:term:`virtual memory` interface (specifically, :c:func:`mmap` on Unix +platforms, and :c:func:`VirtualAlloc` on Windows). None of the +supported platforms randomize the allocated regions of address space, +which means that the :term:`addresses` of :term:`blocks` allocated by +the MPS are predictable: a :term:`client program` that makes an +identical series of calls to the MPS gets an identical series of +addresses back. + +This means that if a program using the MPS has a buffer overflow, the +overflow is more easily exploitable by an attacker than if the program +had used :c:func:`malloc` (which has some randomization of the +allocated addresses), because it is easier for an attacker to +determine the address of allocated structures. + +There is currently no workaround for this issue. If this affects you, +please :ref:`contact us <contact>`. + + +.. index:: + pair: security issues; telemetry + +Telemetry +--------- + +In its :term:`hot` and :term:`cool` varieties, the MPS contains a +:term:`telemetry system` which can be configured to record a stream of +events for later analysis and debugging. When using the default +:term:`plinth`, the behaviour of the telemetry system is under the +control of the environment variable :envvar:`MPS_TELEMETRY_CONTROL`, +and the telemetry stream is written to the file named by the +environment variable :envvar:`MPS_TELEMETRY_FILENAME`. + +This means that an attacker who can set arbitrary environment +variables when running a program that uses the MPS can cause that +program to write a telemetry stream to an arbitrary file. This +behaviour might be unexpected, and might enable a data overwriting +attack, or a denial-of-service attack, since telemetry streams are +typically very large. + +If this is an issue for your program, then you can modify or replace +the :ref:`topic-plinth-io` in the :term:`plinth` so that it meets your +requirements, or distribute the :term:`rash` variety of the MPS, which +omits the :term:`telemetry system` entirely, and use the other +varieties only for development and testing. diff --git a/mps/manual/source/topic/telemetry.rst b/mps/manual/source/topic/telemetry.rst index 2c9136ce7da..09445c9a66c 100644 --- a/mps/manual/source/topic/telemetry.rst +++ b/mps/manual/source/topic/telemetry.rst @@ -491,9 +491,10 @@ used in queries, for example: .. note:: If the ``User`` event category is not turned on in the - :term:`telemetry filter` (via :c:func:`mps_telemetry_control`) - then the string is not sent to the telemetry stream. A label - is still returned in this case, but it is useless. + :term:`telemetry filter` (via :c:func:`mps_telemetry_set` or + :envvar:`MPS_TELEMETRY_CONTROL`) then the string is not sent + to the telemetry stream. A label is still returned in this + case, but it is useless. .. c:function:: void mps_telemetry_label(mps_addr_t addr, mps_label_t label) @@ -512,8 +513,9 @@ used in queries, for example: .. note:: If the ``User`` event category is not turned on in the - :term:`telemetry filter` (via :c:func:`mps_telemetry_control`) - then calling this function has no effect. + :term:`telemetry filter` (via :c:func:`mps_telemetry_set` or + :envvar:`MPS_TELEMETRY_CONTROL`) then calling this function + has no effect. .. index:: diff --git a/mps/manual/source/topic/thread.rst b/mps/manual/source/topic/thread.rst index 0697daac301..96e80c06ea1 100644 --- a/mps/manual/source/topic/thread.rst +++ b/mps/manual/source/topic/thread.rst @@ -44,8 +44,7 @@ access that memory. This means that threads must be registered with the MPS by calling :c:func:`mps_thread_reg` (and thread roots created; see :ref:`topic-root-thread`). -For simplicity, we recommend that a thread must be registered with an -:term:`arena` if: +A thread must be registered with an :term:`arena` if: * its :term:`control stack` and :term:`registers` form a root (this is enforced by :c:func:`mps_root_create_thread`); or @@ -70,17 +69,30 @@ Signal and exception handling issues .. warning:: - On Unix platforms (except OS X), the MPS suspends and resumes - threads by sending them signals. There's a shortage of available - signals that aren't already dedicated to other purposes (for - example, ValGrind uses ``SIGUSR1`` and ``SIGUSR2``), so the MPS uses - ``SIGXCPU`` and ``SIGXFSZ``. This means that programs must not mask - these two signals. + On Linux and FreeBSD, the MPS suspends and resumes threads by + sending them signals. There's a shortage of available signals that + aren't already dedicated to other purposes (for example, ValGrind + uses ``SIGUSR1`` and ``SIGUSR2``), so the MPS uses ``SIGXCPU`` and + ``SIGXFSZ``. This means that programs must not mask or handle + either of these signals. - If your program needs to handle these signals, then it must - co-operate with the MPS. At present, there's no documented - mechanism for co-operating: if you are in this situation, please - :ref:`contact us <contact>`. + If your program needs to mask or handle either of these signals, + then you can configure the MPS to use another pair of signals of + your choosing, by defining these preprocessor constants: + + .. c:macro:: CONFIG_PTHREADEXT_SIGSUSPEND + + If this preprocessor constant is defined, its definition names + the signal used to suspend a thread. For example:: + + cc -DCONFIG_PTHREADEXT_SIGSUSPEND=SIGUSR1 -c mps.c + + .. c:macro:: CONFIG_PTHREADEXT_SIGRESUME + + If this preprocessor constant is defined, its definition names + the signal used to resume a thread. For example:: + + cc -DCONFIG_PTHREADEXT_SIGSUSPEND=SIGUSR2 -c mps.c .. warning:: diff --git a/mps/test/README b/mps/test/README index 51bdc59a581..a0be0814742 100644 --- a/mps/test/README +++ b/mps/test/README @@ -43,3 +43,41 @@ From the test directory, build mpslib.a using the Xcode project:: perl test/qa -i ../code -l ../code/xc/Debug/libmps.a run function/232.c etc. See "Testing on Unix" above. + + +Testing on Windows +------------------ + +In a Cygwin shell, from the test directory:: + + PLATFORM=w3i6mv # substitute your platform + VARIETY=cool # or hot + CODE=../code # code directory of the branch you are testing + pushd $CODE + nmake /f $PLATFORM.nmk VARIETY=$VARIETY $PLATFORM/$VARIETY/mps.obj + popd + export LANG=C # avoid locale warnings from Perl. + alias qa="perl test/qa -i $CODE -l $CODE/$PLATFORM/$VARIETY/mps.obj" + qa clib + qa run function/5.c + qa runset testsets/passing + +The runset command can result in this error:: + + LINK : fatal error LNK1168: cannot open test/obj/nt_AMD64__pc/tmp_test.exe for writing + +You may be able to avoid this by running "View Local Services" from +the Windows Control Panel, double-clicking the "Application +Experience" service, and switching "Startup type" to "Automatic". See +the documentation for LNK1168_. + +.. _LNK1168: https://msdn.microsoft.com/en-us/library/hhbdtt6d.aspx + +At present, the easiest way to debug a test case is to edit +test/test/script/platform and set:: + + $comwrap = "vsjitdebugger \""; + +But see job004020_. + +.. _job004020: https://www.ravenbrook.com/project/mps/issue/job004020/ diff --git a/mps/test/argerr/153.c b/mps/test/argerr/153.c index b6d1d6791fa..095a855d1cc 100644 --- a/mps/test/argerr/153.c +++ b/mps/test/argerr/153.c @@ -23,7 +23,7 @@ static void test(void) { cdie(mps_pool_create(&pool, arena, mps_class_mv(), 1024*32, 1024*16, 1024*256), "pool"); - cdie(mps_alloc(&q, pool, (size_t) -100 * mmqaArenaSIZE), "alloc"); + cdie(mps_alloc(&q, pool, ((size_t)-1) - 100 * mmqaArenaSIZE), "alloc"); mps_pool_destroy(pool); mps_arena_destroy(arena); diff --git a/mps/test/conerr/13.c b/mps/test/conerr/13.c index b3712a99e44..b05fe424aa1 100644 --- a/mps/test/conerr/13.c +++ b/mps/test/conerr/13.c @@ -28,7 +28,7 @@ static void test(void) /* cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena"); */ - arena=malloc(64); + arena=malloc(4096); cdie( mps_pool_create(&pool, arena, mps_class_mv(), diff --git a/mps/test/conerr/18.c b/mps/test/conerr/18.c index 4d13dede9b9..d6ea9e923b5 100644 --- a/mps/test/conerr/18.c +++ b/mps/test/conerr/18.c @@ -6,8 +6,8 @@ TEST_HEADER link = testlib.o OUTPUT_SPEC assert = true - assertfile P= poollo.c - assertcond = FormatArena(pool->format) == arena + assertfile P= poolabs.c + assertcond = FormatArena(format) == arena END_HEADER */ diff --git a/mps/test/conerr/2.c b/mps/test/conerr/2.c index 78738d5bc85..ba18c963be0 100644 --- a/mps/test/conerr/2.c +++ b/mps/test/conerr/2.c @@ -17,7 +17,7 @@ static void test(void) { mps_arena_t arena; - arena = malloc(64); + arena = malloc(4096); mps_arena_destroy(arena); comment("Destroy arena."); } diff --git a/mps/test/conerr/25.c b/mps/test/conerr/25.c index 35e4c5c03c7..c4cfc508eea 100644 --- a/mps/test/conerr/25.c +++ b/mps/test/conerr/25.c @@ -30,13 +30,13 @@ static void test(void) cdie(mps_ap_create(&ap, pool), "create ap"); - cdie(mps_reserve(&obj, ap, 152), "reserve"); - (void)mps_commit(ap, &obj, 152); + cdie(mps_reserve(&obj, ap, 256), "reserve"); + (void)mps_commit(ap, &obj, 256); - mps_free(pool, obj, 152); + mps_free(pool, obj, 256); comment("Freed."); - mps_free(pool, obj, 152); + mps_free(pool, obj, 256); comment("Freed again."); mps_pool_destroy(pool); diff --git a/mps/test/conerr/53.c b/mps/test/conerr/53.c index d156e3d7f05..ac072dfda0d 100644 --- a/mps/test/conerr/53.c +++ b/mps/test/conerr/53.c @@ -7,7 +7,7 @@ TEST_HEADER OUTPUT_SPEC assert = true assertfile P= ld.c - assertcond = ld->_epoch <= arena->epoch + assertcond = ld->_epoch <= ArenaHistory(arena)->epoch END_HEADER */ diff --git a/mps/test/conerr/54.c b/mps/test/conerr/54.c index f5474c6e318..3439f22cb71 100644 --- a/mps/test/conerr/54.c +++ b/mps/test/conerr/54.c @@ -7,7 +7,7 @@ TEST_HEADER OUTPUT_SPEC assert = true assertfile P= ld.c - assertcond = ld->_epoch <= arena->epoch + assertcond = ld->_epoch <= history->epoch END_HEADER */ diff --git a/mps/test/conerr/8.c b/mps/test/conerr/8.c index ba37375ea93..63bfc1577e7 100644 --- a/mps/test/conerr/8.c +++ b/mps/test/conerr/8.c @@ -19,7 +19,7 @@ static void test(void) mps_arena_t arena; mps_fmt_t format; - arena=malloc(64); + arena=malloc(4096); cdie(mps_fmt_create_k(&format, arena, mps_args_none), "create format"); diff --git a/mps/test/function/123.c b/mps/test/function/123.c index 4166f30f685..0e354e29bed 100644 --- a/mps/test/function/123.c +++ b/mps/test/function/123.c @@ -35,7 +35,7 @@ static void test(void) mps_fmt_t format; mps_ap_t apamc, apawl; - unsigned int i, c; + mps_word_t i, c; cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (60ul*1024*1024)), "create arena"); diff --git a/mps/test/function/136.c b/mps/test/function/136.c index b76a2fcf59a..f333a206f4d 100644 --- a/mps/test/function/136.c +++ b/mps/test/function/136.c @@ -55,7 +55,7 @@ static void do_test(size_t extendBy, size_t avgSize, size_t align, mps_addr_t p; unsigned int i; unsigned long nLargeObjects = 0, nSmallObjects = 0; - unsigned long largeObjectSize, smallObjectSize; + size_t largeObjectSize, smallObjectSize; largeObjectSize = extendBy; smallObjectSize = align; diff --git a/mps/test/function/140.c b/mps/test/function/140.c index 7502386c7f1..ae442893a12 100644 --- a/mps/test/function/140.c +++ b/mps/test/function/140.c @@ -61,7 +61,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val) static void dt(int kind, size_t extendBy, size_t avgSize, size_t align, - size_t mins, size_t maxs, int number, int iter) + unsigned long mins, unsigned long maxs, int number, int iter) { mps_pool_t pool; int i, hd; @@ -114,11 +114,11 @@ static void dt(int kind, if (queue[hd].addr != NULL) { asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)), - "corrupt at %p (%s: %x, %x, %x, %c%c%c, %x, %x, %i, %i)", + "corrupt at %p (%s: %x, %x, %x, %c%c%c, %lx, %lx, %i, %i)", queue[hd].addr, tdesc[kind], (int) extendBy, (int) avgSize, (int) align, slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f', - (int) mins, (int) maxs, number, iter); + mins, maxs, number, iter); commentif(comments, "Free %i at %x, size %x", hd, queue[hd].addr, queue[hd].size); mps_free(pool, queue[hd].addr, queue[hd].size); @@ -147,16 +147,16 @@ static void dt(int kind, time1=clock(); secs=(time1-time0)/(double)CLOCKS_PER_SEC; - comment("%s test (%x, %x, %x, %c%c%c, %x, %x, %i, %i) in %.2f s", + comment("%s test (%x, %x, %x, %c%c%c, %lx, %lx, %i, %i) in %.2f s", tdesc[kind], (int) extendBy, (int) avgSize, (int) align, slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f', - (int) mins, (int) maxs, number, iter, secs); + mins, maxs, number, iter, secs); } static void test(void) { mps_thr_t thread; - size_t mins; + unsigned long mins; int symm; size_t comlimit; diff --git a/mps/test/function/164.c b/mps/test/function/164.c index aece86397f2..368bbffd86e 100644 --- a/mps/test/function/164.c +++ b/mps/test/function/164.c @@ -58,7 +58,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val) static void dt(int kind, size_t extendBy, size_t avgSize, size_t align, - size_t mins, size_t maxs, int number, int iter) + unsigned long mins, unsigned long maxs, int number, int iter) { mps_pool_t pool; int i, hd; @@ -107,11 +107,11 @@ static void dt(int kind, if (queue[hd].addr != NULL) { asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)), - "corrupt at %x (%s: %x, %x, %x, %c%c%c, %x, %x, %i, %i)", + "corrupt at %x (%s: %x, %x, %x, %c%c%c, %lx, %lx, %i, %i)", queue[hd].addr, tdesc[kind], (int) extendBy, (int) avgSize, (int) align, slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f', - (int) mins, (int) maxs, number, iter); + mins, maxs, number, iter); commentif(comments, "Free %i at %x, size %x", hd, queue[hd].addr, queue[hd].size); mps_free(pool, queue[hd].addr, queue[hd].size); @@ -140,16 +140,16 @@ static void dt(int kind, time1=clock(); secs=(time1-time0)/(double)CLOCKS_PER_SEC; - comment("%s test (%x, %x, %x, %c%c%c, %x, %x, %i, %i) in %.2f s", + comment("%s test (%x, %x, %x, %c%c%c, %lx, %lx, %i, %i) in %.2f s", tdesc[kind], (int) extendBy, (int) avgSize, (int) align, slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f', - (int) mins, (int) maxs, number, iter, secs); + mins, maxs, number, iter, secs); } static void test(void) { mps_thr_t thread; - size_t mins; + unsigned long mins; int symm; size_t comlimit; diff --git a/mps/test/function/165.c b/mps/test/function/165.c index 5bd3bda7a44..167854851a0 100644 --- a/mps/test/function/165.c +++ b/mps/test/function/165.c @@ -30,7 +30,7 @@ static void test(void) mps_pool_t pool; mps_thr_t thread; - unsigned long com0, com1, com2; + size_t com0, com1, com2; /* create a VM arena of 40MB with commit limit of 100MB, i.e. let the arena do the limiting. */ diff --git a/mps/test/function/167.c b/mps/test/function/167.c index c8858668099..fa17c120fb7 100644 --- a/mps/test/function/167.c +++ b/mps/test/function/167.c @@ -30,7 +30,7 @@ static void test(void) mps_pool_t poolhi, poollo; mps_thr_t thread; - unsigned long com0, com1; + size_t com0, com1; /* create a VM arena of 40MB */ diff --git a/mps/test/function/170.c b/mps/test/function/170.c index 28eb7028be7..85a6a89852c 100644 --- a/mps/test/function/170.c +++ b/mps/test/function/170.c @@ -5,7 +5,7 @@ TEST_HEADER language = c link = testlib.o rankfmt.o harness = 2.1 - parameters = EXTEND=65536 AVGSIZE=32 BIGSIZE=(5*1024*1024); + parameters = EXTEND=65536 AVGSIZE=32 BIGSIZE=5*1024*1024 OUTPUT_SPEC completed = yes failed = no diff --git a/mps/test/function/200.c b/mps/test/function/200.c index 90e5494da92..4000d9e4185 100644 --- a/mps/test/function/200.c +++ b/mps/test/function/200.c @@ -57,7 +57,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val) static void dt(int kind, size_t extendBy, size_t avgSize, size_t maxSize, - size_t mins, size_t maxs, int number, int iter) + unsigned long mins, unsigned long maxs, int number, int iter) { mps_pool_t pool; int i, hd; @@ -101,10 +101,10 @@ static void dt(int kind, if (queue[hd].addr != NULL) { asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)), - "corrupt at %x (%s: %x, %x, %x, %x, %x, %i, %i)", + "corrupt at %x (%s: %x, %x, %x, %lx, %lx, %i, %i)", queue[hd].addr, tdesc[kind], (int) extendBy, (int) avgSize, (int) maxSize, - (int) mins, (int) maxs, number, iter); + mins, maxs, number, iter); mps_free(pool, queue[hd].addr, queue[hd].size); } size = ranrange(mins, maxs); @@ -126,15 +126,15 @@ static void dt(int kind, time1=clock(); secs=(time1-time0)/(double)CLOCKS_PER_SEC; - comment("%s test (%x, %x, %x, %x, %x, %i, %i) in %.2f s", + comment("%s test (%x, %x, %x, %lx, %lx, %i, %i) in %.2f s", tdesc[kind], (int) extendBy, (int) avgSize, (int) maxSize, - (int) mins, (int) maxs, number, iter, secs); + mins, maxs, number, iter, secs); } static void test(void) { mps_thr_t thread; - size_t mins; + unsigned long mins; cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*50)), "create arena"); cdie(mps_thread_reg(&thread, arena), "register thread"); diff --git a/mps/test/function/203.c b/mps/test/function/203.c index 479ab25cbda..360f6ffd8be 100644 --- a/mps/test/function/203.c +++ b/mps/test/function/203.c @@ -42,7 +42,7 @@ static void setobj(mps_addr_t a, size_t size, unsigned char val) static mps_res_t mvt_alloc(mps_addr_t *ref, mps_ap_t ap, size_t size) { mps_res_t res; - size = ((size+7)/8)*8; + size = (size + MPS_PF_ALIGN - 1) & ~(MPS_PF_ALIGN - 1); do { MPS_RESERVE_BLOCK(res, *ref, ap, size); @@ -71,7 +71,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val) static void dt(int kind, size_t minSize, size_t avgSize, size_t maxSize, mps_word_t depth, mps_word_t fragLimit, - size_t mins, size_t maxs, int number, int iter) + unsigned long mins, unsigned long maxs, int number, int iter) { mps_pool_t pool; mps_ap_t ap; @@ -118,11 +118,11 @@ static void dt(int kind, if (queue[hd].addr != NULL) { asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)), - "corrupt at %x (%s: %x, %x, %x, %i, %i, %x, %x, %i, %i)", + "corrupt at %x (%s: %x, %x, %x, %i, %i, %lx, %lx, %i, %i)", queue[hd].addr, tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize, (int) depth, (int) fragLimit, - (int) mins, (int) maxs, number, iter); + mins, maxs, number, iter); mps_free(pool, queue[hd].addr, queue[hd].size); } size = ranrange(mins, maxs); @@ -145,16 +145,16 @@ static void dt(int kind, time1=clock(); secs=(time1-time0)/(double)CLOCKS_PER_SEC; - comment("%s test (%x, %x, %x, %i, %i, %x, %x, %i, %i) in %.2f s", + comment("%s test (%x, %x, %x, %i, %i, %lx, %lx, %i, %i) in %.2f s", tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize, (int) depth, (int) fragLimit, - (int) mins, (int) maxs, number, iter, secs); + mins, maxs, number, iter, secs); } static void test(void) { mps_thr_t thread; - size_t mins; + unsigned long mins; mps_word_t dep, frag; cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*100)), "create arena"); diff --git a/mps/test/function/204.c b/mps/test/function/204.c index 52af542c913..73d087c0adf 100644 --- a/mps/test/function/204.c +++ b/mps/test/function/204.c @@ -42,7 +42,7 @@ static void setobj(mps_addr_t a, size_t size, unsigned char val) static mps_res_t mvt_alloc(mps_addr_t *ref, mps_ap_t ap, size_t size) { mps_res_t res; - size = ((size+7)/8)*8; + size = (size + MPS_PF_ALIGN - 1) & ~ (MPS_PF_ALIGN - 1); do { MPS_RESERVE_BLOCK(res, *ref, ap, size); @@ -71,7 +71,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val) static void dt(int kind, size_t minSize, size_t avgSize, size_t maxSize, mps_word_t depth, mps_word_t fragLimit, - size_t mins, size_t maxs, int number, int iter) + unsigned long mins, unsigned long maxs, int number, int iter) { mps_pool_t pool; mps_ap_t ap; @@ -118,11 +118,11 @@ static void dt(int kind, if (queue[hd].addr != NULL) { asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)), - "corrupt at %x (%s: %x, %x, %x, %i, %i, %x, %x, %i, %i)", + "corrupt at %x (%s: %x, %x, %x, %i, %i, %lx, %lx, %i, %i)", queue[hd].addr, tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize, (int) depth, (int) fragLimit, - (int) mins, (int) maxs, number, iter); + mins, maxs, number, iter); mps_free(pool, queue[hd].addr, queue[hd].size); } size = ranrange(mins, maxs); @@ -145,16 +145,16 @@ static void dt(int kind, time1=clock(); secs=(time1-time0)/(double)CLOCKS_PER_SEC; - comment("%s test (%x, %x, %x, %i, %i, %x, %x, %i, %i) in %.2f s", + comment("%s test (%x, %x, %x, %i, %i, %lx, %lx, %i, %i) in %.2f s", tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize, (int) depth, (int) fragLimit, - (int) mins, (int) maxs, number, iter, secs); + mins, maxs, number, iter, secs); } static void test(void) { mps_thr_t thread; - size_t mins; + unsigned long mins; mps_word_t dep, frag; cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*100)), "create arena"); diff --git a/mps/test/function/205.c b/mps/test/function/205.c index 16ff013c766..ff94d098ca2 100644 --- a/mps/test/function/205.c +++ b/mps/test/function/205.c @@ -42,7 +42,7 @@ static void setobj(mps_addr_t a, size_t size, unsigned char val) static mps_res_t mvt_alloc(mps_addr_t *ref, mps_ap_t ap, size_t size) { mps_res_t res; - size = ((size+7)/8)*8; + size = (size + MPS_PF_ALIGN - 1) & ~ (MPS_PF_ALIGN - 1); do { MPS_RESERVE_BLOCK(res, *ref, ap, size); @@ -71,7 +71,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val) static void dt(int kind, size_t minSize, size_t avgSize, size_t maxSize, mps_word_t depth, mps_word_t fragLimit, - size_t mins, size_t maxs, int number, int iter) + unsigned long mins, unsigned long maxs, int number, int iter) { mps_pool_t pool; mps_ap_t ap; @@ -118,11 +118,11 @@ static void dt(int kind, if (queue[hd].addr != NULL) { asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)), - "corrupt at %x (%s: %x, %x, %x, %i, %i, %x, %x, %i, %i)", + "corrupt at %x (%s: %x, %x, %x, %i, %i, %lx, %lx, %i, %i)", queue[hd].addr, tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize, (int) depth, (int) fragLimit, - (int) mins, (int) maxs, number, iter); + mins, maxs, number, iter); mps_free(pool, queue[hd].addr, queue[hd].size); } size = ranrange(mins, maxs); @@ -145,16 +145,16 @@ static void dt(int kind, time1=clock(); secs=(time1-time0)/(double)CLOCKS_PER_SEC; - comment("%s test (%x, %x, %x, %i, %i, %x, %x, %i, %i) in %.2f s", + comment("%s test (%x, %x, %x, %i, %i, %lx, %lx, %i, %i) in %.2f s", tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize, (int) depth, (int) fragLimit, - (int) mins, (int) maxs, number, iter, secs); + mins, maxs, number, iter, secs); } static void test(void) { mps_thr_t thread; - size_t mins; + unsigned long mins; mps_word_t dep, frag; cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*100)), "create arena"); diff --git a/mps/test/function/206.c b/mps/test/function/206.c index 64d5517944d..f9a40cf7f1d 100644 --- a/mps/test/function/206.c +++ b/mps/test/function/206.c @@ -59,7 +59,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val) static void dt(int kind, size_t extendBy, size_t avgSize, size_t align, - size_t mins, size_t maxs, int number, int iter) + unsigned long mins, unsigned long maxs, int number, int iter) { mps_pool_t pool; int i, hd; @@ -103,11 +103,11 @@ static void dt(int kind, if (queue[hd].addr != NULL) { asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)), - "corrupt at %p (%s: %x, %x, %x, %c%c%c, %x, %x, %i, %i)", + "corrupt at %p (%s: %x, %x, %x, %c%c%c, %lx, %lx, %i, %i)", queue[hd].addr, tdesc[kind], (int) extendBy, (int) avgSize, (int) align, slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f', - (int) mins, (int) maxs, number, iter); + mins, maxs, number, iter); mps_free(pool, queue[hd].addr, queue[hd].size); } size = ranrange(mins, maxs); @@ -129,18 +129,18 @@ static void dt(int kind, time1=clock(); secs=(time1-time0)/(double)CLOCKS_PER_SEC; - comment("%s test (%x, %x, %x, %c%c%c, %x, %x, %i, %i) in %.2f s", + comment("%s test (%x, %x, %x, %c%c%c, %lx, %lx, %i, %i) in %.2f s", tdesc[kind], (int) extendBy, (int) avgSize, (int) align, slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f', - (int) mins, (int) maxs, number, iter, secs); + mins, maxs, number, iter, secs); } static void test(void) { mps_thr_t thread; - size_t extendBy, avgSize, maxSize; + size_t avgSize; size_t align = sizeof(void*); - size_t minSize = sizeof(int); + unsigned long extendBy, minSize = sizeof(int), maxSize; int i, j, kind; cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*50)), "create arena"); diff --git a/mps/test/function/207.c b/mps/test/function/207.c index 6d73d87d4bd..c68ac5757af 100644 --- a/mps/test/function/207.c +++ b/mps/test/function/207.c @@ -58,7 +58,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val) static void dt(int kind, size_t extendBy, size_t avgSize, size_t align, - size_t mins, size_t maxs, int number, int iter) + unsigned long mins, unsigned long maxs, int number, int iter) { mps_pool_t pool; int i, hd; @@ -107,11 +107,11 @@ static void dt(int kind, if (queue[hd].addr != NULL) { asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)), - "corrupt at %x (%s: %x, %x, %x, %c%c%c, %x, %x, %i, %i)", + "corrupt at %x (%s: %x, %x, %x, %c%c%c, %lx, %lx, %i, %i)", queue[hd].addr, tdesc[kind], (int) extendBy, (int) avgSize, (int) align, slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f', - (int) mins, (int) maxs, number, iter); + mins, maxs, number, iter); commentif(comments, "Free %i at %x, size %x", hd, queue[hd].addr, queue[hd].size); mps_free(pool, queue[hd].addr, queue[hd].size); @@ -140,16 +140,16 @@ static void dt(int kind, time1=clock(); secs=(time1-time0)/(double)CLOCKS_PER_SEC; - comment("%s test (%x, %x, %x, %c%c%c, %x, %x, %i, %i) in %.2f s", + comment("%s test (%x, %x, %x, %c%c%c, %lx, %lx, %i, %i) in %.2f s", tdesc[kind], (int) extendBy, (int) avgSize, (int) align, slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f', - (int) mins, (int) maxs, number, iter, secs); + mins, maxs, number, iter, secs); } static void test(void) { mps_thr_t thread; - size_t mins; + unsigned long mins; int symm; size_t comlimit; diff --git a/mps/test/function/21.c b/mps/test/function/21.c index 7b493f6602f..7992000899a 100644 --- a/mps/test/function/21.c +++ b/mps/test/function/21.c @@ -24,8 +24,8 @@ static void test(void) { for (p=0; p<2000; p++) { die(mps_alloc(&q, pool, 1024*1024), "alloc"); - q = (mps_addr_t) ((char *) q + 8); - mps_free(pool, q, 256*1024-8); + q = (mps_addr_t) ((char *) q + MPS_PF_ALIGN); + mps_free(pool, q, 256*1024-MPS_PF_ALIGN); report("promise", "%i", p); } } diff --git a/mps/test/function/215.c b/mps/test/function/215.c index ab3862f9a5f..48e7148e029 100644 --- a/mps/test/function/215.c +++ b/mps/test/function/215.c @@ -138,7 +138,7 @@ static void test(void) { } } if(mps_message_get(&message, arena, mps_message_type_gc())) { - unsigned long live, condemned, notCondemned; + size_t live, condemned, notCondemned; live = mps_message_gc_live_size(arena, message); condemned = mps_message_gc_condemned_size(arena, message); notCondemned = diff --git a/mps/test/function/22.c b/mps/test/function/22.c index 8927643e49f..4959b7a88f1 100644 --- a/mps/test/function/22.c +++ b/mps/test/function/22.c @@ -27,8 +27,8 @@ static void test(void) { for (p=0; p<2000; p++) { report("promise", "%i", p); die(mps_alloc(&r, pool, 1024*1024), "alloc"); - mps_free(pool, q, 256*1024-8); - q = (mps_addr_t) ((char *) r + 8); + mps_free(pool, q, 256*1024-MPS_PF_ALIGN); + q = (mps_addr_t) ((char *) r + MPS_PF_ALIGN); } } diff --git a/mps/test/function/223.c b/mps/test/function/223.c index 6fb7a4357fa..75e14915728 100644 --- a/mps/test/function/223.c +++ b/mps/test/function/223.c @@ -138,7 +138,7 @@ static void test(void) { } } if(mps_message_get(&message, arena, mps_message_type_gc())) { - unsigned long live, condemned, notCondemned; + size_t live, condemned, notCondemned; live = mps_message_gc_live_size(arena, message); condemned = mps_message_gc_condemned_size(arena, message); notCondemned = mps_message_gc_not_condemned_size(arena, message); diff --git a/mps/test/function/226.c b/mps/test/function/226.c index ea6607498a2..2295ab34f1c 100644 --- a/mps/test/function/226.c +++ b/mps/test/function/226.c @@ -58,7 +58,7 @@ static void mergelds(int merge) { } } -static void blat(mps_ap_t apamc, int percent) { +static void blat(mps_ap_t apamc, unsigned percent) { int i; for (i=0; i < MAXLDS; i++) { if (ranint(100) < percent) { diff --git a/mps/test/function/232.c b/mps/test/function/232.c index 09c7359b6e2..ff16289fc1b 100644 --- a/mps/test/function/232.c +++ b/mps/test/function/232.c @@ -1,10 +1,10 @@ /* TEST_HEADER - id = $Id: //info.ravenbrook.com/project/mps/branch/2015-08-11/compact/test/function/229.c#1 $ + id = $Id$ summary = test arena extension and compaction language = c link = testlib.o - parameters = SIZE=1024*1024 ITERATIONS=100 + parameters = CHUNKSIZE=1024*1024 ITERATIONS=100 END_HEADER */ @@ -26,7 +26,7 @@ static void test(void) unsigned i; MPS_ARGS_BEGIN(args) { - MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, SIZE); + MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, CHUNKSIZE); die(mps_arena_create_k(&arena, mps_arena_class_vm(), args), "arena_create"); } MPS_ARGS_END(args); @@ -37,12 +37,12 @@ static void test(void) check_chunks(arena, 1); for (i = 0; i < ITERATIONS; ++i) { - die(mps_alloc(&block[i], pool, SIZE), "mps_alloc"); + die(mps_alloc(&block[i], pool, CHUNKSIZE), "mps_alloc"); check_chunks(arena, i + 2); } for (i = ITERATIONS; i > 0; --i) { - mps_free(pool, block[i - 1], SIZE); + mps_free(pool, block[i - 1], CHUNKSIZE); mps_arena_collect(arena); /* ensure ArenaCompact is called */ check_chunks(arena, i); } diff --git a/mps/test/function/26.c b/mps/test/function/26.c index fc738f90733..1c0f840e18f 100644 --- a/mps/test/function/26.c +++ b/mps/test/function/26.c @@ -20,7 +20,8 @@ static mps_res_t trysize(size_t try) { mps_res_t res; die(mps_pool_create(&pool, arena, mps_class_mv(), - 1024*32, 1024*16, 1024*256), "pool"); + (size_t)(1024*32), (size_t)(1024*16), (size_t)(1024*256)), + "pool_create"); comment("Trying %x", try); diff --git a/mps/test/function/38.c b/mps/test/function/38.c index e3512864442..9effe17ddf2 100644 --- a/mps/test/function/38.c +++ b/mps/test/function/38.c @@ -91,7 +91,8 @@ static void test(void) cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated), "create awl pool"); - cdie(mps_pool_create(&poolmv, arena, mps_class_mv(), 0x4000, 128, 0x4000), + cdie(mps_pool_create(&poolmv, arena, mps_class_mv(), + (size_t)0x4000, (size_t)128, (size_t)0x4000), "create mv pool"); cdie(mps_ap_create(&apawl, poolawl, mps_rank_exact()), diff --git a/mps/test/function/47.c b/mps/test/function/47.c index ee7c5605c2e..964de168c02 100644 --- a/mps/test/function/47.c +++ b/mps/test/function/47.c @@ -54,7 +54,8 @@ static void test(void) { cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated), "create awl pool"); - cdie(mps_pool_create(&poolmv, arena, mps_class_mv(), 0x4000, 128, 0x4000), + cdie(mps_pool_create(&poolmv, arena, mps_class_mv(), + (size_t)0x4000, (size_t)128, (size_t)0x4000), "create mv pool"); cdie(mps_ap_create(&apawl, poolawl, mps_rank_exact()), diff --git a/mps/test/function/66.c b/mps/test/function/66.c index d395dbb3637..678fefe7e02 100644 --- a/mps/test/function/66.c +++ b/mps/test/function/66.c @@ -90,7 +90,8 @@ static void test(void) { "create awl pool"); cdie( - mps_pool_create(&poolmv, arena, mps_class_mv(), 0x4000, 128, 0x4000), + mps_pool_create(&poolmv, arena, mps_class_mv(), + (size_t)0x4000, (size_t)128, (size_t)0x4000), "create mv pool"); cdie( diff --git a/mps/test/misc/1.c b/mps/test/misc/1.c index cf955c68cec..a8477ca1f62 100644 --- a/mps/test/misc/1.c +++ b/mps/test/misc/1.c @@ -5,7 +5,7 @@ TEST_HEADER language = c link = testlib.o OUTPUT_SPEC - memoryerror = true + abort = true END_HEADER */ diff --git a/mps/test/misc/2.c b/mps/test/misc/2.c index a6ff666788b..7686fa9fb24 100644 --- a/mps/test/misc/2.c +++ b/mps/test/misc/2.c @@ -6,7 +6,7 @@ TEST_HEADER link = testlib.o parameters = NUM=1 OUTPUT_SPEC - memoryerror = true + abort = true END_HEADER */ diff --git a/mps/test/test/script/headread b/mps/test/test/script/headread index 794027763b2..99c1d0f1359 100644 --- a/mps/test/test/script/headread +++ b/mps/test/test/script/headread @@ -149,7 +149,7 @@ sub read_results { &debug($_); if (/^!/) { # result variable - if (/^!(\w+)\s*=\s*(.+)\s*/) { + if (/^!(\w+)\s*=\s*(.+?)\s*$/) { $real_output{$1} = $2 } else { die "Badly formatted result line in output:\n$_\n"; diff --git a/mps/test/test/script/ntx86bin/cat.exe b/mps/test/test/script/ntx86bin/cat.exe deleted file mode 100644 index 66e26ec6d86..00000000000 Binary files a/mps/test/test/script/ntx86bin/cat.exe and /dev/null differ diff --git a/mps/test/test/script/ntx86bin/strings.exe b/mps/test/test/script/ntx86bin/strings.exe deleted file mode 100644 index 80bfe2e3f89..00000000000 Binary files a/mps/test/test/script/ntx86bin/strings.exe and /dev/null differ diff --git a/mps/test/test/script/ntx86bin/tee.exe b/mps/test/test/script/ntx86bin/tee.exe deleted file mode 100644 index a9fc921ad0d..00000000000 Binary files a/mps/test/test/script/ntx86bin/tee.exe and /dev/null differ diff --git a/mps/test/test/script/platform b/mps/test/test/script/platform index 88b3320db76..9dba51fdef7 100644 --- a/mps/test/test/script/platform +++ b/mps/test/test/script/platform @@ -46,12 +46,12 @@ sub platform_settings { sub settings_nt { - $dirsep = "\\"; + $dirsep = "/"; $cc_command = "cl"; # following line used to include /DMMQA_VERS_$MPS_INTERFACE_VERSION - $cc_opts = "/nologo /DWIN32 /D_WINDOWS /W3 /Zi /Oy- /MD /DMMQA_PROD_$MPS_PRODUCT"; + $cc_opts = "/nologo /DWIN32 /D_WINDOWS /D_CRT_SECURE_NO_WARNINGS /W3 /Zi /Oy- /MD /DMMQA_PROD_$MPS_PRODUCT"; $cc_link = "$obj_dir/platform.obj"; - $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debugtype:both /pdb:none /debug:full"; + $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debug"; $cc_include = "/I$testlib_dir /I$MPS_INCLUDE_DIR /I$obj_dir"; $cc_def = "/D"; $cc_defeq = "="; @@ -62,16 +62,16 @@ sub settings_nt { $cc_objandexe = 1; $obj_suffix = ".obj"; $try_command = ""; - $catcommand = "$script_dir/ntx86bin/cat.exe"; + $catcommand = "cat"; $comwrap = "\""; $comwrapend = "\""; $stdout_red = ">"; - $stdout_dup = "| $script_dir/ntx86bin/tee.exe"; + $stdout_dup = "| tee"; $stdin_red = "<"; $stdboth_red = ">%s 2>&1"; $quotestring = \&nt_quotestring; $platmailfile = \&nt_mailfile; - $stringscommand = "$script_dir/ntx86bin/strings.exe -20 -c"; + $stringscommand = "strings"; $preprocommand = "$cc_command /nologo $cc_preonly"; $exesuff = ".exe"; %ignored_headers = (); @@ -80,11 +80,11 @@ sub settings_nt { sub settings_nt_cap { $cc_opts = "$cc_opts /Gh"; $cc_link = "$cc_link CAP.lib"; - $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debug:full /debugtype:both /pdb:none"; + $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debug"; } sub settings_nt_coff { - $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debugtype:coff /debug:full"; + $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debug"; } diff --git a/mps/test/test/testlib/arg.h b/mps/test/test/testlib/arg.h index 95fa4996f3f..f2f07b81501 100644 --- a/mps/test/test/testlib/arg.h +++ b/mps/test/test/testlib/arg.h @@ -8,6 +8,7 @@ arg.h #include "testlib.h" +#undef UNALIGNED #define UNALIGNED ((mps_addr_t) (((char *) NULL) + 1)) #define MPS_RANK_MIN 0 diff --git a/mps/test/test/testlib/lofmt.c b/mps/test/test/testlib/lofmt.c index 51697c00bdf..35567c8f314 100644 --- a/mps/test/test/testlib/lofmt.c +++ b/mps/test/test/testlib/lofmt.c @@ -186,7 +186,7 @@ long int getlocopycount(locell *obj) return obj->data.copycount; } -long int getlosize(locell *obj) +size_t getlosize(locell *obj) { asserts(obj->tag == LOdata, "getlosize: non-data object."); return obj->data.size - offsetof(struct lodata, data); diff --git a/mps/test/test/testlib/lofmt.h b/mps/test/test/testlib/lofmt.h index 14b9ce2a2c5..e8e2c17d02d 100644 --- a/mps/test/test/testlib/lofmt.h +++ b/mps/test/test/testlib/lofmt.h @@ -56,7 +56,7 @@ locell *alloclo(mps_ap_t ap, size_t bytes); long int getloid(locell *obj); long int getlocopycount(locell *obj); -long int getlosize(locell *obj); +size_t getlosize(locell *obj); #endif diff --git a/mps/test/test/testlib/platform.c b/mps/test/test/testlib/platform.c index 23ffd36f234..83badbf2759 100644 --- a/mps/test/test/testlib/platform.c +++ b/mps/test/test/testlib/platform.c @@ -8,8 +8,7 @@ LONG mySEHFilter(LPEXCEPTION_POINTERS info) { LPEXCEPTION_RECORD er; - int write; - unsigned long address; + ULONG_PTR write, address; er = info->ExceptionRecord; @@ -23,6 +22,7 @@ LONG mySEHFilter(LPEXCEPTION_POINTERS info) { report("memoryop", "read"); } report("memoryaddr", "%ld", address); + report("abort", "true"); myabort(); } diff --git a/mps/test/test/testlib/platform.h b/mps/test/test/testlib/platform.h index c10eb1b103d..86224174957 100644 --- a/mps/test/test/testlib/platform.h +++ b/mps/test/test/testlib/platform.h @@ -4,12 +4,8 @@ */ #ifdef MPS_OS_W3 -#ifdef MMQA_HEADER_mpsw3 -/* we may be required to include mpsw3.h on windows platforms */ -#include "mpsw3.h" -#endif +#include "mpswin.h" /* to trap access violations in the test harness */ LONG mySEHFilter(LPEXCEPTION_POINTERS); #endif -