restore precision for procedure-closure-contents-eq?
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:
parent
44e1262648
commit
ba2eb6487c
|
@ -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 *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;
|
||||
i = c1->code->closure_size;
|
||||
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)
|
||||
&& !(SCHEME_NATIVE_CLOSURE_DATA_FLAGS(nc->code) & NATIVE_SPECIALIZED)) {
|
||||
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);
|
||||
memcpy(data, nc->code, sizeof(Scheme_Native_Closure_Data));
|
||||
SCHEME_NATIVE_CLOSURE_DATA_FLAGS(data) |= NATIVE_SPECIALIZED;
|
||||
|
|
|
@ -158,6 +158,7 @@ static int native_unclosed_proc_MARK(void *p, struct NewGC *gc) {
|
|||
gcMARK2(d->u.arities, gc);
|
||||
}
|
||||
gcMARK2(d->tl_map, gc);
|
||||
gcMARK2(d->eq_key, gc);
|
||||
|
||||
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
|
||||
return 0;
|
||||
|
@ -183,6 +184,7 @@ static int native_unclosed_proc_FIXUP(void *p, struct NewGC *gc) {
|
|||
gcFIXUP2(d->u.arities, gc);
|
||||
}
|
||||
gcFIXUP2(d->tl_map, gc);
|
||||
gcFIXUP2(d->eq_key, gc);
|
||||
|
||||
# ifdef GC_NO_SIZE_NEEDED_FROM_PROCS
|
||||
return 0;
|
||||
|
|
|
@ -2511,6 +2511,7 @@ native_unclosed_proc {
|
|||
gcMARK2(d->u.arities, gc);
|
||||
}
|
||||
gcMARK2(d->tl_map, gc);
|
||||
gcMARK2(d->eq_key, gc);
|
||||
|
||||
size:
|
||||
gcBYTES_TO_WORDS(sizeof(Scheme_Native_Closure_Data));
|
||||
|
|
|
@ -2784,6 +2784,7 @@ typedef struct Scheme_Native_Closure_Data {
|
|||
/* Thumb code is off by one, need real start for GC */
|
||||
void *retain_code;
|
||||
#endif
|
||||
void *eq_key; /* for `procedure-closure-contents-eq?` */
|
||||
} Scheme_Native_Closure_Data;
|
||||
|
||||
#define SCHEME_NATIVE_CLOSURE_DATA_FLAGS(obj) MZ_OPT_HASH_KEY(&(obj)->iso)
|
||||
|
|
Loading…
Reference in New Issue
Block a user