diff --git a/c/alloc.c b/c/alloc.c index f79c9f5b99..4562d50663 100644 --- a/c/alloc.c +++ b/c/alloc.c @@ -168,6 +168,10 @@ ptr S_compute_bytes_allocated(xg, xs) ptr xg; ptr xs; { return Sunsigned(n); } +ptr S_bytes_finalized() { + return Sunsigned(S_G.bytes_finalized); +} + static void maybe_fire_collector() { ISPC s; uptr bytes, fudge; diff --git a/c/externs.h b/c/externs.h index 79c2302305..87e646aafe 100644 --- a/c/externs.h +++ b/c/externs.h @@ -64,6 +64,7 @@ extern void S_protect PROTO((ptr *p)); extern void S_reset_scheme_stack PROTO((ptr tc, iptr n)); extern void S_reset_allocation_pointer PROTO((ptr tc)); extern ptr S_compute_bytes_allocated PROTO((ptr xg, ptr xs)); +extern ptr S_bytes_finalized PROTO(()); extern ptr S_find_more_room PROTO((ISPC s, IGEN g, iptr n, ptr old)); extern void S_dirty_set PROTO((ptr *loc, ptr x)); extern void S_scan_dirty PROTO((ptr **p, ptr **endp)); diff --git a/c/gc.c b/c/gc.c index 1e14812abe..746081ab4e 100644 --- a/c/gc.c +++ b/c/gc.c @@ -21,8 +21,6 @@ #endif /* WIN32 */ #include "popcount.h" -#define enable_object_counts do_not_use_enable_object_counts_in_this_file_use_ifdef_ENABLE_OBJECT_COUNTS_instead - /* locally defined functions */ static uptr list_length PROTO((ptr ls)); static ptr copy_list PROTO((ptr ls, IGEN tg)); @@ -66,6 +64,7 @@ static void sanitize_locked_segment PROTO((seginfo *si)); #ifdef ENABLE_OBJECT_COUNTS static uptr total_size_so_far(); #endif +static uptr target_generation_space_so_far(); #ifdef ENABLE_MEASURE static void init_measure(IGEN min_gen, IGEN max_gen); @@ -360,6 +359,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { seginfo *oldspacesegments, *si, *nextsi; ptr ls, younger_locked_objects; bucket_pointer_list *buckets_to_rebuild; + uptr pre_finalization_size; #ifdef ENABLE_OBJECT_COUNTS ptr count_roots_counts = Snil; iptr count_roots_len; @@ -633,6 +633,8 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { sweep_generation(tc, tg); + 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 obj, rep, tconc, next; @@ -843,6 +845,8 @@ 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; + /* handle weak pairs */ resweep_dirty_weak_pairs(); resweep_weak_pairs(tg); @@ -898,8 +902,10 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { /* 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; + int count = 0; for (g = 0; g <= mcg; 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->space & space_old) || locked(si, p)) { @@ -1855,6 +1861,20 @@ static uptr total_size_so_far() { } #endif +static uptr target_generation_space_so_far() { + IGEN g = target_generation; + ISPC s; + uptr sz = S_G.phantom_sizes[g]; + + 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 += (char *)S_G.next_loc[s][g] - (char *)S_G.base_loc[s][g]; + } + + return sz; +} + /* **************************************** */ #ifdef ENABLE_MEASURE diff --git a/c/gcwrapper.c b/c/gcwrapper.c index ed3852bd0b..60ec3872cd 100644 --- a/c/gcwrapper.c +++ b/c/gcwrapper.c @@ -411,8 +411,11 @@ ptr S_object_backreferences(void) { */ void Scompact_heap() { ptr tc = get_thread_context(); + 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_G.enable_object_counts = eoc; S_pants_down -= 1; } diff --git a/c/globals.h b/c/globals.h index 92cfe40875..0eaa26bd87 100644 --- a/c/globals.h +++ b/c/globals.h @@ -137,6 +137,7 @@ EXTERN struct S_G_struct { ptr gcbackreference[static_generation+1]; uptr phantom_sizes[static_generation+1]; IGEN prcgeneration; + uptr bytes_finalized; /* intern.c */ iptr oblist_length; diff --git a/c/prim.c b/c/prim.c index 8904a3605d..705520b1f3 100644 --- a/c/prim.c +++ b/c/prim.c @@ -170,6 +170,7 @@ void S_prim_init() { Sforeign_symbol("(cs)fixedpathp", (void *)S_fixedpathp); Sforeign_symbol("(cs)bytes_allocated", (void *)S_compute_bytes_allocated); + Sforeign_symbol("(cs)bytes_finalized", (void *)S_bytes_finalized); Sforeign_symbol("(cs)curmembytes", (void *)S_curmembytes); Sforeign_symbol("(cs)maxmembytes", (void *)S_maxmembytes); Sforeign_symbol("(cs)resetmaxmembytes", (void *)S_resetmaxmembytes); diff --git a/csug/system.stex b/csug/system.stex index f425ffa019..bfd3c80a55 100644 --- a/csug/system.stex +++ b/csug/system.stex @@ -4829,6 +4829,18 @@ still in use or not, can be obtained by summing \scheme{(bytes-deallocated)} and \scheme{(bytes-allocated)} and possibly subtracting \scheme{(initial-bytes-allocated)}. +%---------------------------------------------------------------------------- +\entryheader +\formdef{bytes-finalized}{\categoryprocedure}{(bytes-finalized)} +\returns the number of bytes queued in guardians +\listlibraries +\endentryheader + +The number of bytes associated with objects that were registered in +guardians as otherwise inaccessible (including the bytes for objects +reachable only through registered objects) during the most recent +garbage collection. + %---------------------------------------------------------------------------- \entryheader \formdef{current-memory-bytes}{\categoryprocedure}{(current-memory-bytes)} diff --git a/makefiles/Mf-install.in b/makefiles/Mf-install.in index b207e3c76e..b1d5cab17e 100644 --- a/makefiles/Mf-install.in +++ b/makefiles/Mf-install.in @@ -62,7 +62,7 @@ InstallLZ4Target= # no changes should be needed below this point # ############################################################################### -Version=csv9.5.3.25 +Version=csv9.5.3.26 Include=boot/$m PetiteBoot=boot/$m/petite.boot SchemeBoot=boot/$m/scheme.boot diff --git a/s/7.ss b/s/7.ss index 4fe5e1ed41..219280db65 100644 --- a/s/7.ss +++ b/s/7.ss @@ -86,6 +86,13 @@ [(g) (ba (filter-generation g) -1)] [(g s) (ba (if g (filter-generation g) -1) (if s (filter-space s) -1))]))) +(define-who bytes-finalized + (let ([bf (foreign-procedure "(cs)bytes_finalized" + () + scheme-object)]) + (lambda () + (bf)))) + (define $spaces (lambda () (map car (constant real-space-alist)))) (define current-memory-bytes (foreign-procedure "(cs)curmembytes" () uptr)) diff --git a/s/cmacros.ss b/s/cmacros.ss index e5463dd157..38a603b930 100644 --- a/s/cmacros.ss +++ b/s/cmacros.ss @@ -328,7 +328,7 @@ [(_ foo e1 e2) e1] ... [(_ bar e1 e2) e2]))))]))) -(define-constant scheme-version #x09050319) +(define-constant scheme-version #x0905031A) (define-syntax define-machine-types (lambda (x) diff --git a/s/mkgc.ss b/s/mkgc.ss index de6065b8e3..5a49b2e793 100644 --- a/s/mkgc.ss +++ b/s/mkgc.ss @@ -746,37 +746,38 @@ [copy (case-flag counts? [on - (let* ([c_rtd : ptr (cond - [(== _tf_ _) _copy_] - [else rtd])] - [counts : ptr (record-type-counts c_rtd)]) - (cond - [(== counts Sfalse) - (let* ([grtd : IGEN (GENERATION c_rtd)]) - (set! (array-ref (array-ref S_G.countof grtd) countof_rtd_counts) += 1) - ;; Allocate counts struct in same generation as rtd. Initialize timestamp & counts. - (find_room space_data grtd type_typed_object size_rtd_counts counts) - (set! (rtd-counts-type counts) type_rtd_counts) - (set! (rtd-counts-timestamp counts) (array-ref S_G.gctimestamp 0)) - (let* ([g : IGEN 0]) - (while - :? (<= g static_generation) - (set! (rtd-counts-data counts g) 0) - (set! g += 1))) + (when S_G.enable_object_counts + (let* ([c_rtd : ptr (cond + [(== _tf_ _) _copy_] + [else rtd])] + [counts : ptr (record-type-counts c_rtd)]) + (cond + [(== counts Sfalse) + (let* ([grtd : IGEN (GENERATION c_rtd)]) + (set! (array-ref (array-ref S_G.countof grtd) countof_rtd_counts) += 1) + ;; Allocate counts struct in same generation as rtd. Initialize timestamp & counts. + (find_room space_data grtd type_typed_object size_rtd_counts counts) + (set! (rtd-counts-type counts) type_rtd_counts) + (set! (rtd-counts-timestamp counts) (array-ref S_G.gctimestamp 0)) + (let* ([g : IGEN 0]) + (while + :? (<= g static_generation) + (set! (rtd-counts-data counts g) 0) + (set! g += 1))) + (set! (record-type-counts c_rtd) counts) + (set! (array-ref S_G.rtds_with_counts grtd) + ;; this list will get copied again in `rtds_with_counts` fixup + (S_cons_in space_new 0 c_rtd (array-ref S_G.rtds_with_counts grtd))) + (set! (array-ref (array-ref S_G.countof grtd) countof_pair) += 1))] + [else + (trace-early (just counts)) (set! (record-type-counts c_rtd) counts) - (set! (array-ref S_G.rtds_with_counts grtd) - (S_cons_in (cond [(== grtd 0) space_new] [else space_impure]) grtd c_rtd - (array-ref S_G.rtds_with_counts grtd))) - (set! (array-ref (array-ref S_G.countof grtd) countof_pair) += 1))] - [else - (trace-early (just counts)) - (set! (record-type-counts c_rtd) counts) - (when (!= (rtd-counts-timestamp counts) (array-ref S_G.gctimestamp 0)) - (S_fixup_counts counts))]) - (set! (rtd-counts-data counts tg) (+ (rtd-counts-data counts tg) 1)) - ;; Copies size that we've already gathered, but needed for counting from roots: - (when (== p_spc space-count-impure) (set! count_root_bytes += p_sz)) - (count countof-record))] + (when (!= (rtd-counts-timestamp counts) (array-ref S_G.gctimestamp 0)) + (S_fixup_counts counts))]) + (set! (rtd-counts-data counts tg) (+ (rtd-counts-data counts tg) 1)))) + ;; Copies size that we may have already gathered, but needed for counting from roots: + (when (== p_spc space-count-impure) (set! count_root_bytes += p_sz)) + (count countof-record)] [off])] [else])) diff --git a/s/primdata.ss b/s/primdata.ss index 520fbf9f0c..61ac6036d1 100644 --- a/s/primdata.ss +++ b/s/primdata.ss @@ -1165,6 +1165,7 @@ (bwp-object? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (bytes-allocated [sig [() -> (uint)] [(ptr) -> (uint)] [(ptr maybe-sub-symbol) -> (uint)]] [flags alloc]) (bytes-deallocated [sig [() -> (uint)]] [flags unrestricted alloc]) + (bytes-finalized [sig [() -> (uint)]] [flags unrestricted alloc]) (bytevector [sig [(u8/s8 ...) -> (bytevector)]] [flags alloc cp02]) (bytevector->s8-list [sig [(bytevector) -> (list)]] [flags alloc]) (bytevector-truncate! [sig [(bytevector length) -> (bytevector)]] [flags true])