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

fix potential GC problem with continuation copies

Browse Source 
Merge to 5.3
This commit is contained in:
Matthew Flatt 2012-04-14 21:38:41 -06:00
parent b09870cf7e
commit 2ad41bb669
8 changed files with 81 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -427,7 +427,7 @@ scheme_handle_stack_overflow(Scheme_Object *(*k)(void))
&& SCHEME_CONTP(p->cjs.jumping_to_continuation)) {
Scheme_Cont *c = (Scheme_Cont *)p->cjs.jumping_to_continuation;
p->cjs.jumping_to_continuation = NULL;
scheme_longjmpup(&c->buf);
scheme_longjmpup(&c->buf_ptr->buf);
} else {
/* Continue normal escape: */
scheme_longjmp(scheme_error_buf, 1);
@ -1512,7 +1512,7 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc
/* This continuation is the same as another, except
that its mark stack is different. The different part
of the mark stack won't be visible, so we use the other. */
c = c->buf.cont;
c = c->buf_ptr->buf.cont;
}
if (c->composable) {
@ -1588,7 +1588,7 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc
c->resume_to = thread_end_oflow;
p->stack_start = c->prompt_stack_start;
}
scheme_longjmpup(&c->buf);
scheme_longjmpup(&c->buf_ptr->buf);
} else if (prompt->id
&& (prompt->id == c->prompt_id)
&& !prompt_mc) {
@ -1599,7 +1599,7 @@ Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Sc
if ((!prompt->boundary_overflow_id && !p->overflow)
|| (prompt->boundary_overflow_id
&& (prompt->boundary_overflow_id == p->overflow->id))) {
scheme_longjmpup(&c->buf);
scheme_longjmpup(&c->buf_ptr->buf);
} else {
/* Need to unwind overflows... */
Scheme_Overflow *overflow;

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

@ -4634,6 +4634,7 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
)
{
Scheme_Cont *cont;
Scheme_Cont_Jmp *buf_ptr;
cont = MALLOC_ONE_TAGGED(Scheme_Cont);
cont->so.type = scheme_cont_type;
@ -4645,8 +4646,12 @@ static Scheme_Cont *grab_continuation(Scheme_Thread *p, int for_prompt, int comp
if (composable)
cont->composable = 1;
buf_ptr = MALLOC_ONE_RT(Scheme_Cont_Jmp);
SET_REQUIRED_TAG(buf_ptr->type = scheme_rt_cont_jmp);
cont->buf_ptr = buf_ptr;
scheme_init_jmpup_buf(&cont->buf);
scheme_init_jmpup_buf(&cont->buf_ptr->buf);
cont->prompt_tag = prompt_tag;
if (for_prompt)
cont->dw = NULL;
@ -4953,10 +4958,10 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr
intptr_t done = cont->runstack_copied->runstack_size, size;
sub_cont = cont;
while (sub_cont) {
if (sub_cont->buf.cont
&& (sub_cont->runstack_start == sub_cont->buf.cont->runstack_start)) {
if (sub_cont->buf_ptr->buf.cont
&& (sub_cont->runstack_start == sub_cont->buf_ptr->buf.cont->runstack_start)) {
/* Copy shared part in: */
sub_cont = sub_cont->buf.cont;
sub_cont = sub_cont->buf_ptr->buf.cont;
size = sub_cont->runstack_copied->runstack_size;
if (size) {
/* Skip the first item, since that's the call/cc argument,
@ -5003,7 +5008,7 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr
meta_prompt->boundary_overflow_id = NULL;
{
Scheme_Cont *tc;
for (tc = cont; tc->buf.cont; tc = tc->buf.cont) {
for (tc = cont; tc->buf_ptr->buf.cont; tc = tc->buf_ptr->buf.cont) {
}
meta_prompt->mark_boundary = tc->cont_mark_offset;
}
@ -5013,9 +5018,9 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr
Scheme_Cont *rs_cont = cont;
Scheme_Saved_Stack *saved, *actual;
int delta = 0;
while (rs_cont->buf.cont) {
while (rs_cont->buf_ptr->buf.cont) {
delta += rs_cont->runstack_copied->runstack_size;
rs_cont = rs_cont->buf.cont;
rs_cont = rs_cont->buf_ptr->buf.cont;
if (rs_cont->runstack_copied->runstack_size) {
delta -= 1; /* overlap for not-saved call/cc argument */
}
@ -5042,14 +5047,14 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr
/* For copying cont marks back in, we need a list of sub_conts,
deepest to shallowest: */
copied_cms = cont->cont_mark_offset;
for (sub_cont = cont->buf.cont; sub_cont; sub_cont = sub_cont->buf.cont) {
for (sub_cont = cont->buf_ptr->buf.cont; sub_cont; sub_cont = sub_cont->buf_ptr->buf.cont) {
copied_cms = sub_cont->cont_mark_offset;
sub_conts = scheme_make_raw_pair((Scheme_Object *)sub_cont, sub_conts);
}
if (!shortcut_prompt) {
Scheme_Cont *tc;
for (tc = cont; tc->buf.cont; tc = tc->buf.cont) {
for (tc = cont; tc->buf_ptr->buf.cont; tc = tc->buf_ptr->buf.cont) {
}
p->cont_mark_stack_bottom = tc->cont_mark_offset;
p->cont_mark_pos_bottom = tc->cont_mark_pos_bottom;
@ -5262,10 +5267,10 @@ internal_call_cc (int argc, Scheme_Object *argv[])
cont = MALLOC_ONE_TAGGED(Scheme_Cont);
cont->so.type = scheme_cont_type;
cont->buf.cont = sub_cont;
cont->buf_ptr->buf.cont = sub_cont;
cont->escape_cont = sub_cont->escape_cont;
sub_cont = sub_cont->buf.cont;
sub_cont = sub_cont->buf_ptr->buf.cont;
/* This mark stack won't be restored, but it may be
used by `continuation-marks'. */
@ -5349,7 +5354,7 @@ internal_call_cc (int argc, Scheme_Object *argv[])
prompt_cont = NULL;
barrier_cont = NULL;
if (scheme_setjmpup_relative(&cont->buf, cont, stack_start, sub_cont)) {
if (scheme_setjmpup_relative(&cont->buf_ptr->buf, cont->buf_ptr, stack_start, sub_cont)) {
/* We arrive here when the continuation is applied */
Scheme_Object *result, *extra_marks;
Scheme_Overflow *resume;
@ -5876,7 +5881,7 @@ static Scheme_Object *compose_continuation(Scheme_Cont *cont, int exec_chain,
cont->resume_to = overflow;
cont->empty_to_next_mc = (char)empty_to_next_mc;
scheme_current_thread->stack_start = cont->prompt_stack_start;
scheme_longjmpup(&cont->buf);
scheme_longjmpup(&cont->buf_ptr->buf);
ESCAPED_BEFORE_HERE;
}
@ -6537,9 +6542,9 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
if (!cont->runstack_copied) {
/* Current cont was just a mark-stack variation of
next cont, so skip the next cont. */
cont = cont->buf.cont;
cont = cont->buf_ptr->buf.cont;
}
cont = cont->buf.cont;
cont = cont->buf_ptr->buf.cont;
if (cont)
cdelta = cont->cont_mark_offset;
else

31
src/racket/src/mzmark_type.inc
View File

@ -927,7 +927,7 @@ static int cont_proc_MARK(void *p, struct NewGC *gc) {
gcMARK2(c->native_trace, gc);
#endif
MARK_jmpup(&c->buf, gc);
gcMARK2(c->buf_ptr, gc);
MARK_cjs(&c->cjs, gc);
MARK_stack_state(&c->ss, gc);
gcMARK2(c->barrier_prompt, gc);
@ -969,7 +969,7 @@ static int cont_proc_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(c->native_trace, gc);
#endif
FIXUP_jmpup(&c->buf, gc);
gcFIXUP2(c->buf_ptr, gc);
FIXUP_cjs(&c->cjs, gc);
FIXUP_stack_state(&c->ss, gc);
gcFIXUP2(c->barrier_prompt, gc);
@ -997,6 +997,33 @@ static int cont_proc_FIXUP(void *p, struct NewGC *gc) {
#define cont_proc_IS_CONST_SIZE 1
static int cont_jmp_proc_SIZE(void *p, struct NewGC *gc) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Cont_Jmp));
}
static int cont_jmp_proc_MARK(void *p, struct NewGC *gc) {
Scheme_Cont_Jmp *c = (Scheme_Cont_Jmp *)p;
MARK_jmpup(&c->buf, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Cont_Jmp));
}
static int cont_jmp_proc_FIXUP(void *p, struct NewGC *gc) {
Scheme_Cont_Jmp *c = (Scheme_Cont_Jmp *)p;
FIXUP_jmpup(&c->buf, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Cont_Jmp));
}
#define cont_jmp_proc_IS_ATOMIC 0
#define cont_jmp_proc_IS_CONST_SIZE 1
static int meta_cont_proc_SIZE(void *p, struct NewGC *gc) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Meta_Continuation));

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

@ -367,7 +367,7 @@ cont_proc {
gcMARK2(c->native_trace, gc);
#endif
MARK_jmpup(&c->buf, gc);
gcMARK2(c->buf_ptr, gc);
MARK_cjs(&c->cjs, gc);
MARK_stack_state(&c->ss, gc);
gcMARK2(c->barrier_prompt, gc);
@ -391,6 +391,16 @@ cont_proc {
gcBYTES_TO_WORDS(sizeof(Scheme_Cont));
}
cont_jmp_proc {
mark:
Scheme_Cont_Jmp *c = (Scheme_Cont_Jmp *)p;
MARK_jmpup(&c->buf, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Cont_Jmp));
}
meta_cont_proc {
mark:
Scheme_Meta_Continuation *c = (Scheme_Meta_Continuation *)p;

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

@ -1493,11 +1493,16 @@ typedef struct Scheme_Dynamic_Wind {
struct Scheme_Dynamic_Wind *prev;
} Scheme_Dynamic_Wind;
typedef struct Scheme_Cont_Jmp {
MZTAG_IF_REQUIRED
Scheme_Jumpup_Buf buf;
} Scheme_Cont_Jmp;
typedef struct Scheme_Cont {
Scheme_Object so;
char composable, has_prompt_dw, need_meta_prompt, skip_dws;
struct Scheme_Meta_Continuation *meta_continuation;
Scheme_Jumpup_Buf buf;
Scheme_Cont_Jmp *buf_ptr; /* indirection allows sharing */
Scheme_Dynamic_Wind *dw;
int next_meta;
Scheme_Continuation_Jump_State cjs;

15
src/racket/src/setjmpup.c
View File

@ -354,16 +354,16 @@ void scheme_uncopy_stack(int ok, Scheme_Jumpup_Buf *b, intptr_t *prev)
if (c->cont) {
#ifdef STACK_GROWS_UP
top_delta = (((uintptr_t)c->cont->buf.stack_from
top_delta = (((uintptr_t)c->cont->buf_ptr->buf.stack_from
+ c->cont->buf.stack_size)
- (uintptr_t)c->stack_from);
#else
bottom_delta = ((uintptr_t)c->stack_from
+ c->stack_size
- (uintptr_t)c->cont->buf.stack_from);
- (uintptr_t)c->cont->buf_ptr->buf.stack_from);
top_delta = bottom_delta;
#endif
c = &c->cont->buf;
c = &c->cont->buf_ptr->buf;
} else
c = NULL;
}
@ -518,12 +518,15 @@ int scheme_setjmpup_relative(Scheme_Jumpup_Buf *b, void *base,
but watch out. */
intptr_t same_size;
START_XFORM_SKIP;
same_size = find_same(get_copy(c->buf.stack_copy), c->buf.stack_from, c->buf.stack_size);
same_size = find_same(get_copy(c->buf_ptr->buf.stack_copy),
c->buf_ptr->buf.stack_from,
c->buf_ptr->buf.stack_size);
b->cont = c;
#ifdef STACK_GROWS_UP
start = (void *)((char *)c->buf.stack_from + same_size);
start = (void *)((char *)c->buf_ptr->buf.stack_from + same_size);
#else
start = (void *)((char *)c->buf.stack_from + (c->buf.stack_size - same_size));
start = (void *)((char *)c->buf_ptr->buf.stack_from
+ (c->buf_ptr->buf.stack_size - same_size));
#endif
/* In 3m-mode, we need `start' on a var-stack boundary: */
ALIGN_VAR_STACK(__gc_var_stack__, start);

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

@ -274,6 +274,7 @@ enum {
scheme_rt_rb_node, /* 250 */
scheme_rt_lightweight_cont, /* 251 */
scheme_rt_export_info, /* 252 */
scheme_rt_cont_jmp, /* 253 */
#endif
_scheme_last_type_

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

@ -590,6 +590,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_rt_overflow_jmp, mark_overflow_jmp);
GC_REG_TRAV(scheme_rt_meta_cont, meta_cont_proc);
GC_REG_TRAV(scheme_escaping_cont_type, escaping_cont_proc);
GC_REG_TRAV(scheme_rt_cont_jmp, cont_jmp_proc);
GC_REG_TRAV(scheme_char_type, char_obj);
GC_REG_TRAV(scheme_integer_type, bad_trav);