From a106c50798aa6d51690cf50032043dec5a7799ba Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 15 May 2020 11:20:39 -0600 Subject: [PATCH] gc repairs * Fix calculation of segment index for 32-bit platforms * Fix allocation of mark-bit and list-bit arrays in certain unusual cases. * Fix dirty sweep of records on marked pages that have non-pointer fields. * Fix allocation of eveen-sized immobile vectors; a pad word needs to be cleared. * Fix and extend the heap checker (which was used to find several of the other problems). original commit: 8b5e65f5eafac5aea7394901e1dd2f2fc3ccf2bd --- c/Mf-ti3osx | 2 +- c/externs.h | 2 +- c/gc.c | 26 ++++++++--------- c/gcwrapper.c | 79 +++++++++++++++++++++++++++++++++++++++++++++++---- c/prim5.c | 5 ++++ c/types.h | 2 +- mats/misc.ms | 2 +- 7 files changed, 94 insertions(+), 24 deletions(-) diff --git a/c/Mf-ti3osx b/c/Mf-ti3osx index 254f2757c2..26a3fb2655 100644 --- a/c/Mf-ti3osx +++ b/c/Mf-ti3osx @@ -17,7 +17,7 @@ m = ti3osx Cpu = I386 mdclib = -liconv -lm ${ncursesLib} -C = ${CC} ${CPPFLAGS} -m32 -Wpointer-arith -Wall -Wextra -Wno-implicit-fallthrough -Werror -O2 -msse2 -I/opt/X11/include/ ${CFLAGS} +C = ${CC} ${CPPFLAGS} -m32 -Wpointer-arith -Wall -Wextra -Wno-implicit-fallthrough -Werror -g -O2 -msse2 -I/opt/X11/include/ ${CFLAGS} o = o mdsrc = i3le.c mdobj = i3le.o diff --git a/c/externs.h b/c/externs.h index e02e01635c..8bb84c9272 100644 --- a/c/externs.h +++ b/c/externs.h @@ -168,7 +168,7 @@ extern void S_immobilize_object PROTO((ptr v)); extern void S_mobilize_object PROTO((ptr v)); extern ptr S_unregister_guardian PROTO((ptr tconc)); extern void S_compact_heap PROTO((void)); -extern void S_check_heap PROTO((IBOOL aftergc)); +extern void S_check_heap PROTO((IBOOL aftergc, IGEN target_gen)); /* gc-ocd.c */ extern ptr S_gc_ocd PROTO((ptr tc, IGEN mcg, IGEN tg, ptr count_roots)); diff --git a/c/gc.c b/c/gc.c index c04259859a..3a627f8a21 100644 --- a/c/gc.c +++ b/c/gc.c @@ -239,11 +239,11 @@ static ptr sweep_from; #if ptr_alignment == 2 # define record_full_marked_mask 0x55 -# define record_high_marked_mask 0x40 +# define record_high_marked_bit 0x40 # define mask_bits_to_list_bits_mask(m) ((m) | ((m) << 1)) #elif ptr_alignment == 1 # define record_full_marked_mask 0xFF -# define record_high_marked_mask 0x80 +# define record_high_marked_bit 0x80 # define mask_bits_to_list_bits_mask(m) (m) #endif @@ -273,7 +273,7 @@ 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, 0, 0xFF); + init_mask(fully_marked_mask, target_generation, 0xFF); } #ifdef PRESERVE_FLONUM_EQ @@ -287,11 +287,8 @@ static void flonum_set_forwarded(ptr p, seginfo *si) { static int flonum_is_forwarded_p(ptr p, seginfo *si) { if (!si->forwarded_flonums) return 0; - else { - uptr delta = (uptr)UNTYPE(p, type_flonum) - (uptr)build_ptr(si->number, 0); - delta >>= log2_ptr_bytes; - return si->forwarded_flonums[delta >> 3] & (1 << (delta & 0x7)); - } + else + return si->forwarded_flonums[segment_bitmap_byte(p)] & segment_bitmap_bit(p); } # define FLONUM_FWDADDRESS(p) *(ptr*)(UNTYPE(p, type_flonum)) @@ -539,7 +536,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { } /* perform after ScanDirty */ - if (S_checkheap) S_check_heap(0); + if (S_checkheap) S_check_heap(0, mcg); #ifdef DEBUG (void)printf("mcg = %x; go? ", mcg); (void)fflush(stdout); (void)getc(stdin); @@ -639,7 +636,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { seginfo *si = SegInfo(ptr_get_segment(p)); if (si->space == space_new) { if (!si->marked_mask) - init_mask(si->marked_mask, 0, 0); + init_mask(si->marked_mask, tg, 0); si->marked_mask[segment_bitmap_byte(p)] |= segment_bitmap_bit(p); } } @@ -1207,7 +1204,7 @@ ptr GCENTRY(ptr tc, IGEN mcg, IGEN tg, ptr count_roots_ls) { S_flush_instruction_cache(tc); - if (S_checkheap) S_check_heap(1); + if (S_checkheap) S_check_heap(1, mcg); /* post-collection rehashing of tlcs. must come after any use of relocate. @@ -1659,7 +1656,7 @@ static void sweep_dirty(void) { if (si->marked_mask[byte-1] == record_full_marked_mask) { /* next byte is full, so keep looking */ byte--; - } else if (si->marked_mask[byte-1] & record_high_marked_mask) { + } else if (si->marked_mask[byte-1] & record_high_marked_bit) { /* next byte continues, but is not full, so we can start there */ if (at_seg != seg) { @@ -1671,6 +1668,7 @@ static void sweep_dirty(void) { si = SegInfo(at_seg); } else { byte--; + bit = record_high_marked_bit; /* find bit contiguous with highest bit */ while (si->marked_mask[byte] & (bit >> ptr_alignment)) bit >>= ptr_alignment; @@ -2080,14 +2078,14 @@ void copy_and_clear_list_bits(seginfo *oldspacesegments, IGEN tg) { } else { if (si->marked_mask) { /* Besides marking or copying `si->list_bits`, clear bits - where there's no corresopnding mark bit, so we don't try to + where there's no corresponding mark bit, so we don't try to check forwarding in a future GC */ seginfo *bits_si = SegInfo(ptr_get_segment((ptr)si->list_bits)); if (bits_si->old_space) { if (bits_si->use_marks) { if (!bits_si->marked_mask) - init_mask(bits_si->marked_mask, 0, 0); + init_mask(bits_si->marked_mask, tg, 0); bits_si->marked_mask[segment_bitmap_byte((ptr)si->list_bits)] |= segment_bitmap_bit((ptr)si->list_bits); } else { octet *copied_bits; diff --git a/c/gcwrapper.c b/c/gcwrapper.c index 06a9309674..bbd4f4ea02 100644 --- a/c/gcwrapper.c +++ b/c/gcwrapper.c @@ -22,6 +22,7 @@ static void check_heap_dirty_msg PROTO((char *msg, ptr *x)); static IBOOL dirty_listedp PROTO((seginfo *x, IGEN from_g, IGEN to_g)); static void check_dirty_space PROTO((ISPC s)); static void check_dirty PROTO((void)); +static void check_locked_object PROTO((ptr p, IBOOL locked, IGEN g, IBOOL aftergc, IGEN mcg)); static IBOOL checkheap_noisy; @@ -510,6 +511,8 @@ static void segment_tell(seg) uptr seg; { else { printf(" space-%s", spacename[s1]); if (si->old_space) printf(" oldspace"); + if (si->must_mark) printf(" mustmark"); + if (si->marked_mask) printf(" marked"); } printf("\n"); } @@ -534,7 +537,7 @@ static void check_heap_dirty_msg(msg, x) char *msg; ptr *x; { printf("to "); segment_tell(addr_get_segment(*x)); } -void S_check_heap(aftergc) IBOOL aftergc; { +void S_check_heap(aftergc, mcg) IBOOL aftergc; IGEN mcg; { uptr seg; INT d; ISPC s; IGEN g; IDIRTYBYTE dirty; IBOOL found_eos; IGEN pg; ptr p, *pp1, *pp2, *nl; iptr i; @@ -573,6 +576,10 @@ void S_check_heap(aftergc) IBOOL aftergc; { 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) { + if (si->generation != g) { + S_checkheap_errors += 1; + printf("!!! segment in wrong occupied_segments list\n"); + } nonstatic_segments += 1; } } @@ -619,8 +626,11 @@ void S_check_heap(aftergc) IBOOL aftergc; { s = si->space; g = si->generation; + if (si->use_marks) + printf("!!! use_marks set on generation %d segment %#tx\n", g, (ptrdiff_t)seg); + if (s == space_new) { - if (g != 0) { + if (g != 0 && !si->marked_mask) { S_checkheap_errors += 1; printf("!!! unexpected generation %d segment %#tx in space_new\n", g, (ptrdiff_t)seg); } @@ -654,9 +664,18 @@ void S_check_heap(aftergc) IBOOL aftergc; { || psi->old_space || (psi->marked_mask && !(psi->marked_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p)))) { S_checkheap_errors += 1; - printf("!!! dangling reference at %#tx to %#tx\n", (ptrdiff_t)pp1, (ptrdiff_t)p); + printf("!!! dangling reference at %#tx to %#tx%s\n", (ptrdiff_t)pp1, (ptrdiff_t)p, (aftergc ? " after gc" : "")); printf("from: "); segment_tell(seg); printf("to: "); segment_tell(ptr_get_segment(p)); + { + ptr l; + for (l = S_G.locked_objects[psi->generation]; l != Snil; l = Scdr(l)) + if (Scar(l) == p) + printf(" in locked\n"); + for (l = S_G.unlocked_objects[psi->generation]; l != Snil; l = Scdr(l)) + if (Scar(l) == p) + printf(" in unlocked\n"); + } } } } @@ -745,8 +764,9 @@ void S_check_heap(aftergc) IBOOL aftergc; { if (aftergc && (s != space_empty) && (g == 0 - || (s != space_impure && s != space_symbol && s != space_port && s != space_weakpair && s != space_ephemeron - && s != space_impure_record && s != space_immobile_impure && s != space_count_impure && s != space_closure))) { + || (s != space_new && s != space_impure && s != space_symbol && s != space_port && s != space_weakpair && s != space_ephemeron + && s != space_impure_record && s != space_impure_typed_object + && s != space_immobile_impure && s != space_count_impure && s != space_closure))) { for (d = 0; d < cards_per_segment; d += 1) { if (si->dirty_bytes[d] != 0xff) { S_checkheap_errors += 1; @@ -760,6 +780,21 @@ void S_check_heap(aftergc) IBOOL aftergc; { chunk = chunk->next; } } + + { + for (g = 0; g <= S_G.max_nonstatic_generation; INCRGEN(g)) { + ptr l; + for (l = S_G.locked_objects[g]; l != Snil; l = Scdr(l)) + check_locked_object(Scar(l), 1, g, aftergc, mcg); + for (l = S_G.unlocked_objects[g]; l != Snil; l = Scdr(l)) + check_locked_object(Scar(l), 0, g, aftergc, mcg); + } + } + + if (S_checkheap_errors) { + printf("heap check failed%s\n", (aftergc ? " after gc" : "")); + exit(1); + } } static IBOOL dirty_listedp(seginfo *x, IGEN from_g, IGEN to_g) { @@ -826,7 +861,9 @@ static void check_dirty() { S_checkheap_errors += 1; printf("!!! (check_dirty): dirty byte = %d for segment %#tx in %d -> %d dirty list\n", mingval, (ptrdiff_t)(si->number), from_g, to_g); } - if (s != space_new && s != space_impure && s != space_symbol && s != space_port && s != space_impure_record && s != space_weakpair && s != space_ephemeron) { + if (s != space_new && s != space_impure && s != space_symbol && s != space_port + && s != space_impure_record && s != space_impure_typed_object && s != space_immobile_impure + && s != space_weakpair && s != space_ephemeron) { S_checkheap_errors += 1; printf("!!! (check_dirty): unexpected space %d for dirty segment %#tx\n", s, (ptrdiff_t)(si->number)); } @@ -842,10 +879,40 @@ static void check_dirty() { check_dirty_space(space_impure_record); check_dirty_space(space_weakpair); check_dirty_space(space_ephemeron); + check_dirty_space(space_immobile_impure); fflush(stdout); } +static void check_locked_object(ptr p, IBOOL locked, IGEN g, IBOOL aftergc, IGEN mcg) +{ + const char *what = (locked ? "locked" : "unlocked"); + seginfo *psi = MaybeSegInfo(ptr_get_segment(p)); + if (!psi) { + S_checkheap_errors += 1; + printf("!!! generation %d %s object has no segment: %p\n", g, what, p); + } else { + if (psi->generation != g) { + S_checkheap_errors += 1; + printf("!!! generation %d %s object in generation %d segment: %p\n", g, what, psi->generation, p); + } + if (!psi->must_mark && locked) { + S_checkheap_errors += 1; + printf("!!! generation %d %s object not on must-mark page: %p\n", g, what, p); + } + if (!psi->marked_mask) { + if (aftergc && (psi->generation <= mcg)) { + S_checkheap_errors += 1; + printf("!!! %s object not in marked segment: %p\n", what, p); + printf(" in: "); segment_tell(psi->number); + } + } else if (!(psi->marked_mask[segment_bitmap_byte(p)] & segment_bitmap_bit(p))) { + S_checkheap_errors += 1; + printf("!!! generation %d %s object not marked: %p\n", g, what, p); + } + } +} + void S_fixup_counts(ptr counts) { IGEN g; U64 timestamp; diff --git a/c/prim5.c b/c/prim5.c index 2f7872eedc..6ef4de1ec0 100644 --- a/c/prim5.c +++ b/c/prim5.c @@ -222,6 +222,11 @@ static ptr s_make_immobile_vector(uptr len, ptr fill) { for (i = 0; i < len; i++) INITVECTIT(v, i) = fill; + if (!(len & 0x1)) { + /* pad, since we're not going to copy on a GC */ + INITVECTIT(v, len) = FIX(0); + } + return v; } diff --git a/c/types.h b/c/types.h index e7994f33bb..0172681629 100644 --- a/c/types.h +++ b/c/types.h @@ -115,7 +115,7 @@ typedef int IFASLCODE; /* fasl type codes */ #define ptr_get_segment(p) (((uptr)(p) + typemod - 1) >> segment_offset_bits) #define segment_bitmap_bytes (bytes_per_segment >> (log2_ptr_bytes+3)) -#define segment_bitmap_index(p) ((((uptr)(p) + (typemod-1)) & (bytes_per_segment - 1)) >> log2_ptr_bytes) +#define segment_bitmap_index(p) ((((uptr)(p) + (typemod-1)) & ~(typemod-1) & (bytes_per_segment - 1)) >> log2_ptr_bytes) #define segment_bitmap_byte(p) (segment_bitmap_index(p) >> 3) #define segment_bitmap_bits(p, b) ((uptr)(b) << (segment_bitmap_index(p) & 0x7)) #define segment_bitmap_bit(p) segment_bitmap_bits(p,1) diff --git a/mats/misc.ms b/mats/misc.ms index 89f31652e8..5f0727b6fc 100644 --- a/mats/misc.ms +++ b/mats/misc.ms @@ -5299,7 +5299,7 @@ (mat compacting ;; try to provoke the GC into putting a record into marked - ;; (insteda of copied) space and check the write barrier there + ;; (instead of copied) space and check the write barrier there (let loop ([N 2]) (or (= N 8192) (let sel-loop ([sels (list car cadr)])