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