deprecate the-last-stack

* 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.

libguile/backtrace.c

@@ -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"
+	    "Display a backtrace of the current stack to the current\n"
-	    "to the current output port.  If @var{highlights} is given\n"
+            "output port.  If @var{highlights} is given, it should be\n"
-	    "it should be a list; the elements of this list will be\n"
+	    "a list; the elements of this list will be highlighted\n"
-	    "highlighted wherever they appear in the backtrace.")
+	    "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 stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
-    scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var));
   
   if (SCM_UNBNDP (highlights))
     highlights = SCM_EOL;
 
-  if (scm_is_true (the_last_stack))
+  scm_newline (port);
-    {
+  scm_puts ("Backtrace:\n", port);
-      scm_newline (port);
+  scm_display_backtrace_with_highlights (stack, port, SCM_BOOL_F, SCM_BOOL_F,
-      scm_puts ("Backtrace:\n", port);
+                                         highlights);
-      scm_display_backtrace_with_highlights (the_last_stack,
+  scm_newline (port);
-					     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"
 }
 

libguile/backtrace.h

@@ -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);

libguile/deprecated.c

@@ -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 ()
 {

libguile/deprecated.h

@@ -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);

libguile/throw.c

@@ -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 */
 

libguile/throw.h

@@ -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

module/ice-9/debug.scm

@@ -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}

module/ice-9/debugger.scm

@@ -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

module/ice-9/deprecated.scm

@@ -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

module/ice-9/save-stack.scm

@@ -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