gdb/guile/scm-exception.c

   1 /* GDB/Scheme exception support.
   2
   3    Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 /* See README file in this directory for implementation notes, coding
  21    conventions, et.al.  */
  22
  23 /* Notes:
  24
  25    IWBN to support SRFI 34/35.  At the moment we follow Guile's own
  26    exception mechanism.
  27
  28    The non-static functions in this file have prefix gdbscm_ and
  29    not exscm_ on purpose.  */
  30
  31 #include "defs.h"
  32 #include <signal.h>
  33 #include "gdb_assert.h"
  34 #include "guile-internal.h"
  35
  36 /* The <gdb:exception> smob.
  37    This is used to record and handle Scheme exceptions.
  38    One important invariant is that <gdb:exception> smobs are never a valid
  39    result of a function, other than to signify an exception occurred.  */
  40
  41 typedef struct
  42 {
  43   /* This always appears first.  */
  44   gdb_smob base;
  45
  46   /* The key and args parameters to "throw".  */
  47   SCM key;
  48   SCM args;
  49 } exception_smob;
  50
  51 static const char exception_smob_name[] = "gdb:exception";
  52
  53 /* The tag Guile knows the exception smob by.  */
  54 static scm_t_bits exception_smob_tag;
  55
  56 /* A generic error in struct gdb_exception.
  57    I.e., not RETURN_QUIT and not MEMORY_ERROR.  */
  58 static SCM error_symbol;
  59
  60 /* An error occurred accessing inferior memory.
  61    This is not a Scheme programming error.  */
  62 static SCM memory_error_symbol;
  63
  64 /* User interrupt, e.g., RETURN_QUIT in struct gdb_exception.  */
  65 static SCM signal_symbol;
  66
  67 /* A user error, e.g., bad arg to gdb command.  */
  68 static SCM user_error_symbol;
  69
  70 /* Printing the stack is done by first capturing the stack and recording it in
  71    a <gdb:exception> object with this key and with the ARGS field set to
  72    (cons real-key (cons stack real-args)).
  73    See gdbscm_make_exception_with_stack.  */
  74 static SCM with_stack_error_symbol;
  75
  76 /* The key to use for an invalid object exception.  An invalid object is one
  77    where the underlying object has been removed from GDB.  */
  78 SCM gdbscm_invalid_object_error_symbol;
  79
  80 /* Values for "guile print-stack" as symbols.  */
  81 static SCM none_symbol;
  82 static SCM message_symbol;
  83 static SCM full_symbol;
  84
  85 static const char percent_print_exception_message_name[] =
  86   "%print-exception-message";
  87
  88 /* Variable containing %print-exception-message.
  89    It is not defined until late in initialization, after our init routine
  90    has run.  Cope by looking it up lazily.  */
  91 static SCM percent_print_exception_message_var = SCM_BOOL_F;
  92
  93 static const char percent_print_exception_with_stack_name[] =
  94   "%print-exception-with-stack";
  95
  96 /* Variable containing %print-exception-with-stack.
  97    It is not defined until late in initialization, after our init routine
  98    has run.  Cope by looking it up lazily.  */
  99 static SCM percent_print_exception_with_stack_var = SCM_BOOL_F;
 100
 101 /* Counter to keep track of the number of times we create a <gdb:exception>
 102    object, for performance monitoring purposes.  */
 103 static unsigned long gdbscm_exception_count = 0;
 104 \f
 105 /* Administrivia for exception smobs.  */
 106
 107 /* The smob "print" function for <gdb:exception>.  */
 108
 109 static int
 110 exscm_print_exception_smob (SCM self, SCM port, scm_print_state *pstate)
 111 {
 112   exception_smob *e_smob = (exception_smob *) SCM_SMOB_DATA (self);
 113
 114   gdbscm_printf (port, "#<%s ", exception_smob_name);
 115   scm_write (e_smob->key, port);
 116   scm_puts (" ", port);
 117   scm_write (e_smob->args, port);
 118   scm_puts (">", port);
 119
 120   scm_remember_upto_here_1 (self);
 121
 122   /* Non-zero means success.  */
 123   return 1;
 124 }
 125
 126 /* (make-exception key args) -> <gdb:exception> */
 127
 128 SCM
 129 gdbscm_make_exception (SCM key, SCM args)
 130 {
 131   exception_smob *e_smob = (exception_smob *)
 132     scm_gc_malloc (sizeof (exception_smob), exception_smob_name);
 133   SCM smob;
 134
 135   e_smob->key = key;
 136   e_smob->args = args;
 137   smob = scm_new_smob (exception_smob_tag, (scm_t_bits) e_smob);
 138   gdbscm_init_gsmob (&e_smob->base);
 139
 140   ++gdbscm_exception_count;
 141
 142   return smob;
 143 }
 144
 145 /* Return non-zero if SCM is a <gdb:exception> object.  */
 146
 147 int
 148 gdbscm_is_exception (SCM scm)
 149 {
 150   return SCM_SMOB_PREDICATE (exception_smob_tag, scm);
 151 }
 152
 153 /* (exception? scm) -> boolean */
 154
 155 static SCM
 156 gdbscm_exception_p (SCM scm)
 157 {
 158   return scm_from_bool (gdbscm_is_exception (scm));
 159 }
 160
 161 /* (exception-key <gdb:exception>) -> key */
 162
 163 SCM
 164 gdbscm_exception_key (SCM self)
 165 {
 166   exception_smob *e_smob;
 167
 168   SCM_ASSERT_TYPE (gdbscm_is_exception (self), self, SCM_ARG1, FUNC_NAME,
 169                    "gdb:exception");
 170
 171   e_smob = (exception_smob *) SCM_SMOB_DATA (self);
 172   return e_smob->key;
 173 }
 174
 175 /* (exception-args <gdb:exception>) -> arg-list */
 176
 177 SCM
 178 gdbscm_exception_args (SCM self)
 179 {
 180   exception_smob *e_smob;
 181
 182   SCM_ASSERT_TYPE (gdbscm_is_exception (self), self, SCM_ARG1, FUNC_NAME,
 183                    "gdb:exception");
 184
 185   e_smob = (exception_smob *) SCM_SMOB_DATA (self);
 186   return e_smob->args;
 187 }
 188 \f
 189 /* Wrap an exception in a <gdb:exception> object that includes STACK.
 190    gdbscm_print_exception_with_stack knows how to unwrap it.  */
 191
 192 SCM
 193 gdbscm_make_exception_with_stack (SCM key, SCM args, SCM stack)
 194 {
 195   return gdbscm_make_exception (with_stack_error_symbol,
 196                                 scm_cons (key, scm_cons (stack, args)));
 197 }
 198
 199 /* Version of scm_error_scm that creates a gdb:exception object that can later
 200    be passed to gdbscm_throw.
 201    KEY is a symbol denoting the kind of error.
 202    SUBR is either #f or a string marking the function in which the error
 203    occurred.
 204    MESSAGE is either #f or the error message string.  It may contain ~a and ~s
 205    modifiers, provided by ARGS.
 206    ARGS is a list of args to MESSAGE.
 207    DATA is an arbitrary object, its value depends on KEY.  The value to pass
 208    here is a bit underspecified by Guile.  */
 209
 210 SCM
 211 gdbscm_make_error_scm (SCM key, SCM subr, SCM message, SCM args, SCM data)
 212 {
 213   return gdbscm_make_exception (key, scm_list_4 (subr, message, args, data));
 214 }
 215
 216 /* Version of scm_error that creates a gdb:exception object that can later
 217    be passed to gdbscm_throw.
 218    See gdbscm_make_error_scm for a description of the arguments.  */
 219
 220 SCM
 221 gdbscm_make_error (SCM key, const char *subr, const char *message,
 222                    SCM args, SCM data)
 223 {
 224   return gdbscm_make_error_scm
 225     (key,
 226      subr == NULL ? SCM_BOOL_F : scm_from_latin1_string (subr),
 227      message == NULL ? SCM_BOOL_F : scm_from_latin1_string (message),
 228      args, data);
 229 }
 230
 231 /* Version of SCM_ASSERT_TYPE/scm_wrong_type_arg_msg that creates a
 232    gdb:exception object that can later be passed to gdbscm_throw.  */
 233
 234 SCM
 235 gdbscm_make_type_error (const char *subr, int arg_pos, SCM bad_value,
 236                         const char *expected_type)
 237 {
 238   char *msg;
 239   SCM result;
 240
 241   if (arg_pos > 0)
 242     {
 243       if (expected_type != NULL)
 244         {
 245           msg = xstrprintf (_("Wrong type argument in position %d"
 246                               " (expecting %s): ~S"),
 247                             arg_pos, expected_type);
 248         }
 249       else
 250         {
 251           msg = xstrprintf (_("Wrong type argument in position %d: ~S"),
 252                             arg_pos);
 253         }
 254     }
 255   else
 256     {
 257       if (expected_type != NULL)
 258         {
 259           msg = xstrprintf (_("Wrong type argument (expecting %s): ~S"),
 260                             expected_type);
 261         }
 262       else
 263         msg = xstrprintf (_("Wrong type argument: ~S"));
 264     }
 265
 266   result = gdbscm_make_error (scm_arg_type_key, subr, msg,
 267                               scm_list_1 (bad_value), scm_list_1 (bad_value));
 268   xfree (msg);
 269   return result;
 270 }
 271
 272 /* A variant of gdbscm_make_type_error for non-type argument errors.
 273    ERROR_PREFIX and ERROR are combined to build the error message.
 274    Care needs to be taken so that the i18n composed form is still
 275    reasonable, but no one is going to translate these anyway so we don't
 276    worry too much.
 277    ERROR_PREFIX may be NULL, ERROR may not be NULL.  */
 278
 279 static SCM
 280 gdbscm_make_arg_error (SCM key, const char *subr, int arg_pos, SCM bad_value,
 281                        const char *error_prefix, const char *error)
 282 {
 283   char *msg;
 284   SCM result;
 285
 286   if (error_prefix != NULL)
 287     {
 288       if (arg_pos > 0)
 289         {
 290           msg = xstrprintf (_("%s %s in position %d: ~S"),
 291                             error_prefix, error, arg_pos);
 292         }
 293       else
 294         msg = xstrprintf (_("%s %s: ~S"), error_prefix, error);
 295     }
 296   else
 297     {
 298       if (arg_pos > 0)
 299         msg = xstrprintf (_("%s in position %d: ~S"), error, arg_pos);
 300       else
 301         msg = xstrprintf (_("%s: ~S"), error);
 302     }
 303
 304   result = gdbscm_make_error (key, subr, msg,
 305                               scm_list_1 (bad_value), scm_list_1 (bad_value));
 306   xfree (msg);
 307   return result;
 308 }
 309
 310 /* Make an invalid-object error <gdb:exception> object.
 311    OBJECT is the name of the kind of object that is invalid.  */
 312
 313 SCM
 314 gdbscm_make_invalid_object_error (const char *subr, int arg_pos, SCM bad_value,
 315                                   const char *object)
 316 {
 317   return gdbscm_make_arg_error (gdbscm_invalid_object_error_symbol,
 318                                 subr, arg_pos, bad_value,
 319                                 _("Invalid object:"), object);
 320 }
 321
 322 /* Throw an invalid-object error.
 323    OBJECT is the name of the kind of object that is invalid.  */
 324
 325 void
 326 gdbscm_invalid_object_error (const char *subr, int arg_pos, SCM bad_value,
 327                              const char *object)
 328 {
 329   SCM exception
 330     = gdbscm_make_invalid_object_error (subr, arg_pos, bad_value, object);
 331
 332   gdbscm_throw (exception);
 333 }
 334
 335 /* Make an out-of-range error <gdb:exception> object.  */
 336
 337 SCM
 338 gdbscm_make_out_of_range_error (const char *subr, int arg_pos, SCM bad_value,
 339                                 const char *error)
 340 {
 341   return gdbscm_make_arg_error (scm_out_of_range_key,
 342                                 subr, arg_pos, bad_value,
 343                                 _("Out of range:"), error);
 344 }
 345
 346 /* Throw an out-of-range error.
 347    This is the standard Guile out-of-range exception.  */
 348
 349 void
 350 gdbscm_out_of_range_error (const char *subr, int arg_pos, SCM bad_value,
 351                            const char *error)
 352 {
 353   SCM exception
 354     = gdbscm_make_out_of_range_error (subr, arg_pos, bad_value, error);
 355
 356   gdbscm_throw (exception);
 357 }
 358
 359 /* Make a misc-error <gdb:exception> object.  */
 360
 361 SCM
 362 gdbscm_make_misc_error (const char *subr, int arg_pos, SCM bad_value,
 363                        const char *error)
 364 {
 365   return gdbscm_make_arg_error (scm_misc_error_key,
 366                                 subr, arg_pos, bad_value, NULL, error);
 367 }
 368
 369 /* Return a <gdb:exception> object for gdb:memory-error.  */
 370
 371 SCM
 372 gdbscm_make_memory_error (const char *subr, const char *msg, SCM args)
 373 {
 374   return gdbscm_make_error (memory_error_symbol, subr, msg, args,
 375                             SCM_EOL);
 376 }
 377
 378 /* Throw a gdb:memory-error exception.  */
 379
 380 void
 381 gdbscm_memory_error (const char *subr, const char *msg, SCM args)
 382 {
 383   SCM exception = gdbscm_make_memory_error (subr, msg, args);
 384
 385   gdbscm_throw (exception);
 386 }
 387
 388 /* Return non-zero if KEY is gdb:memory-error.
 389    Note: This is an excp_matcher_func function.  */
 390
 391 int
 392 gdbscm_memory_error_p (SCM key)
 393 {
 394   return scm_is_eq (key, memory_error_symbol);
 395 }
 396
 397 /* Return non-zero if KEY is gdb:user-error.
 398    Note: This is an excp_matcher_func function.  */
 399
 400 int
 401 gdbscm_user_error_p (SCM key)
 402 {
 403   return scm_is_eq (key, user_error_symbol);
 404 }
 405
 406 /* Wrapper around scm_throw to throw a gdb:exception.
 407    This function does not return.
 408    This function cannot be called from inside TRY_CATCH.  */
 409
 410 void
 411 gdbscm_throw (SCM exception)
 412 {
 413   scm_throw (gdbscm_exception_key (exception),
 414              gdbscm_exception_args (exception));
 415   gdb_assert_not_reached ("scm_throw returned");
 416 }
 417
 418 /* Convert a GDB exception to a <gdb:exception> object.  */
 419
 420 SCM
 421 gdbscm_scm_from_gdb_exception (struct gdb_exception exception)
 422 {
 423   SCM key;
 424
 425   if (exception.reason == RETURN_QUIT)
 426     {
 427       /* Handle this specially to be consistent with top-repl.scm.  */
 428       return gdbscm_make_error (signal_symbol, NULL, _("User interrupt"),
 429                                 SCM_EOL, scm_list_1 (scm_from_int (SIGINT)));
 430     }
 431
 432   if (exception.error == MEMORY_ERROR)
 433     key = memory_error_symbol;
 434   else
 435     key = error_symbol;
 436
 437   return gdbscm_make_error (key, NULL, "~A",
 438                             scm_list_1 (gdbscm_scm_from_c_string
 439                                         (exception.message)),
 440                             SCM_BOOL_F);
 441 }
 442
 443 /* Convert a GDB exception to the appropriate Scheme exception and throw it.
 444    This function does not return.  */
 445
 446 void
 447 gdbscm_throw_gdb_exception (struct gdb_exception exception)
 448 {
 449   gdbscm_throw (gdbscm_scm_from_gdb_exception (exception));
 450 }
 451
 452 /* Print the error message portion of an exception.
 453    If PORT is #f, use the standard error port.
 454    KEY cannot be gdb:with-stack.
 455
 456    Basically this function is just a wrapper around calling
 457    %print-exception-message.  */
 458
 459 static void
 460 gdbscm_print_exception_message (SCM port, SCM frame, SCM key, SCM args)
 461 {
 462   SCM printer, status;
 463
 464   if (gdbscm_is_false (port))
 465     port = scm_current_error_port ();
 466
 467   gdb_assert (!scm_is_eq (key, with_stack_error_symbol));
 468
 469   /* This does not use scm_print_exception because we tweak the output a bit.
 470      Compare Guile's print-exception with our %print-exception-message for
 471      details.  */
 472   if (gdbscm_is_false (percent_print_exception_message_var))
 473     {
 474       percent_print_exception_message_var
 475         = scm_c_private_variable (gdbscm_init_module_name,
 476                                   percent_print_exception_message_name);
 477       /* If we can't find %print-exception-message, there's a problem on the
 478          Scheme side.  Don't kill GDB, just flag an error and leave it at
 479          that.  */
 480       if (gdbscm_is_false (percent_print_exception_message_var))
 481         {
 482           gdbscm_printf (port, _("Error in Scheme exception printing,"
 483                                  " can't find %s.\n"),
 484                          percent_print_exception_message_name);
 485           return;
 486         }
 487     }
 488   printer = scm_variable_ref (percent_print_exception_message_var);
 489
 490   status = gdbscm_safe_call_4 (printer, port, frame, key, args, NULL);
 491
 492   /* If that failed still tell the user something.
 493      But don't use the exception printing machinery!  */
 494   if (gdbscm_is_exception (status))
 495     {
 496       gdbscm_printf (port, _("Error in Scheme exception printing:\n"));
 497       scm_display (status, port);
 498       scm_newline (port);
 499     }
 500 }
 501
 502 /* Print the description of exception KEY, ARGS to PORT, according to the
 503    setting of "set guile print-stack".
 504    If PORT is #f, use the standard error port.
 505    If STACK is #f, never print the stack, regardless of whether printing it
 506    is enabled.  If STACK is #t, then print it if it is contained in ARGS
 507    (i.e., KEY is gdb:with-stack).  Otherwise STACK is the result of calling
 508    scm_make_stack (which will be ignored in favor of the stack in ARGS if
 509    KEY is gdb:with-stack).
 510    KEY, ARGS are the standard arguments to scm_throw, et.al.
 511
 512    Basically this function is just a wrapper around calling
 513    %print-exception-with-args.  */
 514
 515 void
 516 gdbscm_print_exception_with_stack (SCM port, SCM stack, SCM key, SCM args)
 517 {
 518   SCM printer, status;
 519
 520   if (gdbscm_is_false (port))
 521     port = scm_current_error_port ();
 522
 523   if (gdbscm_is_false (percent_print_exception_with_stack_var))
 524     {
 525       percent_print_exception_with_stack_var
 526         = scm_c_private_variable (gdbscm_init_module_name,
 527                                   percent_print_exception_with_stack_name);
 528       /* If we can't find %print-exception-with-args, there's a problem on the
 529          Scheme side.  Don't kill GDB, just flag an error and leave it at
 530          that.  */
 531       if (gdbscm_is_false (percent_print_exception_with_stack_var))
 532         {
 533           gdbscm_printf (port, _("Error in Scheme exception printing,"
 534                                  " can't find %s.\n"),
 535                          percent_print_exception_with_stack_name);
 536           return;
 537         }
 538     }
 539   printer = scm_variable_ref (percent_print_exception_with_stack_var);
 540
 541   status = gdbscm_safe_call_4 (printer, port, stack, key, args, NULL);
 542
 543   /* If that failed still tell the user something.
 544      But don't use the exception printing machinery!  */
 545   if (gdbscm_is_exception (status))
 546     {
 547       gdbscm_printf (port, _("Error in Scheme exception printing:\n"));
 548       scm_display (status, port);
 549       scm_newline (port);
 550     }
 551 }
 552
 553 /* Print EXCEPTION, a <gdb:exception> object, to PORT.
 554    If PORT is #f, use the standard error port.  */
 555
 556 void
 557 gdbscm_print_gdb_exception (SCM port, SCM exception)
 558 {
 559   gdb_assert (gdbscm_is_exception (exception));
 560
 561   gdbscm_print_exception_with_stack (port, SCM_BOOL_T,
 562                                      gdbscm_exception_key (exception),
 563                                      gdbscm_exception_args (exception));
 564 }
 565
 566 /* Return a string description of <gdb:exception> EXCEPTION.
 567    If EXCEPTION is a gdb:with-stack exception, unwrap it, a backtrace
 568    is never returned as part of the result.
 569
 570    Space for the result is malloc'd, the caller must free.  */
 571
 572 char *
 573 gdbscm_exception_message_to_string (SCM exception)
 574 {
 575   SCM port = scm_open_output_string ();
 576   SCM key, args;
 577   char *result;
 578
 579   gdb_assert (gdbscm_is_exception (exception));
 580
 581   key = gdbscm_exception_key (exception);
 582   args = gdbscm_exception_args (exception);
 583
 584   if (scm_is_eq (key, with_stack_error_symbol)
 585       /* Don't crash on a badly generated gdb:with-stack exception.  */
 586       && scm_is_pair (args)
 587       && scm_is_pair (scm_cdr (args)))
 588     {
 589       key = scm_car (args);
 590       args = scm_cddr (args);
 591     }
 592
 593   gdbscm_print_exception_message (port, SCM_BOOL_F, key, args);
 594   result = gdbscm_scm_to_c_string (scm_get_output_string (port));
 595   scm_close_port (port);
 596
 597   return result;
 598 }
 599
 600 /* Return the value of the "guile print-stack" option as one of:
 601    'none, 'message, 'full.  */
 602
 603 static SCM
 604 gdbscm_percent_exception_print_style (void)
 605 {
 606   if (gdbscm_print_excp == gdbscm_print_excp_none)
 607     return none_symbol;
 608   if (gdbscm_print_excp == gdbscm_print_excp_message)
 609     return message_symbol;
 610   if (gdbscm_print_excp == gdbscm_print_excp_full)
 611     return full_symbol;
 612   gdb_assert_not_reached ("bad value for \"guile print-stack\"");
 613 }
 614
 615 /* Return the current <gdb:exception> counter.
 616    This is for debugging purposes.  */
 617
 618 static SCM
 619 gdbscm_percent_exception_count (void)
 620 {
 621   return scm_from_ulong (gdbscm_exception_count);
 622 }
 623 \f
 624 /* Initialize the Scheme exception support.  */
 625
 626 static const scheme_function exception_functions[] =
 627 {
 628   { "make-exception", 2, 0, 0, gdbscm_make_exception,
 629     "\
 630 Create a <gdb:exception> object.\n\
 631 \n\
 632   Arguments: key args\n\
 633     These are the standard key,args arguments of \"throw\"." },
 634
 635   { "exception?", 1, 0, 0, gdbscm_exception_p,
 636     "\
 637 Return #t if the object is a <gdb:exception> object." },
 638
 639   { "exception-key", 1, 0, 0, gdbscm_exception_key,
 640     "\
 641 Return the exception's key." },
 642
 643   { "exception-args", 1, 0, 0, gdbscm_exception_args,
 644     "\
 645 Return the exception's arg list." },
 646
 647   END_FUNCTIONS
 648 };
 649
 650 static const scheme_function private_exception_functions[] =
 651 {
 652   { "%exception-print-style", 0, 0, 0, gdbscm_percent_exception_print_style,
 653     "\
 654 Return the value of the \"guile print-stack\" option." },
 655
 656   { "%exception-count", 0, 0, 0, gdbscm_percent_exception_count,
 657     "\
 658 Return a count of the number of <gdb:exception> objects created.\n\
 659 This is for debugging purposes." },
 660
 661   END_FUNCTIONS
 662 };
 663
 664 void
 665 gdbscm_initialize_exceptions (void)
 666 {
 667   exception_smob_tag = gdbscm_make_smob_type (exception_smob_name,
 668                                               sizeof (exception_smob));
 669   scm_set_smob_print (exception_smob_tag, exscm_print_exception_smob);
 670
 671   gdbscm_define_functions (exception_functions, 1);
 672   gdbscm_define_functions (private_exception_functions, 0);
 673
 674   error_symbol = scm_from_latin1_symbol ("gdb:error");
 675
 676   memory_error_symbol = scm_from_latin1_symbol ("gdb:memory-error");
 677
 678   user_error_symbol = scm_from_latin1_symbol ("gdb:user-error");
 679
 680   gdbscm_invalid_object_error_symbol
 681     = scm_from_latin1_symbol ("gdb:invalid-object-error");
 682
 683   with_stack_error_symbol = scm_from_latin1_symbol ("gdb:with-stack");
 684
 685   /* The text of this symbol is taken from Guile's top-repl.scm.  */
 686   signal_symbol = scm_from_latin1_symbol ("signal");
 687
 688   none_symbol = scm_from_latin1_symbol ("none");
 689   message_symbol = scm_from_latin1_symbol ("message");
 690   full_symbol = scm_from_latin1_symbol ("full");
 691 }