libguile/backtrace.c

   1 /* Printing of backtraces and error messages
   2  * Copyright (C) 1996, 1997, 1998, 1999 Free Software Foundation
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2, or (at your option)
   7  * any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this software; see the file COPYING.  If not, write to
  16  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  17  * Boston, MA 02111-1307 USA
  18  *
  19  * As a special exception, the Free Software Foundation gives permission
  20  * for additional uses of the text contained in its release of GUILE.
  21  *
  22  * The exception is that, if you link the GUILE library with other files
  23  * to produce an executable, this does not by itself cause the
  24  * resulting executable to be covered by the GNU General Public License.
  25  * Your use of that executable is in no way restricted on account of
  26  * linking the GUILE library code into it.
  27  *
  28  * This exception does not however invalidate any other reasons why
  29  * the executable file might be covered by the GNU General Public License.
  30  *
  31  * This exception applies only to the code released by the
  32  * Free Software Foundation under the name GUILE.  If you copy
  33  * code from other Free Software Foundation releases into a copy of
  34  * GUILE, as the General Public License permits, the exception does
  35  * not apply to the code that you add in this way.  To avoid misleading
  36  * anyone as to the status of such modified files, you must delete
  37  * this exception notice from them.
  38  *
  39  * If you write modifications of your own for GUILE, it is your choice
  40  * whether to permit this exception to apply to your modifications.
  41  * If you do not wish that, delete this exception notice.
  42  *
  43  * The author can be reached at djurfeldt@nada.kth.se
  44  * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN */
  45
  46 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
  47    gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
  48
  49
  50 #include <stdio.h>
  51 #include <ctype.h>
  52
  53 #include "_scm.h"
  54
  55 #ifdef HAVE_UNISTD_H
  56 #include <unistd.h>
  57 #endif
  58
  59 #include "stacks.h"
  60 #include "srcprop.h"
  61 #include "genio.h"
  62 #include "struct.h"
  63 #include "strports.h"
  64 #include "throw.h"
  65 #include "fluids.h"
  66
  67 #include "scm_validate.h"
  68 #include "backtrace.h"
  69
  70 /* {Error reporting and backtraces}
  71  * (A first approximation.)
  72  *
  73  * Note that these functions shouldn't generate errors themselves.
  74  */
  75
  76 #ifndef SCM_RECKLESS
  77 #undef SCM_ASSERT
  78 #define SCM_ASSERT(_cond, _arg, _pos, _subr) \
  79         if (!(_cond)) \
  80           return SCM_BOOL_F;
  81 #endif
  82
  83 SCM scm_the_last_stack_fluid;
  84
  85 static void
  86 display_header (SCM source, SCM port)
  87 {
  88   SCM fname = (SCM_MEMOIZEDP (source)
  89                ? scm_source_property (source, scm_sym_filename)
  90                : SCM_BOOL_F);
  91   if (SCM_STRINGP (fname))
  92     {
  93       scm_prin1 (fname, port, 0);
  94       scm_putc (':', port);
  95       scm_intprint (SCM_INUM (scm_source_property (source, scm_sym_line)) + 1,
  96                     10,
  97                     port);
  98       scm_putc (':', port);
  99       scm_intprint (SCM_INUM (scm_source_property (source, scm_sym_column)) + 1,
 100                     10,
 101                     port);
 102     }
 103   else
 104     scm_puts ("ERROR", port);
 105   scm_puts (": ", port);
 106 }
 107
 108
 109 void
 110 scm_display_error_message (SCM message, SCM args, SCM port)
 111 {
 112   int writingp;
 113   char *start;
 114   char *p;
 115
 116   if (SCM_IMP (message) || !SCM_ROSTRINGP (message) || SCM_IMP (args)
 117       || !scm_list_p (args))
 118     {
 119       scm_prin1 (message, port, 0);
 120       scm_putc ('\n', port);
 121       return;
 122     }
 123
 124   SCM_COERCE_SUBSTR (message);
 125   start = SCM_ROCHARS (message);
 126   for (p = start; *p != '\0'; ++p)
 127     if (*p == '%')
 128       {
 129         if (SCM_IMP (args) || SCM_NCONSP (args))
 130           continue;
 131
 132         ++p;
 133         if (*p == 's')
 134           writingp = 0;
 135         else if (*p == 'S')
 136           writingp = 1;
 137         else
 138           continue;
 139
 140         scm_lfwrite (start, p - start - 1, port);
 141         scm_prin1 (SCM_CAR (args), port, writingp);
 142         args = SCM_CDR (args);
 143         start = p + 1;
 144       }
 145   scm_lfwrite (start, p - start, port);
 146   scm_putc ('\n', port);
 147 }
 148
 149 static void
 150 display_expression (SCM frame,SCM pname,SCM source,SCM port)
 151 {
 152   SCM print_state = scm_make_print_state ();
 153   scm_print_state *pstate = SCM_PRINT_STATE (print_state);
 154   pstate->writingp = 0;
 155   pstate->fancyp = 1;
 156   pstate->level = 2;
 157   pstate->length = 3;
 158   if (SCM_ROSTRINGP (pname))
 159     {
 160       if (SCM_FRAMEP (frame)
 161           && SCM_FRAME_EVAL_ARGS_P (frame))
 162         scm_puts ("While evaluating arguments to ", port);
 163       else
 164         scm_puts ("In procedure ", port);
 165       scm_iprin1 (pname, port, pstate);
 166       if (SCM_MEMOIZEDP (source))
 167         {
 168           scm_puts (" in expression ", port);
 169           pstate->writingp = 1;
 170           scm_iprin1 (scm_unmemoize (source), port, pstate);
 171         }
 172     }
 173   else if (SCM_NIMP (source))
 174     {
 175       scm_puts ("In expression ", port);
 176       pstate->writingp = 1;
 177       scm_iprin1 (scm_unmemoize (source), port, pstate);
 178     }
 179   scm_puts (":\n", port);
 180   scm_free_print_state (print_state);
 181 }
 182
 183 struct display_error_args {
 184   SCM stack;
 185   SCM port;
 186   SCM subr;
 187   SCM message;
 188   SCM args;
 189   SCM rest;
 190 };
 191
 192 static SCM
 193 display_error_body (struct display_error_args *a)
 194 {
 195   SCM current_frame = SCM_BOOL_F;
 196   SCM source = SCM_BOOL_F;
 197   SCM pname = SCM_BOOL_F;
 198   SCM prev_frame = SCM_BOOL_F;
 199
 200   if (SCM_DEBUGGINGP
 201       && SCM_STACKP (a->stack)
 202       && SCM_STACK_LENGTH (a->stack) > 0)
 203     {
 204       current_frame = scm_stack_ref (a->stack, SCM_INUM0);
 205       source = SCM_FRAME_SOURCE (current_frame);
 206       prev_frame = SCM_FRAME_PREV (current_frame);
 207       if (!SCM_MEMOIZEDP (source)
 208           && prev_frame != SCM_BOOL_F)
 209         source = SCM_FRAME_SOURCE (prev_frame);
 210       if (SCM_FRAME_PROC_P (current_frame)
 211           && scm_procedure_p (SCM_FRAME_PROC (current_frame)) == SCM_BOOL_T)
 212         pname = scm_procedure_name (SCM_FRAME_PROC (current_frame));
 213     }
 214   if (!SCM_ROSTRINGP (pname))
 215     pname = a->subr;
 216   if (SCM_ROSTRINGP (pname) || SCM_MEMOIZEDP (source))
 217     {
 218       display_header (source, a->port);
 219       display_expression (current_frame, pname, source, a->port);
 220     }
 221   display_header (source, a->port);
 222   scm_display_error_message (a->message, a->args, a->port);
 223   return SCM_UNSPECIFIED;
 224 }
 225
 226 struct display_error_handler_data {
 227   char *mode;
 228   SCM port;
 229 };
 230
 231 /* This is the exception handler for error reporting routines.
 232    Note that it is very important that this handler *doesn't* try to
 233    print more than the error tag, since the error very probably is
 234    caused by an erroneous print call-back routine.  If we would
 235    tru to print all objects, we would enter an infinite loop. */
 236 static SCM
 237 display_error_handler (struct display_error_handler_data *data,
 238                        SCM tag, SCM args)
 239 {
 240   SCM print_state = scm_make_print_state ();
 241   scm_puts ("\nException during displaying of ", data->port);
 242   scm_puts (data->mode, data->port);
 243   scm_puts (": ", data->port);
 244   scm_iprin1 (tag, data->port, SCM_PRINT_STATE (print_state));
 245   scm_putc ('\n', data->port);
 246   return SCM_UNSPECIFIED;
 247 }
 248
 249 SCM_DEFINE(scm_display_error, "display-error", 6, 0, 0,
 250            (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest),
 251 "")
 252 #define FUNC_NAME s_scm_display_error
 253 {
 254   struct display_error_args a;
 255   struct display_error_handler_data data;
 256   a.stack = stack;
 257   a.port  = port;
 258   a.subr  = subr;
 259   a.message = message;
 260   a.args  = args;
 261   a.rest  = rest;
 262   data.mode = "error";
 263   data.port = port;
 264   scm_internal_catch (SCM_BOOL_T,
 265                       (scm_catch_body_t) display_error_body, &a,
 266                       (scm_catch_handler_t) display_error_handler, &data);
 267   return SCM_UNSPECIFIED;
 268 }
 269 #undef FUNC_NAME
 270
 271 typedef struct {
 272   int level;
 273   int length;
 274 } print_params_t;
 275
 276 static int n_print_params = 9;
 277 static print_params_t default_print_params[] = {
 278   { 4, 9 }, { 4, 3 },
 279   { 3, 4 }, { 3, 3 },
 280   { 2, 4 }, { 2, 3 },
 281   { 1, 4 }, { 1, 3 }, { 1, 2 }
 282 };
 283 static print_params_t *print_params = default_print_params;
 284
 285 #ifdef GUILE_DEBUG
 286 SCM_DEFINE(scm_set_print_params_x, "set-print-params!", 1, 0, 0,
 287            (SCM params),
 288 "")
 289 #define FUNC_NAME s_scm_set_print_params_x
 290 {
 291   int i, n = scm_ilength (params);
 292   SCM ls;
 293   print_params_t *new_params;
 294   SCM_ASSERT (n >= 1, params, SCM_ARG2, FUNC_NAME);
 295   for (ls = params; SCM_NIMP (ls); ls = SCM_CDR (ls))
 296     SCM_ASSERT (scm_ilength (SCM_CAR (params)) == 2
 297                 && SCM_INUMP (SCM_CAAR (ls))
 298                 && SCM_INUM (SCM_CAAR (ls)) >= 0
 299                 && SCM_INUMP (SCM_CADAR (ls))
 300                 && SCM_INUM (SCM_CADAR (ls)) >= 0,
 301                 params,
 302                 SCM_ARG2,
 303                 s_scm_set_print_params_x);
 304   new_params = scm_must_malloc (n * sizeof (print_params_t),
 305                                 FUNC_NAME);
 306   if (print_params != default_print_params)
 307     scm_must_free (print_params);
 308   print_params = new_params;
 309   for (i = 0; i < n; ++i)
 310     {
 311       print_params[i].level = SCM_INUM (SCM_CAAR (params));
 312       print_params[i].length = SCM_INUM (SCM_CADAR (params));
 313       params = SCM_CDR (params);
 314     }
 315   n_print_params = n;
 316   return SCM_UNSPECIFIED;
 317 }
 318 #undef FUNC_NAME
 319 #endif
 320
 321 static void
 322 indent (int n, SCM port)
 323 {
 324   int i;
 325   for (i = 0; i < n; ++i)
 326     scm_putc (' ', port);
 327 }
 328
 329 static void
 330 display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM port,scm_print_state *pstate)
 331 {
 332   SCM string;
 333   int i = 0, n;
 334   scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (sport);
 335   do
 336     {
 337       pstate->length = print_params[i].length;
 338       ptob->seek (sport, 0, SEEK_SET);
 339       if (SCM_CONSP (exp))
 340         {
 341           pstate->level = print_params[i].level - 1;
 342           scm_iprlist (hdr, exp, tlr[0], sport, pstate);
 343           scm_puts (&tlr[1], sport);
 344         }
 345       else
 346         {
 347           pstate->level = print_params[i].level;
 348           scm_iprin1 (exp, sport, pstate);
 349         }
 350       ptob->flush (sport);
 351       n = ptob->seek (sport, 0, SEEK_CUR);
 352       ++i;
 353     }
 354   while (indentation + n > SCM_BACKTRACE_WIDTH && i < n_print_params);
 355   ptob->truncate (sport, n);
 356   string = scm_strport_to_string (sport);
 357   /* Remove control characters */
 358   for (i = 0; i < n; ++i)
 359     if (iscntrl (SCM_CHARS (string)[i]))
 360       SCM_CHARS (string)[i] = ' ';
 361   /* Truncate */
 362   if (indentation + n > SCM_BACKTRACE_WIDTH)
 363     {
 364       n = SCM_BACKTRACE_WIDTH - indentation;
 365       SCM_CHARS (string)[n - 1] = '$';
 366     }
 367
 368   scm_lfwrite (SCM_CHARS (string), n, port);
 369 }
 370
 371 static void
 372 display_application (SCM frame,int indentation,SCM sport,SCM port,scm_print_state *pstate)
 373 {
 374   SCM proc = SCM_FRAME_PROC (frame);
 375   SCM name = (SCM_NFALSEP (scm_procedure_p (proc))
 376               ? scm_procedure_name (proc)
 377               : SCM_BOOL_F);
 378   display_frame_expr ("[",
 379                       scm_cons (SCM_NFALSEP (name) ? name : proc,
 380                                 SCM_FRAME_ARGS (frame)),
 381                       SCM_FRAME_EVAL_ARGS_P (frame) ? " ..." : "]",
 382                       indentation,
 383                       sport,
 384                       port,
 385                       pstate);
 386 }
 387
 388 SCM_DEFINE(scm_display_application, "display-application", 1, 2, 0,
 389            (SCM frame, SCM port, SCM indent),
 390 "")
 391 #define FUNC_NAME s_scm_display_application
 392 {
 393   SCM_VALIDATE_FRAME(1,frame);
 394   if (SCM_UNBNDP (port))
 395     port = scm_cur_outp;
 396   else
 397     SCM_VALIDATE_OPOUTPORT(2,port);
 398   if (SCM_UNBNDP (indent))
 399     indent = SCM_INUM0;
 400   else
 401     SCM_VALIDATE_INUM(3,indent);
 402
 403   if (SCM_FRAME_PROC_P (frame))
 404     /* Display an application. */
 405     {
 406       SCM sport, print_state;
 407       scm_print_state *pstate;
 408
 409       /* Create a string port used for adaptation of printing parameters. */
 410       sport = scm_mkstrport (SCM_INUM0,
 411                              scm_make_string (SCM_MAKINUM (240),
 412                                               SCM_UNDEFINED),
 413                              SCM_OPN | SCM_WRTNG,
 414                              FUNC_NAME);
 415
 416       /* Create a print state for printing of frames. */
 417       print_state = scm_make_print_state ();
 418       pstate = SCM_PRINT_STATE (print_state);
 419       pstate->writingp = 1;
 420       pstate->fancyp = 1;
 421
 422       display_application (frame, SCM_INUM (indent), sport, port, pstate);
 423       return SCM_BOOL_T;
 424     }
 425   else
 426     return SCM_BOOL_F;
 427 }
 428 #undef FUNC_NAME
 429
 430 static void
 431 display_frame (SCM frame,int nfield,int indentation,SCM sport,SCM port,scm_print_state *pstate)
 432 {
 433   int n, i, j;
 434
 435   /* Announce missing frames? */
 436   if (!SCM_BACKWARDS_P && SCM_FRAME_OVERFLOW_P (frame))
 437     {
 438       indent (nfield + 1 + indentation, port);
 439       scm_puts ("...\n", port);
 440     }
 441
 442   /* Check size of frame number. */
 443   n = SCM_FRAME_NUMBER (frame);
 444   for (i = 0, j = n; j > 0; ++i) j /= 10;
 445
 446   /* Number indentation. */
 447   indent (nfield - (i ? i : 1), port);
 448
 449   /* Frame number. */
 450   scm_iprin1 (SCM_MAKINUM (n), port, pstate);
 451
 452   /* Real frame marker */
 453   scm_putc (SCM_FRAME_REAL_P (frame) ? '*' : ' ', port);
 454
 455   /* Indentation. */
 456   indent (indentation, port);
 457
 458   if (SCM_FRAME_PROC_P (frame))
 459     /* Display an application. */
 460     display_application (frame, nfield + 1 + indentation, sport, port, pstate);
 461   else
 462     /* Display a special form. */
 463     {
 464       SCM source = SCM_FRAME_SOURCE (frame);
 465       SCM copy = (SCM_CONSP (source)
 466                   ? scm_source_property (source, scm_sym_copy)
 467                   : SCM_BOOL_F);
 468       SCM umcopy = (SCM_MEMOIZEDP (source)
 469                     ? scm_unmemoize (source)
 470                     : SCM_BOOL_F);
 471       display_frame_expr ("(",
 472                           SCM_CONSP (copy) ? copy : umcopy,
 473                           ")",
 474                           nfield + 1 + indentation,
 475                           sport,
 476                           port,
 477                           pstate);
 478     }
 479   scm_putc ('\n', port);
 480
 481   /* Announce missing frames? */
 482   if (SCM_BACKWARDS_P && SCM_FRAME_OVERFLOW_P (frame))
 483     {
 484       indent (nfield + 1 + indentation, port);
 485       scm_puts ("...\n", port);
 486     }
 487 }
 488
 489 struct display_backtrace_args {
 490   SCM stack;
 491   SCM port;
 492   SCM first;
 493   SCM depth;
 494 };
 495
 496 static SCM
 497 display_backtrace_body(struct display_backtrace_args *a)
 498 #define FUNC_NAME "display_backtrace_body"
 499 {
 500   int n_frames, beg, end, n, i, j;
 501   int nfield, indent_p, indentation;
 502   SCM frame, sport, print_state;
 503   scm_print_state *pstate;
 504
 505   a->port = SCM_COERCE_OUTPORT (a->port);
 506
 507   /* Argument checking and extraction. */
 508   SCM_ASSERT (SCM_STACKP (a->stack),
 509               a->stack,
 510               SCM_ARG1,
 511               s_display_backtrace);
 512   SCM_ASSERT (SCM_OPOUTPORTP (a->port),
 513               a->port,
 514               SCM_ARG2,
 515               s_display_backtrace);
 516   n_frames = SCM_INUM (scm_stack_length (a->stack));
 517   n = SCM_INUMP (a->depth) ? SCM_INUM (a->depth) : SCM_BACKTRACE_DEPTH;
 518   if (SCM_BACKWARDS_P)
 519     {
 520       beg = SCM_INUMP (a->first) ? SCM_INUM (a->first) : 0;
 521       end = beg + n - 1;
 522       if (end >= n_frames)
 523         end = n_frames - 1;
 524       n = end - beg + 1;
 525     }
 526   else
 527     {
 528       if (SCM_INUMP (a->first))
 529         {
 530           beg = SCM_INUM (a->first);
 531           end = beg - n + 1;
 532           if (end < 0)
 533             end = 0;
 534         }
 535       else
 536         {
 537           beg = n - 1;
 538           end = 0;
 539           if (beg >= n_frames)
 540             beg = n_frames - 1;
 541         }
 542       n = beg - end + 1;
 543     }
 544   SCM_ASSERT (beg >= 0 && beg < n_frames, a->first, SCM_ARG3, s_display_backtrace);
 545   SCM_ASSERT (n > 0, a->depth, SCM_ARG4, s_display_backtrace);
 546
 547   /* Create a string port used for adaptation of printing parameters. */
 548   sport = scm_mkstrport (SCM_INUM0,
 549                          scm_make_string (SCM_MAKINUM (240), SCM_UNDEFINED),
 550                          SCM_OPN | SCM_WRTNG,
 551                          FUNC_NAME);
 552
 553   /* Create a print state for printing of frames. */
 554   print_state = scm_make_print_state ();
 555   pstate = SCM_PRINT_STATE (print_state);
 556   pstate->writingp = 1;
 557   pstate->fancyp = 1;
 558
 559   /* First find out if it's reasonable to do indentation. */
 560   if (SCM_BACKWARDS_P)
 561     indent_p = 0;
 562   else
 563     {
 564       indent_p = 1;
 565       frame = scm_stack_ref (a->stack, SCM_MAKINUM (beg));
 566       for (i = 0, j = 0; i < n; ++i)
 567         {
 568           if (SCM_FRAME_REAL_P (frame))
 569             ++j;
 570           if (j > SCM_BACKTRACE_INDENT)
 571             {
 572               indent_p = 0;
 573               break;
 574             }
 575           frame = (SCM_BACKWARDS_P
 576                    ? SCM_FRAME_PREV (frame)
 577                    : SCM_FRAME_NEXT (frame));
 578         }
 579     }
 580
 581   /* Determine size of frame number field. */
 582   j = SCM_FRAME_NUMBER (scm_stack_ref (a->stack, SCM_MAKINUM (end)));
 583   for (i = 0; j > 0; ++i) j /= 10;
 584   nfield = i ? i : 1;
 585
 586   /* Print frames. */
 587   frame = scm_stack_ref (a->stack, SCM_MAKINUM (beg));
 588   indentation = 1;
 589   display_frame (frame, nfield, indentation, sport, a->port, pstate);
 590   for (i = 1; i < n; ++i)
 591     {
 592       if (indent_p && SCM_FRAME_EVAL_ARGS_P (frame))
 593         ++indentation;
 594       frame = SCM_BACKWARDS_P ? SCM_FRAME_PREV (frame) : SCM_FRAME_NEXT (frame);
 595       display_frame (frame, nfield, indentation, sport, a->port, pstate);
 596     }
 597
 598   return SCM_UNSPECIFIED;
 599 }
 600 #undef FUNC_NAME
 601
 602 SCM_DEFINE(scm_display_backtrace, "display-backtrace", 2, 2, 0,
 603            (SCM stack, SCM port, SCM first, SCM depth),
 604 "")
 605 #define FUNC_NAME s_scm_display_backtrace
 606 {
 607   struct display_backtrace_args a;
 608   struct display_error_handler_data data;
 609   a.stack = stack;
 610   a.port  = port;
 611   a.first = first;
 612   a.depth = depth;
 613   data.mode = "backtrace";
 614   data.port = port;
 615   scm_internal_catch (SCM_BOOL_T,
 616                       (scm_catch_body_t) display_backtrace_body, &a,
 617                       (scm_catch_handler_t) display_error_handler, &data);
 618   return SCM_UNSPECIFIED;
 619 }
 620 #undef FUNC_NAME
 621
 622 SCM_VCELL (scm_has_shown_backtrace_hint_p_var, "has-shown-backtrace-hint?");
 623
 624 SCM_DEFINE(scm_backtrace, "backtrace", 0, 0, 0,
 625            (),
 626 "")
 627 #define FUNC_NAME s_scm_backtrace
 628 {
 629   SCM the_last_stack = scm_fluid_ref (SCM_CDR (scm_the_last_stack_fluid));
 630   if (SCM_NFALSEP (the_last_stack))
 631     {
 632       scm_newline (scm_cur_outp);
 633       scm_puts ("Backtrace:\n", scm_cur_outp);
 634       scm_display_backtrace (the_last_stack,
 635                              scm_cur_outp,
 636                              SCM_UNDEFINED,
 637                              SCM_UNDEFINED);
 638       scm_newline (scm_cur_outp);
 639       if (SCM_FALSEP (SCM_CDR (scm_has_shown_backtrace_hint_p_var))
 640           && !SCM_BACKTRACE_P)
 641         {
 642           scm_puts ("Type \"(debug-enable 'backtrace)\" if you would like "
 643                     "a backtrace\n"
 644                     "automatically if an error occurs in the future.\n",
 645                     scm_cur_outp);
 646           SCM_SETCDR (scm_has_shown_backtrace_hint_p_var, SCM_BOOL_T);
 647         }
 648     }
 649   else
 650     {
 651       scm_puts ("No backtrace available.\n", scm_cur_outp);
 652     }
 653   return SCM_UNSPECIFIED;
 654 }
 655 #undef FUNC_NAME
 656
 657 \f
 658
 659 void
 660 scm_init_backtrace ()
 661 {
 662   SCM f = scm_make_fluid ();
 663   scm_the_last_stack_fluid = scm_sysintern ("the-last-stack", f);
 664
 665 #include "backtrace.x"
 666 }