diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-03-22 15:28:35 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-03-22 15:28:35 +0100 |
commit | d9e59f894e1b41958203ddda7f21f4817cfcfe37 (patch) | |
tree | f0d6b0b38ed000aabf327dba4e281c37c60f92a5 /libguile/debug.c | |
parent | f307fbcec2cbaaa95b8c861395133b519c7519cf (diff) | |
parent | 80540f391498ebb0f955db2fafb6a36ed03b7886 (diff) | |
download | guile-d9e59f894e1b41958203ddda7f21f4817cfcfe37.tar.gz |
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts:
libguile/continuations.c
libguile/gc-freelist.c
libguile/gc-mark.c
libguile/symbols.c
libguile/threads.c
module/ice-9/boot-9.scm
Diffstat (limited to 'libguile/debug.c')
-rw-r--r-- | libguile/debug.c | 28 |
1 files changed, 10 insertions, 18 deletions
diff --git a/libguile/debug.c b/libguile/debug.c index a8ccdf8d3..62378921b 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -42,6 +42,7 @@ #include "libguile/root.h" #include "libguile/fluids.h" #include "libguile/objects.h" +#include "libguile/programs.h" #include "libguile/validate.h" #include "libguile/debug.h" @@ -72,7 +73,9 @@ SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0, SCM_OUT_OF_RANGE (1, setting); } SCM_RESET_DEBUG_MODE; +#ifdef STACK_CHECKING scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P; +#endif scm_debug_eframe_size = 2 * SCM_N_FRAMES; scm_dynwind_end (); @@ -312,6 +315,8 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0, #endif if (scm_is_false (name) && SCM_CLOSUREP (proc)) name = scm_reverse_lookup (SCM_ENV (proc), proc); + if (scm_is_false (name) && SCM_PROGRAM_P (proc)) + name = scm_program_name (proc); return name; } } @@ -440,8 +445,10 @@ scm_reverse_lookup (SCM env, SCM data) return SCM_BOOL_F; } -SCM -scm_start_stack (SCM id, SCM exp, SCM env) +SCM_DEFINE (scm_sys_start_stack, "%start-stack", 2, 0, 0, + (SCM id, SCM thunk), + "Call @var{thunk} on an evaluator stack tagged with @var{id}.") +#define FUNC_NAME s_scm_sys_start_stack { SCM answer; scm_t_debug_frame vframe; @@ -451,27 +458,12 @@ scm_start_stack (SCM id, SCM exp, SCM env) vframe.vect = &vframe_vect_body; vframe.vect[0].id = id; scm_i_set_last_debug_frame (&vframe); - answer = scm_i_eval (exp, env); + answer = scm_call_0 (thunk); scm_i_set_last_debug_frame (vframe.prev); return answer; } - -SCM_SYNTAX(s_start_stack, "start-stack", scm_makacro, scm_m_start_stack); - -static SCM -scm_m_start_stack (SCM exp, SCM env) -#define FUNC_NAME s_start_stack -{ - exp = SCM_CDR (exp); - if (!scm_is_pair (exp) - || !scm_is_pair (SCM_CDR (exp)) - || !scm_is_null (SCM_CDDR (exp))) - SCM_WRONG_NUM_ARGS (); - return scm_start_stack (scm_eval_car (exp, env), SCM_CADR (exp), env); -} #undef FUNC_NAME - /* {Debug Objects} * * The debugging evaluator throws these on frame traps. |