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

adjust initial abort handler

Browse Source 
Clients of scheme_apply(), scheme_eval(), etc. (i.e., the variants
without a leading "_") except aborts to continue jumping out, while
a recent change to make them behavior more like a default prompt
handler caused them to return on errors. Changethe handler to behave
like the default, except that after running a result thunk, the
handler effectively aborts again.
This commit is contained in:
Matthew Flatt 2012-09-07 13:49:17 -06:00
parent ff5ce02744
commit 834f4a5bf3
2 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/racket/cmdline.inc
View File

@ -384,6 +384,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
}
}
} else {
scheme_clear_escape();
exit_val = 1;
p->error_buf = save;
break;
@ -444,6 +445,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
e = SCHEME_CDR(e);
}
} else {
scheme_clear_escape();
exit_val = 1;
p->error_buf = save;
break;
@ -473,6 +475,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
scheme_apply_multi_with_prompt(f, 0, NULL);
}
} else {
scheme_clear_escape();
exit_val = 1;
}
p->error_buf = save;
@ -503,6 +506,7 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
repl(fa->global_env, fa);
exit_val = 0;
} else {
scheme_clear_escape();
exit_val = 1;
#ifndef NO_YIELD_BEFORE_EXIT
fa->a->add_yield = 0;
@ -524,6 +528,8 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
yh = scheme_get_param(scheme_current_config(), MZCONFIG_EXE_YIELD_HANDLER);
yha[0] = scheme_make_integer(exit_val);
scheme_apply(yh, 1, yha);
} else {
scheme_clear_escape();
}
p->error_buf = save;
}

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

@ -1111,19 +1111,16 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread, Schem
{
/* Wraps a function `k' with a handler for stack overflows and
barriers to full-continuation jumps. No barrier if !eb. */
void * v;
Scheme_Prompt * volatile prompt = NULL;
mz_jmp_buf *save;
mz_jmp_buf newbuf;
Scheme_Stack_State envss;
Scheme_Dynamic_State save_dyn_state;
Scheme_Thread * volatile p = scheme_current_thread;
volatile int old_pcc = scheme_prompt_capture_count;
Scheme_Cont_Frame_Data cframe;
volatile int need_final_abort = 0;
#ifdef MZ_PRECISE_GC
void *external_stack;
#endif
@ -1171,11 +1168,13 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread, Schem
if (scheme_setjmp(newbuf)) {
p = scheme_current_thread;
if (SAME_OBJ(p->cjs.jumping_to_continuation, (Scheme_Object *)original_default_prompt)) {
/* an abort to the thread start; act like the default prompt handler */
/* an abort to the thread start; act like the default prompt handler,
but remember to jump again */
p->ku.k.i1 = p->cjs.num_vals;
p->ku.k.p1 = p->cjs.val;
reset_cjs(&p->cjs);
k = apply_again_k;
need_final_abort = 1;
} else {
if (!new_thread) {
scheme_restore_env_stack_w_thread(envss, p);
@ -1229,6 +1228,11 @@ void *scheme_top_level_do_worker(void *(*k)(void), int eb, int new_thread, Schem
if (scheme_active_but_sleeping)
scheme_wake_up();
if (need_final_abort) {
p = scheme_current_thread;
scheme_longjmp(*p->error_buf, 1);
}
return (Scheme_Object *)v;
}