mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-21 03:52:16 -08:00
1d00afac81
Publish minor changes to readme and configure files in main directory. Main directory and code directory licence texts are now fully updated. Copied from Perforce Change: 196994
411 lines
12 KiB
C
411 lines
12 KiB
C
/* walk.c: OBJECT WALKER
|
|
*
|
|
* $Id$
|
|
* Copyright (c) 2001-2020 Ravenbrook Limited. See end of file for license.
|
|
*/
|
|
|
|
#include "mpm.h"
|
|
#include "mps.h"
|
|
|
|
SRCID(walk, "$Id$");
|
|
|
|
|
|
/* Heap Walking
|
|
*/
|
|
|
|
|
|
#define FormattedObjectsStepClosureSig ((Sig)0x519F05C1) /* SIGnature Formatted Objects Step CLosure */
|
|
|
|
typedef struct FormattedObjectsStepClosureStruct *FormattedObjectsStepClosure;
|
|
|
|
typedef struct FormattedObjectsStepClosureStruct {
|
|
Sig sig;
|
|
mps_formatted_objects_stepper_t f;
|
|
void *p;
|
|
size_t s;
|
|
} FormattedObjectsStepClosureStruct;
|
|
|
|
|
|
ATTRIBUTE_UNUSED
|
|
static Bool FormattedObjectsStepClosureCheck(FormattedObjectsStepClosure c)
|
|
{
|
|
CHECKS(FormattedObjectsStepClosure, c);
|
|
CHECKL(FUNCHECK(c->f));
|
|
/* p and s fields are arbitrary closures which cannot be checked */
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
static void ArenaFormattedObjectsStep(Addr object, Format format, Pool pool,
|
|
void *p, size_t s)
|
|
{
|
|
FormattedObjectsStepClosure c;
|
|
/* Can't check object */
|
|
AVERT(Format, format);
|
|
AVERT(Pool, pool);
|
|
c = p;
|
|
AVERT(FormattedObjectsStepClosure, c);
|
|
AVER(s == UNUSED_SIZE);
|
|
|
|
(*c->f)((mps_addr_t)object, (mps_fmt_t)format, (mps_pool_t)pool,
|
|
c->p, c->s);
|
|
}
|
|
|
|
|
|
/* ArenaFormattedObjectsWalk -- iterate over all objects
|
|
*
|
|
* So called because it walks all formatted objects in an arena. */
|
|
|
|
static void ArenaFormattedObjectsWalk(Arena arena, FormattedObjectsVisitor f,
|
|
void *p, size_t s)
|
|
{
|
|
Seg seg;
|
|
FormattedObjectsStepClosure c;
|
|
Format format;
|
|
|
|
AVERT(Arena, arena);
|
|
AVER(FUNCHECK(f));
|
|
AVER(f == ArenaFormattedObjectsStep);
|
|
/* Know that p is a FormattedObjectsStepClosure */
|
|
c = p;
|
|
AVERT(FormattedObjectsStepClosure, c);
|
|
/* Know that s is UNUSED_SIZE */
|
|
AVER(s == UNUSED_SIZE);
|
|
|
|
if (SegFirst(&seg, arena)) {
|
|
do {
|
|
if (PoolFormat(&format, SegPool(seg))) {
|
|
ShieldExpose(arena, seg);
|
|
SegWalk(seg, format, f, p, s);
|
|
ShieldCover(arena, seg);
|
|
}
|
|
} while(SegNext(&seg, arena, seg));
|
|
}
|
|
}
|
|
|
|
|
|
/* mps_arena_formatted_objects_walk -- iterate over all objects
|
|
*
|
|
* Client interface to ArenaFormattedObjectsWalk. */
|
|
|
|
void mps_arena_formatted_objects_walk(mps_arena_t mps_arena,
|
|
mps_formatted_objects_stepper_t f,
|
|
void *p, size_t s)
|
|
{
|
|
Arena arena = (Arena)mps_arena;
|
|
FormattedObjectsStepClosureStruct c;
|
|
|
|
ArenaEnter(arena);
|
|
AVERT(Arena, arena);
|
|
AVER(FUNCHECK(f));
|
|
/* p and s are arbitrary closures, hence can't be checked */
|
|
c.sig = FormattedObjectsStepClosureSig;
|
|
c.f = f;
|
|
c.p = p;
|
|
c.s = s;
|
|
ArenaFormattedObjectsWalk(arena, ArenaFormattedObjectsStep, &c, UNUSED_SIZE);
|
|
ArenaLeave(arena);
|
|
}
|
|
|
|
|
|
|
|
/* Root Walking
|
|
*
|
|
* This involves more code than it should. The roots are walked by
|
|
* scanning them. But there's no direct support for invoking the scanner
|
|
* without there being a trace, and there's no direct support for
|
|
* creating a trace without also condemning part of the heap. (@@@@ This
|
|
* looks like a useful candidate for inclusion in the future). For now,
|
|
* the root walker contains its own code for creating a minimal trace
|
|
* and scan state.
|
|
*
|
|
* ASSUMPTIONS
|
|
*
|
|
* .assume.parked: The root walker must be invoked with a parked
|
|
* arena. It's only strictly necessary for there to be no current trace,
|
|
* but the client has no way to ensure this apart from parking the
|
|
* arena.
|
|
*
|
|
* .assume.rootaddr: The client closure is called with a parameter which
|
|
* is the address of a reference to an object referenced from a
|
|
* root. The client may desire this address to be the address of the
|
|
* actual reference in the root (so that the debugger can be used to
|
|
* determine details about the root). This is not always possible, since
|
|
* the root might actually be a register, or the format scan method
|
|
* might not pass this address directly to the fix method. If the format
|
|
* code does pass on the address, the client can be sure to be passed
|
|
* the address of any root other than a register or stack. */
|
|
|
|
|
|
/* rootsStepClosure -- closure environment for root walker
|
|
*
|
|
* Defined as a subclass of ScanState. */
|
|
|
|
#define rootsStepClosureSig ((Sig)0x51965C10) /* SIGnature Roots Step CLOsure */
|
|
|
|
typedef struct rootsStepClosureStruct *rootsStepClosure;
|
|
typedef struct rootsStepClosureStruct {
|
|
ScanStateStruct ssStruct; /* generic scan state object */
|
|
mps_roots_stepper_t f; /* client closure function */
|
|
void *p; /* client closure data */
|
|
size_t s; /* client closure data */
|
|
Root root; /* current root, or NULL */
|
|
Sig sig; /* <code/misc.h#sig> */
|
|
} rootsStepClosureStruct;
|
|
|
|
#define rootsStepClosure2ScanState(rsc) (&(rsc)->ssStruct)
|
|
#define ScanState2rootsStepClosure(ss) \
|
|
PARENT(rootsStepClosureStruct, ssStruct, ss)
|
|
|
|
|
|
/* rootsStepClosureCheck -- check a rootsStepClosure */
|
|
|
|
ATTRIBUTE_UNUSED
|
|
static Bool rootsStepClosureCheck(rootsStepClosure rsc)
|
|
{
|
|
CHECKS(rootsStepClosure, rsc);
|
|
CHECKD(ScanState, &rsc->ssStruct);
|
|
CHECKL(FUNCHECK(rsc->f));
|
|
/* p and s fields are arbitrary closures which cannot be checked */
|
|
if (rsc->root != NULL) {
|
|
CHECKD_NOSIG(Root, rsc->root); /* <design/check/#.hidden-type> */
|
|
}
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
/* rootsStepClosureInit -- Initialize a rootsStepClosure
|
|
*
|
|
* Initialize the parent ScanState too. */
|
|
|
|
static void rootsStepClosureInit(rootsStepClosure rsc,
|
|
Globals arena, Trace trace,
|
|
SegFixMethod rootFix,
|
|
mps_roots_stepper_t f, void *p, size_t s)
|
|
{
|
|
ScanState ss;
|
|
|
|
/* First initialize the ScanState superclass */
|
|
ss = &rsc->ssStruct;
|
|
ScanStateInit(ss, TraceSetSingle(trace), GlobalsArena(arena), RankMIN,
|
|
trace->white);
|
|
|
|
/* Initialize the fix method in the ScanState */
|
|
ss->fix = rootFix;
|
|
|
|
/* Initialize subclass specific data */
|
|
rsc->f = f;
|
|
rsc->p = p;
|
|
rsc->s = s;
|
|
rsc->root = NULL;
|
|
|
|
rsc->sig = rootsStepClosureSig;
|
|
|
|
AVERT(rootsStepClosure, rsc);
|
|
}
|
|
|
|
|
|
/* rootsStepClosureFinish -- Finish a rootsStepClosure
|
|
*
|
|
* Finish the parent ScanState too. */
|
|
|
|
static void rootsStepClosureFinish(rootsStepClosure rsc)
|
|
{
|
|
ScanState ss;
|
|
|
|
ss = rootsStepClosure2ScanState(rsc);
|
|
rsc->sig = SigInvalid;
|
|
ScanStateFinish(ss);
|
|
}
|
|
|
|
|
|
/* RootsWalkFix -- the fix method used during root walking
|
|
*
|
|
* This doesn't cause further scanning of transitive references, it just
|
|
* calls the client closure. */
|
|
|
|
static Res RootsWalkFix(Seg seg, ScanState ss, Ref *refIO)
|
|
{
|
|
rootsStepClosure rsc;
|
|
Ref ref;
|
|
|
|
AVERT(Seg, seg);
|
|
AVERT(ScanState, ss);
|
|
AVER(refIO != NULL);
|
|
rsc = ScanState2rootsStepClosure(ss);
|
|
AVERT(rootsStepClosure, rsc);
|
|
|
|
ref = *refIO;
|
|
|
|
/* Call the client closure - .assume.rootaddr */
|
|
rsc->f((mps_addr_t*)refIO, (mps_root_t)rsc->root, rsc->p, rsc->s);
|
|
|
|
AVER(ref == *refIO); /* can walk object graph - but not modify it */
|
|
|
|
return ResOK;
|
|
}
|
|
|
|
|
|
/* rootWalk -- the step function for ArenaRootsWalk */
|
|
|
|
static Res rootWalk(Root root, void *p)
|
|
{
|
|
ScanState ss = (ScanState)p;
|
|
|
|
AVERT(ScanState, ss);
|
|
|
|
if (RootRank(root) == ss->rank) {
|
|
/* set the root for the benefit of the fix method */
|
|
ScanState2rootsStepClosure(ss)->root = root;
|
|
/* Scan it */
|
|
ScanStateSetSummary(ss, RefSetEMPTY);
|
|
return RootScan(ss, root);
|
|
} else
|
|
return ResOK;
|
|
}
|
|
|
|
|
|
/* rootWalkGrey -- make the root grey for the trace passed as p */
|
|
|
|
static Res rootWalkGrey(Root root, void *p)
|
|
{
|
|
Trace trace = p;
|
|
|
|
AVERT(Root, root);
|
|
AVERT(Trace, trace);
|
|
|
|
RootGrey(root, trace);
|
|
return ResOK;
|
|
}
|
|
|
|
|
|
/* ArenaRootsWalk -- walks all the root in the arena */
|
|
|
|
static Res ArenaRootsWalk(Globals arenaGlobals, mps_roots_stepper_t f,
|
|
void *p, size_t s)
|
|
{
|
|
Arena arena;
|
|
rootsStepClosureStruct rscStruct;
|
|
rootsStepClosure rsc = &rscStruct;
|
|
Trace trace;
|
|
ScanState ss;
|
|
Rank rank;
|
|
Res res;
|
|
Seg seg;
|
|
|
|
AVERT(Globals, arenaGlobals);
|
|
AVER(FUNCHECK(f));
|
|
/* p and s are arbitrary client-provided closure data. */
|
|
arena = GlobalsArena(arenaGlobals);
|
|
|
|
/* Scan all the roots with a minimal trace. Invoke the scanner with a */
|
|
/* rootsStepClosure, which is a subclass of ScanState and contains the */
|
|
/* client-provided closure. Supply a special fix method in order to */
|
|
/* call the client closure. This fix method must perform no tracing */
|
|
/* operations of its own. */
|
|
|
|
res = TraceCreate(&trace, arena, TraceStartWhyWALK);
|
|
/* Have to fail if no trace available. Unlikely due to .assume.parked. */
|
|
if (res != ResOK)
|
|
return res;
|
|
|
|
/* .roots-walk.first-stage: In order to fool MPS_FIX12 into calling
|
|
_mps_fix2 for a reference in a root, the reference must pass the
|
|
first-stage test (against the summary of the trace's white
|
|
set), so make the summary universal. */
|
|
trace->white = ZoneSetUNIV;
|
|
|
|
/* .roots-walk.second-stage: In order to fool _mps_fix2 into calling
|
|
our fix function (RootsWalkFix), the reference must be to a
|
|
segment that is white for the trace, so make all segments white
|
|
for the trace. */
|
|
if (SegFirst(&seg, arena)) {
|
|
do {
|
|
SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
|
|
} while (SegNext(&seg, arena, seg));
|
|
}
|
|
|
|
/* Make the roots grey so that they are scanned */
|
|
res = RootsIterate(arenaGlobals, rootWalkGrey, trace);
|
|
/* Make this trace look like any other trace. */
|
|
arena->flippedTraces = TraceSetAdd(arena->flippedTraces, trace);
|
|
|
|
rootsStepClosureInit(rsc, arenaGlobals, trace, RootsWalkFix, f, p, s);
|
|
ss = rootsStepClosure2ScanState(rsc);
|
|
|
|
for(rank = RankMIN; rank < RankLIMIT; ++rank) {
|
|
ss->rank = rank;
|
|
AVERT(ScanState, ss);
|
|
res = RootsIterate(arenaGlobals, rootWalk, (void *)ss);
|
|
if (res != ResOK)
|
|
break;
|
|
}
|
|
|
|
/* Turn segments black again. */
|
|
if (SegFirst(&seg, arena)) {
|
|
do {
|
|
SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace));
|
|
} while (SegNext(&seg, arena, seg));
|
|
}
|
|
|
|
rootsStepClosureFinish(rsc);
|
|
/* Make this trace look like any other finished trace. */
|
|
trace->state = TraceFINISHED;
|
|
TraceDestroyFinished(trace);
|
|
AVER(!ArenaEmergency(arena)); /* There was no allocation. */
|
|
|
|
return res;
|
|
}
|
|
|
|
|
|
/* mps_arena_roots_walk -- Client interface for walking */
|
|
|
|
void mps_arena_roots_walk(mps_arena_t mps_arena, mps_roots_stepper_t f,
|
|
void *p, size_t s)
|
|
{
|
|
Arena arena = (Arena)mps_arena;
|
|
Res res;
|
|
|
|
ArenaEnter(arena);
|
|
STACK_CONTEXT_BEGIN(arena) {
|
|
AVER(FUNCHECK(f));
|
|
/* p and s are arbitrary closures, hence can't be checked */
|
|
|
|
AVER(ArenaGlobals(arena)->clamped); /* .assume.parked */
|
|
AVER(arena->busyTraces == TraceSetEMPTY); /* .assume.parked */
|
|
|
|
res = ArenaRootsWalk(ArenaGlobals(arena), f, p, s);
|
|
AVER(res == ResOK);
|
|
} STACK_CONTEXT_END(arena);
|
|
ArenaLeave(arena);
|
|
}
|
|
|
|
|
|
/* C. COPYRIGHT AND LICENSE
|
|
*
|
|
* Copyright (C) 2001-2020 Ravenbrook Limited <http://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.
|
|
*/
|