diff options
Diffstat (limited to 'libguile/throw.c')
-rw-r--r-- | libguile/throw.c | 68 |
1 files changed, 43 insertions, 25 deletions
diff --git a/libguile/throw.c b/libguile/throw.c index 7fc9edff7..244bcf153 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -322,16 +322,22 @@ scm_handle_by_proc_catching_all (void *handler_data, SCM tag, SCM throw_args) int scm_exit_status (SCM args) { - if (!SCM_NULL_OR_NIL_P (args)) + if (scm_is_pair (args)) { SCM cqa = SCM_CAR (args); if (scm_is_integer (cqa)) return (scm_to_int (cqa)); else if (scm_is_false (cqa)) - return 1; + return EXIT_FAILURE; + else + return EXIT_SUCCESS; } - return 0; + else if (scm_is_null (args)) + return EXIT_SUCCESS; + else + /* A type error. Strictly speaking we shouldn't get here. */ + return EXIT_FAILURE; } @@ -364,7 +370,7 @@ handler_message (void *handler_data, SCM tag, SCM args) if (should_print_backtrace (tag, stack)) { - scm_puts ("Backtrace:\n", p); + scm_puts_unlocked ("Backtrace:\n", p); scm_display_backtrace_with_highlights (stack, p, SCM_BOOL_F, SCM_BOOL_F, SCM_EOL); @@ -450,7 +456,11 @@ SCM_SYMBOL (sym_pre_init_catch_tag, "%pre-init-catch-tag"); static SCM pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler) { - SCM vm, prompt, res; + struct scm_vm *vp; + volatile SCM v_handler; + SCM res; + scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack; + scm_i_jmp_buf registers; /* Only handle catch-alls without pre-unwind handlers */ if (!SCM_UNBNDP (pre_unwind_handler)) @@ -458,22 +468,34 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler) if (scm_is_false (scm_eqv_p (tag, SCM_BOOL_T))) abort (); - vm = scm_the_vm (); - prompt = scm_c_make_prompt (sym_pre_init_catch_tag, - SCM_VM_DATA (vm)->fp, SCM_VM_DATA (vm)->sp, - SCM_VM_DATA (vm)->ip, 1, -1, scm_i_dynwinds ()); - scm_i_set_dynwinds (scm_cons (prompt, SCM_PROMPT_DYNWINDS (prompt))); - - if (SCM_PROMPT_SETJMP (prompt)) + /* These two are volatile, so we know we can access them after a + nonlocal return to the setjmp. */ + vp = scm_the_vm (); + v_handler = handler; + + /* Push the prompt onto the dynamic stack. */ + scm_dynstack_push_prompt (dynstack, + SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY + | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS, + sym_pre_init_catch_tag, + vp->fp - vp->stack_base, + vp->sp - vp->stack_base, + vp->ip, + ®isters); + + if (SCM_I_SETJMP (registers)) { /* nonlocal exit */ - SCM args = scm_i_prompt_pop_abort_args_x (vm); + SCM args; + /* vp is not volatile */ + vp = scm_the_vm (); + args = scm_i_prompt_pop_abort_args_x (vp); /* cdr past the continuation */ - return scm_apply_0 (handler, scm_cdr (args)); + return scm_apply_0 (v_handler, scm_cdr (args)); } res = scm_call_0 (thunk); - scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ())); + scm_dynstack_pop (dynstack); return res; } @@ -481,14 +503,10 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler) static int find_pre_init_catch (void) { - SCM winds; - - /* Search the wind list for an appropriate prompt. - "Waiter, please bring us the wind list." */ - for (winds = scm_i_dynwinds (); scm_is_pair (winds); winds = SCM_CDR (winds)) - if (SCM_PROMPT_P (SCM_CAR (winds)) - && scm_is_eq (SCM_PROMPT_TAG (SCM_CAR (winds)), sym_pre_init_catch_tag)) - return 1; + if (scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack, + sym_pre_init_catch_tag, + NULL, NULL, NULL, NULL, NULL)) + return 1; return 0; } @@ -497,7 +515,7 @@ static SCM pre_init_throw (SCM k, SCM args) { if (find_pre_init_catch ()) - return scm_at_abort (sym_pre_init_catch_tag, scm_cons (k, args)); + return scm_abort_to_prompt_star (sym_pre_init_catch_tag, scm_cons (k, args)); else { static int error_printing_error = 0; |