gdb/guile/scm-symbol.c

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