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