From a8fc2d55b3007c351c8b6b737afe06dcb34b84a2 Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Tue, 16 Feb 2010 16:46:25 +0000 Subject: [PATCH] Add convenient wrappers to scheme_extract_one_cc_mark_with_meta svn: r18098 --- src/mzscheme/src/eval.c | 9 ++------- src/mzscheme/src/fun.c | 36 ++++++++++++++++++++++++------------ src/mzscheme/src/schpriv.h | 7 ++----- 3 files changed, 28 insertions(+), 24 deletions(-) diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index b563b3b40b..c640ffb774 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -8180,14 +8180,9 @@ static Scheme_Prompt *lookup_cont_prompt(Scheme_Cont *c, { Scheme_Prompt *prompt; - prompt = (Scheme_Prompt *)scheme_extract_one_cc_mark_with_meta(NULL, - SCHEME_PTR_VAL(c->prompt_tag), - NULL, - _prompt_mc, - _prompt_pos); + prompt = scheme_get_prompt(SCHEME_PTR_VAL(c->prompt_tag), _prompt_mc, _prompt_pos); if (!prompt && !SAME_OBJ(scheme_default_prompt_tag, c->prompt_tag)) { - scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, - msg); + scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, msg); } return prompt; diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index 06783af495..b2a3a21a44 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -178,6 +178,10 @@ static Scheme_Object *current_prompt_read(int, Scheme_Object **); static Scheme_Object *write_compiled_closure(Scheme_Object *obj); static Scheme_Object *read_compiled_closure(Scheme_Object *obj); +static Scheme_Object * +scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key, + Scheme_Object *prompt_tag, Scheme_Meta_Continuation **_meta, + MZ_MARK_POS_TYPE *_vpos); typedef void (*DW_PrePost_Proc)(void *); @@ -5598,8 +5602,7 @@ internal_call_cc (int argc, Scheme_Object *argv[]) composable = (argc > 2); - prompt = (Scheme_Prompt *)scheme_extract_one_cc_mark_with_meta(NULL, SCHEME_PTR_VAL(prompt_tag), - NULL, &prompt_cont, &prompt_pos); + prompt = scheme_get_prompt(SCHEME_PTR_VAL(prompt_tag), &prompt_cont, &prompt_pos); if (!prompt && !SAME_OBJ(scheme_default_prompt_tag, prompt_tag)) { scheme_arg_mismatch((composable ? "call-with-composable-continuation" @@ -5862,11 +5865,21 @@ call_with_continuation_barrier (int argc, Scheme_Object *argv[]) Scheme_Prompt *scheme_get_barrier_prompt(Scheme_Meta_Continuation **_meta_cont, MZ_MARK_POS_TYPE *_pos) { - return (Scheme_Prompt *)scheme_extract_one_cc_mark_with_meta(NULL, - barrier_prompt_key, - NULL, - _meta_cont, - _pos); + return (Scheme_Prompt *)scheme_extract_one_cc_mark_with_meta(NULL, barrier_prompt_key, NULL, _meta_cont, _pos); +} + +Scheme_Prompt *scheme_get_prompt(Scheme_Object *prompt_tag, + Scheme_Meta_Continuation **_meta_cont, + MZ_MARK_POS_TYPE *_pos) +{ + return (Scheme_Prompt *)scheme_extract_one_cc_mark_with_meta(NULL, prompt_tag, NULL, _meta_cont, _pos); +} + +static Scheme_Meta_Continuation *scheme_get_meta_continuation(Scheme_Object *key) +{ + Scheme_Meta_Continuation *mc; + scheme_extract_one_cc_mark_with_meta(NULL, key, NULL, &mc, NULL); + return mc; } @@ -7135,7 +7148,7 @@ cont_marks(int argc, Scheme_Object *argv[]) return NULL; } else { Scheme_Meta_Continuation *mc; - scheme_extract_one_cc_mark_with_meta(NULL, argv[0], NULL, &mc, NULL); + mc = scheme_get_meta_continuation(argv[0]); return continuation_marks(scheme_current_thread, NULL, argv[0], mc, prompt_tag, "continuation-marks", 0); @@ -7416,7 +7429,7 @@ extract_cc_proc_marks(int argc, Scheme_Object *argv[]) return scheme_get_stack_trace(argv[0]); } -Scheme_Object * +static Scheme_Object * scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key, Scheme_Object *prompt_tag, Scheme_Meta_Continuation **_meta, MZ_MARK_POS_TYPE *_vpos) @@ -7649,8 +7662,7 @@ extract_one_cc_mark(int argc, Scheme_Object *argv[]) } } - r = scheme_extract_one_cc_mark_with_meta(SCHEME_TRUEP(argv[0]) ? argv[0] : NULL, argv[1], - prompt_tag, NULL, NULL); + r = scheme_extract_one_cc_mark_to_tag(SCHEME_TRUEP(argv[0]) ? argv[0] : NULL, argv[1], prompt_tag); if (!r) { if (argc > 2) r = argv[2]; @@ -7697,7 +7709,7 @@ static Scheme_Object *continuation_prompt_available(int argc, Scheme_Object *arg if (SAME_OBJ(scheme_default_prompt_tag, prompt_tag)) return scheme_true; - scheme_extract_one_cc_mark_with_meta(NULL, argv[1], NULL, &mc, NULL); + mc = scheme_get_meta_continuation(argv[1]); if (continuation_marks(scheme_current_thread, NULL, argv[1], mc, prompt_tag, NULL, 0)) diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 54487f5a2b..e006fd44a9 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -1386,11 +1386,6 @@ typedef struct Scheme_Prompt { /* Compiler helper: */ #define ESCAPED_BEFORE_HERE return NULL -Scheme_Object *scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, - Scheme_Object *key, - Scheme_Object *prompt_tag, - Scheme_Meta_Continuation **_meta_cont, - MZ_MARK_POS_TYPE *_pos); Scheme_Object *scheme_compose_continuation(Scheme_Cont *c, int num_rands, Scheme_Object *value); Scheme_Overflow *scheme_get_thread_end_overflow(void); void scheme_end_current_thread(void); @@ -1401,6 +1396,8 @@ void scheme_drop_prompt_meta_continuations(Scheme_Object *prompt_tag); struct Scheme_Prompt *scheme_get_barrier_prompt(struct Scheme_Meta_Continuation **_meta_cont, MZ_MARK_POS_TYPE *_pos); +Scheme_Prompt *scheme_get_prompt(Scheme_Object *prompt_tag, Scheme_Meta_Continuation **_meta_cont, + MZ_MARK_POS_TYPE *_pos); int scheme_is_cm_deeper(struct Scheme_Meta_Continuation *m1, MZ_MARK_POS_TYPE p1, struct Scheme_Meta_Continuation *m2, MZ_MARK_POS_TYPE p2); void scheme_recheck_prompt_and_barrier(struct Scheme_Cont *c);