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

restore precision for procedure-closure-contents-eq?

Browse Source 
After adding `procedure-specialize`, making
`procedure-closure-contents-eq?` work as before involves
a little extra tracking. I'd prefer to weaken or
even get rid of `procedure-closure-contents-eq?`, but
this adjustment keeps some contract tests passing.
This commit is contained in:
Matthew Flatt 2015-12-23 22:06:18 -07:00
parent 44e1262648
commit ba2eb6487c
4 changed files with 11 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
racket/src/racket/src/fun.c
View File

@ -3377,7 +3377,8 @@ static Scheme_Object *procedure_equal_closure_p(int argc, Scheme_Object *argv[])
Scheme_Native_Closure *c1 = (Scheme_Native_Closure *)v1; Scheme_Native_Closure *c1 = (Scheme_Native_Closure *)v1;
Scheme_Native_Closure *c2 = (Scheme_Native_Closure *)v2; Scheme_Native_Closure *c2 = (Scheme_Native_Closure *)v2;
if (SAME_OBJ(c1->code, c2->code)) { if (SAME_OBJ(c1->code, c2->code)
|| (c1->code->eq_key && SAME_OBJ(c1->code->eq_key, c2->code->eq_key))) {
int i; int i;
i = c1->code->closure_size; i = c1->code->closure_size;
if (i < 0) { if (i < 0) {
@ -3442,6 +3443,11 @@ static Scheme_Object *procedure_specialize(int argc, Scheme_Object *argv[])
if ((nc->code->start_code == scheme_on_demand_jit_code) if ((nc->code->start_code == scheme_on_demand_jit_code)
&& !(SCHEME_NATIVE_CLOSURE_DATA_FLAGS(nc->code) & NATIVE_SPECIALIZED)) { && !(SCHEME_NATIVE_CLOSURE_DATA_FLAGS(nc->code) & NATIVE_SPECIALIZED)) {
Scheme_Native_Closure_Data *data; Scheme_Native_Closure_Data *data;
if (!nc->code->eq_key) {
void *p;
p = scheme_malloc_atomic(sizeof(int));
nc->code->eq_key = p;
}
data = MALLOC_ONE_TAGGED(Scheme_Native_Closure_Data); data = MALLOC_ONE_TAGGED(Scheme_Native_Closure_Data);
memcpy(data, nc->code, sizeof(Scheme_Native_Closure_Data)); memcpy(data, nc->code, sizeof(Scheme_Native_Closure_Data));
SCHEME_NATIVE_CLOSURE_DATA_FLAGS(data) |= NATIVE_SPECIALIZED; SCHEME_NATIVE_CLOSURE_DATA_FLAGS(data) |= NATIVE_SPECIALIZED;

2
racket/src/racket/src/mzmark_jit.inc
View File

@ -158,6 +158,7 @@ static int native_unclosed_proc_MARK(void *p, struct NewGC *gc) {
gcMARK2(d->u.arities, gc); gcMARK2(d->u.arities, gc);
} }
gcMARK2(d->tl_map, gc); gcMARK2(d->tl_map, gc);
gcMARK2(d->eq_key, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0; return 0;
@ -183,6 +184,7 @@ static int native_unclosed_proc_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(d->u.arities, gc); gcFIXUP2(d->u.arities, gc);
} }
gcFIXUP2(d->tl_map, gc); gcFIXUP2(d->tl_map, gc);
gcFIXUP2(d->eq_key, gc);
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
return 0; return 0;

1
racket/src/racket/src/mzmarksrc.c
View File

@ -2511,6 +2511,7 @@ native_unclosed_proc {
gcMARK2(d->u.arities, gc); gcMARK2(d->u.arities, gc);
} }
gcMARK2(d->tl_map, gc); gcMARK2(d->tl_map, gc);
gcMARK2(d->eq_key, gc);
size: size:
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data)); gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data));

1
racket/src/racket/src/schpriv.h
View File

@ -2784,6 +2784,7 @@ typedef struct Scheme_Native_Closure_Data {
/* Thumb code is off by one, need real start for GC */ /* Thumb code is off by one, need real start for GC */
void *retain_code; void *retain_code;
#endif #endif
void *eq_key; /* for `procedure-closure-contents-eq?` */
} Scheme_Native_Closure_Data; } Scheme_Native_Closure_Data;
#define SCHEME_NATIVE_CLOSURE_DATA_FLAGS(obj) MZ_OPT_HASH_KEY(&(obj)->iso) #define SCHEME_NATIVE_CLOSURE_DATA_FLAGS(obj) MZ_OPT_HASH_KEY(&(obj)->iso)