Changed license terms to the plain LGPL thru-out.
[bpt/guile.git] / libguile / backtrace.c
index 5b2c290..4ec2895 100644 (file)
@@ -1,71 +1,50 @@
 /* Printing of backtraces and error messages
- * Copyright (C) 1996, 1997, 1998, 1999 Free Software Foundation
+ * Copyright (C) 1996,1997,1998,1999,2000,2001 Free Software Foundation
  *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
  *
- * This program is distributed in the hope that it will be useful,
+ * This library is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
  *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way.  To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
- *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.
- *
- * The author can be reached at djurfeldt@nada.kth.se
- * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN */
-
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
 
+#if HAVE_CONFIG_H
+#  include <config.h>
+#endif
 
 #include <stdio.h>
 #include <ctype.h>
 
-#include "_scm.h"
+#include "libguile/_scm.h"
 
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
+#ifdef HAVE_IO_H
+#include <io.h>
+#endif
 
-#include "stacks.h"
-#include "srcprop.h"
-#include "genio.h"
-#include "struct.h"
-#include "strports.h"
-#include "throw.h"
-#include "fluids.h"
+#include "libguile/stacks.h"
+#include "libguile/srcprop.h"
+#include "libguile/struct.h"
+#include "libguile/strports.h"
+#include "libguile/throw.h"
+#include "libguile/fluids.h"
+#include "libguile/ports.h"
+#include "libguile/strings.h"
 
-#include "scm_validate.h"
-#include "backtrace.h"
+#include "libguile/validate.h"
+#include "libguile/lang.h"
+#include "libguile/backtrace.h"
+#include "libguile/filesys.h"
 
 /* {Error reporting and backtraces}
  * (A first approximation.)
  * Note that these functions shouldn't generate errors themselves.
  */
 
-#ifndef SCM_RECKLESS
 #undef SCM_ASSERT
 #define SCM_ASSERT(_cond, _arg, _pos, _subr) \
        if (!(_cond)) \
           return SCM_BOOL_F;
-#endif
 
