avoid unnecessary closure-fixup work in incremental mode

This commit is contained in:
Matthew Flatt 2015-11-28 06:09:05 -07:00
parent 46fe53fadb
commit d37bfd45ae
2 changed files with 11 additions and 22 deletions

View File

@ -6100,7 +6100,7 @@ static void mark_pruned_prefixes(struct NewGC *gc) XFORM_SKIP_PROC
if (scheme_prefix_finalize != (Scheme_Prefix *)0x1) {
Scheme_Prefix *pf = scheme_prefix_finalize, *next;
Scheme_Object *clo;
int i, *use_bits, maxpos, inc_fixup_mode;
int i, *use_bits, maxpos;
scheme_prefix_finalize = (Scheme_Prefix *)0x1;
while (pf != (Scheme_Prefix *)0x1) {
@ -6155,24 +6155,17 @@ static void mark_pruned_prefixes(struct NewGC *gc) XFORM_SKIP_PROC
/* Fix up closures that reference this prefix: */
clo = (Scheme_Object *)GC_resolve2(pf->fixup_chain, gc);
pf->fixup_chain = NULL;
inc_fixup_mode = SCHEME_PREFIX_FLAGS(pf) & 0x1;
while (clo) {
Scheme_Object *next;
if (inc_fixup_mode) {
next = ((Scheme_Object **)clo)[1];
clo = ((Scheme_Object **)clo)[0];
}
if (SCHEME_TYPE(clo) == scheme_closure_type) {
Scheme_Closure *cl = (Scheme_Closure *)clo;
int closure_size = ((Scheme_Closure_Data *)GC_resolve2(cl->code, gc))->closure_size;
if (!inc_fixup_mode)
next = cl->vals[closure_size - 1];
next = cl->vals[closure_size - 1];
cl->vals[closure_size-1] = (Scheme_Object *)pf;
} else if (SCHEME_TYPE(clo) == scheme_native_closure_type) {
Scheme_Native_Closure *cl = (Scheme_Native_Closure *)clo;
int closure_size = ((Scheme_Native_Closure_Data *)GC_resolve2(cl->code, gc))->closure_size;
if (!inc_fixup_mode)
next = cl->vals[closure_size - 1];
next = cl->vals[closure_size - 1];
cl->vals[closure_size-1] = (Scheme_Object *)pf;
} else {
MZ_ASSERT(0);
@ -6180,7 +6173,7 @@ static void mark_pruned_prefixes(struct NewGC *gc) XFORM_SKIP_PROC
}
clo = (Scheme_Object *)GC_resolve2(next, gc);
}
if (inc_fixup_mode)
if (SCHEME_PREFIX_FLAGS(pf) & 0x1)
SCHEME_PREFIX_FLAGS(pf) -= 0x1;
/* Next */

View File

@ -41,19 +41,15 @@
mark_stxes = 0;
/* Add this closure to the chain to be repaired when the
prefix is marked (and potentially moved): */
if ((gc_mode == GC_CURRENT_MODE_INCREMENTAL) || (SCHEME_PREFIX_FLAGS(pf) & 0x1)) {
/* Can't steal closure slot for this purpose, since the
slot is still in use until a full collection finishes */
Scheme_Object **pr;
pr = (Scheme_Object **)GC_malloc_for_incremental(2 * sizeof(Scheme_Object *));
pr[0] = (Scheme_Object *)c;
pr[1] = (Scheme_Object *)pf->fixup_chain;
pf->fixup_chain = (Scheme_Object *)pr;
SCHEME_PREFIX_FLAGS(pf) |= 0x1;
} else {
prefix is marked and potentially moved; if we're here
in incremental mode, though, the prefix won't be moved: */
if (gc_mode != GC_CURRENT_MODE_INCREMENTAL) {
c->vals[closure_size - 1] = pf->fixup_chain;
pf->fixup_chain = (Scheme_Object *)c;
} else {
/* Mark the prefix as reached in incremental mode, which
triggers special handling for bakpointers */
SCHEME_PREFIX_FLAGS(pf) |= 0x1;
}
/* Mark just the elements of the prefix that are (newly) used: */