gdb/guile/scm-symbol.c

   1 /* Scheme interface to symbols.
   2
   3    Copyright (C) 2008-2015 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 #include "defs.h"
  24 #include "block.h"
  25 #include "frame.h"
  26 #include "symtab.h"
  27 #include "objfiles.h"
  28 #include "value.h"
  29 #include "guile-internal.h"
  30
  31 /* The <gdb:symbol> smob.  */
  32
  33 typedef struct
  34 {
  35   /* This always appears first.  */
  36   eqable_gdb_smob base;
  37
  38   /* The GDB symbol structure this smob is wrapping.  */
  39   struct symbol *symbol;
  40 } symbol_smob;
  41
  42 static const char symbol_smob_name[] = "gdb:symbol";
  43
  44 /* The tag Guile knows the symbol smob by.  */
  45 static scm_t_bits symbol_smob_tag;
  46
  47 /* Keywords used in argument passing.  */
  48 static SCM block_keyword;
  49 static SCM domain_keyword;
  50 static SCM frame_keyword;
  51
  52 static const struct objfile_data *syscm_objfile_data_key;
  53 static struct gdbarch_data *syscm_gdbarch_data_key;
  54
  55 struct syscm_gdbarch_data
  56 {
  57   /* Hash table to implement eqable gdbarch symbols.  */
  58   htab_t htab;
  59 };
  60 \f
  61 /* Administrivia for symbol smobs.  */
  62
  63 /* Helper function to hash a symbol_smob.  */
  64
  65 static hashval_t
  66 syscm_hash_symbol_smob (const void *p)
  67 {
  68   const symbol_smob *s_smob = p;
  69
  70   return htab_hash_pointer (s_smob->symbol);
  71 }
  72
  73 /* Helper function to compute equality of symbol_smobs.  */
  74
  75 static int
  76 syscm_eq_symbol_smob (const void *ap, const void *bp)
  77 {
  78   const symbol_smob *a = ap;
  79   const symbol_smob *b = bp;
  80
  81   return (a->symbol == b->symbol
  82           && a->symbol != NULL);
  83 }
  84
  85 static void *
  86 syscm_init_arch_symbols (struct gdbarch *gdbarch)
  87 {
  88   struct syscm_gdbarch_data *data
  89     = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct syscm_gdbarch_data);
  90
  91   data->htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob,
  92                                                    syscm_eq_symbol_smob);
  93   return data;
  94 }
  95
  96 /* Return the struct symbol pointer -> SCM mapping table.
  97    It is created if necessary.  */
  98
  99 static htab_t
 100 syscm_get_symbol_map (struct symbol *symbol)
 101 {
 102   htab_t htab;
 103
 104   if (SYMBOL_OBJFILE_OWNED (symbol))
 105     {
 106       struct objfile *objfile = symbol_objfile (symbol);
 107
 108       htab = objfile_data (objfile, syscm_objfile_data_key);
 109       if (htab == NULL)
 110         {
 111           htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob,
 112                                                      syscm_eq_symbol_smob);
 113           set_objfile_data (objfile, syscm_objfile_data_key, htab);
 114         }
 115     }
 116   else
 117     {
 118       struct gdbarch *gdbarch = symbol_arch (symbol);
 119       struct syscm_gdbarch_data *data = gdbarch_data (gdbarch,
 120                                                       syscm_gdbarch_data_key);
 121
 122       htab = data->htab;
 123     }
 124
 125   return htab;
 126 }
 127
 128 /* The smob "free" function for <gdb:symbol>.  */
 129
 130 static size_t
 131 syscm_free_symbol_smob (SCM self)
 132 {
 133   symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
 134
 135   if (s_smob->symbol != NULL)
 136     {
 137       htab_t htab = syscm_get_symbol_map (s_smob->symbol);
 138
 139       gdbscm_clear_eqable_gsmob_ptr_slot (htab, &s_smob->base);
 140     }
 141
 142   /* Not necessary, done to catch bugs.  */
 143   s_smob->symbol = NULL;
 144
 145   return 0;
 146 }
 147
 148 /* The smob "print" function for <gdb:symbol>.  */
 149
 150 static int
 151 syscm_print_symbol_smob (SCM self, SCM port, scm_print_state *pstate)
 152 {
 153   symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
 154
 155   if (pstate->writingp)
 156     gdbscm_printf (port, "#<%s ", symbol_smob_name);
 157   gdbscm_printf (port, "%s",
 158                  s_smob->symbol != NULL
 159                  ? SYMBOL_PRINT_NAME (s_smob->symbol)
 160                  : "<invalid>");
 161   if (pstate->writingp)
 162     scm_puts (">", port);
 163
 164   scm_remember_upto_here_1 (self);
 165
 166   /* Non-zero means success.  */
 167   return 1;
 168 }
 169
 170 /* Low level routine to create a <gdb:symbol> object.  */
 171
 172 static SCM
 173 syscm_make_symbol_smob (void)
 174 {
 175   symbol_smob *s_smob = (symbol_smob *)
 176     scm_gc_malloc (sizeof (symbol_smob), symbol_smob_name);
 177   SCM s_scm;
 178
 179   s_smob->symbol = NULL;
 180   s_scm = scm_new_smob (symbol_smob_tag, (scm_t_bits) s_smob);
 181   gdbscm_init_eqable_gsmob (&s_smob->base, s_scm);
 182
 183   return s_scm;
 184 }
 185
 186 /* Return non-zero if SCM is a symbol smob.  */
 187
 188 int
 189 syscm_is_symbol (SCM scm)
 190 {
 191   return SCM_SMOB_PREDICATE (symbol_smob_tag, scm);
 192 }
 193
 194 /* (symbol? object) -> boolean */
 195
 196 static SCM
 197 gdbscm_symbol_p (SCM scm)
 198 {
 199   return scm_from_bool (syscm_is_symbol (scm));
 200 }
 201
 202 /* Return the existing object that encapsulates SYMBOL, or create a new
 203    <gdb:symbol> object.  */
 204
 205 SCM
 206 syscm_scm_from_symbol (struct symbol *symbol)
 207 {
 208   htab_t htab;
 209   eqable_gdb_smob **slot;
 210   symbol_smob *s_smob, s_smob_for_lookup;
 211   SCM s_scm;
 212
 213   /* If we've already created a gsmob for this symbol, return it.
 214      This makes symbols eq?-able.  */
 215   htab = syscm_get_symbol_map (symbol);
 216   s_smob_for_lookup.symbol = symbol;
 217   slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &s_smob_for_lookup.base);
 218   if (*slot != NULL)
 219     return (*slot)->containing_scm;
 220
 221   s_scm = syscm_make_symbol_smob ();
 222   s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm);
 223   s_smob->symbol = symbol;
 224   gdbscm_fill_eqable_gsmob_ptr_slot (slot, &s_smob->base);
 225
 226   return s_scm;
 227 }
 228
 229 /* Returns the <gdb:symbol> object in SELF.
 230    Throws an exception if SELF is not a <gdb:symbol> object.  */
 231
 232 static SCM
 233 syscm_get_symbol_arg_unsafe (SCM self, int arg_pos, const char *func_name)
 234 {
 235   SCM_ASSERT_TYPE (syscm_is_symbol (self), self, arg_pos, func_name,
 236                    symbol_smob_name);
 237
 238   return self;
 239 }
 240
 241 /* Returns a pointer to the symbol smob of SELF.
 242    Throws an exception if SELF is not a <gdb:symbol> object.  */
 243
 244 static symbol_smob *
 245 syscm_get_symbol_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
 246 {
 247   SCM s_scm = syscm_get_symbol_arg_unsafe (self, arg_pos, func_name);
 248   symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm);
 249
 250   return s_smob;
 251 }
 252
 253 /* Return non-zero if symbol S_SMOB is valid.  */
 254
 255 static int
 256 syscm_is_valid (symbol_smob *s_smob)
 257 {
 258   return s_smob->symbol != NULL;
 259 }
 260
 261 /* Throw a Scheme error if SELF is not a valid symbol smob.
 262    Otherwise return a pointer to the symbol smob.  */
 263
 264 static symbol_smob *
 265 syscm_get_valid_symbol_smob_arg_unsafe (SCM self, int arg_pos,
 266                                         const char *func_name)
 267 {
 268   symbol_smob *s_smob
 269     = syscm_get_symbol_smob_arg_unsafe (self, arg_pos, func_name);
 270
 271   if (!syscm_is_valid (s_smob))
 272     {
 273       gdbscm_invalid_object_error (func_name, arg_pos, self,
 274                                    _("<gdb:symbol>"));
 275     }
 276
 277   return s_smob;
 278 }
 279
 280 /* Throw a Scheme error if SELF is not a valid symbol smob.
 281    Otherwise return a pointer to the symbol struct.  */
 282
 283 struct symbol *
 284 syscm_get_valid_symbol_arg_unsafe (SCM self, int arg_pos,
 285                                    const char *func_name)
 286 {
 287   symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, arg_pos,
 288                                                                 func_name);
 289
 290   return s_smob->symbol;
 291 }
 292
 293 /* Helper function for syscm_del_objfile_symbols to mark the symbol
 294    as invalid.  */
 295
 296 static int
 297 syscm_mark_symbol_invalid (void **slot, void *info)
 298 {
 299   symbol_smob *s_smob = (symbol_smob *) *slot;
 300
 301   s_smob->symbol = NULL;
 302   return 1;
 303 }
 304
 305 /* This function is called when an objfile is about to be freed.
 306    Invalidate the symbol as further actions on the symbol would result
 307    in bad data.  All access to s_smob->symbol should be gated by
 308    syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on
 309    invalid symbols.  */
 310
 311 static void
 312 syscm_del_objfile_symbols (struct objfile *objfile, void *datum)
 313 {
 314   htab_t htab = datum;
 315
 316   if (htab != NULL)
 317     {
 318       htab_traverse_noresize (htab, syscm_mark_symbol_invalid, NULL);
 319       htab_delete (htab);
 320     }
 321 }
 322 \f
 323 /* Symbol methods.  */
 324
 325 /* (symbol-valid? <gdb:symbol>) -> boolean
 326    Returns #t if SELF still exists in GDB.  */
 327
 328 static SCM
 329 gdbscm_symbol_valid_p (SCM self)
 330 {
 331   symbol_smob *s_smob
 332     = syscm_get_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 333
 334   return scm_from_bool (syscm_is_valid (s_smob));
 335 }
 336
 337 /* (symbol-type <gdb:symbol>) -> <gdb:type>
 338    Return the type of SELF, or #f if SELF has no type.  */
 339
 340 static SCM
 341 gdbscm_symbol_type (SCM self)
 342 {
 343   symbol_smob *s_smob
 344     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 345   const struct symbol *symbol = s_smob->symbol;
 346
 347   if (SYMBOL_TYPE (symbol) == NULL)
 348     return SCM_BOOL_F;
 349
 350   return tyscm_scm_from_type (SYMBOL_TYPE (symbol));
 351 }
 352
 353 /* (symbol-symtab <gdb:symbol>) -> <gdb:symtab> | #f
 354    Return the symbol table of SELF.
 355    If SELF does not have a symtab (it is arch-owned) return #f.  */
 356
 357 static SCM
 358 gdbscm_symbol_symtab (SCM self)
 359 {
 360   symbol_smob *s_smob
 361     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 362   const struct symbol *symbol = s_smob->symbol;
 363
 364   if (!SYMBOL_OBJFILE_OWNED (symbol))
 365     return SCM_BOOL_F;
 366   return stscm_scm_from_symtab (symbol_symtab (symbol));
 367 }
 368
 369 /* (symbol-name <gdb:symbol>) -> string */
 370
 371 static SCM
 372 gdbscm_symbol_name (SCM self)
 373 {
 374   symbol_smob *s_smob
 375     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 376   const struct symbol *symbol = s_smob->symbol;
 377
 378   return gdbscm_scm_from_c_string (SYMBOL_NATURAL_NAME (symbol));
 379 }
 380
 381 /* (symbol-linkage-name <gdb:symbol>) -> string */
 382
 383 static SCM
 384 gdbscm_symbol_linkage_name (SCM self)
 385 {
 386   symbol_smob *s_smob
 387     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 388   const struct symbol *symbol = s_smob->symbol;
 389
 390   return gdbscm_scm_from_c_string (SYMBOL_LINKAGE_NAME (symbol));
 391 }
 392
 393 /* (symbol-print-name <gdb:symbol>) -> string */
 394
 395 static SCM
 396 gdbscm_symbol_print_name (SCM self)
 397 {
 398   symbol_smob *s_smob
 399     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 400   const struct symbol *symbol = s_smob->symbol;
 401
 402   return gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol));
 403 }
 404
 405 /* (symbol-addr-class <gdb:symbol>) -> integer */
 406
 407 static SCM
 408 gdbscm_symbol_addr_class (SCM self)
 409 {
 410   symbol_smob *s_smob
 411     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 412   const struct symbol *symbol = s_smob->symbol;
 413
 414   return scm_from_int (SYMBOL_CLASS (symbol));
 415 }
 416
 417 /* (symbol-argument? <gdb:symbol>) -> boolean */
 418
 419 static SCM
 420 gdbscm_symbol_argument_p (SCM self)
 421 {
 422   symbol_smob *s_smob
 423     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 424   const struct symbol *symbol = s_smob->symbol;
 425
 426   return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol));
 427 }
 428
 429 /* (symbol-constant? <gdb:symbol>) -> boolean */
 430
 431 static SCM
 432 gdbscm_symbol_constant_p (SCM self)
 433 {
 434   symbol_smob *s_smob
 435     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 436   const struct symbol *symbol = s_smob->symbol;
 437   enum address_class theclass;
 438
 439   theclass = SYMBOL_CLASS (symbol);
 440
 441   return scm_from_bool (theclass == LOC_CONST || theclass == LOC_CONST_BYTES);
 442 }
 443
 444 /* (symbol-function? <gdb:symbol>) -> boolean */
 445
 446 static SCM
 447 gdbscm_symbol_function_p (SCM self)
 448 {
 449   symbol_smob *s_smob
 450     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 451   const struct symbol *symbol = s_smob->symbol;
 452   enum address_class theclass;
 453
 454   theclass = SYMBOL_CLASS (symbol);
 455
 456   return scm_from_bool (theclass == LOC_BLOCK);
 457 }
 458
 459 /* (symbol-variable? <gdb:symbol>) -> boolean */
 460
 461 static SCM
 462 gdbscm_symbol_variable_p (SCM self)
 463 {
 464   symbol_smob *s_smob
 465     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 466   const struct symbol *symbol = s_smob->symbol;
 467   enum address_class theclass;
 468
 469   theclass = SYMBOL_CLASS (symbol);
 470
 471   return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol)
 472                         && (theclass == LOC_LOCAL || theclass == LOC_REGISTER
 473                             || theclass == LOC_STATIC || theclass == LOC_COMPUTED
 474                             || theclass == LOC_OPTIMIZED_OUT));
 475 }
 476
 477 /* (symbol-needs-frame? <gdb:symbol>) -> boolean
 478    Return #t if the symbol needs a frame for evaluation.  */
 479
 480 static SCM
 481 gdbscm_symbol_needs_frame_p (SCM self)
 482 {
 483   symbol_smob *s_smob
 484     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 485   struct symbol *symbol = s_smob->symbol;
 486   int result = 0;
 487
 488   TRY
 489     {
 490       result = symbol_read_needs_frame (symbol);
 491     }
 492   CATCH (except, RETURN_MASK_ALL)
 493     {
 494       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 495     }
 496   END_CATCH
 497
 498   return scm_from_bool (result);
 499 }
 500
 501 /* (symbol-line <gdb:symbol>) -> integer
 502    Return the line number at which the symbol was defined.  */
 503
 504 static SCM
 505 gdbscm_symbol_line (SCM self)
 506 {
 507   symbol_smob *s_smob
 508     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 509   const struct symbol *symbol = s_smob->symbol;
 510
 511   return scm_from_int (SYMBOL_LINE (symbol));
 512 }
 513
 514 /* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
 515    Return the value of the symbol, or an error in various circumstances.  */
 516
 517 static SCM
 518 gdbscm_symbol_value (SCM self, SCM rest)
 519 {
 520   symbol_smob *s_smob
 521     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 522   struct symbol *symbol = s_smob->symbol;
 523   SCM keywords[] = { frame_keyword, SCM_BOOL_F };
 524   int frame_pos = -1;
 525   SCM frame_scm = SCM_BOOL_F;
 526   frame_smob *f_smob = NULL;
 527   struct frame_info *frame_info = NULL;
 528   struct value *value = NULL;
 529
 530   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O",
 531                               rest, &frame_pos, &frame_scm);
 532   if (!gdbscm_is_false (frame_scm))
 533     f_smob = frscm_get_frame_smob_arg_unsafe (frame_scm, frame_pos, FUNC_NAME);
 534
 535   if (SYMBOL_CLASS (symbol) == LOC_TYPEDEF)
 536     {
 537       gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
 538                                  _("cannot get the value of a typedef"));
 539     }
 540
 541   TRY
 542     {
 543       if (f_smob != NULL)
 544         {
 545           frame_info = frscm_frame_smob_to_frame (f_smob);
 546           if (frame_info == NULL)
 547             error (_("Invalid frame"));
 548         }
 549
 550       if (symbol_read_needs_frame (symbol) && frame_info == NULL)
 551         error (_("Symbol requires a frame to compute its value"));
 552
 553       value = read_var_value (symbol, frame_info);
 554     }
 555   CATCH (except, RETURN_MASK_ALL)
 556     {
 557       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 558     }
 559   END_CATCH
 560
 561   return vlscm_scm_from_value (value);
 562 }
 563 \f
 564 /* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
 565      -> (<gdb:symbol> field-of-this?)
 566    The result is #f if the symbol is not found.
 567    See comment in lookup_symbol_in_language for field-of-this?.  */
 568
 569 static SCM
 570 gdbscm_lookup_symbol (SCM name_scm, SCM rest)
 571 {
 572   char *name;
 573   SCM keywords[] = { block_keyword, domain_keyword, SCM_BOOL_F };
 574   const struct block *block = NULL;
 575   SCM block_scm = SCM_BOOL_F;
 576   int domain = VAR_DOMAIN;
 577   int block_arg_pos = -1, domain_arg_pos = -1;
 578   struct field_of_this_result is_a_field_of_this;
 579   struct symbol *symbol = NULL;
 580   struct cleanup *cleanups;
 581   struct gdb_exception except = exception_none;
 582
 583   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi",
 584                               name_scm, &name, rest,
 585                               &block_arg_pos, &block_scm,
 586                               &domain_arg_pos, &domain);
 587
 588   cleanups = make_cleanup (xfree, name);
 589
 590   if (block_arg_pos >= 0)
 591     {
 592       SCM except_scm;
 593
 594       block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
 595                                   &except_scm);
 596       if (block == NULL)
 597         {
 598           do_cleanups (cleanups);
 599           gdbscm_throw (except_scm);
 600         }
 601     }
 602   else
 603     {
 604       struct frame_info *selected_frame;
 605
 606       TRY
 607         {
 608           selected_frame = get_selected_frame (_("no frame selected"));
 609           block = get_frame_block (selected_frame, NULL);
 610         }
 611       CATCH (except, RETURN_MASK_ALL)
 612         {
 613           GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
 614         }
 615       END_CATCH
 616     }
 617
 618   TRY
 619     {
 620       symbol = lookup_symbol (name, block, domain, &is_a_field_of_this).symbol;
 621     }
 622   CATCH (ex, RETURN_MASK_ALL)
 623     {
 624       except = ex;
 625     }
 626   END_CATCH
 627
 628   do_cleanups (cleanups);
 629   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 630
 631   if (symbol == NULL)
 632     return SCM_BOOL_F;
 633
 634   return scm_list_2 (syscm_scm_from_symbol (symbol),
 635                      scm_from_bool (is_a_field_of_this.type != NULL));
 636 }
 637
 638 /* (lookup-global-symbol name [#:domain domain]) -> <gdb:symbol>
 639    The result is #f if the symbol is not found.  */
 640
 641 static SCM
 642 gdbscm_lookup_global_symbol (SCM name_scm, SCM rest)
 643 {
 644   char *name;
 645   SCM keywords[] = { domain_keyword, SCM_BOOL_F };
 646   int domain_arg_pos = -1;
 647   int domain = VAR_DOMAIN;
 648   struct symbol *symbol = NULL;
 649   struct cleanup *cleanups;
 650   struct gdb_exception except = exception_none;
 651
 652   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i",
 653                               name_scm, &name, rest,
 654                               &domain_arg_pos, &domain);
 655
 656   cleanups = make_cleanup (xfree, name);
 657
 658   TRY
 659     {
 660       symbol = lookup_global_symbol (name, NULL, domain).symbol;
 661     }
 662   CATCH (ex, RETURN_MASK_ALL)
 663     {
 664       except = ex;
 665     }
 666   END_CATCH
 667
 668   do_cleanups (cleanups);
 669   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 670
 671   if (symbol == NULL)
 672     return SCM_BOOL_F;
 673
 674   return syscm_scm_from_symbol (symbol);
 675 }
 676 \f
 677 /* Initialize the Scheme symbol support.  */
 678
 679 /* Note: The SYMBOL_ prefix on the integer constants here is present for
 680    compatibility with the Python support.  */
 681
 682 static const scheme_integer_constant symbol_integer_constants[] =
 683 {
 684 #define X(SYM) { "SYMBOL_" #SYM, SYM }
 685   X (LOC_UNDEF),
 686   X (LOC_CONST),
 687   X (LOC_STATIC),
 688   X (LOC_REGISTER),
 689   X (LOC_ARG),
 690   X (LOC_REF_ARG),
 691   X (LOC_LOCAL),
 692   X (LOC_TYPEDEF),
 693   X (LOC_LABEL),
 694   X (LOC_BLOCK),
 695   X (LOC_CONST_BYTES),
 696   X (LOC_UNRESOLVED),
 697   X (LOC_OPTIMIZED_OUT),
 698   X (LOC_COMPUTED),
 699   X (LOC_REGPARM_ADDR),
 700
 701   X (UNDEF_DOMAIN),
 702   X (VAR_DOMAIN),
 703   X (STRUCT_DOMAIN),
 704   X (LABEL_DOMAIN),
 705   X (VARIABLES_DOMAIN),
 706   X (FUNCTIONS_DOMAIN),
 707   X (TYPES_DOMAIN),
 708 #undef X
 709
 710   END_INTEGER_CONSTANTS
 711 };
 712
 713 static const scheme_function symbol_functions[] =
 714 {
 715   { "symbol?", 1, 0, 0, gdbscm_symbol_p,
 716     "\
 717 Return #t if the object is a <gdb:symbol> object." },
 718
 719   { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p,
 720     "\
 721 Return #t if object is a valid <gdb:symbol> object.\n\
 722 A valid symbol is a symbol that has not been freed.\n\
 723 Symbols are freed when the objfile they come from is freed." },
 724
 725   { "symbol-type", 1, 0, 0, gdbscm_symbol_type,
 726     "\
 727 Return the type of symbol." },
 728
 729   { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab,
 730     "\
 731 Return the symbol table (<gdb:symtab>) containing symbol." },
 732
 733   { "symbol-line", 1, 0, 0, gdbscm_symbol_line,
 734     "\
 735 Return the line number at which the symbol was defined." },
 736
 737   { "symbol-name", 1, 0, 0, gdbscm_symbol_name,
 738     "\
 739 Return the name of the symbol as a string." },
 740
 741   { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name,
 742     "\
 743 Return the linkage name of the symbol as a string." },
 744
 745   { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name,
 746     "\
 747 Return the print name of the symbol as a string.\n\
 748 This is either name or linkage-name, depending on whether the user\n\
 749 asked GDB to display demangled or mangled names." },
 750
 751   { "symbol-addr-class", 1, 0, 0, gdbscm_symbol_addr_class,
 752     "\
 753 Return the address class of the symbol." },
 754
 755   { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p,
 756     "\
 757 Return #t if the symbol needs a frame to compute its value." },
 758
 759   { "symbol-argument?", 1, 0, 0, gdbscm_symbol_argument_p,
 760     "\
 761 Return #t if the symbol is a function argument." },
 762
 763   { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p,
 764     "\
 765 Return #t if the symbol is a constant." },
 766
 767   { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p,
 768     "\
 769 Return #t if the symbol is a function." },
 770
 771   { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p,
 772     "\
 773 Return #t if the symbol is a variable." },
 774
 775   { "symbol-value", 1, 0, 1, gdbscm_symbol_value,
 776     "\
 777 Return the value of the symbol.\n\
 778 \n\
 779   Arguments: <gdb:symbol> [#:frame frame]" },
 780
 781   { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol,
 782     "\
 783 Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\
 784 \n\
 785   Arguments: name [#:block block] [#:domain domain]\n\
 786     name:   a string containing the name of the symbol to lookup\n\
 787     block:  a <gdb:block> object\n\
 788     domain: a SYMBOL_*_DOMAIN value" },
 789
 790   { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol,
 791     "\
 792 Return <gdb:symbol> if found, otherwise #f.\n\
 793 \n\
 794   Arguments: name [#:domain domain]\n\
 795     name:   a string containing the name of the symbol to lookup\n\
 796     domain: a SYMBOL_*_DOMAIN value" },
 797
 798   END_FUNCTIONS
 799 };
 800
 801 void
 802 gdbscm_initialize_symbols (void)
 803 {
 804   symbol_smob_tag
 805     = gdbscm_make_smob_type (symbol_smob_name, sizeof (symbol_smob));
 806   scm_set_smob_free (symbol_smob_tag, syscm_free_symbol_smob);
 807   scm_set_smob_print (symbol_smob_tag, syscm_print_symbol_smob);
 808
 809   gdbscm_define_integer_constants (symbol_integer_constants, 1);
 810   gdbscm_define_functions (symbol_functions, 1);
 811
 812   block_keyword = scm_from_latin1_keyword ("block");
 813   domain_keyword = scm_from_latin1_keyword ("domain");
 814   frame_keyword = scm_from_latin1_keyword ("frame");
 815
 816   /* Register an objfile "free" callback so we can properly
 817      invalidate symbols when an object file is about to be deleted.  */
 818   syscm_objfile_data_key
 819     = register_objfile_data_with_cleanup (NULL, syscm_del_objfile_symbols);
 820
 821   /* Arch-specific symbol data.  */
 822   syscm_gdbarch_data_key
 823     = gdbarch_data_register_post_init (syscm_init_arch_symbols);
 824 }