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

adjust GC to preserve eq? on flonums

Browse Source 
original commit: d405416eb2ec6d5dd147afc7a2af5a6c2f0a8130
This commit is contained in:
Matthew Flatt 2019-01-22 05:24:05 -07:00
parent 6e999d02c3
commit 21fc705234
4 changed files with 91 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
c/gc.c
View File

@ -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;\
@ -152,8 +186,8 @@ uptr list_length(ptr ls) {
}
#define relocate_help_help(ppp, pp, si) { \
if (FWDMARKER(pp) == forward_marker && TYPEBITS(pp) != type_flonum)\
*ppp = FWDADDRESS(pp);\
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 {

11
c/print.c
View File

@ -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);

3
c/segment.c
View File

@ -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; {

8
c/types.h
View File

@ -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;