gdb/guile/scm-symbol.c

   1 /* Scheme interface to symbols.
   2
   3    Copyright (C) 2008-2016 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 (except, RETURN_MASK_ALL)
 494     {
 495       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 496     }
 497   END_CATCH
 498
 499   return scm_from_bool (result);
 500 }
 501
 502 /* (symbol-line <gdb:symbol>) -> integer
 503    Return the line number at which the symbol was defined.  */
 504
 505 static SCM
 506 gdbscm_symbol_line (SCM self)
 507 {
 508   symbol_smob *s_smob
 509     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 510   const struct symbol *symbol = s_smob->symbol;
 511
 512   return scm_from_int (SYMBOL_LINE (symbol));
 513 }
 514
 515 /* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
 516    Return the value of the symbol, or an error in various circumstances.  */
 517
 518 static SCM
 519 gdbscm_symbol_value (SCM self, SCM rest)
 520 {
 521   symbol_smob *s_smob
 522     = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 523   struct symbol *symbol = s_smob->symbol;
 524   SCM keywords[] = { frame_keyword, SCM_BOOL_F };
 525   int frame_pos = -1;
 526   SCM frame_scm = SCM_BOOL_F;
 527   frame_smob *f_smob = NULL;
 528   struct frame_info *frame_info = NULL;
 529   struct value *value = NULL;
 530
 531   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O",
 532                               rest, &frame_pos, &frame_scm);
 533   if (!gdbscm_is_false (frame_scm))
 534     f_smob = frscm_get_frame_smob_arg_unsafe (frame_scm, frame_pos, FUNC_NAME);
 535
 536   if (SYMBOL_CLASS (symbol) == LOC_TYPEDEF)
 537     {
 538       gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
 539                                  _("cannot get the value of a typedef"));
 540     }
 541
 542   TRY
 543     {
 544       if (f_smob != NULL)
 545         {
 546           frame_info = frscm_frame_smob_to_frame (f_smob);
 547           if (frame_info == NULL)
 548             error (_("Invalid frame"));
 549         }
 550
 551       if (symbol_read_needs_frame (symbol) && frame_info == NULL)
 552         error (_("Symbol requires a frame to compute its value"));
 553
 554       /* TODO: currently, we have no way to recover the block in which SYMBOL
 555          was found, so we have no block to pass to read_var_value.  This will
 556          yield an incorrect value when symbol is not local to FRAME_INFO (this
 557          can happen with nested functions).  */
 558       value = read_var_value (symbol, NULL, frame_info);
 559     }
 560   CATCH (except, RETURN_MASK_ALL)
 561     {
 562       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 563     }
 564   END_CATCH
 565
 566   return vlscm_scm_from_value (value);
 567 }
 568 \f
 569 /* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
 570      -> (<gdb:symbol> field-of-this?)
 571    The result is #f if the symbol is not found.
 572    See comment in lookup_symbol_in_language for field-of-this?.  */
 573
 574 static SCM
 575 gdbscm_lookup_symbol (SCM name_scm, SCM rest)
 576 {
 577   char *name;
 578   SCM keywords[] = { block_keyword, domain_keyword, SCM_BOOL_F };
 579   const struct block *block = NULL;
 580   SCM block_scm = SCM_BOOL_F;
 581   int domain = VAR_DOMAIN;
 582   int block_arg_pos = -1, domain_arg_pos = -1;
 583   struct field_of_this_result is_a_field_of_this;
 584   struct symbol *symbol = NULL;
 585   struct cleanup *cleanups;
 586   struct gdb_exception except = exception_none;
 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   cleanups = make_cleanup (xfree, name);
 594
 595   if (block_arg_pos >= 0)
 596     {
 597       SCM except_scm;
 598
 599       block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
 600                                   &except_scm);
 601       if (block == NULL)
 602         {
 603           do_cleanups (cleanups);
 604           gdbscm_throw (except_scm);
 605         }
 606     }
 607   else
 608     {
 609       struct frame_info *selected_frame;
 610
 611       TRY
 612         {
 613           selected_frame = get_selected_frame (_("no frame selected"));
 614           block = get_frame_block (selected_frame, NULL);
 615         }
 616       CATCH (except, RETURN_MASK_ALL)
 617         {
 618           GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
 619         }
 620       END_CATCH
 621     }
 622
 623   TRY
 624     {
 625       symbol = lookup_symbol (name, block, (domain_enum) domain,
 626                               &is_a_field_of_this).symbol;
 627     }
 628   CATCH (ex, RETURN_MASK_ALL)
 629     {
 630       except = ex;
 631     }
 632   END_CATCH
 633
 634   do_cleanups (cleanups);
 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   struct cleanup *cleanups;
 656   struct gdb_exception except = exception_none;
 657
 658   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i",
 659                               name_scm, &name, rest,
 660                               &domain_arg_pos, &domain);
 661
 662   cleanups = make_cleanup (xfree, name);
 663
 664   TRY
 665     {
 666       symbol = lookup_global_symbol (name, NULL, (domain_enum) domain).symbol;
 667     }
 668   CATCH (ex, RETURN_MASK_ALL)
 669     {
 670       except = ex;
 671     }
 672   END_CATCH
 673
 674   do_cleanups (cleanups);
 675   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 676
 677   if (symbol == NULL)
 678     return SCM_BOOL_F;
 679
 680   return syscm_scm_from_symbol (symbol);
 681 }
 682 \f
 683 /* Initialize the Scheme symbol support.  */
 684
 685 /* Note: The SYMBOL_ prefix on the integer constants here is present for
 686    compatibility with the Python support.  */
 687
 688 static const scheme_integer_constant symbol_integer_constants[] =
 689 {
 690 #define X(SYM) { "SYMBOL_" #SYM, SYM }
 691   X (LOC_UNDEF),
 692   X (LOC_CONST),
 693   X (LOC_STATIC),
 694   X (LOC_REGISTER),
 695   X (LOC_ARG),
 696   X (LOC_REF_ARG),
 697   X (LOC_LOCAL),
 698   X (LOC_TYPEDEF),
 699   X (LOC_LABEL),
 700   X (LOC_BLOCK),
 701   X (LOC_CONST_BYTES),
 702   X (LOC_UNRESOLVED),
 703   X (LOC_OPTIMIZED_OUT),
 704   X (LOC_COMPUTED),
 705   X (LOC_REGPARM_ADDR),
 706
 707   X (UNDEF_DOMAIN),
 708   X (VAR_DOMAIN),
 709   X (STRUCT_DOMAIN),
 710   X (LABEL_DOMAIN),
 711   X (VARIABLES_DOMAIN),
 712   X (FUNCTIONS_DOMAIN),
 713   X (TYPES_DOMAIN),
 714 #undef X
 715
 716   END_INTEGER_CONSTANTS
 717 };
 718
 719 static const scheme_function symbol_functions[] =
 720 {
 721   { "symbol?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_p),
 722     "\
 723 Return #t if the object is a <gdb:symbol> object." },
 724
 725   { "symbol-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_valid_p),
 726     "\
 727 Return #t if object is a valid <gdb:symbol> object.\n\
 728 A valid symbol is a symbol that has not been freed.\n\
 729 Symbols are freed when the objfile they come from is freed." },
 730
 731   { "symbol-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_type),
 732     "\
 733 Return the type of symbol." },
 734
 735   { "symbol-symtab", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_symtab),
 736     "\
 737 Return the symbol table (<gdb:symtab>) containing symbol." },
 738
 739   { "symbol-line", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_line),
 740     "\
 741 Return the line number at which the symbol was defined." },
 742
 743   { "symbol-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_name),
 744     "\
 745 Return the name of the symbol as a string." },
 746
 747   { "symbol-linkage-name", 1, 0, 0,
 748     as_a_scm_t_subr (gdbscm_symbol_linkage_name),
 749     "\
 750 Return the linkage name of the symbol as a string." },
 751
 752   { "symbol-print-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_print_name),
 753     "\
 754 Return the print name of the symbol as a string.\n\
 755 This is either name or linkage-name, depending on whether the user\n\
 756 asked GDB to display demangled or mangled names." },
 757
 758   { "symbol-addr-class", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_addr_class),
 759     "\
 760 Return the address class of the symbol." },
 761
 762   { "symbol-needs-frame?", 1, 0, 0,
 763     as_a_scm_t_subr (gdbscm_symbol_needs_frame_p),
 764     "\
 765 Return #t if the symbol needs a frame to compute its value." },
 766
 767   { "symbol-argument?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_argument_p),
 768     "\
 769 Return #t if the symbol is a function argument." },
 770
 771   { "symbol-constant?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_constant_p),
 772     "\
 773 Return #t if the symbol is a constant." },
 774
 775   { "symbol-function?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_function_p),
 776     "\
 777 Return #t if the symbol is a function." },
 778
 779   { "symbol-variable?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_variable_p),
 780     "\
 781 Return #t if the symbol is a variable." },
 782
 783   { "symbol-value", 1, 0, 1, as_a_scm_t_subr (gdbscm_symbol_value),
 784     "\
 785 Return the value of the symbol.\n\
 786 \n\
 787   Arguments: <gdb:symbol> [#:frame frame]" },
 788
 789   { "lookup-symbol", 1, 0, 1, as_a_scm_t_subr (gdbscm_lookup_symbol),
 790     "\
 791 Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\
 792 \n\
 793   Arguments: name [#:block block] [#:domain domain]\n\
 794     name:   a string containing the name of the symbol to lookup\n\
 795     block:  a <gdb:block> object\n\
 796     domain: a SYMBOL_*_DOMAIN value" },
 797
 798   { "lookup-global-symbol", 1, 0, 1,
 799     as_a_scm_t_subr (gdbscm_lookup_global_symbol),
 800     "\
 801 Return <gdb:symbol> if found, otherwise #f.\n\
 802 \n\
 803   Arguments: name [#:domain domain]\n\
 804     name:   a string containing the name of the symbol to lookup\n\
 805     domain: a SYMBOL_*_DOMAIN value" },
 806
 807   END_FUNCTIONS
 808 };
 809
 810 void
 811 gdbscm_initialize_symbols (void)
 812 {
 813   symbol_smob_tag
 814     = gdbscm_make_smob_type (symbol_smob_name, sizeof (symbol_smob));
 815   scm_set_smob_free (symbol_smob_tag, syscm_free_symbol_smob);
 816   scm_set_smob_print (symbol_smob_tag, syscm_print_symbol_smob);
 817
 818   gdbscm_define_integer_constants (symbol_integer_constants, 1);
 819   gdbscm_define_functions (symbol_functions, 1);
 820
 821   block_keyword = scm_from_latin1_keyword ("block");
 822   domain_keyword = scm_from_latin1_keyword ("domain");
 823   frame_keyword = scm_from_latin1_keyword ("frame");
 824
 825   /* Register an objfile "free" callback so we can properly
 826      invalidate symbols when an object file is about to be deleted.  */
 827   syscm_objfile_data_key
 828     = register_objfile_data_with_cleanup (NULL, syscm_del_objfile_symbols);
 829
 830   /* Arch-specific symbol data.  */
 831   syscm_gdbarch_data_key
 832     = gdbarch_data_register_post_init (syscm_init_arch_symbols);
 833 }