mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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

38
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,
scm_display_backtrace_with_highlights (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);
}
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

5
module/ice-9/debug.scm
View file

@ -1,4 +1,4 @@
;;;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2006 Free Software Foundation
;;;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2006, 2010 Free Software Foundation
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -20,7 +20,8 @@
(define-module (ice-9 debug)
:export (frame-number->index trace untrace trace-stack untrace-stack))
#:use-module (ice-9 save-stack)
#:export (frame-number->index trace untrace trace-stack untrace-stack))
;;; {Misc}

1
module/ice-9/debugger.scm
View file

@ -22,6 +22,7 @@
#:use-module (ice-9 debugger utils)
#:use-module (ice-9 debugging traps)
#:use-module (ice-9 scm-style-repl)
#:use-module (ice-9 save-stack)
#:use-module (ice-9 format)
#:export (debug-stack
debug

11
module/ice-9/deprecated.scm
View file

@ -61,6 +61,7 @@
default-pre-unwind-handler
handle-system-error
stack-saved?
the-last-stack
save-stack)
#:replace (module-ref-submodule module-define-submodule!))
@ -654,6 +655,16 @@ the `(system repl common)' module.")
(identifier? #'id)
#'(@ (ice-9 save-stack) stack-saved?))))))
(define-syntax the-last-stack
(lambda (x)
(issue-deprecation-warning
"`the-last-stack' is deprecated. Use it from `(ice-9 save-stack)'
if you need it.")
(syntax-case x ()
(id
(identifier? #'id)
#'(@ (ice-9 save-stack) the-last-stack)))))
(define (save-stack . args)
(issue-deprecation-warning
"`save-stack' is deprecated. Use it from `(ice-9 save-stack)' if you need

3
module/ice-9/save-stack.scm
View file

@ -32,11 +32,14 @@
(define-module (ice-9 save-stack)
;; Replace deprecated root-module bindings, if present.
#:replace (stack-saved?
the-last-stack
save-stack))
;; FIXME: stack-saved? is broken in the presence of threads.
(define stack-saved? #f)
(define the-last-stack (make-fluid))
(define (save-stack . narrowing)
(if (not stack-saved?)
(begin