From 48487ed6fbd84168485bd1206354ea8e037d9b73 Mon Sep 17 00:00:00 2001 From: dyb Date: Fri, 14 Aug 2020 06:08:18 -0600 Subject: [PATCH] Added support for incremental promotion of objects - the collector now promotes objects one generation higher at a time by default. previously, it promoted every live oldspace object to the selected target generation, which could result in objects prematurely skipping one or more generations and thus being retained longer than their ages justify. the biggest cost in terms of code complexity and performance is the recording of pointers from older newspace objects to younger newspace objects that could not previously occur. gc.c, alloc.c, externs.h - the collect procedure now takes an additional optional minimum target generation argument to allow the new default behavior to be overridden. 7.ss, primdata.ss, gcwrapper.c, 7.ms, root-experr*, smgmt.stex, release_notes.stex - added cn flag to control collect-notify mats/Mf-base - resweep_weak_pairs now sets sweep_loc to orig_next_loc rather than first_loc since the latter could result in unnecessary sweeping of existing target-generation weak pairs. gc.c - added set of S_child_processes[newg] to S_child_processes[oldg] in S_do_gc code handling decreases in the maximum generation. gcwrapper.c - a specialized variant of the collector is used in the common case where the max copied generation is 0, the min and max target generations are 1, and there are no locked generation 0 objects is now used. with the default collection parameters and no locking of generation 0 objects, these collections account for 3/4 of all collections. gc.c, gc-011.c (new), gcwrapper.c, externs.h, c/Mf-base - maybe-fire-collector no longer tries to be so precise and instead just counts the number of generation-bytes allocated since the last gc. suprisingly, rebuilding the s directory requires about the same number of collections with this coarser (and less expensive) measurement. this change also fixes a problem with too-frequent collections when the maximum-generation is set to zero. to make the determination even less expensive, a running total of bytes in each generation is now maintained in a new bytes_of_generation vector, and maybe-fire-collector is no longer called when the collector is running. alloc.c, gc.c, gcwrapper.c, globals.h - copy now copies two pairs at once only if they are in the same segment, which saves a few memonry references and tests and turns out not to reduce the number of opportunities significantly in tested programs. gc.c - occupied_segments, first_loc, base_loc, next_loc, bytes_left, bytes_of_space, sweep_loc, and orig_next_loc are now indexed by [g][s] rather than [s][g] to improve locality in the default (and common) case where there are only a handful of active generations. globals.h, types.h, segment.c, gc.c, gcwrapper.c, prim5.c - now maintaining 16-byte architectural stack alignment (if the incoming stack is so aligned) on all x86 platforms except i3nt/ti3nt. more recent versions of gcc sometimes generate sse instructions that require 16-byte stack alignment. x86.ss [Merge for Racket includes additional changes to combine with in-place marking - mflatt] --- racket/src/ChezScheme/LOG | 77 ++ racket/src/ChezScheme/c/Mf-base | 6 +- racket/src/ChezScheme/c/alloc.c | 105 +- racket/src/ChezScheme/c/externs.h | 14 +- racket/src/ChezScheme/c/gc-011.c | 26 + racket/src/ChezScheme/c/gc-ocd.c | 10 +- racket/src/ChezScheme/c/gc-oce.c | 10 +- racket/src/ChezScheme/c/gc.c | 961 ++++++++++-------- racket/src/ChezScheme/c/gcwrapper.c | 52 +- racket/src/ChezScheme/c/globals.h | 14 +- racket/src/ChezScheme/c/prim5.c | 64 +- racket/src/ChezScheme/c/segment.c | 47 +- racket/src/ChezScheme/c/types.h | 6 +- racket/src/ChezScheme/csug/smgmt.stex | 145 +-- racket/src/ChezScheme/mats/7.ms | 71 +- racket/src/ChezScheme/mats/Mf-base | 7 + racket/src/ChezScheme/mats/misc.ms | 57 +- .../mats/root-experr-compile-0-f-f-f | 12 + .../mats/root-experr-compile-2-f-f-f | 12 + .../release_notes/release_notes.stex | 31 +- racket/src/ChezScheme/s/7.ss | 69 +- racket/src/ChezScheme/s/mkgc.ss | 230 +++-- racket/src/ChezScheme/s/primdata.ss | 2 +- 23 files changed, 1260 insertions(+), 768 deletions(-) create mode 100644 racket/src/ChezScheme/c/gc-011.c diff --git a/racket/src/ChezScheme/LOG b/racket/src/ChezScheme/LOG index abb720a18f..7355622865 100644 --- a/racket/src/ChezScheme/LOG +++ b/racket/src/ChezScheme/LOG @@ -2039,3 +2039,80 @@ strnum.ss, syntax.ss, trace.ss - updated bullyx patches patch* +- fixed csug copyright year substititions and changed revisiondate + to not be generated, making the csug build reproducible + newrelease csug/csug.stex +- fixed Windows build using MSYS2 + c/Mf-a6nt, c/Mf-i3nt, c/Mf-ta6nt, c/Mf-ti3nt, mats/Mf-a6nt, + mats/Mf-i3nt, mats/Mf-ta6nt, mats/Mf-ti3nt +- fixed build on Linux with musl libc + expeditor.c +- extended primitive folding to primitives that return multiple + values. + cp0.ss, primdata.ss, + cp0.ms +- fix handling of calling code's address for locking around a callable + that has a u8*, u16*, or u32* argument, which could cause the + cp register copy in the thread context to be changed before + S_call_help gets it + cpnanopass.ss, schlib.c, foreign2.c, foreign.ms +- the collector now promotes objects one generation higher at a time + by default. previously, it promoted every live oldspace object to + the selected target generation, which could result in objects + prematurely skipping one or more generations and thus being + retained longer than their ages justify. the biggest cost in + terms of code complexity and performance is the recording of + pointers from older newspace objects to younger newspace objects + that could not previously occur. + gc.c, alloc.c, externs.h +- the collect procedure now takes an additional optional minimum + target generation argument to allow the new default behavior to + be overridden. + 7.ss, primdata.ss, + gcwrapper.c, + 7.ms, root-experr* +- added cn flag to control collect-notify + mats/Mf-base +- resweep_weak_pairs now sets sweep_loc to orig_next_loc rather than + first_loc since the latter could result in unnecessary sweeping of + existing target-generation weak pairs. + gc.c +- added set of S_child_processes[newg] to S_child_processes[oldg] + in S_do_gc code handling decreases in the maximum generation. + gcwrapper.c +- a specialized variant of the collector is used in the common case + where the max copied generation is 0, the min and max target + generations are 1, and there are no locked generation 0 objects + is now used. with the default collection parameters and no locking + of generation 0 objects, these collections account for 3/4 of all + collections. + gc.c, gc-011.c (new), gcwrapper.c, externs.h, c/Mf-base +- maybe-fire-collector no longer tries to be so precise and instead + just counts the number of generation-bytes allocated since the + last gc. suprisingly, rebuilding the s directory requires about + the same number of collections with this coarser (and less + expensive) measurement. this change also fixes a problem with + too-frequent collections when the maximum-generation is set to + zero. to make the determination even less expensive, a running + total of bytes in each generation is now maintained in a new + bytes_of_generation vector, and maybe-fire-collector is no longer + called when the collector is running. + alloc.c, gc.c, gcwrapper.c, globals.h +- copy now copies two pairs at once only if they are in the same + segment, which saves a few memonry references and tests and turns + out not to reduce the number of opportunities significantly in + tested programs. + gc.c +- occupied_segments, first_loc, base_loc, next_loc, bytes_left, + bytes_of_space, sweep_loc, and orig_next_loc are now indexed + by [g][s] rather than [s][g] to improve locality in the default + (and common) case where there are only a handful of active + generations. + globals.h, types.h, segment.c, gc.c, gcwrapper.c, prim5.c +- documented change to collect procedure + smgmt.stex, release_notes.stex +- now maintaining 16-byte architectural stack alignment (if the + incoming stack is so aligned) on all x86 platforms except + i3nt/ti3nt. more recent versions of gcc sometimes generate sse + instructions that require 16-byte stack alignment. + x86.ss diff --git a/racket/src/ChezScheme/c/Mf-base b/racket/src/ChezScheme/c/Mf-base index a6ac241f3a..aa6c033fc0 100644 --- a/racket/src/ChezScheme/c/Mf-base +++ b/racket/src/ChezScheme/c/Mf-base @@ -35,7 +35,7 @@ KernelLib=../boot/$m/libkernel.a KernelLibLinkDeps=${zlibDep} ${LZ4Dep} KernelLibLinkLibs=${zlibLib} ${LZ4Lib} -kernelsrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-ocd.c gc-oce.c\ +kernelsrc=statics.c segment.c alloc.c symbol.c intern.c gcwrapper.c gc-011.c gc-ocd.c gc-oce.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\ schlib.c thread.c expeditor.c scheme.c compress-io.c random.c @@ -68,8 +68,8 @@ ${kernelobj}: system.h types.h version.h externs.h globals.h segment.h thread.h ${kernelobj}: ${Include}/equates.h ${Include}/scheme.h ${mainobj}: ${Include}/scheme.h ${kernelobj}: ${zlibHeaderDep} ${LZ4HeaderDep} -gc-ocd.o gc-oce.o: gc.c -gc-ocd.o: ${Include}/gc-ocd.inc +gc-011.o gc-ocd.o gc-oce.o: gc.c +gc-011.o gc-ocd.o: ${Include}/gc-ocd.inc gc-oce.o: ${Include}/gc-oce.inc vfasl.o: ${Include}/vfasl.inc diff --git a/racket/src/ChezScheme/c/alloc.c b/racket/src/ChezScheme/c/alloc.c index 03f009a834..ff30dd08c5 100644 --- a/racket/src/ChezScheme/c/alloc.c +++ b/racket/src/ChezScheme/c/alloc.c @@ -25,13 +25,14 @@ void S_alloc_init() { if (S_boot_time) { /* reset the allocation tables */ - for (s = 0; s <= max_real_space; s++) { - for (g = 0; g <= static_generation; g++) { - S_G.base_loc[s][g] = FIX(0); - S_G.first_loc[s][g] = FIX(0); - S_G.next_loc[s][g] = FIX(0); - S_G.bytes_left[s][g] = 0; - S_G.bytes_of_space[s][g] = 0; + for (g = 0; g <= static_generation; g++) { + S_G.bytes_of_generation[g] = 0; + for (s = 0; s <= max_real_space; s++) { + S_G.base_loc[g][s] = FIX(0); + S_G.first_loc[g][s] = FIX(0); + S_G.next_loc[g][s] = FIX(0); + S_G.bytes_left[g][s] = 0; + S_G.bytes_of_space[g][s] = 0; } } @@ -41,6 +42,7 @@ void S_alloc_init() { } S_G.collect_trip_bytes = default_collect_trip_bytes; + S_G.g0_bytes_after_last_gc = 0; /* set to final value in prim.c when known */ S_protect(&S_G.nonprocedure_code); @@ -149,11 +151,12 @@ ptr S_compute_bytes_allocated(xg, xs) ptr xg; ptr xs; { while (g <= gmax) { n += S_G.bytesof[g][countof_phantom]; for (s = smin; s <= smax; s++) { + ptr next_loc = S_G.next_loc[g][s]; /* add in bytes previously recorded */ - n += S_G.bytes_of_space[s][g]; + n += S_G.bytes_of_space[g][s]; /* add in bytes in active segments */ - if (S_G.next_loc[s][g] != FIX(0)) - n += (uptr)S_G.next_loc[s][g] - (uptr)S_G.base_loc[s][g]; + if (next_loc != FIX(0)) + n += (uptr)next_loc - (uptr)S_G.base_loc[g][s]; } if (g == S_G.max_nonstatic_generation) g = static_generation; @@ -173,29 +176,7 @@ ptr S_bytes_finalized() { } static void maybe_fire_collector() { - ISPC s; - uptr bytes, fudge; - - bytes = S_G.bytesof[0][countof_phantom]; - - for (s = 0; s <= max_real_space; s += 1) { - /* bytes already accounted for */ - bytes += S_G.bytes_of_space[s][0]; - /* bytes in current block of segments */ - if (S_G.next_loc[s][0] != FIX(0)) - bytes += (uptr)S_G.next_loc[s][0] - (uptr)S_G.base_loc[s][0]; - } - - /* arbitrary fudge factor to account for space we may not be using yet - arbitrary because: - - we assume each thread has not yet used half it's allocation area - - we assume each thread has not yet used half its stack - - some threads' stacks may not be as much as the default size - */ - fudge = (default_stack_size / 2) + S_nthreads * (bytes_per_segment / 2); - bytes = bytes > fudge ? bytes - fudge : 0; - - if (bytes >= S_G.collect_trip_bytes) + if ((S_G.bytes_of_generation[0] + S_G.bytesof[0][countof_phantom]) - S_G.g0_bytes_after_last_gc >= S_G.collect_trip_bytes) S_fire_collector(); } @@ -228,22 +209,24 @@ ptr S_find_more_room(s, g, n, old) ISPC s; IGEN g; iptr n; ptr old; { if (old == FIX(0)) { /* first object of this space */ - S_G.first_loc[s][g] = new; + S_G.first_loc[g][s] = new; } else { + uptr bytes = (uptr)old - (uptr)S_G.base_loc[g][s]; /* increment bytes_allocated by the closed-off partial segment */ - S_G.bytes_of_space[s][g] += (uptr)old - (uptr)S_G.base_loc[s][g]; + S_G.bytes_of_space[g][s] += bytes; + S_G.bytes_of_generation[g] += bytes; /* lay down an end-of-segment marker */ *(ptr*)TO_VOIDP(old) = forward_marker; *((ptr*)TO_VOIDP(old) + 1) = new; } /* base address of current block of segments to track amount of allocation */ - S_G.base_loc[s][g] = new; + S_G.base_loc[g][s] = new; - S_G.next_loc[s][g] = (ptr)((uptr)new + n); - S_G.bytes_left[s][g] = (nsegs * bytes_per_segment - n) - 2 * ptr_bytes; + S_G.next_loc[g][s] = (ptr)((uptr)new + n); + S_G.bytes_left[g][s] = (nsegs * bytes_per_segment - n) - 2 * ptr_bytes; - if (g == 0) maybe_fire_collector(); + if (g == 0 && S_pants_down == 1) maybe_fire_collector(); S_pants_down -= 1; return new; @@ -274,9 +257,10 @@ void S_reset_allocation_pointer(tc) ptr tc; { seg = S_find_segments(space_new, 0, 1); */ - S_G.bytes_of_space[space_new][0] += bytes_per_segment; + S_G.bytes_of_space[0][space_new] += bytes_per_segment; + S_G.bytes_of_generation[0] += bytes_per_segment; - maybe_fire_collector(); + if (S_pants_down == 1) maybe_fire_collector(); AP(tc) = build_ptr(seg, 0); REAL_EAP(tc) = EAP(tc) = (ptr)((uptr)AP(tc) + bytes_per_segment); @@ -285,22 +269,22 @@ void S_reset_allocation_pointer(tc) ptr tc; { } -FORCEINLINE void mark_segment_dirty(seginfo *si, IGEN from_g) { - IGEN to_g = si->min_dirty_byte; - if (to_g != 0) { +FORCEINLINE void mark_segment_dirty(seginfo *si, IGEN from_g, IGEN to_g) { + IGEN old_to_g = si->min_dirty_byte; + if (to_g < old_to_g) { seginfo **pointer_to_first, *oldfirst; - if (to_g != 0xff) { + if (old_to_g != 0xff) { seginfo *next = si->dirty_next, **prev = si->dirty_prev; /* presently on some other list, so remove */ *prev = next; if (next != NULL) next->dirty_prev = prev; } - oldfirst = *(pointer_to_first = &DirtySegments(from_g, 0)); + oldfirst = *(pointer_to_first = &DirtySegments(from_g, to_g)); *pointer_to_first = si; si->dirty_prev = pointer_to_first; si->dirty_next = oldfirst; if (oldfirst != NULL) oldfirst->dirty_prev = &si->dirty_next; - si->min_dirty_byte = 0; + si->min_dirty_byte = to_g; } } @@ -319,12 +303,23 @@ void S_dirty_set(ptr *loc, ptr x) { IGEN from_g = si->generation; if (from_g != 0) { si->dirty_bytes[((uptr)TO_PTR(loc) >> card_offset_bits) & ((1 << segment_card_offset_bits) - 1)] = 0; - mark_segment_dirty(si, from_g); + mark_segment_dirty(si, from_g, 0); } } } } +void S_mark_card_dirty(uptr card, IGEN to_g) { + uptr loc = card << card_offset_bits; + uptr seg = addr_get_segment(loc); + seginfo *si = SegInfo(seg); + uptr cardno = card & ((1 << segment_card_offset_bits) - 1); + if (to_g < si->dirty_bytes[cardno]) { + si->dirty_bytes[cardno] = to_g; + mark_segment_dirty(si, si->generation, to_g); + } +} + /* scan remembered set from P to ENDP, transfering to dirty vector */ void S_scan_dirty(ptr *p, ptr *endp) { uptr this, last; @@ -347,7 +342,7 @@ void S_scan_dirty(ptr *p, ptr *endp) { IGEN from_g = si->generation; if (from_g != 0) { si->dirty_bytes[((uptr)loc >> card_offset_bits) & ((1 << segment_card_offset_bits) - 1)] = 0; - if (this >> segment_card_offset_bits != last >> segment_card_offset_bits) mark_segment_dirty(si, from_g); + if (this >> segment_card_offset_bits != last >> segment_card_offset_bits) mark_segment_dirty(si, from_g, 0); } last = this; } @@ -376,7 +371,9 @@ void S_scan_remembered_set() { AP(tc) = (ptr)ap; EAP(tc) = (ptr)eap; } else { - S_G.bytes_of_space[space_new][0] -= eap - ap; + uptr bytes = eap - ap; + S_G.bytes_of_space[0][space_new] -= bytes; + S_G.bytes_of_generation[0] -= bytes; S_reset_allocation_pointer(tc); } @@ -420,7 +417,9 @@ ptr S_get_more_room_help(ptr tc, uptr ap, uptr type, uptr size) { AP(tc) = (ptr)ap; EAP(tc) = (ptr)eap; } else { - S_G.bytes_of_space[space_new][0] -= eap - ap; + uptr bytes = eap - ap; + S_G.bytes_of_space[0][space_new] -= bytes; + S_G.bytes_of_generation[0] -= bytes; S_reset_allocation_pointer(tc); } } else if (eap - ap > alloc_waste_maximum) { @@ -428,7 +427,9 @@ ptr S_get_more_room_help(ptr tc, uptr ap, uptr type, uptr size) { EAP(tc) = (ptr)eap; find_room(space_new, 0, type, size, x); } else { - S_G.bytes_of_space[space_new][0] -= eap - ap; + uptr bytes = eap - ap; + S_G.bytes_of_space[0][space_new] -= bytes; + S_G.bytes_of_generation[0] -= bytes; S_reset_allocation_pointer(tc); ap = (uptr)AP(tc); if (size + alloc_waste_maximum <= (uptr)EAP(tc) - ap) { diff --git a/racket/src/ChezScheme/c/externs.h b/racket/src/ChezScheme/c/externs.h index dfab0e02ab..08948df056 100644 --- a/racket/src/ChezScheme/c/externs.h +++ b/racket/src/ChezScheme/c/externs.h @@ -67,6 +67,7 @@ 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_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)); extern void S_scan_remembered_set PROTO((void)); extern void S_get_more_room PROTO((void)); @@ -147,8 +148,8 @@ extern void S_gc_init PROTO((void)); extern void S_register_child_process PROTO((INT child)); #endif /* WIN32 */ extern void S_fixup_counts PROTO((ptr counts)); -extern ptr S_do_gc PROTO((IGEN g, IGEN gtarget, ptr count_roots)); -extern ptr S_gc PROTO((ptr tc, IGEN mcg, IGEN tg, ptr count_roots)); +extern ptr S_do_gc PROTO((IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots)); +extern ptr S_gc PROTO((ptr tc, IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots)); extern void S_gc_init PROTO((void)); extern void S_set_maxgen PROTO((IGEN g)); extern IGEN S_maxgen PROTO((void)); @@ -156,7 +157,6 @@ extern void S_set_minfreegen PROTO((IGEN g)); extern IGEN S_minfreegen PROTO((void)); extern void S_set_minmarkgen PROTO((IGEN g)); extern IGEN S_minmarkgen PROTO((void)); -extern ptr S_locked_objects PROTO((void)); #ifndef WIN32 extern void S_register_child_process PROTO((INT child)); #endif /* WIN32 */ @@ -168,15 +168,19 @@ extern void S_set_enable_object_backreferences PROTO((IBOOL eoc)); extern ptr S_object_backreferences PROTO((void)); extern void S_immobilize_object PROTO((ptr v)); extern void S_mobilize_object PROTO((ptr v)); +extern ptr S_locked_objects PROTO((void)); extern ptr S_unregister_guardian PROTO((ptr tconc)); extern void S_compact_heap PROTO((void)); extern void S_check_heap PROTO((IBOOL aftergc, IGEN target_gen)); +/* gc-011.c */ +extern void S_gc_011 PROTO((ptr tc)); + /* gc-ocd.c */ -extern ptr S_gc_ocd PROTO((ptr tc, IGEN mcg, IGEN tg, ptr count_roots)); +extern ptr S_gc_ocd PROTO((ptr tc, IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots)); /* gc-oce.c */ -extern ptr S_gc_oce PROTO((ptr tc, IGEN mcg, IGEN tg, ptr count_roots)); +extern ptr S_gc_oce PROTO((ptr tc, IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots)); extern ptr S_count_size_increments PROTO((ptr ls, IGEN generation)); /* intern.c */ diff --git a/racket/src/ChezScheme/c/gc-011.c b/racket/src/ChezScheme/c/gc-011.c new file mode 100644 index 0000000000..0c8192b908 --- /dev/null +++ b/racket/src/ChezScheme/c/gc-011.c @@ -0,0 +1,26 @@ +/* gc-011.c + * Copyright 1984-2020 Cisco Systems, Inc. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + */ + +#define GCENTRY S_gc_011_entry +#define MAX_CG 0 +#define MIN_TG 1 +#define MAX_TG 1 +#define NO_LOCKED_OLDSPACE_OBJECTS +#include "gc.c" + +void S_gc_011(ptr tc) { + (void)S_gc_011_entry(tc, Sfalse); +} diff --git a/racket/src/ChezScheme/c/gc-ocd.c b/racket/src/ChezScheme/c/gc-ocd.c index 614d4fa7d1..68f49c6d80 100644 --- a/racket/src/ChezScheme/c/gc-ocd.c +++ b/racket/src/ChezScheme/c/gc-ocd.c @@ -14,5 +14,13 @@ * limitations under the License. */ -#define GCENTRY S_gc_ocd +#define GCENTRY S_gc_ocd_entry #include "gc.c" + +ptr S_gc_ocd(ptr tc, IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots) { + MAX_CG = max_cg; + MIN_TG = min_tg; + MAX_TG = max_tg; + + return S_gc_ocd_entry(tc, count_roots); +} diff --git a/racket/src/ChezScheme/c/gc-oce.c b/racket/src/ChezScheme/c/gc-oce.c index ed8ac751df..71a1124661 100644 --- a/racket/src/ChezScheme/c/gc-oce.c +++ b/racket/src/ChezScheme/c/gc-oce.c @@ -14,8 +14,16 @@ * limitations under the License. */ -#define GCENTRY S_gc_oce +#define GCENTRY S_gc_oce_entry #define ENABLE_OBJECT_COUNTS #define ENABLE_BACKREFERENCE #define ENABLE_MEASURE #include "gc.c" + +ptr S_gc_oce(ptr tc, IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots) { + MAX_CG = max_cg; + MIN_TG = min_tg; + MAX_TG = max_tg; + + return S_gc_oce_entry(tc, count_roots); +} diff --git a/racket/src/ChezScheme/c/gc.c b/racket/src/ChezScheme/c/gc.c index 6039da2600..2faf0c61bf 100644 --- a/racket/src/ChezScheme/c/gc.c +++ b/racket/src/ChezScheme/c/gc.c @@ -121,28 +121,28 @@ /* locally defined functions */ -static ptr copy PROTO((ptr pp, seginfo *si)); -static void mark_object PROTO((ptr pp, seginfo *si)); -static void sweep PROTO((ptr tc, ptr p)); -static void sweep_in_old PROTO((ptr tc, ptr p)); +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 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((IGEN g, seginfo *oldweakspacesegments)); +static void resweep_weak_pairs PROTO((seginfo *oldweakspacesegments)); static void forward_or_bwp PROTO((ptr *pp, ptr p)); -static void sweep_generation PROTO((ptr tc, IGEN g)); +static void sweep_generation PROTO((ptr tc)); static void sweep_from_stack PROTO((ptr tc)); static void enlarge_sweep_stack PROTO(()); static uptr size_object PROTO((ptr p)); -static iptr sweep_typed_object PROTO((ptr tc, ptr p)); -static void sweep_symbol PROTO((ptr p)); -static void sweep_port PROTO((ptr p)); -static void sweep_thread PROTO((ptr p)); -static void sweep_continuation PROTO((ptr p)); -static void sweep_record PROTO((ptr x)); -static IGEN sweep_dirty_record PROTO((ptr x, IGEN tg, IGEN youngest)); -static IGEN sweep_dirty_port PROTO((ptr x, IGEN tg, IGEN youngest)); -static IGEN sweep_dirty_symbol PROTO((ptr x, IGEN tg, IGEN youngest)); -static void sweep_code_object PROTO((ptr tc, ptr co)); +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_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)); +static IGEN sweep_dirty_port PROTO((ptr x, IGEN youngest)); +static IGEN sweep_dirty_symbol PROTO((ptr x, IGEN youngest)); +static void sweep_code_object PROTO((ptr tc, ptr co, IGEN from_g)); static void record_dirty_segment PROTO((IGEN from_g, IGEN to_g, seginfo *si)); static void sweep_dirty PROTO((void)); static void resweep_dirty_weak_pairs PROTO((void)); @@ -152,12 +152,12 @@ 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)); -static void check_pending_ephemerons PROTO(()); -static int check_dirty_ephemeron PROTO((ptr pe, int tg, int youngest)); +static void check_ephemeron PROTO((ptr pe, IGEN from_g)); +static void check_pending_ephemerons PROTO((IGEN from_g)); +static int check_dirty_ephemeron PROTO((ptr pe, int youngest)); static void finish_pending_ephemerons PROTO((seginfo *si)); -static void init_fully_marked_mask(); -static void copy_and_clear_list_bits(seginfo *oldspacesegments, IGEN tg); +static void init_fully_marked_mask(IGEN g); +static void copy_and_clear_list_bits(seginfo *oldspacesegments); #ifdef ENABLE_OBJECT_COUNTS static uptr total_size_so_far(); @@ -180,14 +180,22 @@ static void check_ephemeron_measure(ptr pe); static void check_pending_measure_ephemerons(); #endif +#if defined(MIN_TG) && defined(MAX_TG) +# if MIN_TG == MAX_TG +# define NO_DIRTY_NEWSPACE_POINTERS +# 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 */ static IBOOL change; -static IGEN target_generation; -static IGEN max_copied_generation; -static ptr sweep_loc[max_real_space+1]; -static ptr orig_next_loc[max_real_space+1]; +static ptr sweep_loc[static_generation+1][max_real_space+1]; +static ptr orig_next_loc[static_generation+1][max_real_space+1]; static ptr tlcs_to_rehash; static ptr conts_to_promote; static ptr recheck_guardians_ls; @@ -197,8 +205,28 @@ static int measure_all_enabled; static uptr count_root_bytes; #endif +/* max_cg: maximum copied generation, i.e., maximum generation subject to collection. max_cg >= 0 && max_cg <= 255. + * min_tg: minimum target generation. max_tg == 0 ? min_tg == 0 : min_tg > 0 && min_tg <= max_tg; + * max_tg: maximum target generation. max_tg == max_cg || max_tg == max_cg + 1. + * Objects in generation g are collected into generation MIN(max_tg, MAX(min_tg, g+1)). + */ +#if defined(MAX_CG) && defined(MIN_TG) && defined(MAX_TG) +#else +static IGEN MAX_CG, MIN_TG, MAX_TG; +#endif + +#if defined(MIN_TG) && defined(MAX_TG) && (MIN_TG == MAX_TG) +# define TARGET_GENERATION(si) MIN_TG +# define compute_target_generation(g) MIN_TG +#else +# define TARGET_GENERATION(si) si->generation +FORCEINLINE IGEN compute_target_generation(IGEN g) { + return g == MAX_TG ? g : g < MIN_TG ? MIN_TG : g + 1; +} +#endif + static ptr *sweep_stack_start, *sweep_stack, *sweep_stack_limit; -static octet *fully_marked_mask; +static octet *fully_marked_mask[static_generation+1]; #define push_sweep(p) { \ if (sweep_stack == sweep_stack_limit) enlarge_sweep_stack(); \ @@ -220,21 +248,22 @@ static ptr sweep_from; # define SET_BACKREFERENCE(p) sweep_from = p; # define PUSH_BACKREFERENCE(p) ptr old_sweep_from = sweep_from; SET_SWEEP_FROM(p); # define POP_BACKREFERENCE() SET_SWEEP_FROM(old_sweep_from); -# define ADD_BACKREFERENCE_FROM(p, from_p) \ - { IGEN tg = target_generation; \ - if ((S_G.enable_object_backreferences) && (target_generation < static_generation)) \ - S_G.gcbackreference[tg] = S_cons_in(space_impure, tg, \ - S_cons_in(space_impure, tg, p, from_p), \ - S_G.gcbackreference[tg]); } -# define ADD_BACKREFERENCE(p) ADD_BACKREFERENCE_FROM(p, sweep_from) +# define ADD_BACKREFERENCE_FROM(p, from_p, tg) do { \ + IGEN TG = tg; \ + if ((S_G.enable_object_backreferences) && (TG < static_generation)) \ + S_G.gcbackreference[TG] = S_cons_in(space_impure, TG, \ + S_cons_in(space_impure, TG, p, from_p), \ + S_G.gcbackreference[TG]); \ + } while (0) +# define ADD_BACKREFERENCE(p, tg) ADD_BACKREFERENCE_FROM(p, sweep_from, tg) #else # define BACKREFERENCES_ENABLED 0 # define WITH_TOP_BACKREFERENCE(v, e) e # define SET_BACKREFERENCE(p) # define PUSH_BACKREFERENCE(p) # define POP_BACKREFERENCE() -# define ADD_BACKREFERENCE(p) -# define ADD_BACKREFERENCE_FROM(p, from_p) +# define ADD_BACKREFERENCE_FROM(p, from_p, from_g) +# define ADD_BACKREFERENCE(p, from_g) #endif #if ptr_alignment == 2 @@ -272,8 +301,8 @@ uptr list_length(ptr ls) { #define marked(si, p) (si->marked_mask && (si->marked_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p))) -static void init_fully_marked_mask() { - init_mask(fully_marked_mask, target_generation, 0xFF); +static void init_fully_marked_mask(IGEN g) { + init_mask(fully_marked_mask[g], g, 0xFF); } #ifdef PRESERVE_FLONUM_EQ @@ -308,63 +337,131 @@ static int flonum_is_forwarded_p(ptr p, seginfo *si) { # define ELSE_MEASURE_NONOLDSPACE(p) /* empty */ #endif -#define relocate(ppp) {\ - ptr PP;\ - PP = *ppp;\ - relocate_help(ppp, PP)\ +/* use relocate_pure for newspace fields that can't point to younger + objects or where there's no need to track generations */ + +#define relocate_pure(ppp) do { \ + ptr* PPP = ppp; ptr PP = *PPP; \ + relocate_pure_help(PPP, PP); \ + } while (0) + +#define relocate_pure_help(ppp, pp) do { \ + seginfo *SI; \ + if (!IMMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL) { \ + if (SI->old_space) \ + relocate_pure_help_help(ppp, pp, SI); \ + ELSE_MEASURE_NONOLDSPACE(pp) \ + } \ + } while (0) + +#define relocate_pure_help_help(ppp, pp, si) do { \ + if (FORWARDEDP(pp, si)) \ + *ppp = GET_FWDADDRESS(pp); \ + else if (!marked(si, pp)) \ + mark_or_copy_pure(ppp, pp, si); \ + } while (0) + +#define relocate_code(pp, si) do { \ + if (FWDMARKER(pp) == forward_marker) \ + pp = GET_FWDADDRESS(pp); \ + else if (si->old_space) { \ + if (!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) \ + (void)mark_object(p, si); \ + else \ + (void)copy(p, si, dest); \ + } while (0) + + +/* use relocate_impure for newspace fields that can point to younger objects */ + +#ifdef NO_DIRTY_NEWSPACE_POINTERS + +# define relocate_impure_help(PPP, PP, FROM_G) do {(void)FROM_G; relocate_pure_help(PPP, PP);} while (0) +# define relocate_impure(PPP, FROM_G) do {(void)FROM_G; relocate_pure(PPP);} while (0) + +#else /* !NO_DIRTY_NEWSPACE_POINTERS */ + +#define relocate_impure(ppp, from_g) do { \ + ptr* PPP = ppp; ptr PP = *PPP; IGEN FROM_G = from_g; \ + relocate_impure_help(PPP, PP, FROM_G); \ + } while (0) + +#define relocate_impure_help(ppp, pp, from_g) do { \ + seginfo *SI; \ + if (!IMMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL) { \ + 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 { \ + IGEN __to_g; \ + 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)) { \ + mark_or_copy_impure(__to_g, ppp, pp, from_g, si); \ + if (__to_g < from_g) 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) \ + 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; + } } -/* optimization of: - * relocate(ppp) - * if (GENERATION(*ppp) < youngest) - * youngest = GENERATION(*ppp); - */ -#define relocate_dirty(ppp,tg,youngest) {\ - ptr PP = *ppp; seginfo *SI;\ - if (!IMMEDIATE(PP) && (SI = MaybeSegInfo(ptr_get_segment(PP))) != NULL) {\ - if (SI->old_space) {\ - relocate_help_help(ppp, PP, SI)\ - youngest = tg;\ - } else {\ - IGEN pg;\ - if (youngest != tg && (pg = SI->generation) < youngest) {\ - youngest = pg;\ - }\ - }\ - }\ -} +#endif /* !NO_DIRTY_NEWSPACE_POINTERS */ -#define relocate_help(ppp, pp) {\ - seginfo *SI; \ - if (!IMMEDIATE(pp) && (SI = MaybeSegInfo(ptr_get_segment(pp))) != NULL) { \ - if (SI->old_space) \ - relocate_help_help(ppp, pp, SI) \ - ELSE_MEASURE_NONOLDSPACE(pp) \ - } \ -} - -#define relocate_help_help(ppp, pp, si) { \ - if (FORWARDEDP(pp, si)) \ - *ppp = GET_FWDADDRESS(pp); \ - else if (!marked(si, pp)) \ - mark_or_copy(*ppp, pp, si); \ -} - -#define relocate_code(pp, si) { \ - if (FWDMARKER(pp) == forward_marker) \ - pp = GET_FWDADDRESS(pp); \ - else if (si->old_space) { \ - if (!marked(si, pp)) \ - mark_or_copy(pp, pp, si); \ - } ELSE_MEASURE_NONOLDSPACE(pp) \ -} - -#define mark_or_copy(dest, p, si) { \ - if (si->use_marks) \ - mark_object(p, si); \ - else \ - dest = copy(p, si); \ -} +#define relocate_dirty(PPP, YOUNGEST) do { \ + seginfo *_si; ptr *_ppp = PPP, _pp = *_ppp; IGEN _pg; \ + if (!IMMEDIATE(_pp) && (_si = MaybeSegInfo(ptr_get_segment(_pp))) != NULL) { \ + if (!_si->old_space) { \ + _pg = _si->generation; \ + } else if (FORWARDEDP(_pp, _si)) { \ + *_ppp = GET_FWDADDRESS(_pp); \ + _pg = TARGET_GENERATION(_si); \ + } else if (marked(_si, _pp)) { \ + _pg = TARGET_GENERATION(_si); \ + } else { \ + _pg = copy(_pp, _si, _ppp); \ + } \ + if (_pg < YOUNGEST) YOUNGEST = _pg; \ + } \ + } while (0) #ifdef ENABLE_OBJECT_COUNTS # define is_counting_root(si, p) (si->counting_mask && (si->counting_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p))) @@ -404,27 +501,27 @@ 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) { +static void sweep_in_old(ptr tc, ptr p, IGEN from_g) { /* Detect all the cases when we need to give up on in-place sweeping: */ if (object_directly_refers_to_self(p)) { - relocate(&p) + relocate_pure(&p); return; } /* We've determined that `p` won't refer immediately back to itself, so it's ok to use sweep(). */ - sweep(tc, p); + sweep(tc, p, from_g); } -static void sweep_dirty_object_if_space_new(ptr p, IGEN tg) { +static void sweep_dirty_object_if_space_new(ptr p) { seginfo *si = SegInfo(ptr_get_segment(p)); if (si->space == space_new) - (void)sweep_dirty_object(p, tg, 0); + (void)sweep_dirty_object(p, 0); } -static ptr copy_stack(old, length, clength) ptr old; iptr *length, clength; { - iptr n, m; ptr new; +static ptr copy_stack(ptr old, iptr *length, iptr clength) { + iptr n, m; ptr new; IGEN newg; seginfo *si = SegInfo(ptr_get_segment(old)); /* Don't copy non-oldspace stacks, since we may be sweeping a @@ -432,6 +529,8 @@ static ptr copy_stack(old, length, clength) ptr old; iptr *length, clength; { be a waste of work anyway. */ if (!si->old_space) return old; + newg = TARGET_GENERATION(si); + n = *length; if (si->use_marks) { @@ -439,8 +538,8 @@ static ptr copy_stack(old, length, clength) ptr old; iptr *length, clength; { mark_typemod_data_object(old, n, si); #ifdef ENABLE_OBJECT_COUNTS - S_G.countof[target_generation][countof_stack] += 1; - S_G.bytesof[target_generation][countof_stack] += n; + S_G.countof[newg][countof_stack] += 1; + S_G.bytesof[newg][countof_stack] += n; #endif } @@ -454,11 +553,11 @@ static ptr copy_stack(old, length, clength) ptr old; iptr *length, clength; { n = ptr_align(n); #ifdef ENABLE_OBJECT_COUNTS - S_G.countof[target_generation][countof_stack] += 1; - S_G.bytesof[target_generation][countof_stack] += n; + S_G.countof[newg][countof_stack] += 1; + S_G.bytesof[newg][countof_stack] += n; #endif /* ENABLE_OBJECT_COUNTS */ - find_room(space_data, target_generation, typemod, n, new); + 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); @@ -469,46 +568,45 @@ static ptr copy_stack(old, length, clength) ptr old; iptr *length, clength; { #define NONSTATICINHEAP(si, x) (!IMMEDIATE(x) && (si = MaybeSegInfo(ptr_get_segment(x))) != NULL && si->generation != static_generation) #define ALWAYSTRUE(si, x) (si = SegInfo(ptr_get_segment(x)), 1) -#define partition_guardians(LS, FILTER) { \ - ptr ls; seginfo *si;\ - for (ls = LS; ls != Snil; ls = next) { \ - obj = GUARDIANOBJ(ls); \ - next = GUARDIANNEXT(ls); \ - \ - if (FILTER(si, obj)) { \ - if (!si->old_space || marked(si, obj)) { \ - INITGUARDIANNEXT(ls) = pend_hold_ls; \ - pend_hold_ls = ls; \ - } else if (FORWARDEDP(obj, si)) { \ - INITGUARDIANOBJ(ls) = GET_FWDADDRESS(obj); \ - INITGUARDIANNEXT(ls) = pend_hold_ls; \ - pend_hold_ls = ls; \ - } else { \ - seginfo *t_si; \ - tconc = GUARDIANTCONC(ls); \ - t_si = SegInfo(ptr_get_segment(tconc)); \ - if (!t_si->old_space || marked(t_si, tconc)) { \ - INITGUARDIANNEXT(ls) = final_ls; \ - final_ls = ls; \ - } else if (FWDMARKER(tconc) == forward_marker) { \ - INITGUARDIANTCONC(ls) = FWDADDRESS(tconc); \ - INITGUARDIANNEXT(ls) = final_ls; \ - final_ls = ls; \ - } else { \ - INITGUARDIANNEXT(ls) = pend_final_ls; \ - pend_final_ls = ls; \ - } \ - } \ - } \ - } \ -} +#define partition_guardians(LS, FILTER) do { \ + ptr ls; seginfo *si; \ + for (ls = LS; ls != Snil; ls = next) { \ + obj = GUARDIANOBJ(ls); \ + next = GUARDIANNEXT(ls); \ + if (FILTER(si, obj)) { \ + if (!si->old_space || marked(si, obj)) { \ + INITGUARDIANNEXT(ls) = pend_hold_ls; \ + pend_hold_ls = ls; \ + } else if (FORWARDEDP(obj, si)) { \ + INITGUARDIANOBJ(ls) = GET_FWDADDRESS(obj); \ + INITGUARDIANNEXT(ls) = pend_hold_ls; \ + pend_hold_ls = ls; \ + } else { \ + seginfo *t_si; \ + tconc = GUARDIANTCONC(ls); \ + t_si = SegInfo(ptr_get_segment(tconc)); \ + if (!t_si->old_space || marked(t_si, tconc)) { \ + INITGUARDIANNEXT(ls) = final_ls; \ + final_ls = ls; \ + } else if (FWDMARKER(tconc) == forward_marker) { \ + INITGUARDIANTCONC(ls) = FWDADDRESS(tconc); \ + INITGUARDIANNEXT(ls) = final_ls; \ + final_ls = ls; \ + } else { \ + INITGUARDIANNEXT(ls) = pend_final_ls; \ + pend_final_ls = ls; \ + } \ + } \ + } \ + } \ + } while (0) typedef struct count_root_t { ptr p; IBOOL weak; } count_root_t; -ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { +ptr GCENTRY(ptr tc, ptr count_roots_ls) { IGEN g; ISPC s; seginfo *oldspacesegments, *oldweakspacesegments, *si, *nextsi; ptr ls; @@ -528,6 +626,9 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { tlcs_to_rehash = Snil; conts_to_promote = Snil; +#ifndef NO_DIRTY_NEWSPACE_POINTERS + new_dirty_cards = NULL; +#endif /* !NO_DIRTY_NEWSPACE_POINTERS */ for (ls = S_threads; ls != Snil; ls = Scdr(ls)) { ptr tc = (ptr)THREADTC(Scar(ls)); @@ -536,50 +637,60 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { } /* perform after ScanDirty */ - if (S_checkheap) S_check_heap(0, mcg); + if (S_checkheap) S_check_heap(0, MAX_CG); #ifdef DEBUG -(void)printf("mcg = %x; go? ", mcg); (void)fflush(stdout); (void)getc(stdin); +(void)printf("max_cg = %x; go? ", MAX_CG); (void)fflush(stdout); (void)getc(stdin); #endif - target_generation = tg; - max_copied_generation = mcg; - sweep_stack_start = sweep_stack = sweep_stack_limit = NULL; - fully_marked_mask = NULL; + for (g = MIN_TG; g <= MAX_TG; g++) fully_marked_mask[g] = NULL; /* set up generations to be copied */ - for (s = 0; s <= max_real_space; s++) - for (g = 0; g <= mcg; g++) { - S_G.base_loc[s][g] = FIX(0); - S_G.first_loc[s][g] = FIX(0); - S_G.next_loc[s][g] = FIX(0); - S_G.bytes_left[s][g] = 0; - S_G.bytes_of_space[s][g] = 0; - } + for (g = 0; g <= MAX_CG; g++) { + S_G.bytes_of_generation[g] = 0; + for (s = 0; s <= max_real_space; s++) { + S_G.base_loc[g][s] = FIX(0); + S_G.first_loc[g][s] = FIX(0); + S_G.next_loc[g][s] = FIX(0); + S_G.bytes_left[g][s] = 0; + S_G.bytes_of_space[g][s] = 0; + } + } /* reset phantom size in generations to be copied, even if counting is not otherwise enabled */ pre_phantom_bytes = 0; - for (g = 0; g <= mcg; g++) { + for (g = 0; g <= MAX_CG; g++) { pre_phantom_bytes += S_G.bytesof[g][countof_phantom]; S_G.bytesof[g][countof_phantom] = 0; } - pre_phantom_bytes += S_G.bytesof[tg][countof_phantom]; + for (g = MIN_TG; g <= MAX_TG; g++) { + pre_phantom_bytes += S_G.bytesof[g][countof_phantom]; + } /* set up target generation sweep_loc and orig_next_loc pointers */ - for (s = 0; s <= max_real_space; s++) - orig_next_loc[s] = sweep_loc[s] = S_G.next_loc[s][tg]; + for (g = MIN_TG; g <= MAX_TG; g += 1) { + for (s = 0; s <= max_real_space; s++) { + /* for all but max_tg (and max_tg as well, if max_tg == max_cg), this + will set orig_net_loc and sweep_loc to 0 */ + orig_next_loc[g][s] = sweep_loc[g][s] = S_G.next_loc[g][s]; + } + } /* mark segments from which objects are to be copied or marked */ oldspacesegments = oldweakspacesegments = (seginfo *)NULL; - for (s = 0; s <= max_real_space; s += 1) { - for (g = 0; g <= mcg; g += 1) { - IBOOL maybe_mark = ((tg == S_G.min_mark_gen) && (g == tg)); - for (si = S_G.occupied_segments[s][g]; si != NULL; si = nextsi) { + 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) { + for (si = S_G.occupied_segments[g][s]; si != NULL; si = nextsi) { nextsi = si->next; si->next = oldspacesegments; oldspacesegments = si; si->old_space = 1; + /* update generation now, both to computer the target generation, + and so that any updated dirty references will record the correct + new generation; also used for a check in S_dirty_set */ + si->generation = compute_target_generation(si->generation); if (si->must_mark || (maybe_mark && (!si->marked_mask @@ -587,15 +698,12 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { && (si->chunk->nused_segs >= chunk_sufficiently_compact(si->chunk->segs)))) { if (s != space_new) /* only lock-based marking is allowed on space_new */ si->use_marks = 1; - /* update generation now, so that any updated dirty references - will record the correct new generation; also used for a check in S_dirty_set */ - si->generation = tg; } si->marked_mask = NULL; /* clear old mark bits, if any */ si->marked_count = 0; si->min_dirty_byte = 0; /* prevent registering as dirty while GCing */ } - S_G.occupied_segments[s][g] = NULL; + S_G.occupied_segments[g][s] = NULL; } if (s == space_weakpair) { /* prefix of oldweakspacesegments is for weak pairs */ @@ -606,7 +714,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { #ifdef ENABLE_OBJECT_COUNTS /* clear object counts & bytes for copied generations; bump timestamp */ {INT i; - for (g = 0; g <= mcg; g += 1) { + for (g = 0; g <= MAX_CG; g += 1) { for (i = 0; i < countof_types; i += 1) { S_G.countof[g][i] = 0; S_G.bytesof[g][i] = 0; @@ -621,7 +729,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { #endif /* ENABLE_OBJECT_COUNTS */ /* Clear any backreference lists for copied generations */ - for (g = 0; g <= mcg; g += 1) { + for (g = 0; g <= MAX_CG; g += 1) { S_G.gcbackreference[g] = Snil; } @@ -630,7 +738,8 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { /* Set mark bit for any locked object in `space_new`. Don't sweep until after handling counting roots. Note that the segment won't have `use_marks` set, so non-locked objects will be copied out. */ - for (g = 0; g <= mcg; g += 1) { + for (g = 0; g <= MAX_CG; g += 1) { + IGEN tg = compute_target_generation(g); for (ls = S_G.locked_objects[g]; ls != Snil; ls = Scdr(ls)) { ptr p = Scar(ls); seginfo *si = SegInfo(ptr_get_segment(p)); @@ -682,7 +791,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { iptr i; # ifdef ENABLE_MEASURE - init_measure(tg+1, static_generation); + init_measure(MAX_TG+1, static_generation); # endif for (i = 0; i < count_roots_len; i++) { @@ -698,13 +807,13 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { if (!si->old_space || FORWARDEDP(p, si) || marked(si, p) || !count_roots[i].weak) { /* reached or older; sweep transitively */ - relocate(&p) - sweep(tc, p); - ADD_BACKREFERENCE(p) - sweep_generation(tc, tg); + relocate_pure(&p); + sweep(tc, p, TARGET_GENERATION(si)); + ADD_BACKREFERENCE(p, si->generation); + sweep_generation(tc); # ifdef ENABLE_MEASURE while (flush_measure_stack()) { - sweep_generation(tc, tg); + sweep_generation(tc); } # endif @@ -742,20 +851,25 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { /* sweep older locked and unlocked objects that are on `space_new` segments, because we can't find dirty writes there */ - for (g = mcg + 1; g <= static_generation; INCRGEN(g)) { + for (g = MAX_CG + 1; g <= static_generation; INCRGEN(g)) { for (ls = S_G.locked_objects[g]; ls != Snil; ls = Scdr(ls)) - sweep_dirty_object_if_space_new(Scar(ls), tg); + sweep_dirty_object_if_space_new(Scar(ls)); for (ls = S_G.unlocked_objects[g]; ls != Snil; ls = Scdr(ls)) - sweep_dirty_object_if_space_new(Scar(ls), tg); + sweep_dirty_object_if_space_new(Scar(ls)); } /* Gather and mark all younger locked objects. Any object on a `space_new` segment is already marked, but still needs to be swept. */ - { - ptr locked_objects = ((tg > mcg) ? S_G.locked_objects[tg] : Snil); - for (g = 0; g <= mcg; g += 1) { - for (ls = S_G.locked_objects[g]; ls != Snil; ls = Scdr(ls)) { + { + for (g = MAX_CG; g >= 0; g -= 1) { + ptr locked_objects; + IGEN tg = compute_target_generation(g); + ls = S_G.locked_objects[g]; + S_G.locked_objects[g] = Snil; + S_G.unlocked_objects[g] = Snil; + locked_objects = S_G.locked_objects[tg]; + for (; ls != Snil; ls = Scdr(ls)) { ptr p = Scar(ls); seginfo *si = SegInfo(ptr_get_segment(p)); if (si->space == space_new) { @@ -771,30 +885,29 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { #ifdef ENABLE_OBJECT_COUNTS S_G.countof[tg][countof_pair] += 1; S_G.countof[tg][countof_locked] += 1; - S_G.bytesof[target_generation][countof_locked] += size_object(p); + S_G.bytesof[tg][countof_locked] += size_object(p); #endif /* ENABLE_OBJECT_COUNTS */ } - S_G.locked_objects[g] = Snil; - S_G.unlocked_objects[g] = Snil; + S_G.locked_objects[tg] = locked_objects; } - S_G.locked_objects[tg] = locked_objects; - } + } /* sweep non-oldspace threads, since any thread may have an active stack */ for (ls = S_threads; ls != Snil; ls = Scdr(ls)) { - ptr thread; + ptr thread; seginfo *thread_si; /* someone may have their paws on the list */ if (FWDMARKER(ls) == forward_marker) ls = FWDADDRESS(ls); thread = Scar(ls); - if (!OLDSPACE(thread)) sweep_thread(thread); + thread_si = SegInfo(ptr_get_segment(thread)); + if (!thread_si->old_space) sweep_thread(thread, thread_si->generation); } - relocate(&S_threads) + relocate_pure(&S_threads); /* relocate nonempty oldspace symbols and set up list of buckets to rebuild later */ buckets_to_rebuild = NULL; - for (g = 0; g <= mcg; g += 1) { + for (g = 0; g <= MAX_CG; g += 1) { bucket_list *bl, *blnext; bucket *b; bucket_pointer_list *bpl; bucket **oblist_cell; ptr sym; iptr idx; for (bl = S_G.buckets_of_generation[g]; bl != NULL; bl = blnext) { blnext = bl->cdr; @@ -819,7 +932,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { (SYMVAL(sym) != sunbound || SYMPLIST(sym) != Snil || SYMSPLIST(sym) != Snil)) { seginfo *sym_si = SegInfo(ptr_get_segment(sym)); if (!marked(sym_si, sym)) - mark_or_copy(sym, sym, sym_si); + mark_or_copy_pure(&sym, sym, sym_si); } } S_G.buckets_of_generation[g] = NULL; @@ -828,18 +941,18 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { /* relocate the protected C pointers */ {uptr i; for (i = 0; i < S_G.protect_next; i++) - relocate(S_G.protected[i]) + relocate_pure(S_G.protected[i]); } /* sweep areas marked dirty by assignments into older generations */ sweep_dirty(); - sweep_generation(tc, tg); + sweep_generation(tc); pre_finalization_size = target_generation_space_so_far(); /* handle guardians */ - { ptr hold_ls, pend_hold_ls, final_ls, pend_final_ls, maybe_final_ordered_ls; + { ptr pend_hold_ls, final_ls, pend_final_ls, maybe_final_ordered_ls; ptr obj, rep, tconc, next; IBOOL do_ordered = 0; @@ -869,7 +982,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { GUARDIANENTRIES(tc) = Snil; } - for (g = 0; g <= mcg; g += 1) { + for (g = 0; g <= MAX_CG; g += 1) { partition_guardians(S_G.guardians[g], ALWAYSTRUE); S_G.guardians[g] = Snil; } @@ -881,7 +994,6 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { * for entry in pend_final_ls, obj and tconc are OLDSPACE */ - hold_ls = S_G.guardians[tg]; while (1) { IBOOL relocate_rep = final_ls != Snil; @@ -895,7 +1007,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { rep = GUARDIANREP(ls); /* ftype_guardian_rep is a marker for reference-counted ftype pointer */ if (rep == ftype_guardian_rep) { - int b; iptr *addr; + INT b; iptr *addr; rep = GUARDIANOBJ(ls); if (FWDMARKER(rep) == forward_marker) rep = FWDADDRESS(rep); /* Caution: Building in assumption about shape of an ftype pointer */ @@ -923,7 +1035,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { seginfo *si; if (!IMMEDIATE(rep) && (si = MaybeSegInfo(ptr_get_segment(rep))) != NULL && si->old_space) { PUSH_BACKREFERENCE(rep) - sweep_in_old(tc, rep); + sweep_in_old(tc, rep, si->generation); POP_BACKREFERENCE() } INITGUARDIANNEXT(ls) = maybe_final_ordered_ls; @@ -931,9 +1043,13 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { } } else { /* if tconc was old it's been forwarded */ + IGEN tg; + tconc = GUARDIANTCONC(ls); - - WITH_TOP_BACKREFERENCE(tconc, relocate(&rep)); + + 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 */ @@ -947,47 +1063,52 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { } } - /* discard static pend_hold_ls entries */ - if (tg != static_generation) { - /* copy each entry in pend_hold_ls into hold_ls if tconc accessible */ - ls = pend_hold_ls; pend_hold_ls = Snil; - for ( ; ls != Snil; ls = next) { - ptr p; - seginfo *t_si; - - tconc = GUARDIANTCONC(ls); next = GUARDIANNEXT(ls); + /* copy each entry in pend_hold_ls into hold_ls if tconc accessible */ + ls = pend_hold_ls; pend_hold_ls = Snil; + for ( ; ls != Snil; ls = next) { + ptr p; + seginfo *g_si, *t_si; + + next = GUARDIANNEXT(ls); - t_si = SegInfo(ptr_get_segment(tconc)); + /* 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); - if (t_si->old_space && !marked(t_si, tconc)) { - if (FWDMARKER(tconc) == forward_marker) - tconc = FWDADDRESS(tconc); - else { - INITGUARDIANPENDING(ls) = FIX(GUARDIAN_PENDING_HOLD); - add_pending_guardian(ls, tconc); - continue; - } - } - - rep = GUARDIANREP(ls); - WITH_TOP_BACKREFERENCE(tconc, relocate(&rep)); - relocate_rep = 1; + t_si = SegInfo(ptr_get_segment(tconc)); + + if (t_si->old_space && !marked(t_si, tconc)) { + if (FWDMARKER(tconc) == forward_marker) + tconc = FWDADDRESS(tconc); + else { + INITGUARDIANPENDING(ls) = FIX(GUARDIAN_PENDING_HOLD); + add_pending_guardian(ls, tconc); + continue; + } + } + + rep = GUARDIANREP(ls); + WITH_TOP_BACKREFERENCE(tconc, relocate_pure(&rep)); + relocate_rep = 1; #ifdef ENABLE_OBJECT_COUNTS - S_G.countof[tg][countof_guardian] += 1; + S_G.countof[g][countof_guardian] += 1; #endif /* ENABLE_OBJECT_COUNTS */ - /* In backreference mode, we rely on sweep of the guardian - entry not registering any backreferences. Otherwise, - bogus pair pointers would get created. */ - find_room(space_pure, tg, typemod, size_guardian_entry, p); - INITGUARDIANOBJ(p) = GUARDIANOBJ(ls); - INITGUARDIANREP(p) = rep; - INITGUARDIANTCONC(p) = tconc; - INITGUARDIANNEXT(p) = hold_ls; - INITGUARDIANORDERED(p) = GUARDIANORDERED(ls); - INITGUARDIANPENDING(p) = FIX(0); - hold_ls = p; - } + + /* In backreference mode, we rely on sweep of the guardian + entry not registering any backreferences. Otherwise, + bogus pair pointers would get created. */ + find_room(space_pure, g, typemod, size_guardian_entry, p); + INITGUARDIANOBJ(p) = GUARDIANOBJ(ls); + INITGUARDIANREP(p) = rep; + INITGUARDIANTCONC(p) = tconc; + INITGUARDIANNEXT(p) = S_G.guardians[g]; + INITGUARDIANORDERED(p) = GUARDIANORDERED(ls); + INITGUARDIANPENDING(p) = FIX(0); + S_G.guardians[g] = p; } if (!relocate_rep && !do_ordered && maybe_final_ordered_ls != Snil) { @@ -1014,7 +1135,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { if (!relocate_rep) break; - sweep_generation(tc, tg); + sweep_generation(tc); ls = recheck_guardians_ls; recheck_guardians_ls = Snil; for ( ; ls != Snil; ls = next) { @@ -1052,24 +1173,26 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { } } } - - S_G.guardians[tg] = hold_ls; } S_G.bytes_finalized = target_generation_space_so_far() - pre_finalization_size; - S_adjustmembytes(S_G.bytesof[tg][countof_phantom] - pre_phantom_bytes); + { + iptr post_phantom_bytes = 0; + for (g = MIN_TG; g <= MAX_TG; g++) { + post_phantom_bytes += S_G.bytesof[g][countof_phantom]; + } + S_adjustmembytes(post_phantom_bytes - pre_phantom_bytes); + } /* handle weak pairs */ resweep_dirty_weak_pairs(); - resweep_weak_pairs(tg, oldweakspacesegments); + resweep_weak_pairs(oldweakspacesegments); /* still-pending ephemerons all go to bwp */ finish_pending_ephemerons(oldspacesegments); /* post-gc oblist handling. rebuild old buckets in the target generation, pruning unforwarded symbols */ - { bucket_list *bl, *blnext; bucket *b, *bnext; bucket_pointer_list *bpl; bucket **pb; - ptr sym; seginfo *si; - bl = tg == static_generation ? NULL : S_G.buckets_of_generation[tg]; + { bucket_list *bl; bucket *b, *bnext; bucket_pointer_list *bpl; bucket **pb; ptr sym; for (bpl = buckets_to_rebuild; bpl != NULL; bpl = bpl->cdr) { pb = bpl->car; for (b = TO_VOIDP((uptr)TO_PTR(*pb) - 1); b != NULL && ((uptr)TO_PTR(b->next) & 1); b = bnext) { @@ -1077,23 +1200,24 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { sym = b->sym; si = SegInfo(ptr_get_segment(sym)); if (marked(si, sym) || (FWDMARKER(sym) == forward_marker && ((sym = FWDADDRESS(sym)) || 1))) { - find_room_voidp(space_data, tg, ptr_align(sizeof(bucket)), b); + IGEN g = si->generation; + find_room_voidp(space_data, g, ptr_align(sizeof(bucket)), b); #ifdef ENABLE_OBJECT_COUNTS - S_G.countof[tg][countof_oblist] += 1; - S_G.bytesof[tg][countof_oblist] += sizeof(bucket); + S_G.countof[g][countof_oblist] += 1; + S_G.bytesof[g][countof_oblist] += sizeof(bucket); #endif /* ENABLE_OBJECT_COUNTS */ b->sym = sym; *pb = b; pb = &b->next; - if (tg != static_generation) { - blnext = bl; - find_room_voidp(space_data, tg, ptr_align(sizeof(bucket_list)), bl); + if (g != static_generation) { + find_room_voidp(space_data, g, ptr_align(sizeof(bucket_list)), bl); #ifdef ENABLE_OBJECT_COUNTS - S_G.countof[tg][countof_oblist] += 1; - S_G.bytesof[tg][countof_oblist] += sizeof(bucket_list); + S_G.countof[g][countof_oblist] += 1; + S_G.bytesof[g][countof_oblist] += sizeof(bucket_list); #endif /* ENABLE_OBJECT_COUNTS */ - bl->cdr = blnext; bl->car = b; + bl->cdr = S_G.buckets_of_generation[g]; + S_G.buckets_of_generation[g] = bl; } } else { S_G.oblist_count -= 1; @@ -1101,54 +1225,58 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { } *pb = b; } - if (tg != static_generation) S_G.buckets_of_generation[tg] = bl; } /* rebuild rtds_with_counts lists, dropping otherwise inaccessible rtds */ - { IGEN g; ptr ls, p, newls = tg == mcg ? Snil : S_G.rtds_with_counts[tg]; seginfo *si; + { IGEN g, newg; ptr ls, p; seginfo *si; int count = 0; - for (g = 0; g <= mcg; g += 1) { + for (g = MAX_CG; g >= 0; g -= 1) { for (ls = S_G.rtds_with_counts[g], S_G.rtds_with_counts[g] = Snil; ls != Snil; ls = Scdr(ls)) { count++; p = Scar(ls); si = SegInfo(ptr_get_segment(p)); if (!si->old_space || marked(si, p)) { - newls = S_cons_in(space_impure, tg, p, newls); - S_G.countof[tg][countof_pair] += 1; + 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 + S_G.countof[newg][countof_pair] += 1; +#endif } else if (FWDMARKER(p) == forward_marker) { - newls = S_cons_in(space_impure, tg, FWDADDRESS(p), newls); - S_G.countof[tg][countof_pair] += 1; + p = FWDADDRESS(p); + newg = GENERATION(p); + S_G.rtds_with_counts[newg] = S_cons_in(space_impure, newg, p, S_G.rtds_with_counts[newg]); +#ifdef ENABLE_OBJECT_COUNTS + S_G.countof[newg][countof_pair] += 1; +#endif } } } - S_G.rtds_with_counts[tg] = newls; } #ifndef WIN32 /* rebuild child_process list, reaping any that have died and refusing to promote into the static generation. */ - { - ptr old_ls, new_ls; IGEN gtmp, cpgen; - cpgen = tg == static_generation ? S_G.max_nonstatic_generation : tg; - new_ls = cpgen <= mcg ? Snil : S_child_processes[cpgen]; - for (gtmp = 0; gtmp <= mcg; gtmp += 1) { - for (old_ls = S_child_processes[gtmp]; old_ls != Snil; old_ls = Scdr(old_ls)) { - INT pid = UNFIX(Scar(old_ls)), status, retpid; + { IGEN g, newg; ptr ls, newls; + for (g = MAX_CG; g >= 0; g -= 1) { + newg = compute_target_generation(g); + if (newg == static_generation) newg = S_G.max_nonstatic_generation; + newls = newg == g ? Snil : S_child_processes[newg]; + for (ls = S_child_processes[g], S_child_processes[g] = Snil; ls != Snil; ls = Scdr(ls)) { + INT pid = UNFIX(Scar(ls)), status, retpid; retpid = waitpid(pid, &status, WNOHANG); if (retpid == 0 || (retpid == pid && !(WIFEXITED(status) || WIFSIGNALED(status)))) { - new_ls = S_cons_in(space_impure, cpgen, FIX(pid), new_ls); + newls = S_cons_in(space_impure, newg, FIX(pid), newls); #ifdef ENABLE_OBJECT_COUNTS - S_G.countof[cpgen][countof_pair] += 1; + S_G.countof[newg][countof_pair] += 1; #endif /* ENABLE_OBJECT_COUNTS */ } } - S_child_processes[gtmp] = Snil; + S_child_processes[newg] = newls; } - S_child_processes[cpgen] = new_ls; } #endif /* WIN32 */ - copy_and_clear_list_bits(oldspacesegments, tg); + copy_and_clear_list_bits(oldspacesegments); /* move copied old space segments to empty space, and promote marked old space segments to the target generation */ @@ -1157,6 +1285,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { si->old_space = 0; si->use_marks = 0; if (si->marked_mask != NULL) { + IGEN tg; si->min_dirty_byte = 0xff; if (si->space != space_data) { int d; @@ -1166,12 +1295,12 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { *dp = -1; } } - si->generation = tg; + tg = si->generation; if (tg == static_generation) S_G.number_of_nonstatic_segments -= 1; s = si->space; - si->next = S_G.occupied_segments[s][tg]; - S_G.occupied_segments[s][tg] = si; - S_G.bytes_of_space[s][tg] += si->marked_count; + si->next = S_G.occupied_segments[tg][s]; + S_G.occupied_segments[tg][s] = si; + S_G.bytes_of_space[tg][s] += si->marked_count; si->trigger_guardians = 0; #ifdef PRESERVE_FLONUM_EQ si->forwarded_flonums = 0; @@ -1200,11 +1329,22 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { } } - if (mcg >= S_G.min_free_gen) S_free_chunks(); + S_G.g0_bytes_after_last_gc = S_G.bytes_of_generation[0]; + + if (MAX_CG >= S_G.min_free_gen) S_free_chunks(); S_flush_instruction_cache(tc); - if (S_checkheap) S_check_heap(1, mcg); + +#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) + S_mark_card_dirty(ndc->card, ndc->youngest); + } +#endif /* !NO_DIRTY_NEWSPACE_POINTERS */ + + if (S_checkheap) S_check_heap(1, MAX_CG); /* post-collection rehashing of tlcs. must come after any use of relocate. @@ -1258,8 +1398,8 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { S_resize_oblist(); - /* tell profile_release_counters to look for bwp'd counters at least through tg */ - if (S_G.prcgeneration < tg) S_G.prcgeneration = tg; + /* tell profile_release_counters to look for bwp'd counters at least through max_tg */ + if (S_G.prcgeneration < MAX_TG) S_G.prcgeneration = MAX_TG; if (sweep_stack_start != sweep_stack) S_error_abort("gc: sweep stack ended non-empty"); @@ -1274,29 +1414,33 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { return Svoid; } -#define sweep_space(s, body)\ - slp = &sweep_loc[s];\ - nlp = &S_G.next_loc[s][g];\ - if (*slp == 0) *slp = S_G.first_loc[s][g];\ - pp = TO_VOIDP(*slp);\ - while (pp != (nl = TO_VOIDP(*nlp)))\ - do\ - if ((p = *pp) == forward_marker)\ - pp = TO_VOIDP(*(pp + 1)); \ - else\ - body\ - while (pp != nl);\ - *slp = TO_PTR(pp); +#define sweep_space(s, from_g, body) { \ + slp = &sweep_loc[from_g][s]; \ + 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 \ + if ((p = *pp) == forward_marker) \ + pp = TO_VOIDP(*(pp + 1)); \ + else \ + body \ + while (pp != nl); \ + *slp = TO_PTR(pp); \ + } -static void resweep_weak_pairs(g, oldweakspacesegments) IGEN g; seginfo *oldweakspacesegments; { +static void resweep_weak_pairs(seginfo *oldweakspacesegments) { + IGEN from_g; ptr *slp, *nlp; ptr *pp, p, *nl; seginfo *si; - sweep_loc[space_weakpair] = S_G.first_loc[space_weakpair][g]; - sweep_space(space_weakpair, { - forward_or_bwp(pp, p); - pp += 2; - }) + for (from_g = MIN_TG; from_g <= MAX_TG; from_g += 1) { + sweep_loc[from_g][space_weakpair] = orig_next_loc[from_g][space_weakpair]; + sweep_space(space_weakpair, from_g, { + forward_or_bwp(pp, p); + pp += 2; + }) + } for (si = oldweakspacesegments; si != NULL; si = si->next) { if (si->space != space_weakpair) @@ -1337,103 +1481,107 @@ static void forward_or_bwp(pp, p) ptr *pp; ptr p; { } } -static void sweep_generation(tc, g) ptr tc; IGEN g; { - ptr *slp, *nlp; ptr *pp, p, *nl; +static void sweep_generation(ptr tc) { + ptr *slp, *nlp; ptr *pp, p, *nl; IGEN from_g; do { change = 0; sweep_from_stack(tc); + + for (from_g = MIN_TG; from_g <= MAX_TG; from_g += 1) { - sweep_space(space_impure, { - SET_BACKREFERENCE(TYPE(TO_PTR(pp), type_pair)) /* only pairs put here in backreference mode */ - relocate_help(pp, p) + sweep_space(space_impure, from_g, { + SET_BACKREFERENCE(TYPE(TO_PTR(pp), type_pair)); /* only pairs put here in backreference mode */ + relocate_impure_help(pp, p, from_g); p = *(pp += 1); - relocate_help(pp, p) + relocate_impure_help(pp, p, from_g); pp += 1; - }) - SET_BACKREFERENCE(Sfalse) + }) + SET_BACKREFERENCE(Sfalse) - sweep_space(space_symbol, { + sweep_space(space_symbol, from_g, { p = TYPE(TO_PTR(pp), type_symbol); - sweep_symbol(p); + sweep_symbol(p, from_g); pp += size_symbol / sizeof(ptr); - }) + }) - sweep_space(space_port, { + sweep_space(space_port, from_g, { p = TYPE(TO_PTR(pp), type_typed_object); - sweep_port(p); + sweep_port(p, from_g); pp += size_port / sizeof(ptr); - }) + }) - sweep_space(space_weakpair, { + sweep_space(space_weakpair, from_g, { SET_BACKREFERENCE(TYPE(TO_PTR(pp), type_pair)) p = *(pp += 1); - relocate_help(pp, p) + relocate_impure_help(pp, p, from_g); pp += 1; - }) - SET_BACKREFERENCE(Sfalse) + }) + SET_BACKREFERENCE(Sfalse) - sweep_space(space_ephemeron, { + sweep_space(space_ephemeron, from_g, { p = TYPE(TO_PTR(pp), type_pair); add_ephemeron_to_pending(p); pp += size_ephemeron / sizeof(ptr); - }) + }) - sweep_space(space_pure, { + sweep_space(space_pure, from_g, { SET_BACKREFERENCE(TYPE(TO_PTR(pp), type_pair)) /* only pairs put here in backreference mode */ - relocate_help(pp, p) + relocate_impure_help(pp, p, from_g); p = *(pp += 1); - relocate_help(pp, p) + relocate_impure_help(pp, p, from_g); pp += 1; - }) - SET_BACKREFERENCE(Sfalse) + }) + SET_BACKREFERENCE(Sfalse) - sweep_space(space_continuation, { + sweep_space(space_continuation, from_g, { p = TYPE(TO_PTR(pp), type_closure); - sweep_continuation(p); + sweep_continuation(p, from_g); pp += size_continuation / sizeof(ptr); - }) + }) - sweep_space(space_pure_typed_object, { + sweep_space(space_pure_typed_object, from_g, { p = TYPE(TO_PTR(pp), type_typed_object); - pp = TO_VOIDP(((uptr)TO_PTR(pp) + sweep_typed_object(tc, p))); - }) + pp = TO_VOIDP(((uptr)TO_PTR(pp) + sweep_typed_object(tc, p, from_g))); + }) - sweep_space(space_code, { + sweep_space(space_code, from_g, { p = TYPE(TO_PTR(pp), type_typed_object); - sweep_code_object(tc, p); + sweep_code_object(tc, p, from_g); pp += size_code(CODELEN(p)) / sizeof(ptr); - }) + }) - sweep_space(space_impure_record, { + sweep_space(space_impure_record, from_g, { p = TYPE(TO_PTR(pp), type_typed_object); - sweep_record(p); + sweep_record(p, from_g); pp = TO_VOIDP((iptr)TO_PTR(pp) + size_record_inst(UNFIX(RECORDDESCSIZE(RECORDINSTTYPE(p))))); - }) + }) /* space used only as needed for backreferences: */ - sweep_space(space_impure_typed_object, { + sweep_space(space_impure_typed_object, from_g, { p = TYPE(TO_PTR(pp), type_typed_object); - pp = TO_VOIDP((uptr)TO_PTR(pp) + sweep_typed_object(tc, p)); - }) + pp = TO_VOIDP((uptr)TO_PTR(pp) + sweep_typed_object(tc, p, from_g)); + }) /* space used only as needed for backreferences: */ - sweep_space(space_closure, { + sweep_space(space_closure, from_g, { p = TYPE(TO_PTR(pp), type_closure); - sweep(tc, p); + sweep(tc, p, from_g); pp = TO_VOIDP((uptr)TO_PTR(pp) + size_object(p)); - }) + }) /* don't sweep from space_count_pure or space_count_impure */ + } /* Waiting until sweeping doesn't trigger a change reduces the chance that an ephemeron must be reigistered as a segment-specific trigger or gets triggered for recheck, but it doesn't change the worst-case complexity. */ if (!change) - check_pending_ephemerons(); + for (from_g = MIN_TG; from_g <= MAX_TG; from_g += 1) + check_pending_ephemerons(from_g); } while (change); } @@ -1449,28 +1597,33 @@ void enlarge_sweep_stack() { sweep_stack = TO_VOIDP((uptr)new_sweep_stack + sz); } -void sweep_from_stack(tc) ptr tc; { +void sweep_from_stack(ptr tc) { if (sweep_stack > sweep_stack_start) { change = 1; - while (sweep_stack > sweep_stack_start) - sweep(tc, *(--sweep_stack)); + while (sweep_stack > sweep_stack_start) { + ptr p = *(--sweep_stack); + /* Room for improvement: `si->generation` is needed only + for objects that have impure fields */ + seginfo *si = SegInfo(ptr_get_segment(p)); + sweep(tc, p, si->generation); + } } } - -static iptr sweep_typed_object(tc, p) ptr tc; ptr p; { + +static iptr sweep_typed_object(ptr tc, ptr p, IGEN from_g) { ptr tf = TYPEFIELD(p); if (TYPEP(tf, mask_record, type_record)) { - sweep_record(p); + sweep_record(p, from_g); return size_record_inst(UNFIX(RECORDDESCSIZE(RECORDINSTTYPE(p)))); } else if (TYPEP(tf, mask_thread, type_thread)) { - sweep_thread(p); + sweep_thread(p, from_g); return size_thread; } else { /* We get here only if backreference mode pushed other typed objects into a typed space or if an object is a counting root */ - sweep(tc, p); + sweep(tc, p, from_g); return size_object(p); } } @@ -1498,8 +1651,8 @@ static void record_dirty_segment(IGEN from_g, IGEN to_g, seginfo *si) { } } -static void sweep_dirty(void) { - IGEN tg, mcg, youngest, min_youngest; +static void sweep_dirty() { + IGEN youngest, min_youngest; ptr *pp, *ppend, *nl; uptr seg, d; ISPC s; @@ -1508,12 +1661,10 @@ static void sweep_dirty(void) { PUSH_BACKREFERENCE(Snil) /* '() => from unspecified old object */ - tg = target_generation; - mcg = max_copied_generation; weaksegments_to_resweep = NULL; /* clear dirty segment lists for copied generations */ - for (from_g = 1; from_g <= mcg; from_g += 1) { + for (from_g = 1; from_g <= MAX_CG; from_g += 1) { for (to_g = 0; to_g < from_g; to_g += 1) { DirtySegments(from_g, to_g) = NULL; } @@ -1522,8 +1673,8 @@ static void sweep_dirty(void) { /* NB: could have problems if a card is moved from some current or to-be-swept (from_g, to_g) to some previously swept list due to a dirty_set while we sweep. believe this can't happen as of 6/14/2013. if it can, it might be sufficient to process the lists in reverse order. */ - for (from_g = mcg + 1; from_g <= static_generation; INCRGEN(from_g)) { - for (to_g = 0; to_g <= mcg; to_g += 1) { + for (from_g = MAX_CG + 1; from_g <= static_generation; INCRGEN(from_g)) { + for (to_g = 0; to_g <= MAX_CG; to_g += 1) { for (dirty_si = DirtySegments(from_g, to_g), DirtySegments(from_g, to_g) = NULL; dirty_si != NULL; dirty_si = nextsi) { nextsi = dirty_si->dirty_next; seg = dirty_si->number; @@ -1538,7 +1689,7 @@ static void sweep_dirty(void) { } min_youngest = 0xff; - nl = from_g == tg ? TO_VOIDP(orig_next_loc[s]) : TO_VOIDP(S_G.next_loc[s][from_g]); + nl = from_g == MAX_TG ? TO_VOIDP(orig_next_loc[from_g][s]) : TO_VOIDP(S_G.next_loc[from_g][s]); ppend = TO_VOIDP(build_ptr(seg, 0)); if (s == space_weakpair) { @@ -1564,7 +1715,7 @@ static void sweep_dirty(void) { ppend += bytes_per_card / sizeof(ptr); if (pp <= nl && nl < ppend) ppend = nl; - if (dirty_si->dirty_bytes[d] <= mcg) { + if (dirty_si->dirty_bytes[d] <= MAX_CG) { /* assume we won't find any wrong-way pointers */ youngest = 0xff; @@ -1574,9 +1725,9 @@ static void sweep_dirty(void) { while (pp < ppend && *pp != forward_marker) { /* handle two pointers at a time */ if (!dirty_si->marked_mask || marked(dirty_si, TO_PTR(pp))) { - relocate_dirty(pp,tg,youngest) + relocate_dirty(pp,youngest); pp += 1; - relocate_dirty(pp,tg,youngest) + relocate_dirty(pp,youngest); pp += 1; } else pp += 2; @@ -1596,7 +1747,7 @@ static void sweep_dirty(void) { ptr p = TYPE(TO_PTR(pp), type_symbol); if (!dirty_si->marked_mask || marked(dirty_si, p)) - youngest = sweep_dirty_symbol(p, tg, youngest); + youngest = sweep_dirty_symbol(p, youngest); pp += size_symbol / sizeof(ptr); } @@ -1615,7 +1766,7 @@ static void sweep_dirty(void) { ptr p = TYPE(TO_PTR(pp), type_typed_object); if (!dirty_si->marked_mask || marked(dirty_si, p)) - youngest = sweep_dirty_port(p, tg, youngest); + youngest = sweep_dirty_port(p, youngest); pp += size_port / sizeof(ptr); } @@ -1701,7 +1852,7 @@ static void sweep_dirty(void) { /* quit on end of segment */ if (FWDMARKER(p) == forward_marker) break; - youngest = sweep_dirty_record(p, tg, youngest); + youngest = sweep_dirty_record(p, youngest); p = (ptr)((iptr)p + size_record_inst(UNFIX(RECORDDESCSIZE( RECORDINSTTYPE(p))))); @@ -1747,7 +1898,7 @@ static void sweep_dirty(void) { /* quit on end of segment */ if (FWDMARKER(p) == forward_marker) break; - youngest = sweep_dirty_record(p, tg, youngest); + youngest = sweep_dirty_record(p, youngest); p = (ptr)((iptr)p + size_record_inst(UNFIX(RECORDDESCSIZE( RECORDINSTTYPE(p))))); @@ -1758,7 +1909,7 @@ static void sweep_dirty(void) { /* skip car field and handle cdr field */ if (!dirty_si->marked_mask || marked(dirty_si, TO_PTR(pp))) { pp += 1; - relocate_dirty(pp, tg, youngest) + relocate_dirty(pp, youngest); pp += 1; } else pp += 2; @@ -1767,7 +1918,7 @@ static void sweep_dirty(void) { while (pp < ppend && *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, tg, youngest); + youngest = check_dirty_ephemeron(p, youngest); pp += size_ephemeron / sizeof(ptr); } } else { @@ -1800,16 +1951,13 @@ static void sweep_dirty(void) { static void resweep_dirty_weak_pairs() { weakseginfo *ls; ptr *pp, *ppend, *nl, p; - IGEN from_g, min_youngest, youngest, tg, mcg, pg; + IGEN from_g, min_youngest, youngest; uptr d; - tg = target_generation; - mcg = max_copied_generation; - for (ls = weaksegments_to_resweep; ls != NULL; ls = ls->next) { seginfo *dirty_si = ls->si; from_g = dirty_si->generation; - nl = from_g == tg ? TO_VOIDP(orig_next_loc[space_weakpair]) : TO_VOIDP(S_G.next_loc[space_weakpair][from_g]); + nl = from_g == MAX_TG ? TO_VOIDP(orig_next_loc[from_g][space_weakpair]) : TO_VOIDP(S_G.next_loc[from_g][space_weakpair]); ppend = TO_VOIDP(build_ptr(dirty_si->number, 0)); min_youngest = 0xff; d = 0; @@ -1825,7 +1973,7 @@ static void resweep_dirty_weak_pairs() { pp = ppend; ppend += bytes_per_card / sizeof(ptr); if (pp <= nl && nl < ppend) ppend = nl; - if (dirty_si->dirty_bytes[d] <= mcg) { + if (dirty_si->dirty_bytes[d] <= MAX_CG) { youngest = ls->youngest[d]; while (pp < ppend) { p = *pp; @@ -1835,16 +1983,18 @@ static void resweep_dirty_weak_pairs() { if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) { if (si->old_space) { if (marked(si, p)) { - youngest = tg; + youngest = TARGET_GENERATION(si); } else if (FORWARDEDP(p, si)) { + IGEN newpg; *pp = FWDADDRESS(p); - youngest = tg; + newpg = TARGET_GENERATION(si); + if (newpg < youngest) youngest = newpg; } else { *pp = Sbwp_object; } } else { - if (youngest != tg && (pg = si->generation) < youngest) - youngest = pg; + IGEN pg = si->generation; + if (pg < youngest) youngest = pg; } } @@ -1924,7 +2074,7 @@ static void add_trigger_ephemerons_to_pending(ptr pe) { ephemeron_add(&pending_ephemerons, pe); } -static void check_ephemeron(ptr pe) { +static void check_ephemeron(ptr pe, IGEN from_g) { ptr p; seginfo *si; PUSH_BACKREFERENCE(pe); @@ -1935,30 +2085,30 @@ static void check_ephemeron(ptr pe) { p = Scar(pe); if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->old_space) { if (marked(si, p)) { - relocate(&INITCDR(pe)) + relocate_impure(&INITCDR(pe), from_g); } else if (FORWARDEDP(p, si)) { INITCAR(pe) = FWDADDRESS(p); - relocate(&INITCDR(pe)) + relocate_impure(&INITCDR(pe), from_g); } else { /* Not reached, so far; install as trigger */ ephemeron_add(&si->trigger_ephemerons, pe); si->has_triggers = 1; } } else { - relocate(&INITCDR(pe)) + relocate_impure(&INITCDR(pe), from_g); } POP_BACKREFERENCE(); } -static void check_pending_ephemerons() { +static void check_pending_ephemerons(IGEN from_g) { ptr pe, next_pe; pe = pending_ephemerons; pending_ephemerons = 0; while (pe != 0) { next_pe = EPHEMERONNEXT(pe); - check_ephemeron(pe); + check_ephemeron(pe, from_g); pe = next_pe; } } @@ -1967,21 +2117,20 @@ static void check_pending_ephemerons() { ephemeron (that was not yet added to the pending list), so we can be less pessimistic than setting `youngest` to the target generation: */ -static int check_dirty_ephemeron(ptr pe, int tg, int youngest) { +static IGEN check_dirty_ephemeron(ptr pe, IGEN youngest) { ptr p; seginfo *si; + IGEN pg; PUSH_BACKREFERENCE(pe); p = Scar(pe); if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) { if (si->old_space) { if (marked(si, p)) { - relocate(&INITCDR(pe)) - youngest = tg; + relocate_dirty(&INITCDR(pe), youngest); } else if (FORWARDEDP(p, si)) { INITCAR(pe) = GET_FWDADDRESS(p); - relocate(&INITCDR(pe)) - youngest = tg; + relocate_dirty(&INITCDR(pe), youngest); } else { /* Not reached, so far; add to pending list */ add_ephemeron_to_pending(pe); @@ -1991,18 +2140,18 @@ static int check_dirty_ephemeron(ptr pe, int tg, int youngest) { to the target generation. That assumption covers the value part, too, since it can't end up younger than the target generation. */ - youngest = tg; + if (youngest != MIN_TG && (pg = TARGET_GENERATION(si)) < youngest) + youngest = pg; } } else { - int pg; - if ((pg = si->generation) < youngest) + if (youngest != MIN_TG && (pg = si->generation) < youngest) youngest = pg; - relocate_dirty(&INITCDR(pe), tg, youngest) + relocate_dirty(&INITCDR(pe), youngest); } } else { /* Non-collectable key means that the value determines `youngest`: */ - relocate_dirty(&INITCDR(pe), tg, youngest) + relocate_dirty(&INITCDR(pe), youngest); } POP_BACKREFERENCE() @@ -2051,20 +2200,24 @@ static uptr total_size_so_far() { #endif static uptr target_generation_space_so_far() { - IGEN g = target_generation; + IGEN g; ISPC s; - uptr sz = S_G.bytesof[g][countof_phantom]; + uptr sz = 0; - for (s = 0; s <= max_real_space; s++) { - sz += S_G.bytes_of_space[s][g]; - if (S_G.next_loc[s][g] != FIX(0)) - sz += (uptr)S_G.next_loc[s][g] - (uptr)S_G.base_loc[s][g]; + for (g = MIN_TG; g <= MAX_TG; g++) { + sz += S_G.bytesof[g][countof_phantom]; + + for (s = 0; s <= max_real_space; s++) { + sz += S_G.bytes_of_space[g][s]; + if (S_G.next_loc[g][s] != FIX(0)) + sz += (uptr)S_G.next_loc[g][s] - (uptr)S_G.base_loc[g][s]; + } } return sz; } -void copy_and_clear_list_bits(seginfo *oldspacesegments, IGEN tg) { +void copy_and_clear_list_bits(seginfo *oldspacesegments) { seginfo *si; int i; @@ -2085,11 +2238,11 @@ void copy_and_clear_list_bits(seginfo *oldspacesegments, IGEN tg) { if (bits_si->old_space) { if (bits_si->use_marks) { if (!bits_si->marked_mask) - init_mask(bits_si->marked_mask, tg, 0); + init_mask(bits_si->marked_mask, bits_si->generation, 0); bits_si->marked_mask[segment_bitmap_byte(TO_PTR(si->list_bits))] |= segment_bitmap_bit(TO_PTR(si->list_bits)); } else { octet *copied_bits; - find_room_voidp(space_data, tg, ptr_align(segment_bitmap_bytes), copied_bits); + 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; } @@ -2116,7 +2269,7 @@ void copy_and_clear_list_bits(seginfo *oldspacesegments, IGEN tg) { ptr new_p = FWDADDRESS(p); seginfo *new_si = SegInfo(ptr_get_segment(new_p)); if (!new_si->list_bits) - init_mask(new_si->list_bits, tg, 0); + init_mask(new_si->list_bits, new_si->generation, 0); bits >>= bitpos; new_si->list_bits[segment_bitmap_byte(new_p)] |= segment_bitmap_bits(new_p, bits); } @@ -2194,7 +2347,7 @@ static void push_measure(ptr p) if (si->old_space) { /* We must be in a GC--measure fusion, so switch back to GC */ - relocate_help_help(&p, p, si) + relocate_pure_help_help(&p, p, si); return; } diff --git a/racket/src/ChezScheme/c/gcwrapper.c b/racket/src/ChezScheme/c/gcwrapper.c index c4f3568100..a11097abb5 100644 --- a/racket/src/ChezScheme/c/gcwrapper.c +++ b/racket/src/ChezScheme/c/gcwrapper.c @@ -473,7 +473,7 @@ void Scompact_heap() { IBOOL eoc = S_G.enable_object_counts; S_pants_down += 1; S_G.enable_object_counts = 1; - S_gc_oce(tc, S_G.max_nonstatic_generation, static_generation, Sfalse); + S_gc_oce(tc, S_G.max_nonstatic_generation, static_generation, static_generation, Sfalse); S_G.enable_object_counts = eoc; S_pants_down -= 1; } @@ -584,7 +584,7 @@ void S_check_heap(aftergc, mcg) IBOOL aftergc; IGEN mcg; { for (s = 0; s <= max_real_space; s += 1) { seginfo *si; for (g = 0; g <= S_G.max_nonstatic_generation; INCRGEN(g)) { - for (si = S_G.occupied_segments[s][g]; si != NULL; si = si->next) { + for (si = S_G.occupied_segments[g][s]; si != NULL; si = si->next) { if (si->generation != g) { S_checkheap_errors += 1; printf("!!! segment in wrong occupied_segments list\n"); @@ -592,7 +592,7 @@ void S_check_heap(aftergc, mcg) IBOOL aftergc; IGEN mcg; { nonstatic_segments += 1; } } - for (si = S_G.occupied_segments[s][static_generation]; si != NULL; si = si->next) { + for (si = S_G.occupied_segments[static_generation][s]; si != NULL; si = si->next) { static_segments += 1; } } @@ -647,7 +647,7 @@ void S_check_heap(aftergc, mcg) IBOOL aftergc; IGEN mcg; { || s == space_immobile_impure || s == space_count_pure || s == space_count_impure || s == space_closure) { /* doesn't handle: space_port, space_continuation, space_code, space_pure_typed_object, space_impure_record, or impure_typed_object */ - nl = TO_VOIDP(S_G.next_loc[s][g]); + nl = TO_VOIDP(S_G.next_loc[g][s]); /* check for dangling references */ pp1 = TO_VOIDP(build_ptr(seg, 0)); @@ -819,7 +819,7 @@ static void check_dirty_space(ISPC s) { IGEN from_g, to_g, min_to_g; INT d; seginfo *si; for (from_g = 0; from_g <= static_generation; from_g += 1) { - for (si = S_G.occupied_segments[s][from_g]; si != NULL; si = si->next) { + for (si = S_G.occupied_segments[from_g][s]; si != NULL; si = si->next) { min_to_g = 0xff; for (d = 0; d < cards_per_segment; d += 1) { to_g = si->dirty_bytes[d]; @@ -933,7 +933,7 @@ void S_fixup_counts(ptr counts) { RTDCOUNTSTIMESTAMP(counts) = S_G.gctimestamp[0]; } -ptr S_do_gc(IGEN mcg, IGEN tg, ptr count_roots) { +ptr S_do_gc(IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots) { ptr tc = get_thread_context(); ptr code, result; @@ -949,22 +949,23 @@ ptr S_do_gc(IGEN mcg, IGEN tg, ptr count_roots) { S_G.max_nonstatic_generation = S_G.new_max_nonstatic_generation; } - if (tg == mcg && mcg == S_G.new_max_nonstatic_generation && mcg < S_G.max_nonstatic_generation) { + if (max_tg == max_cg && max_cg == S_G.new_max_nonstatic_generation && max_cg < S_G.max_nonstatic_generation) { IGEN new_g, old_g, from_g, to_g; ISPC s; seginfo *si, *nextsi, *tail; /* reducing max_nonstatic_generation */ new_g = S_G.new_max_nonstatic_generation; old_g = S_G.max_nonstatic_generation; - /* first, collect everything to old_g */ - result = S_gc(tc, old_g, old_g, count_roots); + /* first, collect everything to old_g, ignoring min_tg */ + result = S_gc(tc, old_g, old_g, old_g, count_roots); /* now transfer old_g info to new_g, and clear old_g info */ + S_G.bytes_of_generation[new_g] = S_G.bytes_of_generation[old_g]; S_G.bytes_of_generation[old_g] = 0; for (s = 0; s <= max_real_space; s += 1) { - S_G.first_loc[s][new_g] = S_G.first_loc[s][old_g]; S_G.first_loc[s][old_g] = FIX(0); - S_G.base_loc[s][new_g] = S_G.base_loc[s][old_g]; S_G.base_loc[s][old_g] = FIX(0); - S_G.next_loc[s][new_g] = S_G.next_loc[s][old_g]; S_G.next_loc[s][old_g] = FIX(0); - S_G.bytes_left[s][new_g] = S_G.bytes_left[s][old_g]; S_G.bytes_left[s][old_g] = 0; - S_G.bytes_of_space[s][new_g] = S_G.bytes_of_space[s][old_g]; S_G.bytes_of_space[s][old_g] = 0; - S_G.occupied_segments[s][new_g] = S_G.occupied_segments[s][old_g]; S_G.occupied_segments[s][old_g] = NULL; - for (si = S_G.occupied_segments[s][new_g]; si != NULL; si = si->next) { + S_G.first_loc[new_g][s] = S_G.first_loc[old_g][s]; S_G.first_loc[old_g][s] = FIX(0); + S_G.base_loc[new_g][s] = S_G.base_loc[old_g][s]; S_G.base_loc[old_g][s] = FIX(0); + S_G.next_loc[new_g][s] = S_G.next_loc[old_g][s]; S_G.next_loc[old_g][s] = FIX(0); + S_G.bytes_left[new_g][s] = S_G.bytes_left[old_g][s]; S_G.bytes_left[old_g][s] = 0; + S_G.bytes_of_space[new_g][s] = S_G.bytes_of_space[old_g][s]; S_G.bytes_of_space[old_g][s] = 0; + S_G.occupied_segments[new_g][s] = S_G.occupied_segments[old_g][s]; S_G.occupied_segments[old_g][s] = NULL; + for (si = S_G.occupied_segments[new_g][s]; si != NULL; si = si->next) { si->generation = new_g; } } @@ -988,6 +989,7 @@ ptr S_do_gc(IGEN mcg, IGEN tg, ptr count_roots) { RTDCOUNTSIT(counts, new_g) = RTDCOUNTSIT(counts, old_g); RTDCOUNTSIT(counts, old_g) = 0; } } + S_child_processes[new_g] = S_child_processes[old_g]; /* change old_g dirty bytes in static generation to new_g; splice list of old_g seginfos onto front of new_g seginfos */ @@ -1039,25 +1041,29 @@ ptr S_do_gc(IGEN mcg, IGEN tg, ptr count_roots) { S_G.min_free_gen = S_G.new_min_free_gen; S_G.max_nonstatic_generation = new_g; } else { - result = S_gc(tc, mcg, tg, count_roots); + result = S_gc(tc, max_cg, min_tg, max_tg, count_roots); } - S_pants_down -= 1; /* eagerly give collecting thread, the only one guaranteed to be active, a fresh allocation area. the other threads have to trap to get_more_room if and when they awake and try to allocate */ S_reset_allocation_pointer(tc); + S_pants_down -= 1; + Sunlock_object(code); return result; } -ptr S_gc(ptr tc, IGEN mcg, IGEN tg, ptr count_roots) { - if (tg == static_generation +ptr S_gc(ptr tc, IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots) { + if (min_tg == static_generation || S_G.enable_object_counts || S_G.enable_object_backreferences || (count_roots != Sfalse)) - return S_gc_oce(tc, mcg, tg, count_roots); - else - return S_gc_ocd(tc, mcg, tg, 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) { + S_gc_011(tc); + return Sfalse; + } else + return S_gc_ocd(tc, max_cg, min_tg, max_tg, Sfalse); } diff --git a/racket/src/ChezScheme/c/globals.h b/racket/src/ChezScheme/c/globals.h index 0da2669888..fbc8ddec46 100644 --- a/racket/src/ChezScheme/c/globals.h +++ b/racket/src/ChezScheme/c/globals.h @@ -89,18 +89,20 @@ EXTERN struct S_G_struct { ptr threadno; /* segment.c */ - seginfo *occupied_segments[max_real_space+1][static_generation+1]; + seginfo *occupied_segments[static_generation+1][max_real_space+1]; uptr number_of_nonstatic_segments; uptr number_of_empty_segments; /* alloc.c */ ptr *protected[max_protected]; uptr protect_next; - ptr first_loc[max_real_space+1][static_generation+1]; - ptr base_loc[max_real_space+1][static_generation+1]; - ptr next_loc[max_real_space+1][static_generation+1]; - iptr bytes_left[max_real_space+1][static_generation+1]; - uptr bytes_of_space[max_real_space+1][static_generation+1]; + ptr first_loc[static_generation+1][max_real_space+1]; + ptr base_loc[static_generation+1][max_real_space+1]; + ptr next_loc[static_generation+1][max_real_space+1]; + 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 g0_bytes_after_last_gc; uptr collect_trip_bytes; ptr nonprocedure_code; ptr null_string; diff --git a/racket/src/ChezScheme/c/prim5.c b/racket/src/ChezScheme/c/prim5.c index f1b3096cfc..581c72f5c8 100644 --- a/racket/src/ChezScheme/c/prim5.c +++ b/racket/src/ChezScheme/c/prim5.c @@ -395,8 +395,8 @@ static void s_show_chunks(FILE *out, ptr sorted_chunks) { #define INCRGEN(g) (g = g == S_G.max_nonstatic_generation ? static_generation : g+1) static void s_showalloc(IBOOL show_dump, const char *outfn) { FILE *out; - iptr count[space_total+1][generation_total+1]; - uptr bytes[space_total+1][generation_total+1]; + iptr count[generation_total+1][space_total+1]; + uptr bytes[generation_total+1][space_total+1]; int i, column_size[generation_total+1]; char fmtbuf[FMTBUFSIZE]; static char *spacename[space_total+1] = { alloc_space_names, "bogus", "total" }; @@ -427,42 +427,42 @@ static void s_showalloc(IBOOL show_dump, const char *outfn) { } } } - for (s = 0; s <= space_total; s++) - for (g = 0; g <= generation_total; INCRGEN(g)) - count[s][g] = bytes[s][g] = 0; + for (g = 0; g <= generation_total; INCRGEN(g)) + for (s = 0; s <= space_total; s++) + count[g][s] = bytes[g][s] = 0; - for (s = 0; s <= max_real_space; s++) { - for (g = 0; g <= static_generation; INCRGEN(g)) { + for (g = 0; g <= static_generation; INCRGEN(g)) { + for (s = 0; s <= max_real_space; s++) { /* add in bytes previously recorded */ - bytes[s][g] += S_G.bytes_of_space[s][g]; + bytes[g][s] += S_G.bytes_of_space[g][s]; /* add in bytes in active segments */ - if (S_G.next_loc[s][g] != FIX(0)) - bytes[s][g] += (uptr)S_G.next_loc[s][g] - (uptr)S_G.base_loc[s][g]; + if (S_G.next_loc[g][s] != FIX(0)) + bytes[g][s] += (uptr)S_G.next_loc[g][s] - (uptr)S_G.base_loc[g][s]; } } - for (s = 0; s <= max_real_space; s++) { - for (g = 0; g <= static_generation; INCRGEN(g)) { - for (si = S_G.occupied_segments[s][g]; si != NULL; si = si->next) { - count[s][g] += 1; + for (g = 0; g <= static_generation; INCRGEN(g)) { + for (s = 0; s <= max_real_space; s++) { + for (si = S_G.occupied_segments[g][s]; si != NULL; si = si->next) { + count[g][s] += 1; } } } - for (s = 0; s < space_total; s++) { - for (g = 0; g < generation_total; INCRGEN(g)) { - count[space_total][g] += count[s][g]; - count[s][generation_total] += count[s][g]; - count[space_total][generation_total] += count[s][g]; - bytes[space_total][g] += bytes[s][g]; - bytes[s][generation_total] += bytes[s][g]; - bytes[space_total][generation_total] += bytes[s][g]; + for (g = 0; g < generation_total; INCRGEN(g)) { + for (s = 0; s < space_total; s++) { + count[g][space_total] += count[g][s]; + count[generation_total][s] += count[g][s]; + count[generation_total][space_total] += count[g][s]; + bytes[g][space_total] += bytes[g][s]; + bytes[generation_total][s] += bytes[g][s]; + bytes[generation_total][space_total] += bytes[g][s]; } } for (g = 0; g <= generation_total; INCRGEN(g)) { - if (count[space_total][g] != 0) { - int n = 1 + snprintf(fmtbuf, FMTBUFSIZE, ""Ptd"", (ptrdiff_t)count[space_total][g]); + if (count[g][space_total] != 0) { + int n = 1 + snprintf(fmtbuf, FMTBUFSIZE, ""Ptd"", (ptrdiff_t)count[g][space_total]); column_size[g] = n < 8 ? 8 : n; } } @@ -470,7 +470,7 @@ static void s_showalloc(IBOOL show_dump, const char *outfn) { fprintf(out, "Segments per space & generation:\n\n"); fprintf(out, "%8s", ""); for (g = 0; g <= generation_total; INCRGEN(g)) { - if (count[space_total][g] != 0) { + if (count[g][space_total] != 0) { if (g == generation_total) { /* coverity[uninit_use] */ snprintf(fmtbuf, FMTBUFSIZE, "%%%ds", column_size[g]); @@ -489,25 +489,25 @@ static void s_showalloc(IBOOL show_dump, const char *outfn) { fprintf(out, "\n"); for (s = 0; s <= space_total; s++) { if (s != space_empty) { - if (count[s][generation_total] != 0) { + if (count[generation_total][s] != 0) { fprintf(out, "%7s:", spacename[s]); for (g = 0; g <= generation_total; INCRGEN(g)) { - if (count[space_total][g] != 0) { + if (count[g][space_total] != 0) { /* coverity[uninit_use] */ snprintf(fmtbuf, FMTBUFSIZE, "%%%dtd", column_size[g]); - fprintf(out, fmtbuf, (ptrdiff_t)(count[s][g])); + fprintf(out, fmtbuf, (ptrdiff_t)(count[g][s])); } } fprintf(out, "\n"); fprintf(out, "%8s", ""); for (g = 0; g <= generation_total; INCRGEN(g)) { - if (count[space_total][g] != 0) { - if (count[s][g] != 0 && s <= max_real_space) { + if (count[g][space_total] != 0) { + if (count[g][s] != 0 && s <= max_real_space) { /* coverity[uninit_use] */ snprintf(fmtbuf, FMTBUFSIZE, "%%%dd%%%%", column_size[g] - 1); fprintf(out, fmtbuf, - (int)(((double)bytes[s][g] / - ((double)count[s][g] * bytes_per_segment)) * 100.0)); + (int)(((double)bytes[g][s] / + ((double)count[g][s] * bytes_per_segment)) * 100.0)); } else { /* coverity[uninit_use] */ snprintf(fmtbuf, FMTBUFSIZE, "%%%ds", column_size[g]); diff --git a/racket/src/ChezScheme/c/segment.c b/racket/src/ChezScheme/c/segment.c index c1c90263a6..896146ac64 100644 --- a/racket/src/ChezScheme/c/segment.c +++ b/racket/src/ChezScheme/c/segment.c @@ -36,6 +36,7 @@ Low-level Memory management strategy: #include "sort.h" #include +static void out_of_memory PROTO((void)); static void initialize_seginfo PROTO((seginfo *si, ISPC s, IGEN g)); static seginfo *allocate_segments PROTO((uptr nreq)); static void expand_segment_table PROTO((uptr base, uptr end, seginfo *si)); @@ -51,9 +52,9 @@ void S_segment_init() { S_chunks_full = NULL; for (i = PARTIAL_CHUNK_POOLS; i >= 0; i -= 1) S_chunks[i] = NULL; - for (s = 0; s <= max_real_space; s++) { - for (g = 0; g <= static_generation; g++) { - S_G.occupied_segments[s][g] = NULL; + for (g = 0; g <= static_generation; g++) { + for (s = 0; s <= max_real_space; s++) { + S_G.occupied_segments[g][s] = NULL; } } S_G.number_of_nonstatic_segments = 0; @@ -72,14 +73,16 @@ void S_segment_init() { static uptr membytes = 0; static uptr maxmembytes = 0; +static void out_of_memory(void) { + (void) fprintf(stderr,"out of memory\n"); + S_abnormal_exit(); +} + #if defined(USE_MALLOC) void *S_getmem(iptr bytes, IBOOL zerofill) { void *addr; - if ((addr = malloc(bytes)) == (void *)0) { - (void) fprintf(stderr,"out of memory\n"); - S_abnormal_exit(); - } + if ((addr = malloc(bytes)) == (void *)0) out_of_memory(); debug(printf("getmem(%p) -> %p\n", bytes, addr)) if ((membytes += bytes) > maxmembytes) maxmembytes = membytes; @@ -100,19 +103,13 @@ void *S_getmem(iptr bytes, IBOOL zerofill) { void *addr; if ((uptr)bytes < S_pagesize) { - if ((addr = malloc(bytes)) == (void *)0) { - (void) fprintf(stderr,"out of memory\n"); - S_abnormal_exit(); - } + if ((addr = malloc(bytes)) == (void *)0) out_of_memory(); debug(printf("getmem malloc(%p) -> %p\n", bytes, addr)) if ((membytes += bytes) > maxmembytes) maxmembytes = membytes; if (zerofill) memset(addr, 0, bytes); } else { uptr n = S_pagesize - 1; iptr p_bytes = (iptr)(((uptr)bytes + n) & ~n); - if ((addr = VirtualAlloc((void *)0, (SIZE_T)p_bytes, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) == (void *)0) { - (void) fprintf(stderr, "out of memory\n"); - S_abnormal_exit(); - } + if ((addr = VirtualAlloc((void *)0, (SIZE_T)p_bytes, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) == (void *)0) out_of_memory(); if ((membytes += p_bytes) > maxmembytes) maxmembytes = membytes; debug(printf("getmem VirtualAlloc(%p => %p) -> %p\n", bytes, p_bytes, addr)) } @@ -143,10 +140,7 @@ void *S_getmem(iptr bytes, IBOOL zerofill) { void *addr; if ((uptr)bytes < S_pagesize) { - if ((addr = malloc(bytes)) == (void *)0) { - (void) fprintf(stderr,"out of memory\n"); - S_abnormal_exit(); - } + if ((addr = malloc(bytes)) == (void *)0) out_of_memory(); debug(printf("getmem malloc(%p) -> %p\n", bytes, addr)) if ((membytes += bytes) > maxmembytes) maxmembytes = membytes; if (zerofill) memset(addr, 0, bytes); @@ -158,8 +152,7 @@ void *S_getmem(iptr bytes, IBOOL zerofill) { if ((addr = mmap(NULL, p_bytes, PROT_EXEC|PROT_WRITE|PROT_READ, MAP_PRIVATE|MAP_ANONYMOUS|MAP_32BIT, -1, 0)) == (void *)-1) { #endif if ((addr = mmap(NULL, p_bytes, PROT_EXEC|PROT_WRITE|PROT_READ, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0)) == (void *)-1) { - (void) fprintf(stderr,"out of memory\n"); - S_abnormal_exit(); + out_of_memory(); debug(printf("getmem mmap(%p) -> %p\n", bytes, addr)) } #ifdef MAP_32BIT @@ -284,8 +277,8 @@ iptr S_find_segments(s, g, n) ISPC s; IGEN g; iptr n; { chunk->nused_segs += 1; initialize_seginfo(si, s, g); - si->next = S_G.occupied_segments[s][g]; - S_G.occupied_segments[s][g] = si; + si->next = S_G.occupied_segments[g][s]; + S_G.occupied_segments[g][s] = si; S_G.number_of_empty_segments -= 1; return si->number; } @@ -318,8 +311,8 @@ iptr S_find_segments(s, g, n) ISPC s; IGEN g; iptr n; { S_move_to_chunk_list(chunk, &S_chunks[PARTIAL_CHUNK_POOLS-1]); } chunk->nused_segs += n; - nextsi->next = S_G.occupied_segments[s][g]; - S_G.occupied_segments[s][g] = si; + nextsi->next = S_G.occupied_segments[g][s]; + S_G.occupied_segments[g][s] = si; for (j = n, nextsi = si; j > 0; j -= 1, nextsi = nextsi->next) { initialize_seginfo(nextsi, s, g); } @@ -343,8 +336,8 @@ iptr S_find_segments(s, g, n) ISPC s; IGEN g; iptr n; { for (nextsi = si; n > 0; n -= 1, nextsi += 1) { initialize_seginfo(nextsi, s, g); /* add segment to appropriate list of occupied segments */ - nextsi->next = S_G.occupied_segments[s][g]; - S_G.occupied_segments[s][g] = nextsi; + nextsi->next = S_G.occupied_segments[g][s]; + S_G.occupied_segments[g][s] = nextsi; } return si->number; } diff --git a/racket/src/ChezScheme/c/types.h b/racket/src/ChezScheme/c/types.h index fc2197ebf3..7f9877d845 100644 --- a/racket/src/ChezScheme/c/types.h +++ b/racket/src/ChezScheme/c/types.h @@ -82,9 +82,9 @@ typedef int IFASLCODE; /* fasl type codes */ * no space is left in the current segment. n is assumed to be * an integral multiple of the object alignment. */ #define find_room_T(s, g, t, n, T, x) { \ - ptr X = S_G.next_loc[s][g];\ - S_G.next_loc[s][g] = (ptr)((uptr)X + (n));\ - if ((S_G.bytes_left[s][g] -= (n)) < 0) X = S_find_more_room(s, g, n, X);\ + ptr X = S_G.next_loc[g][s];\ + S_G.next_loc[g][s] = (ptr)((uptr)X + (n));\ + if ((S_G.bytes_left[g][s] -= (n)) < 0) X = S_find_more_room(s, g, n, X);\ (x) = T(TYPE(X, t)); \ } diff --git a/racket/src/ChezScheme/csug/smgmt.stex b/racket/src/ChezScheme/csug/smgmt.stex index 6a5363eacc..41d511a33f 100644 --- a/racket/src/ChezScheme/csug/smgmt.stex +++ b/racket/src/ChezScheme/csug/smgmt.stex @@ -18,8 +18,8 @@ procedures that may be used to control its operation. \section{Garbage Collection\label{SECTSMGMTGC}} -Scheme objects such as pairs, strings, and procedures are -never explicitly deallocated by a Scheme program. +Scheme objects such as pairs, strings, procedures, and user-defined +records are never explicitly deallocated by a Scheme program. Instead, the \index{storage management}storage management system automatically reclaims the storage associated with an object once it proves the object is no longer @@ -44,7 +44,8 @@ The collect-request handler can be redefined by changing the value of the parameter \index{\scheme{collect-request-handler}}\scheme{collect-request-handler}. A program can also cause a collection to occur between collect-request -interrupts by calling \scheme{collect} directly. +interrupts by calling \scheme{collect} directly either without or with +arguments. {\ChezScheme}'s collector is a \emph{generation-based} collector. It segregates objects based on their age (roughly speaking, the @@ -59,64 +60,56 @@ which storage is never reclaimed. Objects are placed into the static generation only when a heap is compacted (see \index{\scheme{Scompact_heap}}\scheme{Scompact_heap} in -Section~\ref{SECTFOREIGNCLIB}) or when the target-generation argument to -\index{\scheme{collect}}\scheme{collect} is the symbol \scheme{static}. +Section~\ref{SECTFOREIGNCLIB}) or when an explicitly specified +target-generation is the symbol \scheme{static}. +This is primarily useful after an application's permanent code and data +structures have been loaded and initialized, to reduce the overhead of +subsequent collections. Nonstatic generations are numbered starting at zero for the youngest generation up through the current value of \index{\scheme{collect-maximum-generation}}\scheme{collect-maximum-generation}. The storage manager places newly allocated objects into generation 0. -During a generation 0 collection, objects in generation 0 that survive the -collection move, by default, to generation 1. -Similarly, during a generation 1 collection, objects in generations 0 and -1 that survive move to generation 2, and so on. -During the collection of the maximum nonstatic collection, all surviving -nonstatic objects move (possibly back) into the maximum nonstatic -generation. -With this mechanism, it is possible for an object to skip one or more -generations, but this is not likely to happen to many objects, and if the -objects become inaccessible, their storage is reclaimed eventually. +When \scheme{collect} is invoked without arguments, generation 0 +objects that survive collection move to generation 1, generation 1 +objects that survive move to generation 2, and so on, except that +objects are never moved past the maximum nonstatic generation. +Objects in the maximum nonstatic generation are collected back into +the maximum nonstatic generation. +While generation 0 is collected during each collection, older +generations are collected less frequently. An internal counter, gc-trip, is maintained to control when each generation is collected. Each time \scheme{collect} is called without arguments (as from the default -collect-request handler), gc-trip is incremented by one. -With a collect-generation radix of $r$, the collected generation +collect-request handler), gc-trip is incremented by one, and the set of +generations to be collected is determined from the current value of +gc-trip and the value of +\index{\scheme{collect-generation-radix}}\scheme{collect-generation-radix}: +with a collect-generation radix of $r$, the maximum collected generation is the highest numbered generation $g$ for which gc-trip is a multiple of $r^g$. If \scheme{collect-generation-radix} is set to 4, the system thus -collects generation 0 every time, generation 1 every 4 times, generation 2 -every 16 times, and so on. +collects generation 0 every time, generation 1 every 4 times, +generation 2 every 16 times, and so on. -Each time \scheme{collect} is called with a single generation argument $g$, -generation $g$ is collected and -gc-trip is advanced to the next $r^g$ boundary, but not past the next -$r^{g+1}$ boundary, where $r$ is again the +When \scheme{collect} is invoked with arguments, the generations to be +collected and their target generations are determined by the arguments. +In addition, the first argument \var{cg} affects the value of gc-trip; +that is, gc-trip is advanced to the next $r^{cg}$ boundary, but +not past the next $r^{cg+1}$ boundary, where $r$ is the value of \scheme{collect-generation-radix}. -If \scheme{collect} is called with a second generation argument, -$tg$, $tg$ determines the target generation. -When $g$ is the maximum nonstatic generation, $tg$ must be -$g$ or the symbol \scheme{static}. -Otherwise, $tg$ must be $g$ or $g+1$. -When the target generation is the symbol \scheme{static}, all data in -the nonstatic generations are moved to the static generation. -Objects in the static generation are never collected. -This is primarily useful after an application's permanent code and data -structures have been loaded and initialized, to reduce the overhead of -subsequent collections. - It is possible to make substantial adjustments in the collector's behavior by setting the parameters described in this section. It is even possible to completely override the collector's default strategy for determining when each generation is collected by redefining the -collect-request handler to call \scheme{collect} with explicit $g$ and -$tg$ arguments. -For example, the programmer can redefine the handler to treat the maximum -nonstatic generation as a static generation over a long period of time -by calling \scheme{collect} with explicit $g$ and $tg$ arguments -that are never equal to the maximum nonstatic generation during that -period of time. +collect-request handler to call \scheme{collect} with arguments. +For example, the programmer can redefine the handler to treat the +maximum nonstatic generation as a static generation over a long +period of time by calling \scheme{collect} with arguments that +prevent the maximum nonstatic generation from being collected during +that period of time. Additional information on {\ChezScheme}'s collector can be found in the report ``Don't stop the {BiBOP}: Flexible and efficient @@ -126,34 +119,62 @@ storage management for dynamically typed languages''~\cite{Dybvig:sm}. %---------------------------------------------------------------------------- \entryheader \formdef{collect}{\categoryprocedure}{(collect)} -\formdef{collect}{\categoryprocedure}{(collect \var{g})} -\formdef{collect}{\categoryprocedure}{(collect \var{g} \var{tg})} -\formdef{collect}{\categoryprocedure}{(collect \var{g} \var{tg} \var{objs})} +\formdef{collect}{\categoryprocedure}{(collect \var{cg})} +\formdef{collect}{\categoryprocedure}{(collect \var{cg} \var{max-tg})} +\formdef{collect}{\categoryprocedure}{(collect \var{cg} \var{min-tg} \var{max-tg})} +\formdef{collect}{\categoryprocedure}{(collect \var{cg} \var{min-tg} \var{max-tg} \var{objs})} \returns a list if \var{objs} is a list, unspecified otherwise \listlibraries \endentryheader \noindent -\var{g} must be a nonnegative fixnum no greater than the -maximum nonstatic generation, i.e., the -value returned by \scheme{collect-maximum-generation}. -If \var{g} is the maximum nonstatic generation, -\var{tg} must be a fixnum equal to \var{g} or the symbol -\scheme{static}. -Otherwise, \var{tg} must be a fixnum equal to or one -greater than \var{g}. -\var{objs} must be either \scheme{#f} or a list. - -This procedure causes the storage manager to perform a garbage collection. -\scheme{collect} is invoked periodically via the collect-request -handler, but it may also be called explicitly to force collection at a -particular time, e.g., before timing a computation. +This procedure causes the storage manager to perform a garbage +collection. +\scheme{collect} is invoked periodically without arguments by the +default collect-request handler, but it may also be called explicitly, +e.g., from a custom collect-request handler, between phases of a +computation when collection is most likely to be successful, or +before timing a computation. In the threaded versions of {\ChezScheme}, the thread that invokes \scheme{collect} must be the only active thread. -The system determines which generations to collect, based on \var{g} and -\var{tg} if provided, as described in the lead-in to this section. +When called without arguments, the system determines automatically +which generations to collect and the target generation for each +collected generation as described in the lead-in to this section. +When called with arguments, the system collects all and only objects +in generations less than or equal to \var{cg} (the maximum collected +generation) into the target generation or generations determined +by \var{min-tg} (the minimum target generation) and \var{max-tg} +(the maximum target generation). +Specifically, the target generation for any object in a collected +generation \var{g} is +$\mbox{min}(\mbox{max}(\mbox{\emph{g}}+1,\mbox{\emph{min-tg}}),\mbox{\emph{max-tg}})$, where +\scheme{static} is taken to have the value one greater +than the maximum nonstatic generation. + +If present, \var{cg} must be a nonnegative fixnum no greater than +the maximum nonstatic generation, i.e., the current value of the +parameter \scheme{collect-maximum-generation}. + +If present, \var{max-tg} must be a nonnegative fixnum or the symbol +\scheme{static} and either equal to \var{cg} or one greater than +\var{cg}, again treating \scheme{static} as having the value one +greater than the maximum nonstatic generation. +If \var{max-tg} is not present (but \var{cg} is), it defaults to +\var{cg} if \var{cg} is equal to the maximum target generation and +to one more than \var{cg} otherwise. + +If present, \var{min-tg} must be a nonnegative fixnum or the symbol +\scheme{static} and no greater than \var{max-tg}, again treating +\scheme{static} as having the value one greater than the maximum +nonstatic generation. +Unless \var{max-cg} is the same as \var{cg}, \var{min-tg} must also +be greater than \var{cg}. +If \var{min-tg} is not present (but \var{cg} is), it defaults to +the same value as \var{max-tg}. + +If present, \var{objs} must be either \scheme{#f} or a list. If \var{objs} is a list, the collection is combined with counting as in \scheme{compute-size-increments}. Counting looks through all generations, as when \scheme{'static} is the second argument to @@ -184,7 +205,7 @@ the collect-request handler. Note that if the collect-request handler (see \scheme{collect-request-handler}) does not call \scheme{collect}, then -\scheme{collect-rendezvous} does not actualy perform a garbage +\scheme{collect-rendezvous} does not actually perform a garbage collection. diff --git a/racket/src/ChezScheme/mats/7.ms b/racket/src/ChezScheme/mats/7.ms index 4ff376769e..f45de4adb1 100644 --- a/racket/src/ChezScheme/mats/7.ms +++ b/racket/src/ChezScheme/mats/7.ms @@ -5606,6 +5606,75 @@ evaluating module init (collect (collect-maximum-generation)) (let ([b3 (bytes-allocated)]) (and (> b2 b1) (< b3 b2)))))) + (error? ; invalid generation + (collect 'static 1 'static)) + (error? ; invalid generation + (collect 'static 1 'static)) + (error? ; invalid generation + (parameterize ([collect-maximum-generation 4]) + (collect 17 1 17))) + (error? ; invalid generation + (collect -1 1 'static)) + (error? ; invalid maximum target generation + (parameterize ([collect-maximum-generation 4]) + (collect 3 1 2))) + (error? ; invalid maximum target generation + (parameterize ([collect-maximum-generation 4]) + (collect 3 1 'dynamic))) + (error? ; invalid minimum target generation + (parameterize ([collect-maximum-generation 4]) + (collect 0 0 3))) + (error? ; invalid minimum target generation + (parameterize ([collect-maximum-generation 4]) + (collect 0 'static 3))) + (error? ; invalid minimum target generation + (parameterize ([collect-maximum-generation 4]) + (collect 0 2 1))) + (error? ; invalid minimum target generation + (parameterize ([collect-maximum-generation 4]) + (collect 0 2 0))) + (error? ; invalid minimum target generation + (parameterize ([collect-maximum-generation 4]) + (collect (collect-maximum-generation) 0 'static))) + (error? ; invalid minimum target generation + (parameterize ([collect-maximum-generation 4]) + (collect (collect-maximum-generation) -1 'static))) + (parameterize ([collect-maximum-generation (max (collect-maximum-generation) 2)]) + (with-interrupts-disabled + (collect (collect-maximum-generation)) + (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 ([b0-1 (bytes-allocated 0)] + [b1-1 (bytes-allocated 1)] + [bm-1 (bytes-allocated (collect-maximum-generation))]) + (unless (>= (- b0-1 b0-0) n) (errorf 'oops1 "b0-0 = ~s, b0-1 = ~s, b0-2 = ~s" b0-0 b0-1 b0-2)) + (unless (< (- b1-1 b1-0) n) (errorf 'oops2 "b1-0 = ~s, b1-1 = ~s, b1-2 = ~s" b1-0 b1-1 b1-2)) + (unless (< (- bm-1 bm-0) n) (errorf 'oops3 "bm-0 = ~s, bm-1 = ~s, bm-2 = ~s" bm-0 bm-1 bm-2)) + (collect (collect-maximum-generation) 1 (collect-maximum-generation)) + (let ([b0-2 (bytes-allocated 0)] + [b1-2 (bytes-allocated 1)] + [bm-2 (bytes-allocated (collect-maximum-generation))]) + (unless (< (- b0-2 b0-0) n) (errorf 'oops4 "b0-0 = ~s, b0-1 = ~s, b0-2 = ~s" b0-0 b0-1 b0-2)) + (unless (>= (- b1-2 b1-0) n) (errorf 'oops5 "b1-0 = ~s, b1-1 = ~s, b1-2 = ~s" b1-0 b1-1 b1-2)) + (unless (< (- bm-2 bm-0) n) (errorf 'oops6 "bm-0 = ~s, bm-1 = ~s, bm-2 = ~s" bm-0 bm-1 bm-2)) + (parameterize ([print-vector-length #t]) (pretty-print v)) + #t)))))) + (parameterize ([collect-maximum-generation 4] + [collect-generation-radix 4] + [collect-trip-bytes (expt 2 20)]) + (collect (collect-maximum-generation)) + (let ([b0 (maximum-memory-bytes)]) + (define tail-spin + (lambda (n) + (do ([i 1 (fx+ i 1)] [next (cons 0 '()) (cdr next)]) + ((fx= i n)) + (set-cdr! next (cons i '()))))) + (tail-spin 50000000) + (let ([b1 (maximum-memory-bytes)]) + (or (< (- b1 b0) (expt 2 24)) + (errorf #f "b0 = ~s, b1 = ~s, b1-b0 = ~s" b0 b1 (- b1 b0)))))) ) (mat object-counts @@ -5632,7 +5701,7 @@ evaluating module init (assert (assp record-type-descriptor? hc)) #t)) ; a few idiot checks including verification of proper behavior when changing collect-maximum-generation - (parameterize ([enable-object-counts #t]) + (parameterize ([enable-object-counts #t] [collect-maximum-generation (collect-maximum-generation)]) (pair? (with-interrupts-disabled (let ([cmg (collect-maximum-generation)]) diff --git a/racket/src/ChezScheme/mats/Mf-base b/racket/src/ChezScheme/mats/Mf-base index 6f4a1b4b1b..6df98eed6e 100644 --- a/racket/src/ChezScheme/mats/Mf-base +++ b/racket/src/ChezScheme/mats/Mf-base @@ -86,6 +86,10 @@ eval = $(defaulteval) defaultctb = (collect-trip-bytes) ctb = $(defaultctb) +# cn defines the value to which collect-notify is set: f for #f, t for #t +defaultcn = f +cn = $(defaultcn) + # cgr is the value to which collect-generation-radix is set. defaultcgr = (collect-generation-radix) cgr = $(defaultcgr) @@ -164,6 +168,7 @@ $(objdir)/%.mo : %.ms mat.so '(heap-check-interval ${hci})'\ '(#%$$enable-check-prelex-flags #${ecpf})'\ '(compile-profile #$p)'\ + '(collect-notify #${cn})'\ '(collect-trip-bytes ${ctb})'\ '(collect-generation-radix ${cgr})'\ '(collect-maximum-generation ${cmg})'\ @@ -189,6 +194,7 @@ $(objdir)/%.mo : %.ms mat.so '(heap-check-interval ${hci})'\ '(#%$$enable-check-prelex-flags #${ecpf})'\ '(compile-profile #$p)'\ + '(collect-notify #${cn})'\ '(collect-trip-bytes ${ctb})'\ '(collect-generation-radix ${cgr})'\ '(collect-maximum-generation ${cmg})'\ @@ -364,6 +370,7 @@ script.all$o makescript$o: '(heap-check-interval ${hci})'\ '(#%$$enable-check-prelex-flags #${ecpf})'\ '(compile-profile #$p)'\ + '(collect-notify #${cn})'\ '(collect-trip-bytes ${ctb})'\ '(collect-generation-radix ${cgr})'\ '(collect-maximum-generation ${cmg})'\ diff --git a/racket/src/ChezScheme/mats/misc.ms b/racket/src/ChezScheme/mats/misc.ms index 708cdad297..b18754e9a0 100644 --- a/racket/src/ChezScheme/mats/misc.ms +++ b/racket/src/ChezScheme/mats/misc.ms @@ -1154,76 +1154,77 @@ ) (mat collect+compute-size-increments - (eq? (void) (collect 0 0 #f)) - (eq? '() (collect 0 0 '())) + (eq? (void) (collect 0 0 0 #f)) + (eq? '() (collect 0 0 0 '())) - (error? (collect 0 0 'not-a-list)) - (error? (collect 0 0 0)) - (error? (collect 'not-a-generation 0 '())) - (error? (collect 0 'not-a-generation '())) - (error? (collect 1 0 '())) + (error? (collect 0 0 0 'not-a-list)) + (error? (collect 0 0 0 0)) + (error? (collect 'not-a-generation 0 0 '())) + (error? (collect 0 'not-a-generation 0 '())) + (error? (collect 0 0 'not-a-generation '())) + (error? (collect 1 0 0 '())) (begin (define-record-type count-wrap (fields val)) - (collect 0 0 (list (make-count-wrap 0))) ; take care of one-time initialization costs - (define wrap-size (car (collect 0 0 (list (make-count-wrap 0))))) ; includes rtd - (define just-wrap-size (cadr (collect 0 0 (list (make-count-wrap 0) (make-count-wrap 1))))) + (collect 0 0 0 (list (make-count-wrap 0))) ; take care of one-time initialization costs + (define wrap-size (car (collect 0 0 0 (list (make-count-wrap 0))))) ; includes rtd + (define just-wrap-size (cadr (collect 0 0 0 (list (make-count-wrap 0) (make-count-wrap 1))))) (define pair-size (compute-size (cons 1 2))) (define ephemeron-size (compute-size (ephemeron-cons 1 2))) #t) (equal? (list pair-size pair-size) - (collect 0 0 (list (cons 1 2) (cons 3 4)))) + (collect 0 0 0 (list (cons 1 2) (cons 3 4)))) (equal? (list (* 3 pair-size) pair-size) (let ([l (list 1 2)]) - (collect 0 0 (list (cons 3 l) (cons 4 l))))) + (collect 0 0 0 (list (cons 3 l) (cons 4 l))))) (equal? (list pair-size) - (collect 0 0 (list (weak-cons (make-bytevector 100) #f)))) + (collect 0 0 0 (list (weak-cons (make-bytevector 100) #f)))) ;; Ephemeron(s) found before key: (equal? (list ephemeron-size (+ (* 2 pair-size) wrap-size)) - (collect 0 0 (let* ([p (make-count-wrap (cons 0 0))] - [e (ephemeron-cons p (cons 0 0))]) - (list e p)))) + (collect 0 0 0 (let* ([p (make-count-wrap (cons 0 0))] + [e (ephemeron-cons p (cons 0 0))]) + (list e p)))) (equal? (list ephemeron-size (+ (* 3 pair-size) wrap-size)) (let* ([v (make-count-wrap (cons 1 2))] [e (ephemeron-cons v (cons 3 4))]) - (collect 0 0 (list e (cons v #f))))) + (collect 0 0 0 (list e (cons v #f))))) (equal? (list (* 2 (+ ephemeron-size pair-size)) (+ (* 4 pair-size) wrap-size)) (let* ([v (make-count-wrap (cons 1 2))] [e* (list (ephemeron-cons v (cons 3 4)) (ephemeron-cons v (cons 5 6)))]) - (collect 0 0 (list e* (cons v #f))))) + (collect 0 0 0 (list e* (cons v #f))))) ;; Key found before ephemeron(s): (equal? (list (+ (* 2 pair-size) wrap-size) (+ ephemeron-size pair-size)) (let* ([v (make-count-wrap (cons 1 2))] [e (ephemeron-cons v (cons 3 4))]) - (collect 0 0 (list (cons v #f) e)))) + (collect 0 0 0 (list (cons v #f) e)))) (equal? (list (* 2 pair-size) (+ (* 4 pair-size) (* 2 ephemeron-size))) (let* ([v (cons 1 2)] [e* (list (ephemeron-cons v (cons 3 4)) (ephemeron-cons v (cons 5 6)))]) - (collect 0 0 (list (cons v #f) e*)))) + (collect 0 0 0 (list (cons v #f) e*)))) ;; Weakly held objects: (equal? '(0) (let* ([v (make-count-wrap (cons 1 2))] [ls (weak-cons v '())]) - (collect 0 0 ls))) + (collect 0 0 0 ls))) (equal? (list wrap-size pair-size (+ just-wrap-size pair-size)) (let* ([v (make-count-wrap (cons 1 2))] [ls (cons* (make-count-wrap 0) (cons v 1) (weak-cons v '()))]) - (collect 0 0 ls))) + (collect 0 0 0 ls))) (equal? (list 0 (+ wrap-size (* 2 pair-size))) (let* ([v (make-count-wrap (cons 1 2))] [ls (weak-cons v (cons (cons v 1) '()))]) - (collect 0 0 ls))) + (collect 0 0 0 ls))) (equal? #!bwp (let* ([v (make-count-wrap (cons 1 2))] [ls (weak-cons v '())]) - (collect 0 0 ls) + (collect 0 0 0 ls) (car ls))) ;; These calls will encounter many kinds of objects, just to make ;; sure they don't fail: - (list? (collect 0 0 (list (call/cc values)))) - (list? (collect (collect-maximum-generation) (collect-maximum-generation) (list (call/cc values)))) + (list? (collect 0 0 0 (list (call/cc values)))) + (list? (collect (collect-maximum-generation) (collect-maximum-generation) (collect-maximum-generation) (list (call/cc values)))) (let () (define e (ephemeron-cons #t (gensym))) @@ -1234,7 +1235,7 @@ ;; For this collection, `e` is both on the dirty list ;; and involved in measuring; make sure those roles ;; don't conflict - (collect 1 1 (list e)) + (collect 1 1 1 (list e)) (equal? e (cons #!bwp #!bwp)))) (let () @@ -1242,7 +1243,7 @@ (collect 0 1) (let ([g (gensym)]) (set-car! e g) - (collect 1 1 (list e)) + (collect 1 1 1 (list e)) (equal? e (cons g 'other)))) ) diff --git a/racket/src/ChezScheme/mats/root-experr-compile-0-f-f-f b/racket/src/ChezScheme/mats/root-experr-compile-0-f-f-f index f193961441..e8be104a04 100644 --- a/racket/src/ChezScheme/mats/root-experr-compile-0-f-f-f +++ b/racket/src/ChezScheme/mats/root-experr-compile-0-f-f-f @@ -7576,6 +7576,18 @@ format.mo:Expected error in mat format-dollar: "format: expected real number for 7.mo:Expected error in mat collect: "collect: invalid generation -1". 7.mo:Expected error in mat collect: "collect: invalid target generation 0 for generation 1". 7.mo:Expected error in mat collect: "collect: invalid generation static". +7.mo:Expected error in mat collect: "collect: invalid generation static". +7.mo:Expected error in mat collect: "collect: invalid generation static". +7.mo:Expected error in mat collect: "collect: invalid generation 17". +7.mo:Expected error in mat collect: "collect: invalid generation -1". +7.mo:Expected error in mat collect: "collect: invalid maximum target generation 2 for generation 3". +7.mo:Expected error in mat collect: "collect: invalid maximum target generation dynamic for generation 3". +7.mo:Expected error in mat collect: "collect: invalid maximum target generation 3 for generation 0". +7.mo:Expected error in mat collect: "collect: invalid maximum target generation 3 for generation 0". +7.mo:Expected error in mat collect: "collect: invalid minimum target generation 2 for generation 0 and maximum target generation 1". +7.mo:Expected error in mat collect: "collect: invalid minimum target generation 2 for generation 0 and maximum target generation 0". +7.mo:Expected error in mat collect: "collect: invalid minimum target generation 0 for generation 4 and maximum target generation static". +7.mo:Expected error in mat collect: "collect: invalid minimum target generation -1 for generation 4 and maximum target generation static". 7.mo:Expected error in mat sstats: "make-sstats: cpu value 0 is not a time record". 7.mo:Expected error in mat sstats: "make-sstats: real value 0 is not a time record". 7.mo:Expected error in mat sstats: "make-sstats: bytes value 0.0 is not an exact integer". diff --git a/racket/src/ChezScheme/mats/root-experr-compile-2-f-f-f b/racket/src/ChezScheme/mats/root-experr-compile-2-f-f-f index 67c3f99152..04b3c476ec 100644 --- a/racket/src/ChezScheme/mats/root-experr-compile-2-f-f-f +++ b/racket/src/ChezScheme/mats/root-experr-compile-2-f-f-f @@ -7170,6 +7170,18 @@ format.mo:Expected error in mat format-dollar: "format: expected real number for 7.mo:Expected error in mat collect: "collect: invalid generation -1". 7.mo:Expected error in mat collect: "collect: invalid target generation 0 for generation 1". 7.mo:Expected error in mat collect: "collect: invalid generation static". +7.mo:Expected error in mat collect: "collect: invalid generation static". +7.mo:Expected error in mat collect: "collect: invalid generation static". +7.mo:Expected error in mat collect: "collect: invalid generation 17". +7.mo:Expected error in mat collect: "collect: invalid generation -1". +7.mo:Expected error in mat collect: "collect: invalid maximum target generation 2 for generation 3". +7.mo:Expected error in mat collect: "collect: invalid maximum target generation dynamic for generation 3". +7.mo:Expected error in mat collect: "collect: invalid maximum target generation 3 for generation 0". +7.mo:Expected error in mat collect: "collect: invalid maximum target generation 3 for generation 0". +7.mo:Expected error in mat collect: "collect: invalid minimum target generation 2 for generation 0 and maximum target generation 1". +7.mo:Expected error in mat collect: "collect: invalid minimum target generation 2 for generation 0 and maximum target generation 0". +7.mo:Expected error in mat collect: "collect: invalid minimum target generation 0 for generation 4 and maximum target generation static". +7.mo:Expected error in mat collect: "collect: invalid minimum target generation -1 for generation 4 and maximum target generation static". 7.mo:Expected error in mat sstats: "make-sstats: cpu value 0 is not a time record". 7.mo:Expected error in mat sstats: "make-sstats: real value 0 is not a time record". 7.mo:Expected error in mat sstats: "make-sstats: bytes value 0.0 is not an exact integer". diff --git a/racket/src/ChezScheme/release_notes/release_notes.stex b/racket/src/ChezScheme/release_notes/release_notes.stex index e65c37cef0..a49fbfb69e 100644 --- a/racket/src/ChezScheme/release_notes/release_notes.stex +++ b/racket/src/ChezScheme/release_notes/release_notes.stex @@ -2,7 +2,7 @@ \thisversion{Version 9.5.3} \thatversion{Version 8.4} -\pubmonth{February} +\pubmonth{June} \pubyear{2020} \begin{document} @@ -112,6 +112,35 @@ unordered by default. An ordered guardian's objects are classified as inaccessible only when they are not reachable from the represetative of any inaccessible object in any other guardian. +\subsection{Incremental promotion of collected objects (9.5.3)} + +In previous versions of {\ChezScheme}, the collector always promoted +surviving objects from every collected generation into a single +target generation. +For example, when the target generation was 3, it promoted not only +surviving objects from generation 2 to generation 3 but also surviving +objects from generations 0 and 1 directly to generation 3. +This caused some prematurely promoted objects to be subjected to +collection less frequently than their ages justified, potentially +resulting in substantial inappropriate storage retention. +This is particularly problematic when side effects result in pointers +from the inappropriately retained objects to younger objects, as +can happen with nonfunctional queues and lazy streams. + +Unless directed to do otherwise, the collector now promotes objects +up only one generation at a time. +That is, generation 0 objects that survive collection are promoted +to generation 1, generation 1 objects are promoted to generation +2, and so on. +(Objects that survive a maximum nonstatic collection are promoted +back into the maximum nonstatic collection.) +Most applications should exhibit lower peak memory usage and possibly +lower run times with this change. +Applications that are adversely affected, if any, might benefit +from a custom collect-request handler or custom values for the +collection parameters that affect the behavior of the default +handler. + \subsection{Unicode Basic Multilingual Plane console I/O in Windows (9.5.3)} Console I/O now supports characters from the Unicode Basic diff --git a/racket/src/ChezScheme/s/7.ss b/racket/src/ChezScheme/s/7.ss index cc9fdf4d3d..84f4acfad3 100644 --- a/racket/src/ChezScheme/s/7.ss +++ b/racket/src/ChezScheme/s/7.ss @@ -795,23 +795,23 @@ (define gc-count 0) (define start-bytes 0) (define docollect - (let ([do-gc (foreign-procedure "(cs)do_gc" (int int ptr) ptr)]) + (let ([do-gc (foreign-procedure "(cs)do_gc" (int int int ptr) ptr)]) (lambda (p) (with-tc-mutex (unless (= $active-threads 1) ($oops 'collect "cannot collect when multiple threads are active")) - (let-values ([(trip g gtarget count-roots) (p gc-trip)]) + (let-values ([(trip g gmintarget gmaxtarget count-roots) (p gc-trip)]) (set! gc-trip trip) (let ([cpu (current-time 'time-thread)] [real (current-time 'time-monotonic)]) (set! gc-bytes (+ gc-bytes (bytes-allocated))) (when (collect-notify) (fprintf (console-output-port) "~%[collecting generation ~s into generation ~s..." - g gtarget) + g gmaxtarget) (flush-output-port (console-output-port))) (when (eqv? g (collect-maximum-generation)) ($clear-source-lines-cache)) - (let ([gc-result (do-gc g gtarget count-roots)]) + (let ([gc-result (do-gc g gmintarget gmaxtarget count-roots)]) ($close-resurrected-files) (when-feature pthreads ($close-resurrected-mutexes&conditions)) @@ -854,14 +854,15 @@ (docollect (lambda (gct) (let ([gct (+ gct 1)]) - (let loop ([g (collect-maximum-generation)]) - (if (= (modulo gct (expt (collect-generation-radix) g)) 0) - (if (fx= g (collect-maximum-generation)) - (values 0 g g #f) - (values gct g (fx+ g 1) #f)) - (loop (fx- g 1))))))))) + (let ([cmg (collect-maximum-generation)]) + (let loop ([g cmg]) + (if (= (modulo gct (expt (collect-generation-radix) g)) 0) + (if (fx= g cmg) + (values 0 g (fxmin g 1) g #f) + (values gct g 1 (fx+ g 1) #f)) + (loop (fx- g 1)))))))))) (define collect2 - (lambda (g gtarget count-roots) + (lambda (g gmintarget gmaxtarget count-roots) (docollect (lambda (gct) (values @@ -875,24 +876,44 @@ (+ gct (modulo (- n gct) n)))) (let ([next (trip g)] [limit (trip (fx+ g 1))]) (if (< next limit) next (- limit 1))))) - g gtarget count-roots))))) + g gmintarget gmaxtarget count-roots))))) (case-lambda [() (collect0)] [(g) - (unless (and (fixnum? g) (fx<= 0 g (collect-maximum-generation))) - ($oops who "invalid generation ~s" g)) - (collect2 g (if (fx= g (collect-maximum-generation)) g (fx+ g 1)) #f)] - [(g gtarget) (collect g gtarget #f)] - [(g gtarget count-roots) - (unless (and (fixnum? g) (fx<= 0 g (collect-maximum-generation))) - ($oops who "invalid generation ~s" g)) - (unless (if (fx= g (collect-maximum-generation)) - (or (eqv? gtarget g) (eq? gtarget 'static)) - (or (eqv? gtarget g) (eqv? gtarget (fx+ g 1)))) - ($oops who "invalid target generation ~s for generation ~s" gtarget g)) + (let ([cmg (collect-maximum-generation)]) + (unless (and (fixnum? g) (fx<= 0 g cmg)) + ($oops who "invalid generation ~s" g)) + (let ([gtarget (if (fx= g cmg) g (fx+ g 1))]) + (collect2 g gtarget gtarget #f)))] + [(g gtarget) + (let ([cmg (collect-maximum-generation)]) + (unless (and (fixnum? g) (fx<= 0 g cmg)) + ($oops who "invalid generation ~s" g)) + (unless (if (fx= g cmg) + (or (eqv? gtarget g) (eq? gtarget 'static)) + (or (eqv? gtarget g) (eqv? gtarget (fx+ g 1)))) + ($oops who "invalid target generation ~s for generation ~s" gtarget g))) + (let ([gtarget (if (eq? gtarget 'static) (constant static-generation) gtarget)]) + (collect2 g gtarget gtarget #f))] + [(g gmintarget gmaxtarget) (collect g gmintarget gmaxtarget #f)] + [(g gmintarget gmaxtarget count-roots) + (let ([cmg (collect-maximum-generation)]) + (unless (and (fixnum? g) (fx<= 0 g cmg)) + ($oops who "invalid generation ~s" g)) + (unless (if (fx= g cmg) + (or (eqv? gmaxtarget g) (eq? gmaxtarget 'static)) + (or (eqv? gmaxtarget g) (eqv? gmaxtarget (fx+ g 1)))) + ($oops who "invalid maximum target generation ~s for generation ~s" gmaxtarget g)) + (unless (or (eqv? gmintarget gmaxtarget) + (and (fixnum? gmintarget) + (fx<= 1 gmintarget (if (fixnum? gmaxtarget) gmaxtarget cmg)))) + ($oops who "invalid minimum target generation ~s for generation ~s and maximum target generation ~s" gmintarget g gmaxtarget))) (unless (or (not count-roots) (list? count-roots)) ($oops who "invalid counting-roots list ~s" count-roots)) - (collect2 g (if (eq? gtarget 'static) (constant static-generation) gtarget) count-roots)]))) + (collect2 g + (if (eq? gmintarget 'static) (constant static-generation) gmintarget) + (if (eq? gmaxtarget 'static) (constant static-generation) gmaxtarget) + count-roots)]))) (set! collect-rendezvous (let ([fire-collector (foreign-procedure "(cs)fire_collector" () void)]) diff --git a/racket/src/ChezScheme/s/mkgc.ss b/racket/src/ChezScheme/s/mkgc.ss index 513ceb5469..1d41b9472d 100644 --- a/racket/src/ChezScheme/s/mkgc.ss +++ b/racket/src/ChezScheme/s/mkgc.ss @@ -78,10 +78,12 @@ ;; inferred for `space-data` ;; * counting-root : check a counting root before pushing to sweep stack ;; - (trace ) : relocate for sweep, copy for copy, recur otherwise -;; - (trace-early ) : relocate for sweep, copy, and mark; recur otherwise -;; - (trace-now ) : direct recur -;; - (trace-early-rtd ) : for record types, avoids recur on #!base-rtd +;; - (trace-pure ) : like `trace`, but no need for generation tracking +;; - (trace-early ) : relocate for sweep, copy, and mark; recur otherwise; implies pure +;; - (trace-now ) : direct recur; implies pure +;; - (trace-early-rtd ) : for record types, avoids recur on #!base-rtd; implies pure ;; - (trace-ptrs ) : trace an array of pointerrs +;; - (trace-pure-ptrs ) : pure analog of `trace-ptrs` ;; - (copy ) : copy for copy, ignore otherwise ;; - (copy-bytes ) : copy an array of bytes ;; - (copy-flonum ) : copy flonum and forward @@ -206,7 +208,7 @@ (copy-clos-code code) (copy-stack-length continuation-stack-length continuation-stack-clength) (copy continuation-stack-clength) - (trace-nonself continuation-winders) + (trace-pure-nonself continuation-winders) (trace-nonself continuation-attachments) (cond [(== (continuation-stack-length _) scaled-shot-1-shot-flag)] @@ -220,7 +222,7 @@ (continuation-stack-clength _))))] [else]) (count countof-stack (continuation-stack-length _) 1 [sweep measure]) - (trace continuation-link) + (trace-pure continuation-link) (trace-return continuation-return-address (continuation-return-address _)) (case-mode [copy (copy continuation-stack)] @@ -258,10 +260,15 @@ [else (mark counting-root) (count countof-closure)])) - (when (or-not-as-dirty - (& (code-type code) (<< code-flag-mutable-closure code-flags-offset))) - (copy-clos-code code) - (trace-ptrs closure-data len)) + (cond + [(and-purity-sensitive-mode + (& (code-type code) (<< code-flag-mutable-closure code-flags-offset))) + (copy-clos-code code) + (trace-ptrs closure-data len)] + [(and-not-as-dirty 1) + (copy-clos-code code) + (trace-pure-ptrs closure-data len)] + [else]) (pad (when (== (& len 1) 0) (set! (closure-data _copy_ len) (FIX 0)))) (count countof-closure)])] @@ -458,8 +465,8 @@ (vspace vspace_impure) ; would be better if we had pure, but these are rare (size size-ratnum) (copy-type ratnum-type) - (trace-immutable-now ratnum-numerator) - (trace-immutable-now ratnum-denominator) + (trace-now ratnum-numerator) + (trace-now ratnum-denominator) (mark) (vfasl-pad-word) (count countof-ratnum)] @@ -469,8 +476,8 @@ (vspace vspace_impure) ; same rationale as ratnum (size size-exactnum) (copy-type exactnum-type) - (trace-immutable-now exactnum-real) - (trace-immutable-now exactnum-imag) + (trace-now exactnum-real) + (trace-now exactnum-imag) (mark) (vfasl-pad-word) (count countof-exactnum)] @@ -519,11 +526,11 @@ (copy-type code-type) (copy code-length) (copy code-reloc) - (trace-nonself code-name) - (trace-nonself code-arity-mask) + (trace-pure-nonself code-name) + (trace-pure-nonself code-arity-mask) (copy code-closure-length) - (trace-nonself code-info) - (trace-nonself code-pinfo*) + (trace-pure-nonself code-info) + (trace-pure-nonself code-pinfo*) (trace-code len)) (count countof-code)] @@ -575,6 +582,12 @@ [else (trace field)])) +(define-trace-macro (trace-pure-nonself field) + (case-mode + [self-test] + [else + (trace-pure field)])) + (define-trace-macro (trace-nonself/vfasl-as-nil field) (case-mode [vfasl-copy @@ -611,7 +624,7 @@ (set! (FWDMARKER cdr_p) forward_marker) (set! (FWDADDRESS cdr_p) new_cdr_p) (case-flag maybe-backreferences? - [on (ADD_BACKREFERENCE_FROM new_cdr_p new_p)] + [on (ADD_BACKREFERENCE_FROM new_cdr_p new_p _tg_)] [off]) (count count-pair size-pair 2)] [else @@ -646,10 +659,6 @@ (constant byte-alignment)) (constant bytes-per-segment)))) -(define-trace-macro (trace-immutable-now ref) - (when (and-not-as-dirty 1) - (trace-now ref))) - (define-trace-macro (trace-code-early code) (unless-code-relocated (case-mode @@ -692,9 +701,8 @@ [(copy measure) (trace ref)] [sweep - (define val : ptr (ref _)) - (trace (just val)) - (set! (ref _) val)] + (trace ref) ; can't trace `val` directly, because we need an impure relocate + (define val : ptr (ref _))] [vfasl-copy (set! (ref _copy_) vfasl-val)] [else])) @@ -705,7 +713,9 @@ (define code : ptr (cond [(Sprocedurep val) (CLOSCODE val)] [else (SYMCODE _)])) - (trace (just code)) + (case-flag as-dirty? + [on (trace (just code))] + [off (trace-pure (just code))]) (INITSYMCODE _ code)] [measure] [vfasl-copy @@ -772,7 +782,7 @@ (case-mode [(sweep self-test) ;; Bignum pointer mask may need forwarding - (trace (record-type-pm rtd)) + (trace-pure (record-type-pm rtd)) (set! num (record-type-pm rtd))] [else])]) (let* ([index : iptr (- (BIGLEN num) 1)] @@ -854,8 +864,8 @@ ;; For max_copied_generation, the list will get copied again in `rtds_with_counts` fixup; ;; meanwhile, allocating in `space_impure` would copy and sweep old list entries causing ;; otherwise inaccessible rtds to be retained - (S_cons_in (cond [(<= grtd max_copied_generation) space_new] [else space_impure]) - (cond [(<= grtd max_copied_generation) 0] [else grtd]) + (S_cons_in (cond [(<= grtd MAX_CG) space_new] [else space_impure]) + (cond [(<= grtd MAX_CG) 0] [else grtd]) c_rtd (array-ref S_G.rtds_with_counts grtd))) (set! (array-ref (array-ref S_G.countof grtd) countof_pair) += 1))] @@ -913,10 +923,10 @@ (measure_add_stack_size (tc-scheme-stack tc) (tc-scheme-stack-size tc))] [else]) (set! (tc-stack-cache tc) Snil) - (trace (tc-cchain tc)) - (trace (tc-stack-link tc)) - (trace (tc-winders tc)) - (trace (tc-attachments tc)) + (trace-pure (tc-cchain tc)) + (trace-pure (tc-stack-link tc)) + (trace-pure (tc-winders tc)) + (trace-pure (tc-attachments tc)) (case-mode [sweep (set! (tc-cached-frame tc) Sfalse)] @@ -933,26 +943,26 @@ (set! (tc-X tc) 0) (set! (tc-Y tc) 0)] [else]) - (trace (tc-threadno tc)) - (trace (tc-current-input tc)) - (trace (tc-current-output tc)) - (trace (tc-current-error tc)) - (trace (tc-sfd tc)) - (trace (tc-current-mso tc)) - (trace (tc-target-machine tc)) - (trace (tc-fxlength-bv tc)) - (trace (tc-fxfirst-bit-set-bv tc)) - (trace (tc-null-immutable-vector tc)) - (trace (tc-null-immutable-fxvector tc)) - (trace (tc-null-immutable-bytevector tc)) - (trace (tc-null-immutable-string tc)) - (trace (tc-compile-profile tc)) - (trace (tc-subset-mode tc)) - (trace (tc-default-record-equal-procedure tc)) - (trace (tc-default-record-hash-procedure tc)) - (trace (tc-compress-format tc)) - (trace (tc-compress-level tc)) - (trace (tc-parameters tc)) + (trace-pure (tc-threadno tc)) + (trace-pure (tc-current-input tc)) + (trace-pure (tc-current-output tc)) + (trace-pure (tc-current-error tc)) + (trace-pure (tc-sfd tc)) + (trace-pure (tc-current-mso tc)) + (trace-pure (tc-target-machine tc)) + (trace-pure (tc-fxlength-bv tc)) + (trace-pure (tc-fxfirst-bit-set-bv tc)) + (trace-pure (tc-null-immutable-vector tc)) + (trace-pure (tc-null-immutable-fxvector tc)) + (trace-pure (tc-null-immutable-bytevector tc)) + (trace-pure (tc-null-immutable-string tc)) + (trace-pure (tc-compile-profile tc)) + (trace-pure (tc-subset-mode tc)) + (trace-pure (tc-default-record-equal-procedure tc)) + (trace-pure (tc-default-record-hash-procedure tc)) + (trace-pure (tc-compress-format tc)) + (trace-pure (tc-compress-level tc)) + (trace-pure (tc-parameters tc)) (case-mode [(sweep) (set! (tc-DSTBV tc) Sfalse) @@ -961,7 +971,7 @@ (let* ([i : INT 0]) (while :? (< i virtual_register_count) - (trace (tc-virtual-registers tc i)) + (trace-pure (tc-virtual-registers tc i)) (set! i += 1))))])) (define-trace-macro (trace-stack base-expr fp-expr ret-expr) @@ -986,10 +996,10 @@ :? (!= mask 0) (set! pp += 1) (when (& mask #x0001) - (trace (* pp))) + (trace-pure (* pp))) (set! mask >>= 1)))] [else - (trace (* (ENTRYNONCOMPACTLIVEMASKADDR oldret))) + (trace-pure (* (ENTRYNONCOMPACTLIVEMASKADDR oldret))) (let* ([num : ptr (ENTRYLIVEMASK oldret)] [index : iptr (BIGLEN num)]) @@ -1002,7 +1012,7 @@ :? (> bits 0) (set! bits -= 1) (set! pp += 1) - (when (& mask 1) (trace (* pp))) + (when (& mask 1) (trace-pure (* pp))) (set! mask >>= 1)))))]))))) (define-trace-macro (trace-return copy-field field) @@ -1023,7 +1033,7 @@ (relocate_code c_p x_si) (set! field (cast ptr (+ (cast uptr c_p) co))))] [else - (trace (just c_p))])) + (trace-pure (just c_p))])) (define-trace-macro (trace-code len) (case-mode @@ -1072,7 +1082,7 @@ [vfasl-sweep (set! obj (vfasl_encode_relocation vfi obj))] [else - (trace (just obj))]) + (trace-pure (just obj))]) (case-mode [sweep (S_set_code_obj "gc" (RELOC_TYPE entry) _ a obj item_off)] @@ -1083,7 +1093,7 @@ (case-mode [sweep (cond - [(&& (== target_generation static_generation) + [(&& (== from_g static_generation) (&& (! S_G.retain_static_relocation) (== 0 (& (code-type _) (<< code_flag_template code_flags_offset))))) (set! (code-reloc _) (cast ptr 0))] @@ -1098,7 +1108,7 @@ (mark_typemod_data_object t n t_si)] [else (let* ([oldt : ptr t]) - (find_room space_data target_generation typemod n t) + (find_room space_data from_g typemod n t) (memcpy_aligned (TO_VOIDP t) (TO_VOIDP oldt) n))]))) (set! (reloc-table-code t) _) (set! (code-reloc _) t)]) @@ -1142,6 +1152,11 @@ [vfasl-copy 1] [else e])) +(define-trace-macro (and-purity-sensitive-mode e) + (case-mode + [sweep e] + [else 0])) + (define-trace-macro (when-vfasl e) (case-mode [(vfasl-copy vfasl-sweep) e] @@ -1320,13 +1335,13 @@ (code (format "static ~a ~a(~aptr p~a)" (case (lookup 'mode config) - [(copy vfasl-copy) "ptr"] + [(copy mark) "IGEN"] + [(vfasl-copy) "ptr"] [(size vfasl-sweep) "uptr"] [(self-test) "IBOOL"] [(sweep) (if (lookup 'as-dirty? config #f) "IGEN" "void")] - [(mark) "void"] [else "void"]) name (case (lookup 'mode config) @@ -1339,11 +1354,15 @@ "vfasl_info *vfi, "] [else ""]) (case (lookup 'mode config) - [(copy mark vfasl-copy) ", seginfo *si"] + [(copy) ", seginfo *si, ptr *dest"] + [(mark vfasl-copy) ", seginfo *si"] [(sweep) - (if (lookup 'as-dirty? config #f) - ", IGEN tg, IGEN youngest" - "")] + (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)"] + [else ", IGEN from_g"])] [else ""])) (let ([body (lambda () @@ -1376,20 +1395,22 @@ "check_triggers(si);" (code-block "ptr new_p;" - "IGEN tg = target_generation;" + "IGEN tg = TARGET_GENERATION(si);" (body) "FWDMARKER(p) = forward_marker;" "FWDADDRESS(p) = new_p;" (and (lookup 'maybe-backreferences? config #f) - "ADD_BACKREFERENCE(p)") - "return new_p;"))] + "ADD_BACKREFERENCE(p, tg);") + "*dest = new_p;" + "return tg;"))] [(mark) (code-block "change = 1;" "check_triggers(si);" (ensure-segment-mark-mask "si" "" '()) (body) - "ADD_BACKREFERENCE(p)")] + "ADD_BACKREFERENCE(p, si->generation);" + "return si->generation;")] [(sweep) (code-block (and (lookup 'maybe-backreferences? config #f) @@ -1522,10 +1543,14 @@ [else #f]) (statements (cdr l) (cons `(copy-extra-rtd ,field) config)))] [`(trace ,field) - (code (trace-statement field config #f) + (code (trace-statement field config #f 'impure) + (statements (cdr l) config))] + [`(trace-pure ,field) + (code (and (not (lookup 'as-dirty? config #f)) + (trace-statement field config #f 'pure)) (statements (cdr l) config))] [`(trace-early ,field) - (code (trace-statement field config #t) + (code (trace-statement field config #t 'pure) (statements (cdr l) (if (symbol? field) (cons `(copy-extra ,field) config) config)))] @@ -1535,15 +1560,16 @@ [(copy) (code-block (format "ptr tmp_p = ~a;" (field-expression field config "p" #f)) - (relocate-statement "tmp_p" config) + (relocate-statement 'pure "tmp_p" config) (format "~a = tmp_p;" (field-expression field config "new_p" #f)))] [(self-test) #f] [(measure vfasl-copy vfasl-sweep) (statements (list `(trace ,field)) config)] [(mark) - (relocate-statement (field-expression field config "p" #t) config)] + (relocate-statement 'pure (field-expression field config "p" #t) config)] [else - (trace-statement field config #f)]) + (and (not (lookup 'as-dirty? config #f)) + (trace-statement field config #f 'pure))]) (statements (cdr l) config))] [`(copy ,field) (code (copy-statement field config) @@ -1599,6 +1625,14 @@ [else (statements (cons `(copy ,field) (cdr l)) config)])] [`(trace-ptrs ,offset ,len) + (statements (cons `(trace-ptrs ,offset ,len impure) + (cdr l)) + config)] + [`(trace-pure-ptrs ,offset ,len) + (statements (cons `(trace-ptrs ,offset ,len pure) + (cdr l)) + config)] + [`(trace-ptrs ,offset ,len ,purity) (case (lookup 'mode config) [(copy vfasl-copy) (statements (cons `(copy-bytes ,offset (* ptr_bytes ,len)) @@ -1609,8 +1643,9 @@ (loop-over-pointers (field-expression offset config "p" #t) len - (trace-statement `(array-ref p_p idx) config #f) - config))] + (trace-statement `(array-ref p_p idx) config #f purity) + config) + (statements (cdr l) config))] [(self-test) (code (loop-over-pointers (field-expression offset config "p" #t) @@ -1743,7 +1778,8 @@ [(copy) (unless (null? (cdr l)) (error 'skip-forwarding "not at end")) - (code "return new_p;")] + (code "*dest = new_p;" + "return tg;")] [else (statements (cdr l) config)])] [`(mark . ,flags) @@ -1813,7 +1849,7 @@ (cond [(equal? tst "1") (if else? - (code-block "else" rhs) + (code "else" (code-block rhs)) rhs)] [else (code (format "~aif (~a)" (if else? "else " "") tst) @@ -1902,6 +1938,7 @@ [`_tg_ (case (lookup 'mode config) [(copy) "tg"] + [(mark) "TARGET_GENERATION(si)"] [else "target_generation"])] [`_backreferences?_ (if (lookup 'maybe-backreferences? config #f) @@ -2016,14 +2053,14 @@ "for (idx = 0; idx < p_len; idx++)" (code-block body))) - (define (trace-statement field config early?) + (define (trace-statement field config early? purity) (define mode (lookup 'mode config)) (cond [(or (eq? mode 'sweep) (eq? mode 'vfasl-sweep) (and early? (or (eq? mode 'copy) (eq? mode 'mark)))) - (relocate-statement (field-expression field config "p" #t) config)] + (relocate-statement purity (field-expression field config "p" #t) config)] [(or (eq? mode 'copy) (eq? mode 'vfasl-copy)) (copy-statement field config)] @@ -2033,15 +2070,17 @@ (format "if (p == ~a) return 1;" (field-expression field config "p" #f))] [else #f])) - (define (relocate-statement e config) + (define (relocate-statement purity e config) (define mode (lookup 'mode config)) (case mode [(vfasl-sweep) (format "vfasl_relocate(vfi, &~a);" e)] [else (if (lookup 'as-dirty? config #f) - (format "relocate_dirty(&~a, tg, youngest);" e) - (format "relocate(&~a);" e))])) + (begin + (when (eq? purity 'pure) (error 'relocate-statement "pure as dirty?")) + (format "relocate_dirty(&~a, youngest);" e)) + (format "relocate_~a(&~a~a);" purity e (if (eq? purity 'impure) ", from_g" "")))])) (define (measure-statement e) (code @@ -2075,9 +2114,11 @@ [(or (eq? mode modes) (and (pair? modes) (memq mode modes))) (cond [(lookup 'counts? config #f) - (let ([tg (if (eq? real-mode 'copy) - "tg" - "target_generation")]) + (let ([tg (case real-mode + [(copy) "tg"] + [(sweep) "from_g"] + [(mark) "TARGET_GENERATION(si)"] + [else "target_generation"])]) (code (format "S_G.countof[~a][~a] += ~a;" tg (as-c counter) scale) (if (lookup 'constant-size? config #f) @@ -2144,13 +2185,14 @@ "if (seg == end_seg) {" " si->marked_count += p_sz;" "} else {" - " seginfo *mark_si;" + " seginfo *mark_si; IGEN g;" " si->marked_count += ((uptr)build_ptr(seg+1,0)) - addr;" " seg++;" " while (seg < end_seg) {" " mark_si = SegInfo(seg);" - " if (!fully_marked_mask) init_fully_marked_mask();" - " mark_si->marked_mask = fully_marked_mask;" + " g = mark_si->generation;" + " if (!fully_marked_mask[g]) init_fully_marked_mask(g);" + " mark_si->marked_mask = fully_marked_mask[g];" " mark_si->marked_count = segment_bitmap_bytes;" " seg++;" " }" @@ -2239,8 +2281,8 @@ (define (ensure-segment-mark-mask si inset flags) (code (format "~aif (!~a->marked_mask) {" inset si) - (format "~a find_room_voidp(space_data, target_generation, ptr_align(segment_bitmap_bytes), ~a->marked_mask);" - inset si) + (format "~a find_room_voidp(space_data, ~a->generation, ptr_align(segment_bitmap_bytes), ~a->marked_mask);" + inset si si) (if (memq 'no-clear flags) (format "~a /* no clearing needed */" inset) (format "~a memset(~a->marked_mask, 0, segment_bitmap_bytes);" inset si)) @@ -2444,7 +2486,7 @@ (as-dirty? #t))) (sweep1 'symbol) (sweep1 'symbol "sweep_dirty_symbol" '((as-dirty? #t))) - (sweep1 'thread) + (sweep1 'thread "sweep_thread" '((from-g-only-counting? #t))) (sweep1 'port) (sweep1 'port "sweep_dirty_port" '((as-dirty? #t))) (sweep1 'closure "sweep_continuation" '((code-relocated? #t) diff --git a/racket/src/ChezScheme/s/primdata.ss b/racket/src/ChezScheme/s/primdata.ss index 16ed7f7ed3..acb39e3305 100644 --- a/racket/src/ChezScheme/s/primdata.ss +++ b/racket/src/ChezScheme/s/primdata.ss @@ -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) -> (void/list)]] [flags true]) + (collect [sig [() (sub-ufixnum) (sub-ufixnum ptr) (sub-ufixnum ptr ptr) (sub-ufixnum ptr ptr ptr) -> (void)]] [flags true]) (collect-rendezvous [sig [() -> (void)]] [flags]) (collections [sig [() -> (uint)]] [flags unrestricted alloc]) (compile [sig [(sub-ptr) (sub-ptr environment) -> (ptr ...)]] [flags])