mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

add %default-prompt-tag, and error (not abort()) on an abort to bad tag

Browse source 
* libguile/init.c (scm_i_init_guile): Call scm_init_control after
  initing fluids.
* libguile/control.h (scm_sys_default_prompt_tag): New internal var.
* libguile/control.c (scm_c_abort): If abort is called for an unknown
  tag, raise an exception, except if the tag was the default prompt tag,
  in which case really abort -- to prevent recursion when some other
  patches land.
  (scm_init_control): Define %default-prompt-tag in the default
  environment.
This commit is contained in:
Andy Wingo 2010-02-24 18:55:34 +01:00
parent 29366989cf
commit 3ccee39194
3 changed files with 19 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

17
libguile/control.c
View file

@ -28,6 +28,9 @@
SCM scm_sys_default_prompt_tag;
SCM SCM
scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p, scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p,
scm_t_int64 vm_cookie) scm_t_int64 vm_cookie)
@ -193,10 +196,14 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie)
any code that might throw up. */ any code that might throw up. */
if (scm_is_false (prompt)) if (scm_is_false (prompt))
{ {
/* FIXME: jump to default */ if (scm_is_eq (tag, scm_fluid_ref (scm_sys_default_prompt_tag)))
/* scm_handle_by_message (NULL, key, args); */ {
fprintf (stderr, "No prompt found for abort to default prompt tag!\n");
abort (); abort ();
} }
else
scm_misc_error ("abort", "abort to unknown tag", scm_list_1 (tag));
}
cont = reify_partial_continuation (vm, prompt, winds, cookie); cont = reify_partial_continuation (vm, prompt, winds, cookie);
@ -250,9 +257,13 @@ SCM_DEFINE (scm_at_abort, "@abort", 2, 0, 0, (SCM tag, SCM args),
} }
#undef FUNC_NAME #undef FUNC_NAME
void scm_init_control (void) void
scm_init_control (void)
{ {
#include "control.x" #include "control.x"
scm_sys_default_prompt_tag = scm_make_fluid ();
scm_fluid_set_x (scm_sys_default_prompt_tag, scm_gensym (SCM_UNDEFINED));
scm_c_define ("%default-prompt-tag", scm_sys_default_prompt_tag);
} }
/* /*

3
libguile/control.h
View file

@ -42,6 +42,9 @@ struct scm_prompt_registers
}; };
SCM_INTERNAL SCM scm_sys_default_prompt_tag;
SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p, SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p,
scm_t_int64 cookie); scm_t_int64 cookie);
SCM_INTERNAL SCM scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, SCM_INTERNAL SCM scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,

2
libguile/init.c
View file

@ -470,7 +470,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_async (); /* requires smob_prehistory */ scm_init_async (); /* requires smob_prehistory */
scm_init_boolean (); scm_init_boolean ();
scm_init_chars (); scm_init_chars ();
scm_init_control ();
#ifdef GUILE_DEBUG_MALLOC #ifdef GUILE_DEBUG_MALLOC
scm_init_debug_malloc (); scm_init_debug_malloc ();
#endif #endif
@ -478,6 +477,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_eq (); scm_init_eq ();
scm_init_error (); scm_init_error ();
scm_init_fluids (); scm_init_fluids ();
scm_init_control (); /* requires fluids */
scm_init_feature (); scm_init_feature ();
scm_init_backtrace (); scm_init_backtrace ();
scm_init_fports (); scm_init_fports ();