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