suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

repairs to initial merge of incremental promotion of objects

Browse Source
This commit is contained in:
Matthew Flatt 2020-08-14 06:10:13 -06:00
parent 48487ed6fb
commit 3aa2d99000
20 changed files with 351 additions and 219 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/src/ChezScheme/c/Makefile.a6nt
View File

@ -47,13 +47,13 @@ MTZlibLib=..\zlib\zlibmt.lib
MDLZ4Lib=..\lz4\lib\liblz4.lib
MTLZ4Lib=..\lz4\lib\liblz4mt.lib
csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-oce.c gc-ocd.c\
csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-011.c gc-oce.c gc-ocd.c\
number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c\
foreign.c prim.c prim5.c flushcache.c\
windows.c\
schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-oce.obj gc-ocd.obj\
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-011.obj gc-oce.obj gc-ocd.obj\
number.obj schsig.obj io.obj new-io.obj print.obj fasl.obj vfasl.obj stats.obj\
foreign.obj prim.obj prim5.obj flushcache.obj\
windows.obj\

4
racket/src/ChezScheme/c/Makefile.i3nt
View File

@ -46,13 +46,13 @@ MTZlibLib=..\zlib\zlibmt.lib
MDLZ4Lib=..\lz4\lib\liblz4.lib
MTLZ4Lib=..\lz4\lib\liblz4mt.lib
csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-oce.c gc-ocd.c\
csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-011.c gc-oce.c gc-ocd.c\
number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c\
foreign.c prim.c prim5.c flushcache.c\
windows.c\
schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-oce.obj gc-ocd.obj\
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-011.obj gc-oce.obj gc-ocd.obj\
number.obj schsig.obj io.obj new-io.obj print.obj fasl.obj vfasl.obj stats.obj\
foreign.obj prim.obj prim5.obj flushcache.obj\
windows.obj\

4
racket/src/ChezScheme/c/Makefile.ta6nt
View File

@ -47,13 +47,13 @@ MTZlibLib=..\zlib\zlibmt.lib
MDLZ4Lib=..\lz4\lib\liblz4.lib
MTLZ4Lib=..\lz4\lib\liblz4mt.lib
csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-oce.c gc-ocd.c\
csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-011.c gc-oce.c gc-ocd.c\
number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c\
foreign.c prim.c prim5.c flushcache.c\
windows.c\
schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-oce.obj gc-ocd.obj\
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-011.obj gc-oce.obj gc-ocd.obj\
number.obj schsig.obj io.obj new-io.obj print.obj fasl.obj vfasl.obj stats.obj\
foreign.obj prim.obj prim5.obj flushcache.obj\
windows.obj\

5
racket/src/ChezScheme/c/Makefile.ti3nt
View File

@ -1,3 +1,4 @@
# Makefile.ti3nt
# Copyright 1984-2017 Cisco Systems, Inc.
#
@ -46,13 +47,13 @@ MTZlibLib=..\zlib\zlibmt.lib
MDLZ4Lib=..\lz4\lib\liblz4.lib
MTLZ4Lib=..\lz4\lib\liblz4mt.lib
csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-oce.c gc-ocd.c\
csrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-011.c gc-oce.c gc-ocd.c\
number.c schsig.c io.c new-io.c print.c fasl.c vfasl.c stats.c\
foreign.c prim.c prim5.c flushcache.c\
windows.c\
schlib.c thread.c expeditor.c scheme.c compress-io.c random.c
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-oce.obj gc-ocd.obj\
cobj=statics.obj segment.obj alloc.obj symbol.obj intern.obj gcwrapper.obj gc-011.c gc-oce.obj gc-ocd.obj\
number.obj schsig.obj io.obj new-io.obj print.obj fasl.obj vfasl.obj stats.obj\
foreign.obj prim.obj prim5.obj flushcache.obj\
windows.obj\

21
racket/src/ChezScheme/c/alloc.c
View File

