From 21fc70523409118b12fdf33425a59f6ecaba163d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 22 Jan 2019 05:24:05 -0700 Subject: [PATCH] adjust GC to preserve `eq?` on flonums original commit: d405416eb2ec6d5dd147afc7a2af5a6c2f0a8130 --- c/gc.c | 85 +++++++++++++++++++++++++++++++++++++++++++++-------- c/print.c | 11 +++++-- c/segment.c | 3 ++ c/types.h | 8 +++++ 4 files changed, 91 insertions(+), 16 deletions(-) diff --git a/c/gc.c b/c/gc.c index 498e6ad44d..d8e742fbcf 100644 --- a/c/gc.c +++ b/c/gc.c @@ -119,6 +119,40 @@ uptr list_length(ptr ls) { return i; } +#ifdef PRESERVE_FLONUM_EQ + +static void flonum_set_forwarded(ptr p, seginfo *si) { + uptr delta = (uptr)UNTYPE(p, type_flonum) - (uptr)build_ptr(si->number, 0); + delta >>= log2_ptr_bytes; + if (!si->forwarded_flonums) { + ptr ff; + uptr sz = (bytes_per_segment) >> (3 + log2_ptr_bytes); + find_room(space_data, 0, typemod, ptr_align(sz), ff); + memset(ff, 0, sz); + si->forwarded_flonums = ff; + } + si->forwarded_flonums[delta >> 3] |= (1 << (delta & 0x7)); +} + +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)); + } +} + +# define FLONUM_FWDADDRESS(p) *(ptr*)(UNTYPE(p, type_flonum)) + +# define FORWARDEDP(p, si) ((TYPEBITS(p) == type_flonum) ? flonum_is_forwarded_p(p, si) : (FWDMARKER(p) == forward_marker)) +# define GET_FWDADDRESS(p) ((TYPEBITS(p) == type_flonum) ? FLONUM_FWDADDRESS(p) : FWDADDRESS(p)) +#else +# define FORWARDEDP(p, si) (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) +# define GET_FWDADDRESS(p) FWDADDRESS(p) +#endif + #define relocate(ppp) {\ ptr PP;\ PP = *ppp;\ @@ -151,9 +185,9 @@ uptr list_length(ptr ls) { relocate_help_help(ppp, pp, SI)\ } -#define relocate_help_help(ppp, pp, si) {\ - if (FWDMARKER(pp) == forward_marker && TYPEBITS(pp) != type_flonum)\ - *ppp = FWDADDRESS(pp);\ +#define relocate_help_help(ppp, pp, si) { \ + if (FORWARDEDP(pp, si)) \ + *ppp = GET_FWDADDRESS(pp); \ else\ *ppp = copy(pp, si);\ } @@ -405,8 +439,24 @@ static ptr copy(pp, si) ptr pp; seginfo *si; { find_room(space_data, tg, type_typed_object, size_inexactnum, p); INEXACTNUM_TYPE(p) = type_inexactnum; +# ifdef PRESERVE_FLONUM_EQ + { + ptr pt; + pt = TYPE(&INEXACTNUM_REAL_PART(pp), type_flonum); + if (flonum_is_forwarded_p(pt, si)) + INEXACTNUM_REAL_PART(p) = FLODAT(FLONUM_FWDADDRESS(pt)); + else + INEXACTNUM_REAL_PART(p) = INEXACTNUM_REAL_PART(pp); + pt = TYPE(&INEXACTNUM_IMAG_PART(pp), type_flonum); + if (flonum_is_forwarded_p(pt, si)) + INEXACTNUM_IMAG_PART(p) = FLODAT(FLONUM_FWDADDRESS(pt)); + else + INEXACTNUM_IMAG_PART(p) = INEXACTNUM_IMAG_PART(pp); + } +# else INEXACTNUM_REAL_PART(p) = INEXACTNUM_REAL_PART(pp); INEXACTNUM_IMAG_PART(p) = INEXACTNUM_IMAG_PART(pp); +# endif } else if (TYPEP(tf, mask_bignum, type_bignum)) { iptr n; n = size_bignum(BIGLEN(pp)); @@ -559,7 +609,12 @@ static ptr copy(pp, si) ptr pp; seginfo *si; { #endif /* ENABLE_OBJECT_COUNTS */ find_room(space_data, tg, type_flonum, size_flonum, p); FLODAT(p) = FLODAT(pp); +# ifdef PRESERVE_FLONUM_EQ + flonum_set_forwarded(pp, si); + FLONUM_FWDADDRESS(pp) = p; +# else /* no room for forwarding address, so let 'em be duplicated */ +# endif return p; } else { S_error_abort("copy(gc): illegal type"); @@ -803,8 +858,8 @@ static ptr copy_stack(old, length, clength) ptr old; iptr *length, clength; { if (!(si->space & space_old) || locked(obj)) { \ INITGUARDIANNEXT(ls) = pend_hold_ls; \ pend_hold_ls = ls; \ - } else if (FWDMARKER(obj) == forward_marker && TYPEBITS(obj) != type_flonum) { \ - INITGUARDIANOBJ(ls) = FWDADDRESS(obj); \ + } else if (FORWARDEDP(obj, si)) { \ + INITGUARDIANOBJ(ls) = GET_FWDADDRESS(obj); \ INITGUARDIANNEXT(ls) = pend_hold_ls; \ pend_hold_ls = ls; \ } else { \ @@ -1076,7 +1131,7 @@ void GCENTRY(ptr tc, IGEN mcg, IGEN tg) { representative can't itself be a tconc, so we won't discover any new tconcs at that point. */ ptr obj = GUARDIANOBJ(ls); - if (FWDMARKER(obj) == forward_marker && TYPEBITS(obj) != type_flonum) { + if (FORWARDEDP(obj, SegInfo(ptr_get_segment(obj)))) { /* Object is reachable, so we might as well move this one to the hold list --- via pend_hold_ls, which leads to a copy to move to hold_ls */ @@ -1151,7 +1206,7 @@ void GCENTRY(ptr tc, IGEN mcg, IGEN tg) { for (; ls != Snil; ls = next) { ptr obj = GUARDIANOBJ(ls); next = GUARDIANNEXT(ls); - if (FWDMARKER(obj) == forward_marker && TYPEBITS(obj) != type_flonum) { + if (FORWARDEDP(obj, SegInfo(ptr_get_segment(obj)))) { /* Will defintely move to hold_ls, but the entry must be copied to move from pend_hold_ls to hold_ls: */ @@ -1371,6 +1426,10 @@ void GCENTRY(ptr tc, IGEN mcg, IGEN tg) { if (g == static_generation) S_G.number_of_nonstatic_segments -= 1; si->next = S_G.occupied_segments[s][g]; S_G.occupied_segments[s][g] = si; +#ifdef PRESERVE_FLONUM_EQ + /* any flonums forwarded won't be reference anymore */ + si->forwarded_flonums = NULL; +#endif } else { chunkinfo *chunk = si->chunk; if (si->generation != static_generation) S_G.number_of_nonstatic_segments -= 1; @@ -1474,8 +1533,8 @@ static void forward_or_bwp(pp, p) ptr *pp; ptr p; { seginfo *si; /* adapted from relocate */ if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->space & space_old && !locked(p)) { - if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) { - *pp = FWDADDRESS(p); + if (FORWARDEDP(p, si)) { + *pp = GET_FWDADDRESS(p); } else { *pp = Sbwp_object; } @@ -2225,7 +2284,7 @@ static void resweep_dirty_weak_pairs() { if (si->space & space_old) { if (locked(p)) { youngest = tg; - } else if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) { + } else if (FORWARDEDP(p, si)) { *pp = FWDADDRESS(p); youngest = tg; } else { @@ -2314,7 +2373,7 @@ static void check_ephemeron(ptr pe, int add_to_trigger) { p = Scar(pe); if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && si->space & space_old && !locked(p)) { - if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) { + if (FORWARDEDP(p, si)) { INITCAR(pe) = FWDADDRESS(p); relocate(&INITCDR(pe)) if (!add_to_trigger) @@ -2365,8 +2424,8 @@ static int check_dirty_ephemeron(ptr pe, int tg, int youngest) { p = Scar(pe); if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) { if (si->space & space_old && !locked(p)) { - if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) { - INITCAR(pe) = FWDADDRESS(p); + if (FORWARDEDP(p, si)) { + INITCAR(pe) = GET_FWDADDRESS(p); relocate(&INITCDR(pe)) youngest = tg; } else { diff --git a/c/print.c b/c/print.c index 8a8537f777..45bebd1303 100644 --- a/c/print.c +++ b/c/print.c @@ -34,6 +34,7 @@ static void pvec PROTO((ptr x)); static void pfxvector PROTO((ptr x)); static void pbytevector PROTO((ptr x)); static void pflonum PROTO((ptr x)); +static void pflodat PROTO((double x)); static void pfixnum PROTO((ptr x)); static void pbignum PROTO((ptr x)); static void wrint PROTO((ptr x)); @@ -113,9 +114,9 @@ static void pfile(UNUSED ptr x) { } static void pinexactnum(x) ptr x; { - S_prin1(TYPE(&INEXACTNUM_REAL_PART(x),type_flonum)); + pflodat(INEXACTNUM_REAL_PART(x)); if (INEXACTNUM_IMAG_PART(x) >= 0.0) putchar('+'); - S_prin1(TYPE(&INEXACTNUM_IMAG_PART(x),type_flonum)); + pflodat(INEXACTNUM_IMAG_PART(x)); putchar('i'); } @@ -246,10 +247,14 @@ static void pbytevector(x) ptr x; { } static void pflonum(x) ptr x; { + pflodat(FLODAT(x)); +} + +static void pflodat(x) double x; { char buf[256], *s; /* use snprintf to get it in a string */ - (void) snprintf(buf, 256, "%.16g",FLODAT(x)); + (void) snprintf(buf, 256, "%.16g", x); /* print the silly thing */ printf("%s", buf); diff --git a/c/segment.c b/c/segment.c index 5d44e48835..2cb3bfbef4 100644 --- a/c/segment.c +++ b/c/segment.c @@ -239,6 +239,9 @@ static void initialize_seginfo(seginfo *si, ISPC s, IGEN g) { si->has_triggers = 0; si->trigger_ephemerons = 0; si->trigger_guardians = 0; +#ifdef PRESERVE_FLONUM_EQ + si->forwarded_flonums = NULL; +#endif } iptr S_find_segments(s, g, n) ISPC s; IGEN g; iptr n; { diff --git a/c/types.h b/c/types.h index 3f413dadd9..af9af3efba 100644 --- a/c/types.h +++ b/c/types.h @@ -103,6 +103,10 @@ typedef int IFASLCODE; /* fasl type codes */ }\ } +#ifndef NO_PRESERVE_FLONUM_EQ +# define PRESERVE_FLONUM_EQ +#endif + /* size of protected array used to store roots for the garbage collector */ #define max_protected 100 @@ -128,6 +132,10 @@ typedef struct _seginfo { struct _seginfo *dirty_next; /* pointer to the next seginfo on the DirtySegments list */ ptr trigger_ephemerons; /* ephemerons to re-check if object in segment is copied out */ ptr trigger_guardians; /* guardians to re-check if object in segment is copied out */ +#ifdef PRESERVE_FLONUM_EQ + octet *forwarded_flonums; /* bitmap of flonums whose payload is a forwarding pointer */ + iptr ff_when; +#endif octet dirty_bytes[cards_per_segment]; /* one dirty byte per card */ } seginfo;