mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-03-26 08:41:47 -07:00
Code Issues Projects Releases Wiki Activity

New api function mps_pool_walk.

Browse source
This commit is contained in:
Gareth Rees 2020-08-31 10:48:26 +01:00
parent a8fe3c5134
commit 359bd5b034
25 changed files with 718 additions and 115 deletions
Download patch file Download diff file Expand all files Collapse all files

27
mps/code/amcss.c
View file

@ -128,6 +128,24 @@ static void test_stepper(mps_addr_t object, mps_fmt_t fmt, mps_pool_t pool,
}
/* area_scan -- area scanning function for mps_pool_walk */
static mps_res_t area_scan(mps_ss_t ss, void *base, void *limit, void *closure)
{
unsigned long *count = closure;
mps_res_t res;
while (base < limit) {
mps_addr_t prev = base;
++ *count;
res = dylan_scan1(ss, &base);
if (res != MPS_RES_OK) return res;
Insist(prev < base);
}
Insist(base == limit);
return MPS_RES_OK;
}
/* test -- the body of the test */
static void test(mps_pool_class_t pool_class, size_t roots_count)
@ -225,11 +243,14 @@ static void test(mps_pool_class_t pool_class, size_t roots_count)
"NULL in arena");
if (collections == collectionsCOUNT / 2) {
unsigned long object_count = 0;
unsigned long count1 = 0, count2 = 0;
mps_arena_park(arena);
mps_arena_formatted_objects_walk(arena, test_stepper, &object_count, 0);
mps_arena_formatted_objects_walk(arena, test_stepper, &count1, 0);
die(mps_pool_walk(pool, area_scan, &count2), "mps_pool_walk");
mps_arena_release(arena);
printf("stepped on %lu objects.\n", object_count);
printf("stepped on %lu objects.\n", count1);
printf("walked %lu objects.\n", count2);
Insist(count1 == count2);
}
if (collections == rampSwitch) {
int begin_ramp = !ramping

32
mps/code/amcssth.c
View file

@ -5,9 +5,9 @@
* Portions copyright (c) 2002 Global Graphics Software.
*
* The main thread parks the arena half way through the test case and
* runs mps_arena_formatted_objects_walk(). This checks that walking
* works while the other threads continue to allocate in the
* background.
* runs mps_pool_walk() and mps_arena_formatted_objects_walk(). This
* checks that walking works while the other threads continue to
* allocate in the background.
*/
#include "fmtdy.h"
@ -86,6 +86,24 @@ static void test_stepper(mps_addr_t object, mps_fmt_t fmt, mps_pool_t pool,
}
/* area_scan -- area scanning function for mps_pool_walk */
static mps_res_t area_scan(mps_ss_t ss, void *base, void *limit, void *closure)
{
unsigned long *count = closure;
mps_res_t res;
while (base < limit) {
mps_addr_t prev = base;
++ *count;
res = dylan_scan1(ss, &base);
if (res != MPS_RES_OK) return res;
Insist(prev < base);
}
Insist(base == limit);
return MPS_RES_OK;
}
/* churn -- create an object and install into roots */
static void churn(mps_ap_t ap, size_t roots_count)
@ -209,11 +227,13 @@ static void test_pool(const char *name, mps_pool_t pool, size_t roots_count)
if (collections >= collectionsCOUNT / 2 && !walked)
{
unsigned long count = 0;
unsigned long count1 = 0, count2 = 0;
mps_arena_park(arena);
mps_arena_formatted_objects_walk(arena, test_stepper, &count, 0);
mps_arena_formatted_objects_walk(arena, test_stepper, &count1, 0);
die(mps_pool_walk(pool, area_scan, &count2), "mps_pool_walk");
mps_arena_release(arena);
printf("stepped on %lu objects.\n", count);
printf("stepped on %lu objects.\n", count1);
printf("walked %lu objects.\n", count2);
walked = TRUE;
}
if (collections >= rampSwitch && !ramped) {

3
mps/code/format.c
View file

@ -40,8 +40,7 @@ Bool FormatCheck(Format format)
/* FormatNo methods -- default values for format keyword arguments */
static mps_res_t FormatNoScan(mps_ss_t mps_ss, mps_addr_t base,
mps_addr_t limit)
mps_res_t FormatNoScan(mps_ss_t mps_ss, mps_addr_t base, mps_addr_t limit)
{
UNUSED(mps_ss);
UNUSED(base);

23
mps/code/locv.c
View file

@ -42,6 +42,23 @@ static mps_fmt_A_s locv_fmt =
static mps_addr_t roots[4];
/* area_scan -- area scanning function for mps_pool_walk */
static mps_res_t area_scan(mps_ss_t ss, void *base, void *limit, void *closure)
{
unsigned long *count = closure;
testlib_unused(ss);
while (base < limit) {
mps_addr_t prev = base;
++ *count;
base = skip(base);
Insist(prev < base);
}
Insist(base == limit);
return MPS_RES_OK;
}
int main(int argc, char *argv[])
{
mps_arena_t arena;
@ -85,9 +102,15 @@ int main(int argc, char *argv[])
*(mps_word_t *)p = sizeof(void *);
cdie(mps_commit(ap, p, sizeof(void *)), "commit last");
mps_arena_park(arena);
{
size_t count = 0;
mps_arena_formatted_objects_walk(arena, stepper, &count, 0);
cdie(count == 4, "stepped 4 objects");
}
{
size_t count = 0;
die(mps_pool_walk(pool, area_scan, &count), "mps_pool_walk");
cdie(count == 4, "walk 4 objects");
}

1
mps/code/mpm.h
View file

@ -812,6 +812,7 @@ extern Res FormatCreate(Format *formatReturn, Arena arena, ArgList args);
extern void FormatDestroy(Format format);
extern Arena FormatArena(Format format);
extern Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth);
extern mps_res_t FormatNoScan(mps_ss_t mps_ss, mps_addr_t base, mps_addr_t limit);
/* Reference Interface -- see <code/ref.c> */

5
mps/code/mpmst.h
View file

@ -402,8 +402,9 @@ typedef struct ScanStateStruct {
Sig sig; /* <design/sig> */
struct mps_ss_s ss_s; /* .ss <http://bash.org/?400459> */
Arena arena; /* owning arena */
mps_area_scan_t formatScan; /* formatted area scanning function */
void *formatScanClosure; /* closure argument for .formatScan */
mps_fmt_scan_t formatScan; /* callback for scanning formatted objects */
mps_area_scan_t areaScan; /* ditto via the area scanning interface */
void *areaScanClosure; /* closure argument for areaScan */
SegFixMethod fix; /* third stage fix function */
void *fixClosure; /* see .ss.fix-closure */
TraceSet traces; /* traces to scan for */

1
mps/code/mps.h
View file

@ -498,6 +498,7 @@ extern mps_res_t mps_pool_create_k(mps_pool_t *, mps_arena_t,
extern void mps_pool_destroy(mps_pool_t);
extern size_t mps_pool_total_size(mps_pool_t);
extern size_t mps_pool_free_size(mps_pool_t);
extern mps_res_t mps_pool_walk(mps_pool_t, mps_area_scan_t, void *);
/* Chains */

58
mps/code/poollo.c
View file

@ -71,6 +71,7 @@ static Bool loSegBufferFill(Addr *baseReturn, Addr *limitReturn,
Seg seg, Size size, RankSet rankSet);
static void loSegBufferEmpty(Seg seg, Buffer buffer);
static Res loSegWhiten(Seg seg, Trace trace);
static Res loSegScan(Bool *totalReturn, Seg seg, ScanState ss);
static Res loSegFix(Seg seg, ScanState ss, Ref *refIO);
static void loSegReclaim(Seg seg, Trace trace);
static void loSegWalk(Seg seg, Format format, FormattedObjectsVisitor f,
@ -89,6 +90,7 @@ DEFINE_CLASS(Seg, LOSeg, klass)
klass->bufferFill = loSegBufferFill;
klass->bufferEmpty = loSegBufferEmpty;
klass->whiten = loSegWhiten;
klass->scan = loSegScan;
klass->fix = loSegFix;
klass->fixEmergency = loSegFix;
klass->reclaim = loSegReclaim;
@ -646,6 +648,62 @@ static Res loSegWhiten(Seg seg, Trace trace)
}
static Res loSegScan(Bool *totalReturn, Seg seg, ScanState ss)
{
LOSeg loseg = MustBeA(LOSeg, seg);
Pool pool = SegPool(seg);
Addr p, base, limit;
Buffer buffer;
Bool hasBuffer = SegBuffer(&buffer, seg);
Format format = NULL; /* suppress "may be used uninitialized" warning */
Bool b;
AVER(totalReturn != NULL);
AVERT(Seg, seg);
AVERT(ScanState, ss);
base = SegBase(seg);
limit = SegLimit(seg);
b = PoolFormat(&format, pool);
AVER(b);
p = base;
while (p < limit) {
Addr q;
Index i;
if (hasBuffer) {
if (p == BufferScanLimit(buffer)
&& BufferScanLimit(buffer) != BufferLimit(buffer)) {
/* skip over buffered area */
p = BufferLimit(buffer);
continue;
}
/* since we skip over the buffered area we are always */
/* either before the buffer, or after it, never in it */
AVER(p < BufferGetInit(buffer) || BufferLimit(buffer) <= p);
}
i = PoolIndexOfAddr(base, pool, p);
if (!BTGet(loseg->alloc, i)) {
p = AddrAdd(p, PoolAlignment(pool));
continue;
}
q = (*format->skip)(AddrAdd(p, format->headerSize));
q = AddrSub(q, format->headerSize);
if (BTGet(loseg->mark, i)) {
Res res = TraceScanFormat(ss, p, q);
if (res != ResOK)
return res;
}
p = q;
}
AVER(p == limit);
return ResOK;
}
static Res loSegFix(Seg seg, ScanState ss, Ref *refIO)
{
LOSeg loseg = MustBeA_CRITICAL(LOSeg, seg);

40
mps/code/sncss.c
View file

@ -84,6 +84,28 @@ static void fmtVisitor(mps_addr_t object, mps_fmt_t format,
env->obj += obj->size;
}
/* area_scan -- area scanning function for mps_pool_walk */
static mps_res_t area_scan(mps_ss_t ss, void *base, void *limit, void *closure)
{
env_t env = closure;
testlib_unused(ss);
while (base < limit) {
mps_addr_t prev = base;
obj_t obj = base;
if (obj->pad)
env->pad += obj->size;
else
env->obj += obj->size;
base = fmtSkip(base);
Insist(prev < base);
}
Insist(base == limit);
return MPS_RES_OK;
}
#define AP_MAX 3 /* Number of allocation points */
#define DEPTH_MAX 20 /* Maximum depth of frame push */
@ -152,11 +174,10 @@ static void test(mps_pool_class_t pool_class)
}
}
mps_arena_park(arena);
{
env_s env = {0, 0};
env_s env1 = {0, 0}, env2 = {0, 0};
size_t alloc = 0;
size_t free = mps_pool_free_size(pool);
size_t total = mps_pool_total_size(pool);
for (i = 0; i < NELEMS(aps); ++i) {
ap_t a = &aps[i];
@ -165,15 +186,12 @@ static void test(mps_pool_class_t pool_class)
}
}
mps_arena_formatted_objects_walk(arena, fmtVisitor, &env, 0);
mps_arena_formatted_objects_walk(arena, fmtVisitor, &env1, 0);
Insist(alloc == env1.obj);
printf("alloc=%lu obj=%lu pad=%lu free=%lu total=%lu\n",
(unsigned long)alloc,
(unsigned long)env.obj,
(unsigned long)env.pad,
(unsigned long)free,
(unsigned long)total);
Insist(alloc == env.obj);
die(mps_pool_walk(pool, area_scan, &env2), "mps_pool_walk");
Insist(alloc == env2.obj);
Insist(env1.pad == env2.pad);
}
for (i = 0; i < NELEMS(aps); ++i) {

46
mps/code/trace.c
View file

@ -38,7 +38,8 @@ Bool ScanStateCheck(ScanState ss)
CHECKS(ScanState, ss);
CHECKL(FUNCHECK(ss->formatScan));
/* Can't check ss->formatScanClosure. */
CHECKL(FUNCHECK(ss->areaScan));
/* Can't check ss->areaScanClosure. */
CHECKL(FUNCHECK(ss->fix));
/* Can't check ss->fixClosure. */
CHECKL(ScanStateZoneShift(ss) == ss->arena->zoneShift);
@ -58,20 +59,12 @@ Bool ScanStateCheck(ScanState ss)
}
/* traceNoScan -- Area scan method that must not be called. */
/* traceNoAreaScan -- area scan function that must not be called */
static mps_res_t traceNoScan(mps_ss_t ss, void *base, void *limit, void *closure)
static mps_res_t traceNoAreaScan(mps_ss_t ss, void *base, void *limit, void *closure)
{
UNUSED(ss);
AVER(base != NULL);
AVER(limit != NULL);
AVER(base < limit);
AVER(closure == UNUSED_POINTER);
NOTREACHED;
return MPS_RES_UNIMPL;
UNUSED(closure);
return FormatNoScan(ss, base, limit);
}
@ -110,8 +103,8 @@ void ScanStateInit(ScanState ss, TraceSet ts, Arena arena,
if (ss->fix == SegFix && ArenaEmergency(arena))
ss->fix = SegFixEmergency;
ss->formatScan = traceNoScan;
ss->formatScanClosure = UNUSED_POINTER;
ss->formatScan = FormatNoScan;
ss->areaScan = traceNoAreaScan;
ss->rank = rank;
ss->traces = ts;
ScanStateSetZoneShift(ss, arena->zoneShift);
@ -135,24 +128,6 @@ void ScanStateInit(ScanState ss, TraceSet ts, Arena arena,
}
/* traceFormatScan -- Area scan method that dispatches to a format scan.
*
* This is a wrapper for formatted object scanning functions, which
* should not otherwise be called directly from within the MPS.
*/
static mps_res_t traceFormatScan(mps_ss_t mps_ss, void *base, void *limit, void *closure)
{
Format format = closure;
AVER_CRITICAL(base != NULL);
AVER_CRITICAL(limit != NULL);
AVER_CRITICAL(base < limit);
AVERT_CRITICAL(Format, format);
return format->scan(mps_ss, base, limit);
}
/* ScanStateInitSeg -- Initialize a ScanState object for scanning a segment */
void ScanStateInitSeg(ScanState ss, TraceSet ts, Arena arena,
@ -163,8 +138,7 @@ void ScanStateInitSeg(ScanState ss, TraceSet ts, Arena arena,
ScanStateInit(ss, ts, arena, rank, white);
if (PoolFormat(&format, SegPool(seg))) {
ss->formatScan = traceFormatScan;
ss->formatScanClosure = format;
ss->formatScan = format->scan;
}
}
@ -1561,7 +1535,7 @@ Res TraceScanFormat(ScanState ss, Addr base, Addr limit)
* ss->formatScan. */
ss->scannedSize += AddrOffset(base, limit);
return ss->formatScan(&ss->ss_s, base, limit, ss->formatScanClosure);
return ss->formatScan(&ss->ss_s, base, limit);
}

117
mps/code/walk.c
View file

@ -381,6 +381,123 @@ void mps_arena_roots_walk(mps_arena_t mps_arena, mps_roots_stepper_t f,
}
/* walkNoFix -- third-stage fix function for poolWalk.
*
* The second-stage fix is not called via poolWalk; so this is not
* called either. The NOTREACHED checks that this is the case.
*/
static Res walkNoFix(Seg seg, ScanState ss, Addr *refIO)
{
AVERT(Seg, seg);
AVERT(ScanState, ss);
AVER(refIO != NULL);
NOTREACHED;
return ResUNIMPL;
}
/* poolWalkScan -- format scanner for poolWalk */
static mps_res_t poolWalkScan(mps_ss_t mps_ss, void *base, void *limit)
{
ScanState ss = PARENT(ScanStateStruct, ss_s, mps_ss);
AVERT(ScanState, ss);
AVER(base != NULL);
AVER(limit != NULL);
AVER(base < limit);
return ss->areaScan(mps_ss, base, limit, ss->areaScanClosure);
}
/* poolWalk -- walk formatted areas in a pool
*
* See <design/walk>.
*/
static Res poolWalk(Arena arena, Pool pool, mps_area_scan_t area_scan, void *closure)
{
Trace trace;
TraceSet ts;
ScanStateStruct ss;
Ring node, nextNode;
Res res = ResOK;
AVERT(Arena, arena);
AVERT(Pool, pool);
AVER(FUNCHECK(area_scan));
/* closure is arbitrary and can't be checked */
AVER(ArenaGlobals(arena)->clamped); /* .assume.parked */
AVER(arena->busyTraces == TraceSetEMPTY); /* .assume.parked */
/* Synthesize a flipped trace with an empty white set. The empty
* white set means that the MPS_FIX1 test will always fail and
* _mps_fix2 will never be called. */
res = TraceCreate(&trace, arena, TraceStartWhyWALK);
/* Fail if no trace available. Unlikely due to .assume.parked. */
if (res != ResOK)
return res;
trace->white = ZoneSetEMPTY;
trace->state = TraceFLIPPED;
arena->flippedTraces = TraceSetAdd(arena->flippedTraces, trace);
ts = TraceSetSingle(trace);
ScanStateInit(&ss, ts, arena, RankEXACT, trace->white);
ss.formatScan = poolWalkScan;
ss.areaScan = area_scan;
ss.areaScanClosure = closure;
ss.fix = walkNoFix;
RING_FOR(node, &pool->segRing, nextNode) {
Bool wasTotal;
Seg seg = SegOfPoolRing(node);
Bool needSummary = SegRankSet(seg) != RankSetEMPTY;
if (needSummary)
ScanStateSetSummary(&ss, RefSetEMPTY);
/* Expose the segment to make sure we can scan it. */
ShieldExpose(arena, seg);
res = SegScan(&wasTotal, seg, &ss);
ShieldCover(arena, seg);
if (needSummary)
ScanStateUpdateSummary(&ss, seg, res == ResOK && wasTotal);
if (res != ResOK)
break;
}
ScanStateFinish(&ss);
trace->state = TraceFINISHED;
TraceDestroyFinished(trace);
AVER(!ArenaEmergency(arena)); /* There was no allocation. */
return res;
}
mps_res_t mps_pool_walk(mps_pool_t pool, mps_area_scan_t area_scan, void *closure)
{
Arena arena;
Res res;
AVER(TESTT(Pool, pool));
arena = PoolArena(pool);
ArenaEnter(arena);
AVER(FUNCHECK(area_scan));
/* closure is arbitrary and can't be checked */
res = poolWalk(arena, pool, area_scan, closure);
ArenaLeave(arena);
return res;
}
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2020 Ravenbrook Limited <https://www.ravenbrook.com/>.

79
mps/code/walkt0.c
View file

@ -138,6 +138,30 @@ static void object_stepper(mps_addr_t object, mps_fmt_t format,
}
/* area_scan -- area scanning function for mps_pool_walk */
static mps_res_t area_scan(mps_ss_t ss, void *base, void *limit, void *closure)
{
object_stepper_data_t sd = closure;
mps_res_t res;
while (base < limit) {
size_t size = AddrOffset(base, dylan_skip(base));
mps_addr_t prev = base;
if (dylan_ispad(base)) {
sd->padSize += size;
} else {
++ sd->count;
sd->objSize += size;
}
res = dylan_scan1(ss, &base);
if (res != MPS_RES_OK) return res;
Insist(prev < base);
}
Insist(base == limit);
return MPS_RES_OK;
}
/* A roots stepper function. Passed to mps_arena_roots_walk. */
typedef struct roots_stepper_data {
@ -169,6 +193,7 @@ static void test(mps_arena_t arena, mps_pool_class_t pool_class)
unsigned long objs;
object_stepper_data_s objectStepperData, *sd;
roots_stepper_data_s rootsStepperData, *rsd;
int walk;
die(dylan_fmt(&format, arena), "fmt_create");
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
@ -217,29 +242,39 @@ static void test(mps_arena_t arena, mps_pool_class_t pool_class)
printf("%lu %lu\n", (unsigned long)rsd->count, (unsigned long)exactRootsCOUNT);
Insist(rsd->count == exactRootsCOUNT);
sd = &objectStepperData;
sd->arena = arena;
sd->expect_pool = pool;
sd->expect_fmt = format;
sd->count = 0;
sd->objSize = 0;
sd->padSize = 0;
mps_arena_formatted_objects_walk(arena, object_stepper, sd, sizeof *sd);
Insist(sd->count == objs);
for (walk = 0; walk < 2; ++walk)
{
sd = &objectStepperData;
sd->arena = arena;
sd->expect_pool = pool;
sd->expect_fmt = format;
sd->count = 0;
sd->objSize = 0;
sd->padSize = 0;
if (walk) {
mps_arena_formatted_objects_walk(arena, object_stepper,
sd, sizeof *sd);
} else {
die(mps_pool_walk(pool, area_scan, sd), "mps_pool_walk");
}
Insist(sd->count == objs);
totalSize = mps_pool_total_size(pool);
freeSize = mps_pool_free_size(pool);
allocSize = totalSize - freeSize;
bufferSize = AddrOffset(ap->init, ap->limit);
printf("%s: obj=%lu pad=%lu total=%lu free=%lu alloc=%lu buffer=%lu\n",
ClassName(pool_class),
(unsigned long)sd->objSize,
(unsigned long)sd->padSize,
(unsigned long)totalSize,
(unsigned long)freeSize,
(unsigned long)allocSize,
(unsigned long)bufferSize);
Insist(sd->objSize + sd->padSize + bufferSize == allocSize);
totalSize = mps_pool_total_size(pool);
freeSize = mps_pool_free_size(pool);
allocSize = totalSize - freeSize;
bufferSize = AddrOffset(ap->init, ap->limit);
printf("%s: obj=%lu pad=%lu total=%lu free=%lu alloc=%lu buffer=%lu\n",
ClassName(pool_class),
(unsigned long)sd->objSize,
(unsigned long)sd->padSize,
(unsigned long)totalSize,
(unsigned long)freeSize,
(unsigned long)allocSize,
(unsigned long)bufferSize);
Insist(sd->objSize + sd->padSize + bufferSize == allocSize);
}
mps_arena_collect(arena);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);

3
mps/design/index.txt
View file

@ -111,6 +111,7 @@ trace_ Tracer
type_ General MPS types
version-library_ Library version mechanism
vm_ Virtual mapping
walk_ Walking formatted objects
write-barrier_ Write Barrier
writef_ The WriteF function
====================== ================================================
@ -187,6 +188,7 @@ writef_ The WriteF function
.. _type: type
.. _version-library: version-library
.. _vm: vm
.. _walk: walk
.. _write-barrier: write-barrier
.. _writef: writef
@ -223,6 +225,7 @@ Document History
- 2014-01-17 GDR_ Add abq, nailboard, range.
- 2016-03-22 RB_ Add write-barier.
- 2016-03-27 RB_ Goodbye pool MV *sniff*.
- 2020-08-31 GDR_ Add walk.
.. _RB: https://www.ravenbrook.com/consultants/rb
.. _NB: https://www.ravenbrook.com/consultants/nb

3
mps/design/object-debug.txt
View file

@ -343,11 +343,10 @@ _`.interface.tags.alloc`: Two functions to extend the existing
``mps_alloc()`` (request.???.??? proposes to remove the varargs)
``void (*mps_objects_step_t)(mps_addr_t addr, size_t size, mps_fmt_t format, mps_pool_t pool, void *tag_data, void *p)``
``void mps_pool_walk(mps_arena_t arena, mps_pool_t pool, mps_objects_step_t step, void *p)``
``void mps_arena_walk(mps_arena_t arena, mps_objects_step_t step, void *p)``
_`.interface.tags.walker`: Functions to walk all the allocated
objects in a pool or an arena (only client pools in this case),
objects in an arena (only client pools in this case),
``format`` and ``tag_data`` can be ``NULL`` (``tag_data`` really wants
to be ``void *``, not ``mps_addr_t``, because it's stored
together with the internal tag data in an MPS internal pool)

11
mps/design/seg.txt
View file

@ -317,10 +317,13 @@ segment ``seg``, passing the scan state ``ss`` to
summary of *all* its objects. If it succeeds in accumulating such a
summary it must indicate that it has done so by setting the
``*totalReturn`` parameter to ``TRUE``. Otherwise it must set
``*totalReturn`` to ``FALSE``. Segment classes are not required to
provide this method, and not doing so indicates that all instances of
this class will have no fixable or traceable references in them. This
method is called via the generic function ``SegScan()``.
``*totalReturn`` to ``FALSE``. This method is called via the generic
function ``SegScan()``.
_`.method.scan.required`: Automatically managed segment classes are
required to provide this method, even if all instances of this class
will have no fixable or traceable references in them, in order to
support ``mps_pool_walk()``.
``typedef Res (*SegFixMethod)(Seg seg, ScanState ss, Ref *refIO)``

5
mps/design/sp.txt
View file

@ -96,7 +96,6 @@ Args Locals Function
4 0 ``SegScan()``
4 5 ``amcSegScan()``
3 0 ``TraceScanFormat()``
4 1 ``traceFormatScan()``
3 ≤64 ``format->scan()``
3 0 ``SegFix()``
4 15 ``amcSegFix()``
@ -114,12 +113,12 @@ Args Locals Function
3 7 ``SplaySplay()``
4 8 ``SplaySplitDown()``
3 0 ``SplayZig()``
115 ≤259 **Total**
111 ≤258 **Total**
==== ====== ========================
We expect that a compiler will not need to push all local variables
onto the stack, but even in the case where it pushes all of them, this
call requires no more than 374 words of stack space.
call requires no more than 369 words of stack space.
This isn't necessarily the deepest call into the MPS (the MPS's
modular design and class system makes it hard to do a complete

157
mps/design/walk.txt Normal file
View file

@ -0,0 +1,157 @@
.. mode: -*- rst -*-
Walking formatted objects
=========================
:Tag: design.mps.walk
:Author: Gareth Rees
:Date: 2020-08-31
:Status: complete design
:Revision: $Id$
:Copyright: See `Copyright and License`_.
:Index terms: pair: walk; design
Introduction
------------
_`.intro`: This is the design of the formatted objects walk interface.
The intended audience is MPS developers.
_`.source`: Based on [GDR_2020-08-30]_.
Use cases
---------
_`.case.reload`: A language runtime that offers hot reloading of code
will need to walk all objects belonging to a class (say) in order to
modify the references in the objects so they refer to the updated
class definition. [Strömbäck_2020-08-20]_
_`.case.serialize`: A language runtime that offers serialization and
deserialization of the heap will need to walk all formatted objects in
order to identify references to globals (during serialization) and
modify references to refer to the new locations of the globals (after
deserialization). [GDR_2018-08-30]_
Requirements
------------
_`.req.walk.all`: It must be possible for the client program to visit
all automatically managed formatted objects using a callback.
_`.req.walk.assume-format`: The callback should not need to switch on
the format, as this may be awkward in a program which has modules
using different pools with different formats.
_`.req.walk.examine`: It must be possible for the callback to examine
other automatically managed memory while walking the objects.
_`.req.walk.modify`: It must be possible for the callback to modify
the references in the objects.
_`.req.walk.overhead`: The overhead of calling the callback should be
minimized.
_`.req.walk.perf`: The performance of subsequent collections should
not be affected.
_`.req.walk.closure`: The callback must have access to arbitrary data
from the caller.
_`.req.walk.maint`: The interface should be easy to implement and
maintain.
Design
------
A new public function ``mps_pool_walk()`` visits the live formatted
objects in an automatically managed pool.
_`.sol.walk.all`: The client program must know which pools it has
created so it can call ``mps_pool_walk()`` for each pool.
_`.sol.walk.assume-format`: All objects in a pool share the same
format, so the callback does not need to switch on the format.
_`.sol.walk.examine`: ``mps_pool_walk()`` must only be called when the
arena is parked, and so there is no read barrier on any object.
_`.sol.walk.modify`: ``mps_pool_walk()`` arranges for write-protection
to be removed from each segment while it is being walked and restored
afterwards if necessary.
_`.sol.walk.overhead`: The callback is called for contiguous regions
of formatted objects (not just for each object) where possible so that
the per-object function call overhead is minimized.
_`.sol.walk.perf`: The callback uses the scanning protocol so that
every reference is fixed and the summary is maintained.
_`.sol.walk.closure`: ``mps_pool_walk()`` takes a closure pointer
which is stored in the ``ScanState`` and passed to the callback.
_`.sol.walk.maint`: We reuse the scanning protocol and provide a
generic implementation that iterates over the ring of segments in the
pool. We set up an empty white set in the ``ScanState`` so that the
``MPS_FIX1()`` test always fails and ``_mps_fix2()`` is never called.
This avoids any per-pool code to support the interface.
References
----------
.. [GDR_2018-08-30]
"Save/restore draft proposal";
Gareth Rees; 2018-08-30;
<https://info.ravenbrook.com/mail/2018/08/30/12-57-09/0/>.
.. [GDR_2020-08-30]
"Re: Modifying objects during mps_formatted_objects_walk";
Gareth Rees; 2020-08-30;
<https://info.ravenbrook.com/mail/2020/08/31/19-17-03/0/>.
.. [Strömbäck_2020-08-20]
"Modifying objects during mps_formatted_objects_walk";
Filip Strömbäck; 2020-08-20;
<https://info.ravenbrook.com/mail/2020/08/20/21-01-34/0/>.
Document History
----------------
- 2020-08-31 GDR_ Initial version based on [GDR_2020-08-30]_
.. _GDR: https://www.ravenbrook.com/consultants/gdr/
Copyright and License
---------------------
Copyright © 2001–2020 `Ravenbrook Limited <https://www.ravenbrook.com/>`_.
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.
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 AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDER OR 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.

1
mps/manual/source/design/index.rst
View file

@ -48,5 +48,6 @@ Design
type
version-library
vm
walk
write-barrier
writef

9
mps/manual/source/pool/amcz.rst
View file

@ -86,12 +86,3 @@ AMCZ interface
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, fmt);
res = mps_pool_create_k(&pool, arena, mps_class_amcz(), args);
} MPS_ARGS_END(args);
.. index::
pair: AMCZ pool class; introspection
AMCZ introspection
------------------
See :ref:`pool-amc-introspection`.

8
mps/manual/source/release.rst
View file

@ -39,6 +39,11 @@ New features
experimental: the implementation is likely to change in future
versions of the MPS. See :ref:`design-monitor`.
#. The new function :c:func:`mps_pool_walk` visits all areas of
:term:`formatted objects` in a pool using the
:ref:`topic-scanning-protocol`. This allows the client program to
safely update references in the visited objects.
Interface changes
.................
@ -89,6 +94,9 @@ Interface changes
.. |unpack| replace:: :py:func:`struct.unpack`
.. _unpack: https://docs.python.org/3/library/struct.html#struct.unpack
#. The function :c:func:`mps_formatted_objects_walk` is deprecated in
favour of the new function :c:func:`mps_pool_walk`.
Other changes
.............

1
mps/manual/source/topic/error.rst
View file

@ -67,6 +67,7 @@ assume that any MPS function that returns a result code can return
* :c:macro:`MPS_RES_PARAM`: an invalid parameter was passed.
.. _topic-result-codes:
Result codes
------------

36
mps/manual/source/topic/pool.rst
View file

@ -170,3 +170,39 @@ Pool introspection
at the address, use :c:func:`mps_addr_fmt`. If you only care
whether the address belongs to a particular :term:`arena`, use
:c:func:`mps_arena_has_addr`.
.. c:function:: mps_res_t mps_pool_walk(mps_pool_t pool, mps_area_scan_t scan_area, void *closure)
Visit all :term:`formatted objects` in a :term:`pool`. The pool
must be :term:`automatically managed <automatic memory
management>`. The pool's :term:`arena` must be in the
:term:`parked state`.
:c:data:`pool` is the pool whose formatted objects are visited.
:c:data:`scan_area` is an area scanning function. See
:ref:`topic-scanning-area`.
:c:data:`closure` is an arbitrary pointer that will be passed to
:c:data:`scan_area`.
The scanning function is called multiple times with disjoint areas
of memory that cover all formatted objects in the pool. The areas
may also include :term:`padding objects` if the pool's format has
a :term:`padding method`, but never includes :term:`forwarding
objects` since the arena is in the parked state.
The scanning function must follow the
:ref:`topic-scanning-protocol`. In particular, it must :term:`fix`
every :term:`reference` in the area. The scanning function may
return :c:macro:`MPS_RES_OK` to continue visiting areas of
formatted objects, or return other :ref:`topic-result-codes` to
stop visiting and return to the caller.
.. note::
If the scanning function modifies a reference, it must scan
the modified reference. It is safe to scan the original
reference as well, but this may lead to unwanted
:term:`retention`.

22
mps/manual/source/topic/scanning.rst
View file

@ -17,13 +17,21 @@ Scanning
Memory Pool System, and the most critical of the memory management
functions that have to be implemented by the :term:`client program`.
Scanning is performed for two tasks: during :term:`tracing <trace>`,
blocks are scanned in order to follow references, and so determine
which blocks are :term:`reachable` and which are not. After objects
have been moved in memory, blocks are scanned in order to identify
references that need to be updated to point to the new locations of
these objects. Both tasks use the same scanning protocol, described
here.
Scanning is used to carry out three tasks:
#. During :term:`tracing <trace>`, blocks are scanned in order to
follow references, and so determine which blocks are
:term:`reachable` and which are not.
#. After objects have been moved in memory, blocks are scanned in
order to identify references that need to be updated to point to
the new locations of these objects.
#. When iterating over allocated blocks in a pool using
:c:func:`mps_pool_walk`, blocks are scanned in order to keep data
structures consistent when references are updated.
All these tasks use the same protocol, described here.
.. index::

76
mps/test/function/104.c
View file

@ -1,7 +1,7 @@
/*
TEST_HEADER
id = $Id$
summary = test of mps_arena_formatted_objects_walk, inc AMCZ
summary = test of mps_pool_walk and mps_arena_formatted_objects_walk, inc AMCZ
language = c
link = testlib.o rankfmt.o
parameters = VERBOSE=0
@ -48,7 +48,7 @@ long int apppadcount;
int oldstamp, newstamp;
mps_arena_t arena;
mps_pool_t poolamc, poollo, poolawl;
mps_pool_t poolamc, poolamcz, poolawl;
mps_thr_t thread;
mps_root_t root, root1;
@ -109,6 +109,61 @@ static void stepper(mps_addr_t addr, mps_fmt_t fmt, mps_pool_t pool,
}
static mps_res_t area_scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit, void *closure)
{
int i;
asserts(closure == MAGICPOINT, "VII. Void * didn't get passed!");
MPS_SCAN_BEGIN(ss)
{
while (base < limit)
{
mycell *obj = base;
mps_res_t res;
mps_addr_t p, q;
switch (obj->tag & 0x3)
{
case MCpad:
apppadcount += 1;
base = (mps_addr_t) (obj->pad.tag &~ (mps_word_t) 3);
break;
case MCdata:
appcount += 1;
asserts(obj->data.checkedflag != newstamp,
"III/IV. step on object again at %p", obj);
commentif(VERBOSE && obj->data.checkedflag != oldstamp,
"*. step on unreachable object at %p", obj);
obj->data.checkedflag = newstamp;
p = obj->data.assoc;
if (p != NULL) {
res = MPS_FIX12(ss, &p);
if (res != MPS_RES_OK) return res;
obj->data.assoc = p;
}
for (i=0; i<(obj->data.numrefs); i++)
{
p = obj->data.ref[i].addr;
if (p != NULL)
{
res = MPS_FIX12(ss, (mps_addr_t *) &p);
if (res != MPS_RES_OK) return res;
obj->data.ref[i].addr = p;
}
}
base = (mps_addr_t) ((char *) obj + (obj->data.size));
break;
default:
asserts(0, "area_scan: bizarre obj tag at %p.", obj);
}
}
}
MPS_SCAN_END(ss);
return MPS_RES_OK;
}
static void test(void *stack_pointer)
{
mycell *a[4], /* a is a table of exact roots */
@ -135,7 +190,7 @@ static void test(void *stack_pointer)
die(mmqa_pool_create_chain(&poolamc, arena, mps_class_amc(), format, chain),
"create pool(amc)");
die(mmqa_pool_create_chain(&poollo, arena, mps_class_amcz(), format, chain),
die(mmqa_pool_create_chain(&poolamcz, arena, mps_class_amcz(), format, chain),
"create pool(amcz)");
die(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
@ -146,7 +201,7 @@ static void test(void *stack_pointer)
"create ap(amc)");
cdie(
mps_ap_create(&aplo, poollo, mps_rank_exact()),
mps_ap_create(&aplo, poolamcz, mps_rank_exact()),
"create ap(amcz)");
cdie(
@ -192,8 +247,17 @@ static void test(void *stack_pointer)
oldstamp = newstamp;
newstamp += 1;
mps_arena_formatted_objects_walk(arena, stepper,
(void *)MAGICPOINT, MAGICSIZE);
MAGICPOINT, MAGICSIZE);
oldstamp = newstamp;
newstamp += 1;
mps_pool_walk(poolamc, area_scan, MAGICPOINT);
mps_pool_walk(poolamcz, area_scan, MAGICPOINT);
mps_pool_walk(poolawl, area_scan, MAGICPOINT);
mps_arena_release(arena);
comment("tracing...");
@ -220,7 +284,7 @@ static void test(void *stack_pointer)
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poollo);
mps_pool_destroy(poolamcz);
mps_pool_destroy(poolawl);
comment("Destroyed pools.");

69
mps/test/function/97.c
View file

@ -1,7 +1,7 @@
/*
TEST_HEADER
id = $Id$
summary = test of mps_arena_formatted_objects_walk
summary = test of mps_pool_walk and mps_arena_formatted_objects_walk
language = c
link = testlib.o rankfmt.o
parameters = VERBOSE=0
@ -106,6 +106,62 @@ static void stepper(mps_addr_t addr, mps_fmt_t fmt, mps_pool_t pool,
}
}
static mps_res_t area_scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit, void *closure)
{
int i;
asserts(closure == MAGICPOINT, "VII. Void * didn't get passed!");
MPS_SCAN_BEGIN(ss)
{
while (base < limit)
{
mycell *obj = base;
mps_res_t res;
mps_addr_t p, q;
switch (obj->tag & 0x3)
{
case MCpad:
apppadcount += 1;
base = (mps_addr_t) (obj->pad.tag &~ (mps_word_t) 3);
break;
case MCdata:
appcount += 1;
asserts(obj->data.checkedflag != newstamp,
"III/IV. step on object again at %p", obj);
commentif(VERBOSE && obj->data.checkedflag != oldstamp,
"*. step on unreachable object at %p", obj);
obj->data.checkedflag = newstamp;
p = obj->data.assoc;
if (p != NULL) {
res = MPS_FIX12(ss, &p);
if (res != MPS_RES_OK) return res;
obj->data.assoc = p;
}
for (i=0; i<(obj->data.numrefs); i++)
{
p = obj->data.ref[i].addr;
if (p != NULL)
{
res = MPS_FIX12(ss, (mps_addr_t *) &p);
if (res != MPS_RES_OK) return res;
obj->data.ref[i].addr = p;
}
}
base = (mps_addr_t) ((char *) obj + (obj->data.size));
break;
default:
asserts(0, "area_scan: bizarre obj tag at %p.", obj);
}
}
}
MPS_SCAN_END(ss);
return MPS_RES_OK;
}
static void test(void *stack_pointer)
{
/* a is a table of exact roots
@ -201,8 +257,17 @@ static void test(void *stack_pointer)
oldstamp = newstamp;
newstamp += 1;
mps_arena_formatted_objects_walk(arena, stepper,
(void *) MAGICPOINT, MAGICSIZE);
MAGICPOINT, MAGICSIZE);
oldstamp = newstamp;
newstamp += 1;
mps_pool_walk(poolamc, area_scan, MAGICPOINT);
mps_pool_walk(poollo, area_scan, MAGICPOINT);
mps_pool_walk(poolawl, area_scan, MAGICPOINT);
mps_arena_release(arena);
comment("tracing...");