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   try
 490     {
 491       result = symbol_read_needs_frame (symbol);
 492     }
 493   catch (const gdb_exception_RETURN_MASK_ALL &except)
 494     {
 495       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 496     }
 497
 498   return scm_from_bool (result);
 499 }
 500
 501 /* (symbol-line <gdb:symbol>) -> integer
 502    Return the line number at which the symbol was defined.  */
 503
 504 static SCM
 505 gdbscm_symbol_line (SCM self)
 506 {
 507   symbol_smob *s_smob
 508     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 509   const struct symbol *symbol = s_smob->symbol;
 510
 511   return scm_from_int (SYMBOL_LINE (symbol));
 512 }
 513
 514 /* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
 515    Return the value of the symbol, or an error in various circumstances.  */
 516
 517 static SCM
 518 gdbscm_symbol_value (SCM self, SCM rest)
 519 {
 520   symbol_smob *s_smob
 521     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 522   struct symbol *symbol = s_smob->symbol;
 523   SCM keywords[] = { frame_keyword, SCM_BOOL_F };
 524   int frame_pos = -1;
 525   SCM frame_scm = SCM_BOOL_F;
 526   frame_smob *f_smob = NULL;
 527   struct frame_info *frame_info = NULL;
 528   struct value *value = NULL;
 529
 530   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O",
 531                               rest, &frame_pos, &frame_scm);
 532   if (!gdbscm_is_false (frame_scm))
 533     f_smob = frscm_get_frame_smob_arg_unsafe (frame_scm, frame_pos, FUNC_NAME);
 534
 535   if (SYMBOL_CLASS (symbol) == LOC_TYPEDEF)
 536     {
 537       gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
 538                                  _("cannot get the value of a typedef"));
 539     }
 540
 541   try
 542     {
 543       if (f_smob != NULL)
 544         {
 545           frame_info = frscm_frame_smob_to_frame (f_smob);
 546           if (frame_info == NULL)
 547             error (_("Invalid frame"));
 548         }
 549
 550       if (symbol_read_needs_frame (symbol) && frame_info == NULL)
 551         error (_("Symbol requires a frame to compute its value"));
 552
 553       /* TODO: currently, we have no way to recover the block in which SYMBOL
 554          was found, so we have no block to pass to read_var_value.  This will
 555          yield an incorrect value when symbol is not local to FRAME_INFO (this
 556          can happen with nested functions).  */
 557       value = read_var_value (symbol, NULL, frame_info);
 558     }
 559   catch (const gdb_exception_RETURN_MASK_ALL &except)
 560     {
 561       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 562     }
 563
 564   return vlscm_scm_from_value (value);
 565 }
 566 \f
 567 /* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
 568      -> (<gdb:symbol> field-of-this?)
 569    The result is #f if the symbol is not found.
 570    See comment in lookup_symbol_in_language for field-of-this?.  */
 571
 572 static SCM
 573 gdbscm_lookup_symbol (SCM name_scm, SCM rest)
 574 {
 575   char *name;
 576   SCM keywords[] = { block_keyword, domain_keyword, SCM_BOOL_F };
 577   const struct block *block = NULL;
 578   SCM block_scm = SCM_BOOL_F;
 579   int domain = VAR_DOMAIN;
 580   int block_arg_pos = -1, domain_arg_pos = -1;
 581   struct field_of_this_result is_a_field_of_this;
 582   struct symbol *symbol = NULL;
 583
 584   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi",
 585                               name_scm, &name, rest,
 586                               &block_arg_pos, &block_scm,
 587                               &domain_arg_pos, &domain);
 588
 589   if (block_arg_pos >= 0)
 590     {
 591       SCM except_scm;
 592
 593       block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
 594                                   &except_scm);
 595       if (block == NULL)
 596         {
 597           xfree (name);
 598           gdbscm_throw (except_scm);
 599         }
 600     }
 601   else
 602     {
 603       struct frame_info *selected_frame;
 604
 605       try
 606         {
 607           selected_frame = get_selected_frame (_("no frame selected"));
 608           block = get_frame_block (selected_frame, NULL);
 609         }
 610       catch (const gdb_exception_RETURN_MASK_ALL &ex)
 611         {
 612           xfree (name);
 613           GDBSCM_HANDLE_GDB_EXCEPTION (ex);
 614         }
 615     }
 616
 617   struct gdb_exception except = exception_none;
 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_RETURN_MASK_ALL &ex)
 624     {
 625       except = 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   struct gdb_exception except = exception_none;
 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_RETURN_MASK_ALL &ex)
 660     {
 661       except = 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
 815   /* Register an objfile "free" callback so we can properly
 816      invalidate symbols when an object file is about to be deleted.  */
 817   syscm_objfile_data_key
 818     = register_objfile_data_with_cleanup (NULL, syscm_del_objfile_symbols);
 819
 820   /* Arch-specific symbol data.  */
 821   syscm_gdbarch_data_key
 822     = gdbarch_data_register_post_init (syscm_init_arch_symbols);
 823 }