gdb/guile/scm-symbol.c

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