gdb/guile/scm-symbol.c

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