gdb/guile/scm-exception.c

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