@ -157,6 +157,10 @@ ptr S_compute_bytes_allocated(xg, xs) ptr xg; ptr xs; {
/* add in bytes in active segments */
if (next_loc != FIX(0))
n += (uptr)next_loc - (uptr)S_G.base_loc[g][s];
if (s == space_data) {
/* don't count space used for bitmaks */
n -= S_G.bitmask_overhead[g];
}
}
if (g == S_G.max_nonstatic_generation)
g = static_generation;
@ -268,6 +272,21 @@ void S_reset_allocation_pointer(tc) ptr tc; {
S_pants_down -= 1;
}
void S_record_new_dirty_card(ptr *ppp, IGEN to_g) {
uptr card = (uptr)ppp >> card_offset_bits;
dirtycardinfo *ndc = S_G.new_dirty_cards;
if (ndc != NULL && ndc->card == card) {
if (to_g < ndc->youngest) ndc->youngest = to_g;
} else {
dirtycardinfo *next = ndc;
find_room_voidp(space_new, 0, ptr_align(sizeof(dirtycardinfo)), ndc);
ndc->card = card;
ndc->youngest = to_g;
ndc->next = next;
S_G.new_dirty_cards = ndc;
}
}
FORCEINLINE void mark_segment_dirty(seginfo *si, IGEN from_g, IGEN to_g) {
IGEN old_to_g = si->min_dirty_byte;
@ -297,7 +316,7 @@ void S_dirty_set(ptr *loc, ptr x) {
if (!IMMEDIATE(x)) {
seginfo *t_si = SegInfo(ptr_get_segment(x));
if (t_si->generation < si->generation)
S_error_abort("wrong-way pointer installed during GC");
S_record_new_dirty_card(loc, t_si->generation);
}
} else {
IGEN from_g = si->generation;

1
racket/src/ChezScheme/c/externs.h
View File

@ -66,6 +66,7 @@ extern void S_reset_allocation_pointer PROTO((ptr tc));
extern ptr S_compute_bytes_allocated PROTO((ptr xg, ptr xs));
extern ptr S_bytes_finalized PROTO(());
extern ptr S_find_more_room PROTO((ISPC s, IGEN g, iptr n, ptr old));
extern void S_record_new_dirty_card PROTO((ptr *ppp, IGEN to_g));
extern void S_dirty_set PROTO((ptr *loc, ptr x));
extern void S_mark_card_dirty PROTO((uptr card, IGEN to_g));
extern void S_scan_dirty PROTO((ptr *p, ptr *endp));

2
racket/src/ChezScheme/c/gc-011.c
View File

@ -18,7 +18,7 @@
#define MAX_CG 0
#define MIN_TG 1
#define MAX_TG 1
#define NO_LOCKED_OLDSPACE_OBJECTS
#define NO_NEWSPACE_MARKS
#include "gc.c"
void S_gc_011(ptr tc) {

375
racket/src/ChezScheme/c/gc.c
View File

@ -38,21 +38,24 @@
Generations range from 0 to `S_G.max_nonstatic_generation` plus a
static generation. After an object moves to the static generation,
it doesn't move anymore. (In the case of code objects, relocations
it doesn't move anymore. In the case of code objects, relocations
may be discarded when the code object moves into a static
generation.)
generation.
For the most part, collecting generations 0 through mgc (= max
copied generation) to tg (= target generation) means copying
objects from old segments into fresh segments at generation tg.
Note that tg is either the same as or one larger than mgc.
For the most part, collecting generations 0 through MAX_CG (= max
copied generation) to MIN_TG to MAX_TG (= target generation) means
copying objects from old segments into fresh segments generations
MIN_TG through MAX_TG. Note that MAX_TG is either the same as or
one larger than MAX_CG. For objects in generation 0 through MAX_CG,
the target generation is either one more than the current
generation or it's MIN_TG.
But objects might be marked [and swept] instead of copied [and
swept] as triggered by two possibilities: one or more objects on
the source segment are immobile (subsumes locked) or mgc == tg and
the object is on a segment that hasn't been disovered as sparse by
a precious marking (non-copying) pass. Segments with marked objects
are promoted to generation tg.
Objects might be marked [and swept] instead of copied [and swept]
as triggered by two possibilities: one or more objects on the
source segment are immobile (subsumes locked) or MAX_CG == MAX_TG
and the object is on a MAX_CG segment that hasn't been disovered as
sparse by a previous marking (non-copying) pass. Segments with
marked objects are promoted to the target generation.
As a special case, locking on `space_new` does not mark all objects
on that segment, because dirty-write handling cannot deal with
@ -70,14 +73,14 @@
Marking an object means setting a bit in `marked_mask`, which is
allocated as needed. Any segments that ends up with a non-NULL
`marked_mask` is promoted to tg at the end of collection. If a
marked object spans multiple segments, then `masked_mask` is
created across all of the segments. It's possible for a segment to
end up with `marked_mask` even though `use_marks` was not set: an
marked object spanned into the segment, or it's `space_new` segment
with locked objects; in that case, other objects will be copied out
of the segment, because `use_marks` is how relocation decides
whether to copy or mark.
`marked_mask` is kept in its new generation at the end of
collection. If a marked object spans multiple segments, then
`masked_mask` is created across all of the segments. It's possible
for a segment to end up with `marked_mask` even though `use_marks`
was not set: an marked object spanned into the segment, or it's a
`space_new` segment with locked objects; in that case, other
objects will be copied out of the segment, because `use_marks` is
how relocation decides whether to copy or mark.
If an object is copied, then its first word is set to
`forward_marker` and its second word is set to the new address.
@ -85,25 +88,25 @@
whether an object has been reached:
* the object must be in an `old_space` segment, otherwise it counts
as reached because it's in a generation older than mcg;
as reached because it's in a generation older than MAX_CG;
* the object either starts with `forward_marker` or its mark bit is
set (and those arer mutually exclusive).
set (and those are mutually exclusive).
Besides the one bit at the start of an object, extra bits for the
object content may be set as well. Those extra bits tell the
dirty-object sweeper which words in a previously marked page should
be swept and which should be skipped, so the extra bits are only
needed for impure objects in certain kinds of spaces. Only every
alternate word needs to be marked that way, so half of the mark
bits are usually irrelevant; the exception is that flonums can be
between normal object-start positions, so those mark bits can
matter, at least if we're preserving `eq?` on flonums (but the bits
are not relevant to dirty-object sweeping, since flonums don't have
pointer fields).
Besides the one bit for the start of an object in the mark mask,
extra bits for the object content may be set as well. Those extra
bits tell the dirty-object sweeper which words in a previously
marked page should be swept and which should be skipped, so the
extra bits are only needed for impure objects in certain kinds of
spaces. Only every alternate word needs to be marked that way, so
half of the mark bits are usually irrelevant; the exception is that
flonums can be between normal object-start positions, so those mark
bits can matter, at least if we're preserving `eq?` on flonums (but
the bits are not relevant to dirty-object sweeping, since flonums
don't have pointer fields).
It's ok to sweep an object multiple times (but to be be avoided if
possible).
It's ok to sweep an object multiple times, but that's to be be
avoided if possible.
Pending Ephemerons and Guardians
--------------------------------
@ -124,7 +127,8 @@
static IGEN copy PROTO((ptr pp, seginfo *si, ptr *dest));
static IGEN mark_object PROTO((ptr pp, seginfo *si));
static void sweep PROTO((ptr tc, ptr p, IGEN from_g));
static void sweep_in_old PROTO((ptr tc, ptr p, IGEN from_g));
static void sweep_in_old PROTO((ptr p));
static void sweep_object_in_old PROTO((ptr p));
static IBOOL object_directly_refers_to_self PROTO((ptr p));
static ptr copy_stack PROTO((ptr old, iptr *length, iptr clength));
static void resweep_weak_pairs PROTO((seginfo *oldweakspacesegments));
@ -136,7 +140,7 @@ static uptr size_object PROTO((ptr p));
static iptr sweep_typed_object PROTO((ptr tc, ptr p, IGEN from_g));
static void sweep_symbol PROTO((ptr p, IGEN from_g));
static void sweep_port PROTO((ptr p, IGEN from_g));
static void sweep_thread PROTO((ptr p, IGEN from_g));
static void sweep_thread PROTO((ptr p));
static void sweep_continuation PROTO((ptr p, IGEN from_g));
static void sweep_record PROTO((ptr x, IGEN from_g));
static IGEN sweep_dirty_record PROTO((ptr x, IGEN youngest));
@ -152,8 +156,8 @@ static void add_trigger_guardians_to_recheck PROTO((ptr ls));
static void add_ephemeron_to_pending PROTO((ptr p));
static void add_trigger_ephemerons_to_pending PROTO((ptr p));
static void check_triggers PROTO((seginfo *si));
static void check_ephemeron PROTO((ptr pe, IGEN from_g));
static void check_pending_ephemerons PROTO((IGEN from_g));
static void check_ephemeron PROTO((ptr pe));
static void check_pending_ephemerons PROTO(());
static int check_dirty_ephemeron PROTO((ptr pe, int youngest));
static void finish_pending_ephemerons PROTO((seginfo *si));
static void init_fully_marked_mask(IGEN g);
@ -186,10 +190,6 @@ static void check_pending_measure_ephemerons();
# endif
#endif
#ifndef NO_DIRTY_NEWSPACE_POINTERS
static void record_new_dirty_card PROTO((ptr *ppp, IGEN to_g));
#endif /* !NO_DIRTY_NEWSPACE_POINTERS */
/* #define DEBUG */
/* initialized and used each gc cycle. any others should be defined in globals.h */
@ -217,7 +217,8 @@ static IGEN MAX_CG, MIN_TG, MAX_TG;
#if defined(MIN_TG) && defined(MAX_TG) && (MIN_TG == MAX_TG)
# define TARGET_GENERATION(si) MIN_TG
# define compute_target_generation(g) MIN_TG
# define compute_target_generation(g) MIN_TG
# define CONSTANT_TARGET_GENERATION
#else
# define TARGET_GENERATION(si) si->generation
FORCEINLINE IGEN compute_target_generation(IGEN g) {
@ -297,10 +298,19 @@ uptr list_length(ptr ls) {
#define init_mask(dest, tg, init) { \
find_room_voidp(space_data, tg, ptr_align(segment_bitmap_bytes), dest); \
memset(dest, init, segment_bitmap_bytes); \
S_G.bitmask_overhead[tg] += ptr_align(segment_bitmap_bytes); \
}
#define marked(si, p) (si->marked_mask && (si->marked_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p)))
#ifdef NO_NEWSPACE_MARKS
# define new_marked(si, p) 0
# define CAN_MARK_AND(x) 0
#else
# define new_marked(si, p) marked(si, p)
# define CAN_MARK_AND(x) x
#endif
static void init_fully_marked_mask(IGEN g) {
init_mask(fully_marked_mask[g], g, 0xFF);
}
@ -357,7 +367,7 @@ static int flonum_is_forwarded_p(ptr p, seginfo *si) {
#define relocate_pure_help_help(ppp, pp, si) do { \
if (FORWARDEDP(pp, si)) \
*ppp = GET_FWDADDRESS(pp); \
else if (!marked(si, pp)) \
else if (!new_marked(si, pp)) \
mark_or_copy_pure(ppp, pp, si); \
} while (0)
@ -365,13 +375,13 @@ static int flonum_is_forwarded_p(ptr p, seginfo *si) {
if (FWDMARKER(pp) == forward_marker) \
pp = GET_FWDADDRESS(pp); \
else if (si->old_space) { \
if (!marked(si, pp)) \
if (!new_marked(si, pp)) \
mark_or_copy_pure(&pp, pp, si); \
} ELSE_MEASURE_NONOLDSPACE(pp) \
} while (0)
#define mark_or_copy_pure(dest, p, si) do { \
if (si->use_marks) \
if (CAN_MARK_AND(si->use_marks)) \
(void)mark_object(p, si); \
else \
(void)copy(p, si, dest); \
@ -398,7 +408,7 @@ static int flonum_is_forwarded_p(ptr p, seginfo *si) {
if (SI->old_space) \
relocate_impure_help_help(ppp, pp, from_g, SI); \
ELSE_MEASURE_NONOLDSPACE(pp) \
} \
} \
} while (0)
#define relocate_impure_help_help(ppp, pp, from_g, si) do { \
@ -406,44 +416,20 @@ static int flonum_is_forwarded_p(ptr p, seginfo *si) {
if (FORWARDEDP(pp, si)) { \
*ppp = GET_FWDADDRESS(pp); \
__to_g = TARGET_GENERATION(si); \
if (__to_g < from_g) record_new_dirty_card(ppp, __to_g); \
} else if (!marked(si, pp)) { \
if (__to_g < from_g) S_record_new_dirty_card(ppp, __to_g); \
} else if (!new_marked(si, pp)) { \
mark_or_copy_impure(__to_g, ppp, pp, from_g, si); \
if (__to_g < from_g) record_new_dirty_card(ppp, __to_g); \
if (__to_g < from_g) S_record_new_dirty_card(ppp, __to_g); \
} \
} while (0)
#define mark_or_copy_impure(to_g, dest, p, from_g, si) do { \
if (si->use_marks) \
if (CAN_MARK_AND(si->use_marks)) \
to_g = mark_object(p, si); \
else \
to_g = copy(p, si, dest); \
} while (0)
typedef struct _dirtycardinfo {
uptr card;
IGEN youngest;
struct _dirtycardinfo *next;
} dirtycardinfo;
static dirtycardinfo *new_dirty_cards;
static void record_new_dirty_card(ptr *ppp, IGEN to_g) {
uptr card = (uptr)ppp >> card_offset_bits;
dirtycardinfo *ndc = new_dirty_cards;
if (ndc != NULL && ndc->card == card) {
if (to_g < ndc->youngest) ndc->youngest = to_g;
} else {
dirtycardinfo *next = ndc;
find_room(space_new, 0, typemod, ptr_align(sizeof(dirtycardinfo)), ndc);
ndc->card = card;
ndc->youngest = to_g;
ndc->next = next;
new_dirty_cards = ndc;
}
}
#endif /* !NO_DIRTY_NEWSPACE_POINTERS */
#define relocate_dirty(PPP, YOUNGEST) do { \
@ -454,8 +440,10 @@ static void record_new_dirty_card(ptr *ppp, IGEN to_g) {
} else if (FORWARDEDP(_pp, _si)) { \
*_ppp = GET_FWDADDRESS(_pp); \
_pg = TARGET_GENERATION(_si); \
} else if (marked(_si, _pp)) { \
} else if (new_marked(_si, _pp)) { \
_pg = TARGET_GENERATION(_si); \
} else if (CAN_MARK_AND(_si->use_marks)) { \
_pg = mark_object(_pp, _si); \
} else { \
_pg = copy(_pp, _si, _ppp); \
} \
@ -467,6 +455,10 @@ static void record_new_dirty_card(ptr *ppp, IGEN to_g) {
# define is_counting_root(si, p) (si->counting_mask && (si->counting_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p)))
#endif
static void relocate_indirect(ptr p) {
relocate_pure(&p);
}
FORCEINLINE void check_triggers(seginfo *si) {
/* Registering ephemerons and guardians to recheck at the
granularity of a segment means that the worst-case complexity of
@ -501,7 +493,7 @@ FORCEINLINE void check_triggers(seginfo *si) {
set to a forwarding marker and pointer. To handle that problem,
sweep_in_old() is allowed to copy the object, since the object
is going to get copied anyway. */
static void sweep_in_old(ptr tc, ptr p, IGEN from_g) {
static void sweep_in_old(ptr p) {
/* Detect all the cases when we need to give up on in-place
sweeping: */
if (object_directly_refers_to_self(p)) {
@ -510,8 +502,10 @@ static void sweep_in_old(ptr tc, ptr p, IGEN from_g) {
}
/* We've determined that `p` won't refer immediately back to itself,
so it's ok to use sweep(). */
sweep(tc, p, from_g);
so it's ok to sweep(), but only update `p` for pure relocations;
impure oness must that will happen later, after `p` is
potentially copied, so the card updates will be right. */
sweep_object_in_old(p);
}
static void sweep_dirty_object_if_space_new(ptr p) {
@ -532,7 +526,8 @@ static ptr copy_stack(ptr old, iptr *length, iptr clength) {
newg = TARGET_GENERATION(si);
n = *length;
#ifndef NO_NEWSPACE_MARKS
if (si->use_marks) {
if (!marked(si, old)) {
mark_typemod_data_object(old, n, si);
@ -545,6 +540,7 @@ static ptr copy_stack(ptr old, iptr *length, iptr clength) {
return old;
}
#endif
/* reduce headroom created for excessively large frames (typically resulting from apply with long lists) */
if (n != clength && n > default_stack_size && n > (m = clength + one_shot_headroom)) {
@ -557,13 +553,17 @@ static ptr copy_stack(ptr old, iptr *length, iptr clength) {
S_G.bytesof[newg][countof_stack] += n;
#endif /* ENABLE_OBJECT_COUNTS */
find_room(space_data, newg, typemod, n, new);
n = ptr_align(clength);
/* warning: stack may have been left non-double-aligned by split_and_resize */
memcpy_aligned(TO_VOIDP(new), TO_VOIDP(old), n);
if (n == 0) {
return (ptr)0;
} else {
find_room(space_data, newg, typemod, n, new);
n = ptr_align(clength);
/* warning: stack may have been left non-double-aligned by split_and_resize */
memcpy_aligned(TO_VOIDP(new), TO_VOIDP(old), n);
/* also returning possibly updated value in *length */
return new;
/* also returning possibly updated value in *length */
return new;
}
}
#define NONSTATICINHEAP(si, x) (!IMMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && si->generation != static_generation)
@ -574,7 +574,7 @@ static ptr copy_stack(ptr old, iptr *length, iptr clength) {
obj = GUARDIANOBJ(ls); \
next = GUARDIANNEXT(ls); \
if (FILTER(si, obj)) { \
if (!si->old_space || marked(si, obj)) { \
if (!si->old_space || new_marked(si, obj)) { \
INITGUARDIANNEXT(ls) = pend_hold_ls; \
pend_hold_ls = ls; \
} else if (FORWARDEDP(obj, si)) { \
@ -585,7 +585,7 @@ static ptr copy_stack(ptr old, iptr *length, iptr clength) {
seginfo *t_si; \
tconc = GUARDIANTCONC(ls); \
t_si = SegInfo(ptr_get_segment(tconc)); \
if (!t_si->old_space || marked(t_si, tconc)) { \
if (!t_si->old_space || new_marked(t_si, tconc)) { \
INITGUARDIANNEXT(ls) = final_ls; \
final_ls = ls; \
} else if (FWDMARKER(tconc) == forward_marker) { \
@ -627,8 +627,9 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
tlcs_to_rehash = Snil;
conts_to_promote = Snil;
#ifndef NO_DIRTY_NEWSPACE_POINTERS
new_dirty_cards = NULL;
S_G.new_dirty_cards = NULL;
#endif /* !NO_DIRTY_NEWSPACE_POINTERS */
S_G.must_mark_gen0 = 0;
for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
ptr tc = (ptr)THREADTC(Scar(ls));
@ -655,6 +656,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
S_G.next_loc[g][s] = FIX(0);
S_G.bytes_left[g][s] = 0;
S_G.bytes_of_space[g][s] = 0;
S_G.bitmask_overhead[g] = 0;
}
}
@ -682,6 +684,14 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
for (g = 0; g <= MAX_CG; g += 1) {
IBOOL maybe_mark = ((g >= S_G.min_mark_gen) && (g >= MIN_TG));
for (s = 0; s <= max_real_space; s += 1) {
seginfo *saved;
if (s == space_weakpair) {
saved = oldspacesegments;
oldspacesegments = oldweakspacesegments;
} else
saved = NULL;
for (si = S_G.occupied_segments[g][s]; si != NULL; si = nextsi) {
nextsi = si->next;
si->next = oldspacesegments;
@ -704,12 +714,20 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
si->min_dirty_byte = 0; /* prevent registering as dirty while GCing */
}
S_G.occupied_segments[g][s] = NULL;
if (s == space_weakpair) {
oldweakspacesegments = oldspacesegments;
oldspacesegments = saved;
}
}
if (s == space_weakpair) {
/* prefix of oldweakspacesegments is for weak pairs */
oldweakspacesegments = oldspacesegments;
}
}
}
if (oldweakspacesegments) {
/* make oldweakspacesegments a prefix of weakspacesegments */
seginfo *p;
for (p = oldweakspacesegments; p->next; p = p->next);
p->next = oldspacesegments;
oldspacesegments = oldweakspacesegments;
}
#ifdef ENABLE_OBJECT_COUNTS
/* clear object counts & bytes for copied generations; bump timestamp */
@ -894,14 +912,13 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
/* sweep non-oldspace threads, since any thread may have an active stack */
for (ls = S_threads; ls != Snil; ls = Scdr(ls)) {
ptr thread; seginfo *thread_si;
ptr thread;
/* someone may have their paws on the list */
if (FWDMARKER(ls) == forward_marker) ls = FWDADDRESS(ls);
thread = Scar(ls);
thread_si = SegInfo(ptr_get_segment(thread));
if (!thread_si->old_space) sweep_thread(thread, thread_si->generation);
if (!OLDSPACE(thread)) sweep_thread(thread);
}
relocate_pure(&S_threads);
@ -931,7 +948,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
/* coordinate with alloc.c */
(SYMVAL(sym) != sunbound || SYMPLIST(sym) != Snil || SYMSPLIST(sym) != Snil)) {
seginfo *sym_si = SegInfo(ptr_get_segment(sym));
if (!marked(sym_si, sym))
if (!new_marked(sym_si, sym))
mark_or_copy_pure(&sym, sym, sym_si);
}
}
@ -1025,7 +1042,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
won't discover any new tconcs at that point. */
ptr obj = GUARDIANOBJ(ls);
seginfo *o_si = SegInfo(ptr_get_segment(obj));
if (FORWARDEDP(obj, o_si) || marked(o_si, obj)) {
if (FORWARDEDP(obj, o_si) || new_marked(o_si, obj)) {
/* Object is reachable, so we might as well move
this one to the hold list --- via pend_hold_ls, which
leads to a copy to move to hold_ls */
@ -1034,8 +1051,10 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
} else {
seginfo *si;
if (!IMMEDIATE(rep) && (si = MaybeSegInfo(ptr_get_segment(rep))) != NULL && si->old_space) {
PUSH_BACKREFERENCE(rep)
sweep_in_old(tc, rep, si->generation);
/* mark things reachable from `rep`, but not `rep` itself, unless
`rep` is immediately reachable from itself */
PUSH_BACKREFERENCE(ls)
sweep_in_old(rep);
POP_BACKREFERENCE()
}
INITGUARDIANNEXT(ls) = maybe_final_ordered_ls;
@ -1043,20 +1062,17 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
}
} else {
/* if tconc was old it's been forwarded */
IGEN tg;
tconc = GUARDIANTCONC(ls);
WITH_TOP_BACKREFERENCE(tconc, relocate_pure(&rep));
tg = GENERATION(tconc);
old_end = Scdr(tconc);
/* allocate new_end in tg, in case `tconc` is on a marked segment */
new_end = S_cons_in(space_impure, tg, FIX(0), FIX(0));
new_end = S_cons_in(space_impure, 0, FIX(0), FIX(0));
#ifdef ENABLE_OBJECT_COUNTS
S_G.countof[tg][countof_pair] += 1;
S_G.countof[0][countof_pair] += 1;
#endif /* ENABLE_OBJECT_COUNTS */
/* These assignments may trigger card marking or additions to `new_dirty_cards`: */
SETCAR(old_end,rep);
SETCDR(old_end,new_end);
SETCDR(tconc,new_end);
@ -1067,20 +1083,25 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
ls = pend_hold_ls; pend_hold_ls = Snil;
for ( ; ls != Snil; ls = next) {
ptr p;
seginfo *g_si, *t_si;
seginfo *t_si;
#ifdef CONSTANT_TARGET_GENERATION
g = MAX_TG;
#else
seginfo *g_si;
g_si = SegInfo(ptr_get_segment(ls));
g = TARGET_GENERATION(g_si);
#endif
next = GUARDIANNEXT(ls);
/* discard static pend_hold_ls entries */
g_si = SegInfo(ptr_get_segment(ls));
g = TARGET_GENERATION(g_si);
if (g == static_generation) continue;
tconc = GUARDIANTCONC(ls);
t_si = SegInfo(ptr_get_segment(tconc));
if (t_si->old_space && !marked(t_si, tconc)) {
if (t_si->old_space && !new_marked(t_si, tconc)) {
if (FWDMARKER(tconc) == forward_marker)
tconc = FWDADDRESS(tconc);
else {
@ -1120,7 +1141,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
ptr obj = GUARDIANOBJ(ls);
seginfo *o_si = SegInfo(ptr_get_segment(obj));
next = GUARDIANNEXT(ls);
if (FORWARDEDP(obj, o_si) || marked(o_si, obj)) {
if (FORWARDEDP(obj, o_si) || new_marked(o_si, obj)) {
/* Will defintely move to hold_ls, but the entry
must be copied to move from pend_hold_ls to
hold_ls: */
@ -1162,8 +1183,10 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
INITGUARDIANNEXT(ls) = final_ls;
final_ls = ls;
} else {
#ifndef NO_NEWSPACE_MARKS
seginfo *t_si = SegInfo(ptr_get_segment(tconc));
if (marked(t_si, tconc)) {
#endif
if (new_marked(t_si, tconc)) {
INITGUARDIANNEXT(ls) = final_ls;
final_ls = ls;
} else {
@ -1199,7 +1222,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
bnext = TO_VOIDP((uptr)TO_PTR(b->next) - 1);
sym = b->sym;
si = SegInfo(ptr_get_segment(sym));
if (marked(si, sym) || (FWDMARKER(sym) == forward_marker && ((sym = FWDADDRESS(sym)) || 1))) {
if (new_marked(si, sym) || (FWDMARKER(sym) == forward_marker && ((sym = FWDADDRESS(sym)) || 1))) {
IGEN g = si->generation;
find_room_voidp(space_data, g, ptr_align(sizeof(bucket)), b);
#ifdef ENABLE_OBJECT_COUNTS
@ -1235,7 +1258,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
count++;
p = Scar(ls);
si = SegInfo(ptr_get_segment(p));
if (!si->old_space || marked(si, p)) {
if (!si->old_space || new_marked(si, p)) {
newg = TARGET_GENERATION(si);
S_G.rtds_with_counts[newg] = S_cons_in(space_impure, newg, p, S_G.rtds_with_counts[newg]);
#ifdef ENABLE_OBJECT_COUNTS
@ -1307,7 +1330,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
#endif
} else {
chunkinfo *chunk = si->chunk;
if (si->generation != static_generation) S_G.number_of_nonstatic_segments -= 1;
S_G.number_of_nonstatic_segments -= 1;
S_G.number_of_empty_segments += 1;
si->space = space_empty;
si->next = chunk->unused_segs;
@ -1335,11 +1358,10 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
S_flush_instruction_cache(tc);
#ifndef NO_DIRTY_NEWSPACE_POINTERS
/* mark dirty those newspace cards to which we've added wrong-way pointers */
{ dirtycardinfo *ndc;
for (ndc = new_dirty_cards; ndc != NULL; ndc = ndc->next)
for (ndc = S_G.new_dirty_cards; ndc != NULL; ndc = ndc->next)
S_mark_card_dirty(ndc->card, ndc->youngest);
}
#endif /* !NO_DIRTY_NEWSPACE_POINTERS */
@ -1389,7 +1411,7 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
}
/* Promote opportunistic 1-shot continuations, because we can no
longer cached one and we can no longer reliably fuse the stack
longer cache one and we can no longer reliably fuse the stack
back. */
while (conts_to_promote != Snil) {
S_promote_to_multishot(CONTLINK(Scar(conts_to_promote)));
@ -1419,13 +1441,14 @@ ptr GCENTRY(ptr tc, ptr count_roots_ls) {
nlp = &S_G.next_loc[from_g][s]; \
if (*slp == 0) *slp = S_G.first_loc[from_g][s]; \
pp = TO_VOIDP(*slp); \
while (pp != (nl = (ptr *)*nlp)) \
do \
while (pp != (nl = (ptr *)*nlp)) { \
do { \
if ((p = *pp) == forward_marker) \
pp = TO_VOIDP(*(pp + 1)); \
else \
body \
while (pp != nl); \
} while (pp != nl); \
} \
*slp = TO_PTR(pp); \
}
@ -1472,7 +1495,7 @@ static void resweep_weak_pairs(seginfo *oldweakspacesegments) {
static void forward_or_bwp(pp, p) ptr *pp; ptr p; {
seginfo *si;
/* adapted from relocate */
if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space && !marked(si, p)) {
if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space && !new_marked(si, p)) {
if (FORWARDEDP(p, si)) {
*pp = GET_FWDADDRESS(p);
} else {
@ -1580,8 +1603,7 @@ static void sweep_generation(ptr tc) {
segment-specific trigger or gets triggered for recheck, but
it doesn't change the worst-case complexity. */
if (!change)
for (from_g = MIN_TG; from_g <= MAX_TG; from_g += 1)
check_pending_ephemerons(from_g);
check_pending_ephemerons();
} while (change);
}
@ -1618,7 +1640,7 @@ static iptr sweep_typed_object(ptr tc, ptr p, IGEN from_g) {
sweep_record(p, from_g);
return size_record_inst(UNFIX(RECORDDESCSIZE(RECORDINSTTYPE(p))));
} else if (TYPEP(tf, mask_thread, type_thread)) {
sweep_thread(p, from_g);
sweep_thread(p);
return size_thread;
} else {
/* We get here only if backreference mode pushed other typed objects into
@ -1716,21 +1738,31 @@ static void sweep_dirty() {
if (pp <= nl && nl < ppend) ppend = nl;
if (dirty_si->dirty_bytes[d] <= MAX_CG) {
/* assume we won't find any wrong-way pointers */
/* start out with assumption that we won't find any wrong-way pointers */
youngest = 0xff;
if ((s == space_impure) || (s == space_immobile_impure)
|| (s == space_impure_typed_object) || (s == space_count_impure)
|| (s == space_closure)) {
while (pp < ppend && *pp != forward_marker) {
/* handle two pointers at a time */
if (!dirty_si->marked_mask || marked(dirty_si, TO_PTR(pp))) {
if (dirty_si->marked_mask) {
while (pp < ppend) {
/* handle two pointers at a time */
if (marked(dirty_si, TO_PTR(pp))) {
relocate_dirty(pp,youngest);
pp += 1;
relocate_dirty(pp,youngest);
pp += 1;
} else
pp += 2;
}
} else {
while (pp < ppend && *pp != forward_marker) {
/* handle two pointers at a time */
relocate_dirty(pp,youngest);
pp += 1;
relocate_dirty(pp,youngest);
pp += 1;
} else
pp += 2;
}
}
} else if (s == space_symbol) {
/* old symbols cannot overlap segment boundaries
@ -1743,7 +1775,8 @@ static void sweep_dirty() {
(size_symbol / sizeof(ptr))) *
(size_symbol / sizeof(ptr));
while (pp < ppend && *pp != forward_marker) { /* might overshoot card by part of a symbol. no harm. */
/* might overshoot card by part of a symbol. no harm. */
while (pp < ppend && (dirty_si->marked_mask || (*pp != forward_marker))) {
ptr p = TYPE(TO_PTR(pp), type_symbol);
if (!dirty_si->marked_mask || marked(dirty_si, p))
@ -1762,7 +1795,8 @@ static void sweep_dirty() {
(size_port / sizeof(ptr))) *
(size_port / sizeof(ptr));
while (pp < ppend && *pp != forward_marker) { /* might overshoot card by part of a port. no harm. */
/* might overshoot card by part of a port. no harm. */
while (pp < ppend && (dirty_si->marked_mask || (*pp != forward_marker))) {
ptr p = TYPE(TO_PTR(pp), type_typed_object);
if (!dirty_si->marked_mask || marked(dirty_si, p))
@ -1849,9 +1883,6 @@ static void sweep_dirty() {
/* skip unmarked words */
p = (ptr)((uptr)p + byte_alignment);
} else {
/* quit on end of segment */
if (FWDMARKER(p) == forward_marker) break;
youngest = sweep_dirty_record(p, youngest);
p = (ptr)((iptr)p +
size_record_inst(UNFIX(RECORDDESCSIZE(
@ -1905,7 +1936,7 @@ static void sweep_dirty() {
}
}
} else if (s == space_weakpair) {
while (pp < ppend && *pp != forward_marker) {
while (pp < ppend && (dirty_si->marked_mask || (*pp != forward_marker))) {
/* skip car field and handle cdr field */
if (!dirty_si->marked_mask || marked(dirty_si, TO_PTR(pp))) {
pp += 1;
@ -1915,7 +1946,7 @@ static void sweep_dirty() {
pp += 2;
}
} else if (s == space_ephemeron) {
while (pp < ppend && *pp != forward_marker) {
while (pp < ppend && (dirty_si->marked_mask || (*pp != forward_marker))) {
ptr p = TYPE(TO_PTR(pp), type_pair);
if (!dirty_si->marked_mask || marked(dirty_si, p))
youngest = check_dirty_ephemeron(p, youngest);
@ -1976,25 +2007,27 @@ static void resweep_dirty_weak_pairs() {
if (dirty_si->dirty_bytes[d] <= MAX_CG) {
youngest = ls->youngest[d];
while (pp < ppend) {
p = *pp;
seginfo *si;
if (!dirty_si->marked_mask || marked(dirty_si, TO_PTR(pp))) {
p = *pp;
seginfo *si;
/* handle car field */
if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) {
if (si->old_space) {
if (marked(si, p)) {
youngest = TARGET_GENERATION(si);
} else if (FORWARDEDP(p, si)) {
IGEN newpg;
*pp = FWDADDRESS(p);
newpg = TARGET_GENERATION(si);
if (newpg < youngest) youngest = newpg;
/* handle car field */
if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) {
if (si->old_space) {
if (new_marked(si, p)) {
youngest = TARGET_GENERATION(si);
} else if (FORWARDEDP(p, si)) {
IGEN newpg;
*pp = FWDADDRESS(p);
newpg = TARGET_GENERATION(si);
if (newpg < youngest) youngest = newpg;
} else {
*pp = Sbwp_object;
}
} else {
*pp = Sbwp_object;
IGEN pg = si->generation;
if (pg < youngest) youngest = pg;
}
} else {
IGEN pg = si->generation;
if (pg < youngest) youngest = pg;
}
}
@ -2074,19 +2107,30 @@ static void add_trigger_ephemerons_to_pending(ptr pe) {
ephemeron_add(&pending_ephemerons, pe);
}
static void check_ephemeron(ptr pe, IGEN from_g) {
static void check_ephemeron(ptr pe) {
ptr p;
seginfo *si;
IGEN from_g;
PUSH_BACKREFERENCE(pe);
EPHEMERONNEXT(pe) = 0;
EPHEMERONPREVREF(pe) = 0;
from_g = GENERATION(pe);
p = Scar(pe);
if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space) {
if (marked(si, p)) {
if (new_marked(si, p)) {
#ifndef NO_DIRTY_NEWSPACE_POINTERS
IGEN tg = TARGET_GENERATION(si);
if (tg < from_g) S_record_new_dirty_card(&INITCAR(pe), tg);
#endif
relocate_impure(&INITCDR(pe), from_g);
} else if (FORWARDEDP(p, si)) {
#ifndef NO_DIRTY_NEWSPACE_POINTERS
IGEN tg = TARGET_GENERATION(si);
if (tg < from_g) S_record_new_dirty_card(&INITCAR(pe), tg);
#endif
INITCAR(pe) = FWDADDRESS(p);
relocate_impure(&INITCDR(pe), from_g);
} else {
@ -2101,14 +2145,14 @@ static void check_ephemeron(ptr pe, IGEN from_g) {
POP_BACKREFERENCE();
}
static void check_pending_ephemerons(IGEN from_g) {
static void check_pending_ephemerons() {
ptr pe, next_pe;
pe = pending_ephemerons;
pending_ephemerons = 0;
while (pe != 0) {
next_pe = EPHEMERONNEXT(pe);
check_ephemeron(pe, from_g);
check_ephemeron(pe);
pe = next_pe;
}
}
@ -2126,7 +2170,7 @@ static IGEN check_dirty_ephemeron(ptr pe, IGEN youngest) {
p = Scar(pe);
if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) {
if (si->old_space) {
if (marked(si, p)) {
if (new_marked(si, p)) {
relocate_dirty(&INITCDR(pe), youngest);
} else if (FORWARDEDP(p, si)) {
INITCAR(pe) = GET_FWDADDRESS(p);
@ -2225,8 +2269,8 @@ void copy_and_clear_list_bits(seginfo *oldspacesegments) {
for (si = oldspacesegments; si != NULL; si = si->next) {
if (si->list_bits) {
if ((si->generation == 0) && !si->marked_mask) {
/* drop generation-0 bits, because probably the relevant pairs
if ((si->generation == 1) && !si->marked_mask) {
/* drop (former) generation-0 bits, because probably the relevant pairs
were short-lived, and it's ok to recompute them if needed */
} else {
if (si->marked_mask) {
@ -2245,6 +2289,7 @@ void copy_and_clear_list_bits(seginfo *oldspacesegments) {
find_room_voidp(space_data, bits_si->generation, ptr_align(segment_bitmap_bytes), copied_bits);
memcpy_aligned(copied_bits, si->list_bits, segment_bitmap_bytes);
si->list_bits = copied_bits;
S_G.bitmask_overhead[bits_si->generation] += ptr_align(segment_bitmap_bytes);
}
}

26
racket/src/ChezScheme/c/gcwrapper.c
View File

@ -192,8 +192,11 @@ void S_immobilize_object(x) ptr x; {
/* Try a little to to support cancellation of segment-level
* immobilzation --- but we don't try too hard */
if (si->must_mark < MUST_MARK_INFINITY)
if (si->must_mark < MUST_MARK_INFINITY) {
si->must_mark++;
if (si->generation == 0)
S_G.must_mark_gen0 = 1;
}
/* Note: for `space_new`, `must_mark` doesn't really mean all
objects must be marked; only those in the locked list must be
@ -297,8 +300,11 @@ void Slock_object(x) ptr x; {
tc_mutex_acquire()
S_pants_down += 1;
/* immobilize */
if (si->must_mark < MUST_MARK_INFINITY)
if (si->must_mark < MUST_MARK_INFINITY) {
si->must_mark++;
if (si->generation == 0)
S_G.must_mark_gen0 = 1;
}
/* add x to locked list. remove from unlocked list */
S_G.locked_objects[g] = S_cons_in((g == 0 ? space_new : space_impure), g, x, S_G.locked_objects[g]);
if (S_G.enable_object_counts) {
@ -512,6 +518,7 @@ static void segment_tell(seg) uptr seg; {
if ((si = MaybeSegInfo(seg)) == NULL) {
printf(" out of heap bounds\n");
} else {
printf(" si=%p", si);
printf(" generation=%d", si->generation);
s = si->space;
s1 = si->space;
@ -671,7 +678,10 @@ void S_check_heap(aftergc, mcg) IBOOL aftergc; IGEN mcg; {
if (psi != NULL) {
if ((psi->space == space_empty)
|| psi->old_space
|| (psi->marked_mask && !(psi->marked_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p)))) {
|| (psi->marked_mask && !(psi->marked_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p))
/* corner case: a continuation in space_count_pure can refer to code via CLOSENTRY
where the entry point doesn't have a mark bit: */
&& !((s == space_count_pure) && (psi->space == space_code)))) {
S_checkheap_errors += 1;
printf("!!! dangling reference at "PHtx" to "PHtx"%s\n", (ptrdiff_t)pp1, (ptrdiff_t)p, (aftergc ? " after gc" : ""));
printf("from: "); segment_tell(seg);
@ -870,7 +880,7 @@ static void check_dirty() {
S_checkheap_errors += 1;
printf("!!! (check_dirty): dirty byte = %d for segment "PHtx" in %d -> %d dirty list\n", mingval, (ptrdiff_t)(si->number), from_g, to_g);
}
if (s != space_new && s != space_impure && s != space_symbol && s != space_port
if (s != space_new && s != space_impure && s != space_count_impure && s != space_symbol && s != space_port
&& s != space_impure_record && s != space_impure_typed_object && s != space_immobile_impure
&& s != space_weakpair && s != space_ephemeron) {
S_checkheap_errors += 1;
@ -989,7 +999,9 @@ ptr S_do_gc(IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots) {
RTDCOUNTSIT(counts, new_g) = RTDCOUNTSIT(counts, old_g); RTDCOUNTSIT(counts, old_g) = 0;
}
}
#ifndef WIN32
S_child_processes[new_g] = S_child_processes[old_g];
#endif
/* change old_g dirty bytes in static generation to new_g; splice list of old_g
seginfos onto front of new_g seginfos */
@ -1061,9 +1073,11 @@ ptr S_gc(ptr tc, IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots) {
|| S_G.enable_object_counts || S_G.enable_object_backreferences
|| (count_roots != Sfalse))
return S_gc_oce(tc, max_cg, min_tg, max_tg, count_roots);
else if (max_cg == 0 && min_tg == 1 && max_tg == 1 && S_G.locked_objects[0] == Snil) {
else if (max_cg == 0 && min_tg == 1 && max_tg == 1
&& !S_G.must_mark_gen0 && S_G.locked_objects[0] == Snil
&& (S_G.min_mark_gen > 0)) {
S_gc_011(tc);
return Sfalse;
return Svoid;
} else
return S_gc_ocd(tc, max_cg, min_tg, max_tg, Sfalse);
}

3
racket/src/ChezScheme/c/globals.h
View File

@ -102,6 +102,7 @@ EXTERN struct S_G_struct {
iptr bytes_left[static_generation+1][max_real_space+1];
uptr bytes_of_space[static_generation+1][max_real_space+1];
uptr bytes_of_generation[static_generation+1];
uptr bitmask_overhead[static_generation+1];
uptr g0_bytes_after_last_gc;
uptr collect_trip_bytes;
ptr nonprocedure_code;
@ -142,6 +143,8 @@ EXTERN struct S_G_struct {
ptr gcbackreference[static_generation+1];
IGEN prcgeneration;
uptr bytes_finalized;
dirtycardinfo *new_dirty_cards;
IBOOL must_mark_gen0;
/* intern.c */
iptr oblist_length;

4
racket/src/ChezScheme/c/pb.c
View File

@ -841,6 +841,10 @@ void S_pb_interp(ptr tc, void *bytecode) {
regs[Cretval] = ((pb_uptr_int32_int32_uptr_uptr_t)proc)(regs[Carg1], regs[Carg2], regs[Carg3],
regs[Carg4]);
break;
case pb_call_uptr_int32_int32_int32_uptr:
regs[Cretval] = ((pb_uptr_int32_int32_int32_uptr_t)proc)(regs[Carg1], regs[Carg2], regs[Carg3],
regs[Carg4]);
break;
case pb_call_uptr_int32_voids_uptr_uptr:
regs[Cretval] = ((pb_uptr_int32_voids_uptr_uptr_t)proc)(regs[Carg1], TO_VOIDP(regs[Carg2]), regs[Carg3],
regs[Carg4]);

6
racket/src/ChezScheme/c/schsig.c
View File

@ -49,6 +49,7 @@ void S_promote_to_multishot(k) ptr k; {
static void split(k, s) ptr k; ptr *s; {
iptr m, n;
seginfo *si;
ISPC spc;
tc_mutex_acquire()
/* set m to size of lower piece, n to size of upper piece */
@ -56,8 +57,11 @@ static void split(k, s) ptr k; ptr *s; {
n = CONTCLENGTH(k) - m;
si = SegInfo(ptr_get_segment(k));
spc = si->space;
if (spc != space_new) spc = space_continuation; /* to avoid space_count_pure */
/* insert a new continuation between k and link(k) */
CONTLINK(k) = S_mkcontinuation(si->space,
CONTLINK(k) = S_mkcontinuation(spc,
si->generation,
CLOSENTRY(k),
CONTSTACK(k),

6
racket/src/ChezScheme/c/types.h
View File

@ -298,6 +298,12 @@ typedef struct _bucket_pointer_list {
#define DIRTYSET(lhs,rhs) S_dirty_set(lhs, rhs);
typedef struct _dirtycardinfo {
uptr card;
IGEN youngest;
struct _dirtycardinfo *next;
} dirtycardinfo;
/* derived accessors/constructors */
#define FWDMARKER(p) FORWARDMARKER((uptr)UNTYPE_ANY(p))
#define FWDADDRESS(p) FORWARDADDRESS((uptr)UNTYPE_ANY(p))

2
racket/src/ChezScheme/makefiles/Mf-install.in
View File

@ -62,7 +62,7 @@ InstallLZ4Target=
# no changes should be needed below this point #
###############################################################################
Version=csv9.5.3.36
Version=csv9.5.3.37
Include=boot/$m
PetiteBoot=boot/$m/petite.boot
SchemeBoot=boot/$m/scheme.boot

18
racket/src/ChezScheme/mats/4.ms
View File

@ -4804,6 +4804,24 @@
(eq? #!bwp (ephemeron-key e))
(eq? #!bwp (ephemeron-value e)))))))))
;; ----------------------------------------
;; Check interaction of mutation and incremental generation promotion
(with-interrupts-disabled
(let ([key "key"])
(let ([e (ephemeron-cons key #f)])
(collect 0 1 1)
(let ([key2 (gensym key)])
;; e is gen 1, key2 is gen 0:
(set-car! e key2)
(collect 1 1 2)
;; Now, e is gen 1, key2 is gen 0
(and (eq? (car e) key2)
(begin
(collect 1 2 2)
;; Check that the GC update the reference to `key2` in `e`:
(eq? (car e) key2)))))))
;; ----------------------------------------
;; Check fasl:
(let ([s (gensym)])

2
racket/src/ChezScheme/mats/7.ms
View File

@ -5645,7 +5645,7 @@ evaluating module init
(let ([b0-0 (bytes-allocated 0)]
[b1-0 (bytes-allocated 1)]
[bm-0 (bytes-allocated (collect-maximum-generation))])
(let* ([v (make-vector 2000)] [n (compute-size v)])
(let* ([v (make-vector 20000)] [n (compute-size v)])
(let ([b0-1 (bytes-allocated 0)]
[b1-1 (bytes-allocated 1)]
[bm-1 (bytes-allocated (collect-maximum-generation))])

5
racket/src/ChezScheme/mats/root-experr-compile-0-f-f-f
View File

@ -3989,8 +3989,9 @@ misc.mo:Expected error in mat compute-size-increments: "compute-size-increments:
misc.mo:Expected error in mat collect+compute-size-increments: "collect: invalid counting-roots list not-a-list".
misc.mo:Expected error in mat collect+compute-size-increments: "collect: invalid counting-roots list 0".
misc.mo:Expected error in mat collect+compute-size-increments: "collect: invalid generation not-a-generation".
misc.mo:Expected error in mat collect+compute-size-increments: "collect: invalid target generation not-a-generation for generation 0".
misc.mo:Expected error in mat collect+compute-size-increments: "collect: invalid target generation 0 for generation 1".
misc.mo:Expected error in mat collect+compute-size-increments: "collect: invalid minimum target generation not-a-generation for generation 0 and maximum target generation 0".
misc.mo:Expected error in mat collect+compute-size-increments: "collect: invalid maximum target generation not-a-generation for generation 0".
misc.mo:Expected error in mat collect+compute-size-increments: "collect: invalid maximum target generation 0 for generation 1".
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".

7
racket/src/ChezScheme/s/cmacros.ss
View File

@ -357,7 +357,7 @@
;; ---------------------------------------------------------------------
;; Version and machine types:
(define-constant scheme-version #x09050324)
(define-constant scheme-version #x09050325)
(define-syntax define-machine-types
(lambda (x)
@ -2082,11 +2082,11 @@
(define-constant unscaled-shot-1-shot-flag -1)
(define-constant scaled-shot-1-shot-flag
(* (constant unscaled-shot-1-shot-flag) (constant ptr-bytes)))
;; opportunistic--1-shot-flag is in the continuation length field for
;; opportunistic-1-shot-flag is in the continuation length field for
;; a one-shot continuation that is only treated a 1-shot when
;; it's contiguous with the current stack when called, in which case
;; the continuation can be just merged back with the current stack
(define-constant opportunistic-1-shot-flag 0)
(define-constant opportunistic-1-shot-flag (* -2 (constant ptr-bytes)))
;;; underflow limit determines how much we're willing to copy on
;;; stack underflow/continuation invocation
@ -3238,6 +3238,7 @@
[uptr int32 int32 uptr uptr]
[uptr int32 void* uptr uptr]
[uptr uptr uptr uptr uptr]
[uptr int32 int32 int32 uptr]
[uptr uptr void* uptr uptr]
[uptr uptr uptr uptr uptr int32]
[uptr uptr uptr uptr uptr uptr]

73
racket/src/ChezScheme/s/mkgc.ss
View File

@ -18,6 +18,7 @@
;; Currently supported traversal modes:
;; - copy
;; - sweep
;; - sweep-in-old ; like sweep, but don't update impure
;; - mark
;; - self-test : check immediate pointers only for self references
;; - size : immediate size, so does not recur
@ -201,9 +202,11 @@
[else space-continuation]))
(vfasl-fail "closure")
(size size-continuation)
(mark one-bit counting-root)
(case-mode
[self-test]
[mark
(copy-stack-length continuation-stack-length continuation-stack-clength)
(mark one-bit counting-root)]
[else
(copy-clos-code code)
(copy-stack-length continuation-stack-length continuation-stack-clength)
@ -214,14 +217,15 @@
[(== (continuation-stack-length _) scaled-shot-1-shot-flag)]
[else
(case-mode
[sweep
(when (OLDSPACE (continuation-stack _))
[(sweep)
(define stk : ptr (continuation-stack _))
(when (&& (!= stk (cast ptr 0)) (OLDSPACE stk))
(set! (continuation-stack _)
(copy_stack (continuation-stack _)
(& (continuation-stack-length _))
(continuation-stack-clength _))))]
[else])
(count countof-stack (continuation-stack-length _) 1 [sweep measure])
(count countof-stack (continuation-stack-length _) 1 [measure])
(trace-pure continuation-link)
(trace-return continuation-return-address (continuation-return-address _))
(case-mode
@ -607,13 +611,11 @@
[(&& (!= cdr_p _)
(&& (== (TYPEBITS cdr_p) type_pair)
(&& (!= (set! qsi (MaybeSegInfo (ptr_get_segment cdr_p))) NULL)
(&& (-> qsi old_space)
(&& (== (-> qsi space) (-> si space))
(&& (!= (FWDMARKER cdr_p) forward_marker)
(&& (! (-> qsi use_marks))
;; Checking `marked_mask`, too, in
;; case the pair is locked
(! (-> qsi marked_mask)))))))))
(&& (== qsi si)
(&& (!= (FWDMARKER cdr_p) forward_marker)
;; Checking `marked_mask`, in
;; case the pair is locked
(! (-> qsi marked_mask)))))))
(check_triggers qsi)
(size size-pair 2)
(define new_cdr_p : ptr (cast ptr (+ (cast uptr _copy_) size_pair)))
@ -672,7 +674,7 @@
(case-mode
[(copy vfasl-copy)
(SETCLOSCODE _copy_ code)]
[(sweep)
[(sweep sweep-in-old)
(unless-code-relocated
(SETCLOSCODE _copy_ code))]
[(vfasl-sweep)
@ -684,13 +686,13 @@
(define-trace-macro (copy-stack-length continuation-stack-length continuation-stack-clength)
(case-mode
[copy
[(copy mark)
;; Don't promote general one-shots, but promote opportunistic one-shots
(cond
[(== (continuation-stack-length _) opportunistic-1-shot-flag)
(set! (continuation-stack-length _copy_) (continuation-stack-clength _))
;; May need to recur at end to promote link:
(set! conts_to_promote (S_cons_in space_new 0 new_p conts_to_promote))]
(set! conts_to_promote (S_cons_in space_new 0 _copy_ conts_to_promote))]
[else
(copy continuation-stack-length)])]
[else
@ -700,7 +702,7 @@
(case-mode
[(copy measure)
(trace ref)]
[sweep
[(sweep sweep-in-old)
(trace ref) ; can't trace `val` directly, because we need an impure relocate
(define val : ptr (ref _))]
[vfasl-copy
@ -709,7 +711,7 @@
(define-trace-macro (trace-symcode symbol-pvalue val)
(case-mode
[sweep
[(sweep sweep-in-old)
(define code : ptr (cond
[(Sprocedurep val) (CLOSCODE val)]
[else (SYMCODE _)]))
@ -780,7 +782,7 @@
[on]
[off
(case-mode
[(sweep self-test)
[(sweep sweep-in-old self-test)
;; Bignum pointer mask may need forwarding
(trace-pure (record-type-pm rtd))
(set! num (record-type-pm rtd))]
@ -895,6 +897,9 @@
(cast iptr (port-buffer _))))
(trace port-buffer)
(set! (port-last _) (cast ptr (+ (cast iptr (port-buffer _)) n))))]
[sweep-in-old
(when (& (cast uptr _tf_) flag)
(trace port-buffer))]
[else
(trace-nonself port-buffer)]))
@ -906,7 +911,7 @@
(define tc : ptr (cast ptr (offset _)))
(when (!= tc (cast ptr 0))
(case-mode
[sweep
[(sweep)
(let* ([old_stack : ptr (tc-scheme-stack tc)])
(when (OLDSPACE old_stack)
(let* ([clength : iptr (- (cast uptr (SFP tc)) (cast uptr old_stack))])
@ -914,7 +919,6 @@
(set! (tc-scheme-stack tc) (copy_stack old_stack
(& (tc-scheme-stack-size tc))
(+ clength (sizeof ptr))))
(count countof-stack (tc-scheme-stack-size tc) 1 sweep)
(set! (tc-sfp tc) (cast ptr (+ (cast uptr (tc-scheme-stack tc)) clength)))
(set! (tc-esp tc) (cast ptr (- (+ (cast uptr (tc-scheme-stack tc))
(tc-scheme-stack-size tc))
@ -1027,11 +1031,14 @@
(define co : iptr (+ (ENTRYOFFSET xcp) (- (cast uptr xcp) (cast uptr (TO_PTR (ENTRYOFFSETADDR xcp))))))
(define c_p : ptr (cast ptr (- (cast uptr xcp) co)))
(case-mode
[sweep
[(sweep sweep-in-old)
(define x_si : seginfo* (SegInfo (ptr_get_segment c_p)))
(when (-> x_si old_space)
(relocate_code c_p x_si)
(set! field (cast ptr (+ (cast uptr c_p) co))))]
(case-mode
[sweep-in-old]
[else
(set! field (cast ptr (+ (cast uptr c_p) co)))]))]
[else
(trace-pure (just c_p))]))
@ -1042,7 +1049,7 @@
[else
(define t : ptr (code-reloc _))
(case-mode
[(sweep vfasl-sweep)
[(sweep sweep-in-old vfasl-sweep)
(define m : iptr (reloc-table-size t))
(define oldco : ptr (reloc-table-code t))]
[else
@ -1154,7 +1161,7 @@
(define-trace-macro (and-purity-sensitive-mode e)
(case-mode
[sweep e]
[(sweep sweep-in-old) e]
[else 0]))
(define-trace-macro (when-vfasl e)
@ -1342,6 +1349,7 @@
[(sweep) (if (lookup 'as-dirty? config #f)
"IGEN"
"void")]
[(sweep-in-old) "void"]
[else "void"])
name
(case (lookup 'mode config)
@ -1359,9 +1367,7 @@
[(sweep)
(cond
[(lookup 'as-dirty? config #f) ", IGEN youngest"]
[(and (lookup 'from-g-only-counting? config #f)
(not (lookup 'counts? config #f)))
", IGEN UNUSED(from_g)"]
[(lookup 'no-from-g? config #f) ""]
[else ", IGEN from_g"])]
[else ""]))
(let ([body
@ -1529,7 +1535,7 @@
(code (case (and (not (lookup 'as-dirty? config #f))
(not (lookup 'rtd-relocated? config #f))
(lookup 'mode config))
[(copy sweep mark)
[(copy sweep sweep-in-old mark)
(code
"/* Relocate to make sure we aren't using an oldspace descriptor"
" that has been overwritten by a forwarding marker, but don't loop"
@ -1638,7 +1644,7 @@
(statements (cons `(copy-bytes ,offset (* ptr_bytes ,len))
(cdr l))
config)]
[(sweep measure vfasl-sweep)
[(sweep measure sweep-in-old vfasl-sweep)
(code
(loop-over-pointers
(field-expression offset config "p" #t)
@ -2057,6 +2063,7 @@
(define mode (lookup 'mode config))
(cond
[(or (eq? mode 'sweep)
(eq? mode 'sweep-in-old)
(eq? mode 'vfasl-sweep)
(and early? (or (eq? mode 'copy)
(eq? mode 'mark))))
@ -2075,6 +2082,10 @@
(case mode
[(vfasl-sweep)
(format "vfasl_relocate(vfi, &~a);" e)]
[(sweep-in-old)
(if (eq? purity 'pure)
(format "relocate_pure(&~a);" e)
(format "relocate_indirect(~a);" e))]
[else
(if (lookup 'as-dirty? config #f)
(begin
@ -2286,6 +2297,7 @@
(if (memq 'no-clear flags)
(format "~a /* no clearing needed */" inset)
(format "~a memset(~a->marked_mask, 0, segment_bitmap_bytes);" inset si))
(format "~a S_G.bitmask_overhead[~a->generation] += ptr_align(segment_bitmap_bytes);" inset si)
(format "~a}" inset)))
(define (just-mark-bit-space? sp)
@ -2464,6 +2476,9 @@
`((mode sweep)
(maybe-backreferences? ,count?)
(counts? ,count?))))
(print-code (generate "sweep_object_in_old"
`((mode sweep-in-old)
(maybe-backreferences? ,count?))))
(print-code (generate "sweep_dirty_object"
`((mode sweep)
(maybe-backreferences? ,count?)
@ -2486,7 +2501,7 @@
(as-dirty? #t)))
(sweep1 'symbol)
(sweep1 'symbol "sweep_dirty_symbol" '((as-dirty? #t)))
(sweep1 'thread "sweep_thread" '((from-g-only-counting? #t)))
(sweep1 'thread "sweep_thread" '((no-from-g? #t)))
(sweep1 'port)
(sweep1 'port "sweep_dirty_port" '((as-dirty? #t)))
(sweep1 'closure "sweep_continuation" '((code-relocated? #t)

2
racket/src/ChezScheme/s/primdata.ss
View File

@ -1224,7 +1224,7 @@
(chmod [sig [(pathname sub-ufixnum) -> (void)]] [flags])
(clear-input-port [sig [() (input-port) -> (void)]] [flags true])
(clear-output-port [sig [() (output-port) -> (void)]] [flags true])
(collect [sig [() (sub-ufixnum) (sub-ufixnum ptr) (sub-ufixnum ptr ptr) (sub-ufixnum ptr ptr ptr) -> (void)]] [flags true])
(collect [sig [() (sub-ufixnum) (sub-ufixnum ptr) (sub-ufixnum ptr ptr) (sub-ufixnum ptr ptr ptr) -> (void/list)]] [flags true])
(collect-rendezvous [sig [() -> (void)]] [flags])
(collections [sig [() -> (uint)]] [flags unrestricted alloc])
(compile [sig [(sub-ptr) (sub-ptr environment) -> (ptr ...)]] [flags])