summaryrefslogtreecommitdiff
path: root/libguile/throw.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/throw.c')
-rw-r--r--libguile/throw.c57
1 files changed, 35 insertions, 22 deletions
diff --git a/libguile/throw.c b/libguile/throw.c
index 9c293516d..ae131d0ad 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 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,10 @@ 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;
+ volatile SCM vm, 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 +467,30 @@ 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 ();
+ /* These two are volatile, so we know we can access them after a
+ nonlocal return to the setjmp. */
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))
+ v_handler = handler;
+
+ /* Push the prompt onto the dynamic stack. */
+ scm_dynstack_push_prompt (dynstack,
+ SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY,
+ sym_pre_init_catch_tag,
+ SCM_VM_DATA (vm)->fp,
+ SCM_VM_DATA (vm)->sp,
+ SCM_VM_DATA (vm)->ip,
+ &registers);
+
+ if (SCM_I_SETJMP (registers))
{
/* nonlocal exit */
SCM args = scm_i_prompt_pop_abort_args_x (vm);
/* 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 +498,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;
}