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

Add convenient wrappers to scheme_extract_one_cc_mark_with_meta

Browse Source 
svn: r18098
This commit is contained in:
Kevin Tew 2010-02-16 16:46:25 +00:00
parent da6b25befa
commit a8fc2d55b3
3 changed files with 28 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/mzscheme/src/eval.c
View File

@ -8180,14 +8180,9 @@ static Scheme_Prompt *lookup_cont_prompt(Scheme_Cont *c,
{ {
Scheme_Prompt *prompt; Scheme_Prompt *prompt;
prompt = (Scheme_Prompt *)scheme_extract_one_cc_mark_with_meta(NULL, prompt = scheme_get_prompt(SCHEME_PTR_VAL(c->prompt_tag), _prompt_mc, _prompt_pos);
SCHEME_PTR_VAL(c->prompt_tag),
NULL,
_prompt_mc,
_prompt_pos);
if (!prompt && !SAME_OBJ(scheme_default_prompt_tag, c->prompt_tag)) { if (!prompt && !SAME_OBJ(scheme_default_prompt_tag, c->prompt_tag)) {
scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, msg);
msg);
} }
return prompt; return prompt;

36
src/mzscheme/src/fun.c
View File

@ -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 *write_compiled_closure(Scheme_Object *obj);
static Scheme_Object *read_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 *); typedef void (*DW_PrePost_Proc)(void *);
@ -5598,8 +5602,7 @@ internal_call_cc (int argc, Scheme_Object *argv[])
composable = (argc > 2); composable = (argc > 2);
prompt = (Scheme_Prompt *)scheme_extract_one_cc_mark_with_meta(NULL, SCHEME_PTR_VAL(prompt_tag), prompt = scheme_get_prompt(SCHEME_PTR_VAL(prompt_tag), &prompt_cont, &prompt_pos);
NULL, &prompt_cont, &prompt_pos);
if (!prompt && !SAME_OBJ(scheme_default_prompt_tag, prompt_tag)) { if (!prompt && !SAME_OBJ(scheme_default_prompt_tag, prompt_tag)) {
scheme_arg_mismatch((composable scheme_arg_mismatch((composable
? "call-with-composable-continuation" ? "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, Scheme_Prompt *scheme_get_barrier_prompt(Scheme_Meta_Continuation **_meta_cont,
MZ_MARK_POS_TYPE *_pos) MZ_MARK_POS_TYPE *_pos)
{ {
return (Scheme_Prompt *)scheme_extract_one_cc_mark_with_meta(NULL, return (Scheme_Prompt *)scheme_extract_one_cc_mark_with_meta(NULL, barrier_prompt_key, NULL, _meta_cont, _pos);
barrier_prompt_key, }
NULL,
_meta_cont, Scheme_Prompt *scheme_get_prompt(Scheme_Object *prompt_tag,
_pos); 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; return NULL;
} else { } else {
Scheme_Meta_Continuation *mc; 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, return continuation_marks(scheme_current_thread, NULL, argv[0], mc, prompt_tag,
"continuation-marks", 0); "continuation-marks", 0);
@ -7416,7 +7429,7 @@ extract_cc_proc_marks(int argc, Scheme_Object *argv[])
return scheme_get_stack_trace(argv[0]); 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_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key,
Scheme_Object *prompt_tag, Scheme_Meta_Continuation **_meta, Scheme_Object *prompt_tag, Scheme_Meta_Continuation **_meta,
MZ_MARK_POS_TYPE *_vpos) 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], r = scheme_extract_one_cc_mark_to_tag(SCHEME_TRUEP(argv[0]) ? argv[0] : NULL, argv[1], prompt_tag);
prompt_tag, NULL, NULL);
if (!r) { if (!r) {
if (argc > 2) if (argc > 2)
r = argv[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)) if (SAME_OBJ(scheme_default_prompt_tag, prompt_tag))
return scheme_true; 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, if (continuation_marks(scheme_current_thread, NULL, argv[1], mc, prompt_tag,
NULL, 0)) NULL, 0))

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

@ -1386,11 +1386,6 @@ typedef struct Scheme_Prompt {
/* Compiler helper: */ /* Compiler helper: */
#define ESCAPED_BEFORE_HERE return NULL #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_Object *scheme_compose_continuation(Scheme_Cont *c, int num_rands, Scheme_Object *value);
Scheme_Overflow *scheme_get_thread_end_overflow(void); Scheme_Overflow *scheme_get_thread_end_overflow(void);
void scheme_end_current_thread(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, struct Scheme_Prompt *scheme_get_barrier_prompt(struct Scheme_Meta_Continuation **_meta_cont,
MZ_MARK_POS_TYPE *_pos); 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, 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); struct Scheme_Meta_Continuation *m2, MZ_MARK_POS_TYPE p2);
void scheme_recheck_prompt_and_barrier(struct Scheme_Cont *c); void scheme_recheck_prompt_and_barrier(struct Scheme_Cont *c);