-SCM scm_the_last_stack_fluid;
+SCM scm_the_last_stack_fluid_var;
 
 static void
 display_header (SCM source, SCM port)
 {
-  SCM fname = (SCM_MEMOIZEDP (source)
-              ? scm_source_property (source, scm_sym_filename)
-              : SCM_BOOL_F);
-  if (SCM_STRINGP (fname))
+  if (SCM_MEMOIZEDP (source))
     {
-      scm_prin1 (fname, port, 0);
-      scm_putc (':', port);
-      scm_intprint (SCM_INUM (scm_source_property (source, scm_sym_line)) + 1,
-                   10,
-                   port);
-      scm_putc (':', port);
-      scm_intprint (SCM_INUM (scm_source_property (source, scm_sym_column)) + 1,
-                   10,
-                   port);
+      SCM fname = scm_source_property (source, scm_sym_filename);
+      SCM line = scm_source_property (source, scm_sym_line);
+      SCM col = scm_source_property (source, scm_sym_column);
+
+      /* Dirk:FIXME:: Maybe we should store the _port_ rather than the
+       * filename with the source properties?  Then we could in case of
+       * non-file ports give at least some more details than just
+       * "<unnamed port>". */
+      if (SCM_STRINGP (fname))
+       scm_prin1 (fname, port, 0);
+      else
+       scm_puts ("<unnamed port>", port);
+
+      if (!SCM_FALSEP (line) && !SCM_FALSEP (col))
+       {
+         scm_putc (':', port);
+         scm_intprint (SCM_INUM (line) + 1, 10, port);
+         scm_putc (':', port);
+         scm_intprint (SCM_INUM (col) + 1, 10, port);
+       }
     }
   else
     scm_puts ("ERROR", port);
@@ -109,45 +94,20 @@ display_header (SCM source, SCM port)
 void
 scm_display_error_message (SCM message, SCM args, SCM port)
 {
-  int writingp;
-  char *start;
-  char *p;
-  
-  if (SCM_IMP (message) || !SCM_ROSTRINGP (message) || SCM_IMP (args)
-      || !scm_list_p (args))
+  if (SCM_STRINGP (message) && !SCM_FALSEP (scm_list_p (args)))
     {
-      scm_prin1 (message, port, 0);
-      scm_putc ('\n', port);
-      return;
+      scm_simple_format (port, message, args);
+      scm_newline (port);
+    }
+  else
+    {
+      scm_display (message, port);
+      scm_newline (port);
     }
-
-  SCM_COERCE_SUBSTR (message);
-  start = SCM_ROCHARS (message);
-  for (p = start; *p != '\0'; ++p)
-    if (*p == '%')
-      {
-       if (SCM_IMP (args) || SCM_NCONSP (args))
-         continue;
-       
-       ++p;
-       if (*p == 's')
-         writingp = 0;
-       else if (*p == 'S')
-         writingp = 1;
-       else
-         continue;
-
-       scm_lfwrite (start, p - start - 1, port);
-       scm_prin1 (SCM_CAR (args), port, writingp);
-       args = SCM_CDR (args);
-       start = p + 1;
-      }
-  scm_lfwrite (start, p - start, port);
-  scm_putc ('\n', port);
 }
 
 static void
-display_expression (SCM frame,SCM pname,SCM source,SCM port)
+display_expression (SCM frame, SCM pname, SCM source, SCM port)
 {
   SCM print_state = scm_make_print_state ();
   scm_print_state *pstate = SCM_PRINT_STATE (print_state);
@@ -155,7 +115,7 @@ display_expression (SCM frame,SCM pname,SCM source,SCM port)
   pstate->fancyp = 1;
   pstate->level = 2;
   pstate->length = 3;
-  if (SCM_ROSTRINGP (pname))
+  if (SCM_SYMBOLP (pname) || SCM_STRINGP (pname))
     {
       if (SCM_FRAMEP (frame)
          && SCM_FRAME_EVAL_ARGS_P (frame))
@@ -170,7 +130,7 @@ display_expression (SCM frame,SCM pname,SCM source,SCM port)
          scm_iprin1 (scm_unmemoize (source), port, pstate);
        }
     }
-  else if (SCM_NIMP (source))
+  else if (SCM_MEMOIZEDP (source))
     {
       scm_puts ("In expression ", port);
       pstate->writingp = 1;
@@ -194,8 +154,8 @@ display_error_body (struct display_error_args *a)
 {
   SCM current_frame = SCM_BOOL_F;
   SCM source = SCM_BOOL_F;
-  SCM pname = SCM_BOOL_F;
   SCM prev_frame = SCM_BOOL_F;
+  SCM pname = a->subr;
 
   if (SCM_DEBUGGINGP
       && SCM_STACKP (a->stack)
@@ -204,16 +164,13 @@ display_error_body (struct display_error_args *a)
       current_frame = scm_stack_ref (a->stack, SCM_INUM0);
       source = SCM_FRAME_SOURCE (current_frame);
       prev_frame = SCM_FRAME_PREV (current_frame);
-      if (!SCM_MEMOIZEDP (source)
-         && prev_frame != SCM_BOOL_F)
+      if (!SCM_MEMOIZEDP (source) && !SCM_FALSEP (prev_frame))
        source = SCM_FRAME_SOURCE (prev_frame);
-      if (SCM_FRAME_PROC_P (current_frame)
-         && scm_procedure_p (SCM_FRAME_PROC (current_frame)) == SCM_BOOL_T)
+      if (!SCM_SYMBOLP (pname) && !SCM_STRINGP (pname) && SCM_FRAME_PROC_P (current_frame)
+         && SCM_EQ_P (scm_procedure_p (SCM_FRAME_PROC (current_frame)), SCM_BOOL_T))
        pname = scm_procedure_name (SCM_FRAME_PROC (current_frame));
     }
-  if (!SCM_ROSTRINGP (pname))
-    pname = a->subr;
-  if (SCM_ROSTRINGP (pname) || SCM_MEMOIZEDP (source))
+  if (SCM_SYMBOLP (pname) || SCM_STRINGP (pname) || SCM_MEMOIZEDP (source))
     {
       display_header (source, a->port);
       display_expression (current_frame, pname, source, a->port);
@@ -232,10 +189,10 @@ struct display_error_handler_data {
    Note that it is very important that this handler *doesn't* try to
    print more than the error tag, since the error very probably is
    caused by an erroneous print call-back routine.  If we would
-   tru to print all objects, we would enter an infinite loop. */
+   try to print all objects, we would enter an infinite loop. */
 static SCM
 display_error_handler (struct display_error_handler_data *data,
-                      SCM tag, SCM args)
+                      SCM tag, SCM args SCM_UNUSED)
 {
   SCM print_state = scm_make_print_state ();
   scm_puts ("\nException during displaying of ", data->port);
@@ -246,10 +203,14 @@ display_error_handler (struct display_error_handler_data *data,
   return SCM_UNSPECIFIED;
 }
 
-GUILE_PROC(scm_display_error, "display-error", 6, 0, 0,
-           (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest),
-"")
-#define FUNC_NAME s_scm_display_error
+
+/* The function scm_i_display_error prints out a detailed error message.  This
+ * function will be called directly within libguile to signal error messages.
+ * No parameter checks will be performed by scm_i_display_error.  Thus, User
+ * code should rather use the function scm_display_error.
+ */
+void
+scm_i_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest)
 {
   struct display_error_args a;
   struct display_error_handler_data data;
@@ -262,12 +223,31 @@ GUILE_PROC(scm_display_error, "display-error", 6, 0, 0,
   data.mode = "error";
   data.port = port;
   scm_internal_catch (SCM_BOOL_T,
-                     (scm_catch_body_t) display_error_body, &a,
-                     (scm_catch_handler_t) display_error_handler, &data);
+                     (scm_t_catch_body) display_error_body, &a,
+                     (scm_t_catch_handler) display_error_handler, &data);
+}
+
+
+SCM_DEFINE (scm_display_error, "display-error", 6, 0, 0,
+           (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest),
+           "Display an error message to the output port @var{port}.\n"
+           "@var{stack} is the saved stack for the error, @var{subr} is\n"
+           "the name of the procedure in which the error occurred and\n"
+           "@var{message} is the actual error message, which may contain\n"
+           "formatting instructions. These will format the arguments in\n"
+           "the list @var{args} accordingly.  @var{rest} is currently\n"
+           "ignored.")
+#define FUNC_NAME s_scm_display_error
+{
+  SCM_VALIDATE_OUTPUT_PORT (2, port);
+
+  scm_i_display_error (stack, port, subr, message, args, rest);
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
+
 typedef struct {
   int level;
   int length;
@@ -283,16 +263,20 @@ static print_params_t default_print_params[] = {
 static print_params_t *print_params = default_print_params;
 
 #ifdef GUILE_DEBUG
-GUILE_PROC(scm_set_print_params_x, "set-print-params!", 1, 0, 0,
+SCM_DEFINE (scm_set_print_params_x, "set-print-params!", 1, 0, 0,
            (SCM params),
-"")
+           "Set the print parameters to the values from @var{params}.\n"
+           "@var{params} must be a list of two-element lists which must\n"
+           "hold two integer values.")
 #define FUNC_NAME s_scm_set_print_params_x
 {
-  int i, n = scm_ilength (params);
+  int i;
+  int n;
   SCM ls;
   print_params_t *new_params;
-  SCM_ASSERT (n >= 1, params, SCM_ARG2, FUNC_NAME);
-  for (ls = params; SCM_NIMP (ls); ls = SCM_CDR (ls))
+
+  SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, params, n);
+  for (ls = params; !SCM_NULL_OR_NIL_P (ls); ls = SCM_CDR (ls))
     SCM_ASSERT (scm_ilength (SCM_CAR (params)) == 2
                && SCM_INUMP (SCM_CAAR (ls))
                && SCM_INUM (SCM_CAAR (ls)) >= 0
@@ -301,10 +285,9 @@ GUILE_PROC(scm_set_print_params_x, "set-print-params!", 1, 0, 0,
                params,
                SCM_ARG2,
                s_scm_set_print_params_x);
-  new_params = scm_must_malloc (n * sizeof (print_params_t),
-                               FUNC_NAME);
+  new_params = scm_malloc (n * sizeof (print_params_t));
   if (print_params != default_print_params)
-    scm_must_free (print_params);
+    free (print_params);
   print_params = new_params;
   for (i = 0; i < n; ++i)
     {
@@ -327,11 +310,11 @@ indent (int n, SCM port)
 }
 
 static void
-display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM port,scm_print_state *pstate)
+display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, SCM port, scm_print_state *pstate)
 {
   SCM string;
   int i = 0, n;
-  scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (sport);
+  scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (sport);
   do
     {
       pstate->length = print_params[i].length;
@@ -356,27 +339,27 @@ display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM po
   string = scm_strport_to_string (sport);
   /* Remove control characters */
   for (i = 0; i < n; ++i)
-    if (iscntrl (SCM_CHARS (string)[i]))
-      SCM_CHARS (string)[i] = ' ';
+    if (iscntrl (SCM_STRING_CHARS (string)[i]))
+      SCM_STRING_CHARS (string)[i] = ' ';
   /* Truncate */
   if (indentation + n > SCM_BACKTRACE_WIDTH)
     {
       n = SCM_BACKTRACE_WIDTH - indentation;
-      SCM_CHARS (string)[n - 1] = '$';
+      SCM_STRING_CHARS (string)[n - 1] = '$';
     }
       
-  scm_lfwrite (SCM_CHARS (string), n, port);
+  scm_lfwrite (SCM_STRING_CHARS (string), n, port);
 }
 
 static void
-display_application (SCM frame,int indentation,SCM sport,SCM port,scm_print_state *pstate)
+display_application (SCM frame, int indentation, SCM sport, SCM port, scm_print_state *pstate)
 {
   SCM proc = SCM_FRAME_PROC (frame);
-  SCM name = (SCM_NFALSEP (scm_procedure_p (proc))
+  SCM name = (!SCM_FALSEP (scm_procedure_p (proc))
              ? scm_procedure_name (proc)
              : SCM_BOOL_F);
   display_frame_expr ("[",
-                     scm_cons (SCM_NFALSEP (name) ? name : proc,
+                     scm_cons (!SCM_FALSEP (name) ? name : proc,
                                SCM_FRAME_ARGS (frame)),
                      SCM_FRAME_EVAL_ARGS_P (frame) ? " ..." : "]",
                      indentation,
@@ -385,20 +368,22 @@ display_application (SCM frame,int indentation,SCM sport,SCM port,scm_print_stat
                      pstate);
 }
 
-GUILE_PROC(scm_display_application, "display-application", 1, 2, 0, 
+SCM_DEFINE (scm_display_application, "display-application", 1, 2, 0, 
            (SCM frame, SCM port, SCM indent),
-"")
+           "Display a procedure application @var{frame} to the output port\n"
+           "@var{port}. @var{indent} specifies the indentation of the\n"
+           "output.")
 #define FUNC_NAME s_scm_display_application
 {
-  SCM_VALIDATE_FRAME(1,frame);
+  SCM_VALIDATE_FRAME (1, frame);
   if (SCM_UNBNDP (port))
     port = scm_cur_outp;
   else
-    SCM_VALIDATE_OPOUTPORT(2,port);
+    SCM_VALIDATE_OPOUTPORT (2, port);
   if (SCM_UNBNDP (indent))
     indent = SCM_INUM0;
   else
-    SCM_VALIDATE_INT(3,indent);
+    SCM_VALIDATE_INUM (3, indent);
   
   if (SCM_FRAME_PROC_P (frame))
     /* Display an application. */
@@ -427,8 +412,94 @@ GUILE_PROC(scm_display_application, "display-application", 1, 2, 0,
 }
 #undef FUNC_NAME
 
+SCM_SYMBOL (sym_base, "base");
+
+static void
+display_backtrace_get_file_line (SCM frame, SCM *file, SCM *line)
+{
+  SCM source = SCM_FRAME_SOURCE (frame);
+  *file = SCM_MEMOIZEDP (source) ? scm_source_property (source, scm_sym_filename) : SCM_BOOL_F;
+  *line = (SCM_MEMOIZEDP (source)) ? scm_source_property (source, scm_sym_line) : SCM_BOOL_F;
+}
+
 static void
-display_frame (SCM frame,int nfield,int indentation,SCM sport,SCM port,scm_print_state *pstate)
+display_backtrace_file (frame, last_file, port, pstate)
+     SCM frame;
+     SCM *last_file;
+     SCM port;
+     scm_print_state *pstate;
+{
+  SCM file, line;
+
+  display_backtrace_get_file_line (frame, &file, &line);
+
+  if (SCM_EQ_P (file, *last_file))
+    return;
+
+  *last_file = file;
+
+  scm_puts ("In ", port);
+  if (SCM_FALSEP (file))
+    if (SCM_FALSEP (line))
+      scm_puts ("unknown file", port);
+    else
+      scm_puts ("current input", port);
+  else
+    {
+      pstate->writingp = 0;
+      scm_iprin1 (file, port, pstate);
+      pstate->writingp = 1;
+    }
+  scm_puts (":\n", port);
+}
+
+static void
+display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate)
+{
+  SCM file, line;
+
+  display_backtrace_get_file_line (frame, &file, &line);
+
+  if (SCM_EQ_P (SCM_SHOW_FILE_NAME, sym_base))
+    {
+      if (SCM_FALSEP (file))
+       {
+         if (SCM_FALSEP (line))
+           scm_putc ('?', port);
+         else
+           scm_puts ("<stdin>", port);
+       }
+      else
+       {
+         pstate -> writingp = 0;
+#ifdef HAVE_POSIX
+         scm_iprin1 (SCM_STRINGP (file) ? scm_basename (file, SCM_UNDEFINED) : file,
+                     port, pstate);
+#else
+         scm_iprin1 (file, port, pstate);
+#endif
+         pstate -> writingp = 1;
+       }
+
+      scm_putc (':', port);
+    }
+  else if (!SCM_FALSEP (line))
+    {
+      int i, j=0;
+      for (i = SCM_INUM (line)+1; i > 0; i = i/10, j++)
+       ;
+      indent (4-j, port);
+    }
+
+  if (SCM_FALSEP (line))
+    scm_puts ("   ?", port);
+  else
+    scm_intprint (SCM_INUM (line) + 1, 10, port);
+  scm_puts (": ", port);
+}
+
+static void
+display_frame (SCM frame, int nfield, int indentation, SCM sport, SCM port, scm_print_state *pstate)
 {
   int n, i, j;
 
@@ -439,6 +510,10 @@ display_frame (SCM frame,int nfield,int indentation,SCM sport,SCM port,scm_print
       scm_puts ("...\n", port);
     }
 
+  /* display file name and line number */
+  if (!SCM_FALSEP (SCM_SHOW_FILE_NAME))
+    display_backtrace_file_and_line (frame, port, pstate);
+
   /* Check size of frame number. */
   n = SCM_FRAME_NUMBER (frame);
   for (i = 0, j = n; j > 0; ++i) j /= 10;
@@ -494,25 +569,20 @@ struct display_backtrace_args {
 };
 
 static SCM
-display_backtrace_body(struct display_backtrace_args *a)
+display_backtrace_body (struct display_backtrace_args *a)
 #define FUNC_NAME "display_backtrace_body"
 {
   int n_frames, beg, end, n, i, j;
   int nfield, indent_p, indentation;
   SCM frame, sport, print_state;
+  SCM last_file;
   scm_print_state *pstate;
 
   a->port = SCM_COERCE_OUTPORT (a->port);
 
   /* Argument checking and extraction. */
-  SCM_ASSERT (SCM_STACKP (a->stack),
-             a->stack,
-             SCM_ARG1,
-             s_display_backtrace);
-  SCM_ASSERT (SCM_OPOUTPORTP (a->port),
-             a->port,
-             SCM_ARG2,
-             s_display_backtrace);
+  SCM_VALIDATE_STACK (1, a->stack);
+  SCM_VALIDATE_OPOUTPORT (2, a->port);
   n_frames = SCM_INUM (scm_stack_length (a->stack));
   n = SCM_INUMP (a->depth) ? SCM_INUM (a->depth) : SCM_BACKTRACE_DEPTH;
   if (SCM_BACKWARDS_P)
@@ -561,6 +631,8 @@ display_backtrace_body(struct display_backtrace_args *a)
     indent_p = 0;
   else
     {
+      unsigned int j;
+
       indent_p = 1;
       frame = scm_stack_ref (a->stack, SCM_MAKINUM (beg));
       for (i = 0, j = 0; i < n; ++i)
@@ -586,22 +658,32 @@ display_backtrace_body(struct display_backtrace_args *a)
   /* Print frames. */
   frame = scm_stack_ref (a->stack, SCM_MAKINUM (beg));
   indentation = 1;
-  display_frame (frame, nfield, indentation, sport, a->port, pstate);
-  for (i = 1; i < n; ++i)
+  last_file = SCM_UNDEFINED;
+  for (i = 0; i < n; ++i)
     {
+      if (!SCM_EQ_P (SCM_SHOW_FILE_NAME, sym_base))
+       display_backtrace_file (frame, &last_file, a->port, pstate);
+
+      display_frame (frame, nfield, indentation, sport, a->port, pstate);
       if (indent_p && SCM_FRAME_EVAL_ARGS_P (frame))
        ++indentation;
-      frame = SCM_BACKWARDS_P ? SCM_FRAME_PREV (frame) : SCM_FRAME_NEXT (frame);
-      display_frame (frame, nfield, indentation, sport, a->port, pstate);
+      frame = (SCM_BACKWARDS_P ? 
+              SCM_FRAME_PREV (frame) : SCM_FRAME_NEXT (frame));
     }
 
+  scm_remember_upto_here_1 (print_state);
+  
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-GUILE_PROC(scm_display_backtrace, "display-backtrace", 2, 2, 0, 
-           (SCM stack, SCM port, SCM first, SCM depth),
-"")
+SCM_DEFINE (scm_display_backtrace, "display-backtrace", 2, 2, 0, 
+           (SCM stack, SCM port, SCM first, SCM depth),
+           "Display a backtrace to the output port @var{port}. @var{stack}\n"
+           "is the stack to take the backtrace from, @var{first} specifies\n"
+           "where in the stack to start and @var{depth} how much frames\n"
+           "to display. Both @var{first} and @var{depth} can be @code{#f},\n"
+           "which means that default values will be used.")
 #define FUNC_NAME s_scm_display_backtrace
 {
   struct display_backtrace_args a;
@@ -613,21 +695,23 @@ GUILE_PROC(scm_display_backtrace, "display-backtrace", 2, 2, 0,
   data.mode = "backtrace";
   data.port = port;
   scm_internal_catch (SCM_BOOL_T,
-                     (scm_catch_body_t) display_backtrace_body, &a,
-                     (scm_catch_handler_t) display_error_handler, &data);
+                     (scm_t_catch_body) display_backtrace_body, &a,
+                     (scm_t_catch_handler) display_error_handler, &data);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-SCM_VCELL (scm_has_shown_backtrace_hint_p_var, "has-shown-backtrace-hint?");
+SCM_VARIABLE (scm_has_shown_backtrace_hint_p_var, "has-shown-backtrace-hint?");
 
-GUILE_PROC(scm_backtrace, "backtrace", 0, 0, 0, 
-           (),
-"")
+SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0, 
+           (),
+           "Display a backtrace of the stack saved by the last error\n"
+           "to the current output port.")
 #define FUNC_NAME s_scm_backtrace
 {
-  SCM the_last_stack = scm_fluid_ref (SCM_CDR (scm_the_last_stack_fluid));
-  if (SCM_NFALSEP (the_last_stack))
+  SCM the_last_stack =
+    scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var));
+  if (!SCM_FALSEP (the_last_stack))
     {
       scm_newline (scm_cur_outp);
       scm_puts ("Backtrace:\n", scm_cur_outp);
@@ -636,14 +720,14 @@ GUILE_PROC(scm_backtrace, "backtrace", 0, 0, 0,
                             SCM_UNDEFINED,
                             SCM_UNDEFINED);
       scm_newline (scm_cur_outp);
-      if (SCM_FALSEP (SCM_CDR (scm_has_shown_backtrace_hint_p_var))
+      if (SCM_FALSEP (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",
                    scm_cur_outp);
-         SCM_SETCDR (scm_has_shown_backtrace_hint_p_var, SCM_BOOL_T);
+         SCM_VARIABLE_SET (scm_has_shown_backtrace_hint_p_var, SCM_BOOL_T);
        }
     }
   else
@@ -660,7 +744,13 @@ void
 scm_init_backtrace ()
 {
   SCM f = scm_make_fluid ();
-  scm_the_last_stack_fluid = scm_sysintern ("the-last-stack", f);
+  scm_the_last_stack_fluid_var = scm_c_define ("the-last-stack", f);
 
-#include "backtrace.x"
+#include "libguile/backtrace.x"
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/