diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index 87b77c4921..f5e1c4f6fa 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -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; diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 93bff42e4a..390bf57276 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -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 diff --git a/src/racket/src/mzmark_type.inc b/src/racket/src/mzmark_type.inc index 34dc445785..710375d3a7 100644 --- a/src/racket/src/mzmark_type.inc +++ b/src/racket/src/mzmark_type.inc @@ -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)); diff --git a/src/racket/src/mzmarksrc.c b/src/racket/src/mzmarksrc.c index fd5d147f5b..85487a8de7 100644 --- a/src/racket/src/mzmarksrc.c +++ b/src/racket/src/mzmarksrc.c @@ -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; diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 969b26f9f2..9172ec62a4 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -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; diff --git a/src/racket/src/setjmpup.c b/src/racket/src/setjmpup.c index 567164d5a3..a346aa1e02 100644 --- a/src/racket/src/setjmpup.c +++ b/src/racket/src/setjmpup.c @@ -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); diff --git a/src/racket/src/stypes.h b/src/racket/src/stypes.h index cbe8a3d52c..d859c9f600 100644 --- a/src/racket/src/stypes.h +++ b/src/racket/src/stypes.h @@ -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_ diff --git a/src/racket/src/type.c b/src/racket/src/type.c index a197a2d03a..8a73acd2b0 100644 --- a/src/racket/src/type.c +++ b/src/racket/src/type.c @@ -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);