mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

deprecate the-last-stack

Browse source 
* libguile/backtrace.h (scm_the_last_stack_fluid_var)
* libguile/backtrace.c (scm_init_backtrace): No more
  scm_the_last_stack_fluid_var. The replacement is to resolve
  `the-last-stack' in (ice-9 stack-catch).
  (scm_backtrace_with_highlights): Accordingly, instead of backtracing
  the last stack, backtrace the current stack.

* libguile/throw.h:
* libguile/throw.c:
* libguile/deprecated.h:
* libguile/deprecated.c (scm_internal_stack_catch): Deprecate this
  function.

* module/ice-9/save-stack.scm (the-last-stack): Move here from boot-9.

* module/ice-9/debug.scm:
* module/ice-9/debugger.scm: Use (ice-9 save-stack) for the-last-stack.

* module/ice-9/deprecated.scm (the-last-stack): Add deprecated shim.
This commit is contained in:
Andy Wingo 2010-06-19 13:43:33 +02:00
parent a0d57eedfa
commit ec16eb7847
10 changed files with 89 additions and 92 deletions
Download patch file Download diff file Expand all files Collapse all files

48
libguile/backtrace.c
View file

@ -71,8 +71,6 @@
if (!(_cond)) \
return SCM_BOOL_F;
SCM scm_the_last_stack_fluid_var;
static void
display_header (SCM source, SCM port)
{
@ -662,43 +660,24 @@ SCM_VARIABLE (scm_has_shown_backtrace_hint_p_var, "has-shown-backtrace-hint?");
SCM_DEFINE (scm_backtrace_with_highlights, "backtrace", 0, 1, 0,
(SCM highlights),
"Display a backtrace of the stack saved by the last error\n"
"to the current output port. If @var{highlights} is given\n"
"it should be a list; the elements of this list will be\n"
"highlighted wherever they appear in the backtrace.")
"Display a backtrace of the current stack to the current\n"
"output port. If @var{highlights} is given, it should be\n"
"a list; the elements of this list will be highlighted\n"
"wherever they appear in the backtrace.")
#define FUNC_NAME s_scm_backtrace_with_highlights
{
SCM port = scm_current_output_port ();
SCM the_last_stack =
scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var));
SCM stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
if (SCM_UNBNDP (highlights))
highlights = SCM_EOL;
if (scm_is_true (the_last_stack))
{
scm_newline (port);
scm_puts ("Backtrace:\n", port);
scm_display_backtrace_with_highlights (the_last_stack,
port,
SCM_BOOL_F,
SCM_BOOL_F,
highlights);
scm_newline (port);
if (scm_is_false (SCM_VARIABLE_REF (scm_has_shown_backtrace_hint_p_var))
&& !SCM_BACKTRACE_P)
{
scm_puts ("Type \"(debug-enable 'backtrace)\" if you would like "
"a backtrace\n"
"automatically if an error occurs in the future.\n",
port);
SCM_VARIABLE_SET (scm_has_shown_backtrace_hint_p_var, SCM_BOOL_T);
}
}
else
{
scm_puts ("No backtrace available.\n", port);
}
scm_newline (port);
scm_puts ("Backtrace:\n", port);
scm_display_backtrace_with_highlights (stack, port, SCM_BOOL_F, SCM_BOOL_F,
highlights);
scm_newline (port);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -714,9 +693,6 @@ scm_backtrace (void)
void
scm_init_backtrace ()
{
SCM f = scm_make_fluid ();
scm_the_last_stack_fluid_var = scm_c_define ("the-last-stack", f);
#include "libguile/backtrace.x"
}

4
libguile/backtrace.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_BACKTRACE_H
#define SCM_BACKTRACE_H
/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006, 2008, 2010 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
@ -25,8 +25,6 @@
#include "libguile/__scm.h"
SCM_API SCM scm_the_last_stack_fluid_var;
SCM_API void scm_display_error_message (SCM message, SCM args, SCM port);
SCM_INTERNAL void scm_i_display_error (SCM stack, SCM port, SCM subr,
SCM message, SCM args, SCM rest);

49
libguile/deprecated.c
View file

@ -1937,6 +1937,55 @@ scm_badargsp (SCM formals, SCM args)
/* scm_internal_stack_catch
Use this one if you want debugging information to be stored in
the-last-stack on error. */
static SCM
ss_handler (void *data SCM_UNUSED, SCM tag, SCM throw_args)
{
/* In the stack */
scm_fluid_set_x (scm_variable_ref
(scm_c_module_lookup
(scm_c_resolve_module ("ice-9 save-stack"),
"the-last-stack")),
scm_make_stack (SCM_BOOL_T, SCM_EOL));
/* Throw the error */
return scm_throw (tag, throw_args);
}
struct cwss_data
{
SCM tag;
scm_t_catch_body body;
void *data;
};
static SCM
cwss_body (void *data)
{
struct cwss_data *d = data;
return scm_c_with_throw_handler (d->tag, d->body, d->data, ss_handler, NULL, 0);
}
SCM
scm_internal_stack_catch (SCM tag,
scm_t_catch_body body,
void *body_data,
scm_t_catch_handler handler,
void *handler_data)
{
struct cwss_data d;
d.tag = tag;
d.body = body;
d.data = body_data;
scm_c_issue_deprecation_warning
("`scm_internal_stack_catch' is deprecated. Talk to guile-devel if you see this message.");
return scm_internal_catch (tag, cwss_body, &d, handler, handler_data);
}
void
scm_i_init_deprecated ()
{

8
libguile/deprecated.h
View file

@ -26,6 +26,7 @@
#include "libguile/__scm.h"
#include "libguile/strings.h"
#include "libguile/eval.h"
#include "libguile/throw.h"
#if (SCM_ENABLE_DEPRECATED == 1)
@ -630,6 +631,13 @@ SCM_DEPRECATED SCM scm_dynamic_args_call (SCM symb, SCM dobj, SCM args);
/* Deprecated 2010-05-12, no replacement */
SCM_DEPRECATED int scm_badargsp (SCM formals, SCM args);
/* Deprecated 2010-06-19, use call-with-error-handling instead */
SCM_DEPRECATED SCM scm_internal_stack_catch (SCM tag,
scm_t_catch_body body,
void *body_data,
scm_t_catch_handler handler,
void *handler_data);
void scm_i_init_deprecated (void);

44
libguile/throw.c
View file

@ -252,50 +252,6 @@ scm_c_with_throw_handler (SCM tag,
return scm_with_throw_handler (tag, sbody, shandler);
}
/* scm_internal_stack_catch
Use this one if you want debugging information to be stored in
scm_the_last_stack_fluid_var on error. */
static SCM
ss_handler (void *data SCM_UNUSED, SCM tag, SCM throw_args)
{
/* Save the stack */
scm_fluid_set_x (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var),
scm_make_stack (SCM_BOOL_T, SCM_EOL));
/* Throw the error */
return scm_throw (tag, throw_args);
}
struct cwss_data
{
SCM tag;
scm_t_catch_body body;
void *data;
};
static SCM
cwss_body (void *data)
{
struct cwss_data *d = data;
return scm_c_with_throw_handler (d->tag, d->body, d->data, ss_handler, NULL, 0);
}
SCM
scm_internal_stack_catch (SCM tag,
scm_t_catch_body body,
void *body_data,
scm_t_catch_handler handler,
void *handler_data)
{
struct cwss_data d;
d.tag = tag;
d.body = body;
d.data = body_data;
return scm_internal_catch (tag, cwss_body, &d, handler, handler_data);
}
/* body and handler functions for use with any of the above catch variants */

8
libguile/throw.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_THROW_H
#define SCM_THROW_H
/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 2010 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
@ -52,12 +52,6 @@ SCM_API SCM scm_internal_catch (SCM tag,
scm_t_catch_handler handler,
void *handler_data);
SCM_API SCM scm_internal_stack_catch (SCM tag,
scm_t_catch_body body,
void *body_data,
scm_t_catch_handler handler,
void *handler_data);
/* The first argument to scm_body_thunk should be a pointer to one of
these. See the implementation of catch in throw.c. */
struct scm_body_thunk_data