if (!(_cond)) \
return SCM_BOOL_F;
-SCM scm_the_last_stack_fluid_var;
-
static void
display_header (SCM source, SCM port)
{
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
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"
}
#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
#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);
\f
+/* 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);
+}
+
+\f
+
void
scm_i_init_deprecated ()
{
#include "libguile/__scm.h"
#include "libguile/strings.h"
#include "libguile/eval.h"
+#include "libguile/throw.h"
#if (SCM_ENABLE_DEPRECATED == 1)
/* 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);
+
\f
void scm_i_init_deprecated (void);
}
\f
-/* 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);
-}
-
-
-\f
/* body and handler functions for use with any of the above catch variants */
/* This is a body function you can pass to scm_internal_catch if you
#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
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
-;;;; 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
\f
(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))
\f
;;; {Misc}
#: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
default-pre-unwind-handler
handle-system-error
stack-saved?
+ the-last-stack
save-stack)
#:replace (module-ref-submodule module-define-submodule!))
(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
(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
HCoop / bpt / guile.git / commitdiff