1 /* Scheme interface to symbols.
3 Copyright (C) 2008-2014 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
25 #include "exceptions.h"
30 #include "guile-internal.h"
32 /* The <gdb:symbol> smob. */
36 /* This always appears first. */
39 /* The GDB symbol structure this smob is wrapping. */
40 struct symbol *symbol;
43 static const char symbol_smob_name[] = "gdb:symbol";
45 /* The tag Guile knows the symbol smob by. */
46 static scm_t_bits symbol_smob_tag;
48 /* Keywords used in argument passing. */
49 static SCM block_keyword;
50 static SCM domain_keyword;
51 static SCM frame_keyword;
53 static const struct objfile_data *syscm_objfile_data_key;
55 /* Administrivia for symbol smobs. */
57 /* Helper function to hash a symbol_smob. */
60 syscm_hash_symbol_smob (const void *p)
62 const symbol_smob *s_smob = p;
64 return htab_hash_pointer (s_smob->symbol);
67 /* Helper function to compute equality of symbol_smobs. */
70 syscm_eq_symbol_smob (const void *ap, const void *bp)
72 const symbol_smob *a = ap;
73 const symbol_smob *b = bp;
75 return (a->symbol == b->symbol
76 && a->symbol != NULL);
79 /* Return the struct symbol pointer -> SCM mapping table.
80 It is created if necessary. */
83 syscm_objfile_symbol_map (struct symbol *symbol)
85 struct objfile *objfile = SYMBOL_SYMTAB (symbol)->objfile;
86 htab_t htab = objfile_data (objfile, syscm_objfile_data_key);
90 htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob,
91 syscm_eq_symbol_smob);
92 set_objfile_data (objfile, syscm_objfile_data_key, htab);
98 /* The smob "free" function for <gdb:symbol>. */
101 syscm_free_symbol_smob (SCM self)
103 symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
105 if (s_smob->symbol != NULL)
107 htab_t htab = syscm_objfile_symbol_map (s_smob->symbol);
109 gdbscm_clear_eqable_gsmob_ptr_slot (htab, &s_smob->base);
112 /* Not necessary, done to catch bugs. */
113 s_smob->symbol = NULL;
118 /* The smob "print" function for <gdb:symbol>. */
121 syscm_print_symbol_smob (SCM self, SCM port, scm_print_state *pstate)
123 symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self);
125 if (pstate->writingp)
126 gdbscm_printf (port, "#<%s ", symbol_smob_name);
127 gdbscm_printf (port, "%s",
128 s_smob->symbol != NULL
129 ? SYMBOL_PRINT_NAME (s_smob->symbol)
131 if (pstate->writingp)
132 scm_puts (">", port);
134 scm_remember_upto_here_1 (self);
136 /* Non-zero means success. */
140 /* Low level routine to create a <gdb:symbol> object. */
143 syscm_make_symbol_smob (void)
145 symbol_smob *s_smob = (symbol_smob *)
146 scm_gc_malloc (sizeof (symbol_smob), symbol_smob_name);
149 s_smob->symbol = NULL;
150 s_scm = scm_new_smob (symbol_smob_tag, (scm_t_bits) s_smob);
151 gdbscm_init_eqable_gsmob (&s_smob->base, s_scm);
156 /* Return non-zero if SCM is a symbol smob. */
159 syscm_is_symbol (SCM scm)
161 return SCM_SMOB_PREDICATE (symbol_smob_tag, scm);
164 /* (symbol? object) -> boolean */
167 gdbscm_symbol_p (SCM scm)
169 return scm_from_bool (syscm_is_symbol (scm));
172 /* Return the existing object that encapsulates SYMBOL, or create a new
173 <gdb:symbol> object. */
176 syscm_scm_from_symbol (struct symbol *symbol)
179 eqable_gdb_smob **slot;
180 symbol_smob *s_smob, s_smob_for_lookup;
183 /* If we've already created a gsmob for this symbol, return it.
184 This makes symbols eq?-able. */
185 htab = syscm_objfile_symbol_map (symbol);
186 s_smob_for_lookup.symbol = symbol;
187 slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &s_smob_for_lookup.base);
189 return (*slot)->containing_scm;
191 s_scm = syscm_make_symbol_smob ();
192 s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm);
193 s_smob->symbol = symbol;
194 gdbscm_fill_eqable_gsmob_ptr_slot (slot, &s_smob->base);
199 /* Returns the <gdb:symbol> object in SELF.
200 Throws an exception if SELF is not a <gdb:symbol> object. */
203 syscm_get_symbol_arg_unsafe (SCM self, int arg_pos, const char *func_name)
205 SCM_ASSERT_TYPE (syscm_is_symbol (self), self, arg_pos, func_name,
211 /* Returns a pointer to the symbol smob of SELF.
212 Throws an exception if SELF is not a <gdb:symbol> object. */
215 syscm_get_symbol_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
217 SCM s_scm = syscm_get_symbol_arg_unsafe (self, arg_pos, func_name);
218 symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm);
223 /* Return non-zero if symbol S_SMOB is valid. */
226 syscm_is_valid (symbol_smob *s_smob)
228 return s_smob->symbol != NULL;
231 /* Throw a Scheme error if SELF is not a valid symbol smob.
232 Otherwise return a pointer to the symbol smob. */
235 syscm_get_valid_symbol_smob_arg_unsafe (SCM self, int arg_pos,
236 const char *func_name)
239 = syscm_get_symbol_smob_arg_unsafe (self, arg_pos, func_name);
241 if (!syscm_is_valid (s_smob))
243 gdbscm_invalid_object_error (func_name, arg_pos, self,
250 /* Throw a Scheme error if SELF is not a valid symbol smob.
251 Otherwise return a pointer to the symbol struct. */
254 syscm_get_valid_symbol_arg_unsafe (SCM self, int arg_pos,
255 const char *func_name)
257 symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, arg_pos,
260 return s_smob->symbol;
263 /* Helper function for syscm_del_objfile_symbols to mark the symbol
267 syscm_mark_symbol_invalid (void **slot, void *info)
269 symbol_smob *s_smob = (symbol_smob *) *slot;
271 s_smob->symbol = NULL;
275 /* This function is called when an objfile is about to be freed.
276 Invalidate the symbol as further actions on the symbol would result
277 in bad data. All access to s_smob->symbol should be gated by
278 syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on
282 syscm_del_objfile_symbols (struct objfile *objfile, void *datum)
288 htab_traverse_noresize (htab, syscm_mark_symbol_invalid, NULL);
293 /* Symbol methods. */
295 /* (symbol-valid? <gdb:symbol>) -> boolean
296 Returns #t if SELF still exists in GDB. */
299 gdbscm_symbol_valid_p (SCM self)
302 = syscm_get_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
304 return scm_from_bool (syscm_is_valid (s_smob));
307 /* (symbol-type <gdb:symbol>) -> <gdb:type>
308 Return the type of SELF, or #f if SELF has no type. */
311 gdbscm_symbol_type (SCM self)
314 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
315 const struct symbol *symbol = s_smob->symbol;
317 if (SYMBOL_TYPE (symbol) == NULL)
320 return tyscm_scm_from_type (SYMBOL_TYPE (symbol));
323 /* (symbol-symtab <gdb:symbol>) -> <gdb:symtab>
324 Return the symbol table of SELF. */
327 gdbscm_symbol_symtab (SCM self)
330 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
331 const struct symbol *symbol = s_smob->symbol;
333 return stscm_scm_from_symtab (SYMBOL_SYMTAB (symbol));
336 /* (symbol-name <gdb:symbol>) -> string */
339 gdbscm_symbol_name (SCM self)
342 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
343 const struct symbol *symbol = s_smob->symbol;
345 return gdbscm_scm_from_c_string (SYMBOL_NATURAL_NAME (symbol));
348 /* (symbol-linkage-name <gdb:symbol>) -> string */
351 gdbscm_symbol_linkage_name (SCM self)
354 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
355 const struct symbol *symbol = s_smob->symbol;
357 return gdbscm_scm_from_c_string (SYMBOL_LINKAGE_NAME (symbol));
360 /* (symbol-print-name <gdb:symbol>) -> string */
363 gdbscm_symbol_print_name (SCM self)
366 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
367 const struct symbol *symbol = s_smob->symbol;
369 return gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol));
372 /* (symbol-addr-class <gdb:symbol>) -> integer */
375 gdbscm_symbol_addr_class (SCM self)
378 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
379 const struct symbol *symbol = s_smob->symbol;
381 return scm_from_int (SYMBOL_CLASS (symbol));
384 /* (symbol-argument? <gdb:symbol>) -> boolean */
387 gdbscm_symbol_argument_p (SCM self)
390 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
391 const struct symbol *symbol = s_smob->symbol;
393 return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol));
396 /* (symbol-constant? <gdb:symbol>) -> boolean */
399 gdbscm_symbol_constant_p (SCM self)
402 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
403 const struct symbol *symbol = s_smob->symbol;
404 enum address_class class;
406 class = SYMBOL_CLASS (symbol);
408 return scm_from_bool (class == LOC_CONST || class == LOC_CONST_BYTES);
411 /* (symbol-function? <gdb:symbol>) -> boolean */
414 gdbscm_symbol_function_p (SCM self)
417 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
418 const struct symbol *symbol = s_smob->symbol;
419 enum address_class class;
421 class = SYMBOL_CLASS (symbol);
423 return scm_from_bool (class == LOC_BLOCK);
426 /* (symbol-variable? <gdb:symbol>) -> boolean */
429 gdbscm_symbol_variable_p (SCM self)
432 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
433 const struct symbol *symbol = s_smob->symbol;
434 enum address_class class;
436 class = SYMBOL_CLASS (symbol);
438 return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol)
439 && (class == LOC_LOCAL || class == LOC_REGISTER
440 || class == LOC_STATIC || class == LOC_COMPUTED
441 || class == LOC_OPTIMIZED_OUT));
444 /* (symbol-needs-frame? <gdb:symbol>) -> boolean
445 Return #t if the symbol needs a frame for evaluation. */
448 gdbscm_symbol_needs_frame_p (SCM self)
451 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
452 struct symbol *symbol = s_smob->symbol;
453 volatile struct gdb_exception except;
456 TRY_CATCH (except, RETURN_MASK_ALL)
458 result = symbol_read_needs_frame (symbol);
460 GDBSCM_HANDLE_GDB_EXCEPTION (except);
462 return scm_from_bool (result);
465 /* (symbol-line <gdb:symbol>) -> integer
466 Return the line number at which the symbol was defined. */
469 gdbscm_symbol_line (SCM self)
472 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
473 const struct symbol *symbol = s_smob->symbol;
475 return scm_from_int (SYMBOL_LINE (symbol));
478 /* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
479 Return the value of the symbol, or an error in various circumstances. */
482 gdbscm_symbol_value (SCM self, SCM rest)
485 = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
486 struct symbol *symbol = s_smob->symbol;
487 SCM keywords[] = { frame_keyword, SCM_BOOL_F };
489 SCM frame_scm = SCM_BOOL_F;
490 frame_smob *f_smob = NULL;
491 struct frame_info *frame_info = NULL;
492 struct value *value = NULL;
493 volatile struct gdb_exception except;
495 gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O",
496 rest, &frame_pos, &frame_scm);
497 if (!gdbscm_is_false (frame_scm))
498 f_smob = frscm_get_frame_smob_arg_unsafe (frame_scm, frame_pos, FUNC_NAME);
500 if (SYMBOL_CLASS (symbol) == LOC_TYPEDEF)
502 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
503 _("cannot get the value of a typedef"));
506 TRY_CATCH (except, RETURN_MASK_ALL)
510 frame_info = frscm_frame_smob_to_frame (f_smob);
511 if (frame_info == NULL)
512 error (_("Invalid frame"));
515 if (symbol_read_needs_frame (symbol) && frame_info == NULL)
516 error (_("Symbol requires a frame to compute its value"));
518 value = read_var_value (symbol, frame_info);
520 GDBSCM_HANDLE_GDB_EXCEPTION (except);
522 return vlscm_scm_from_value (value);
525 /* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
526 -> (<gdb:symbol> field-of-this?)
527 The result is #f if the symbol is not found.
528 See comment in lookup_symbol_in_language for field-of-this?. */
531 gdbscm_lookup_symbol (SCM name_scm, SCM rest)
534 SCM keywords[] = { block_keyword, domain_keyword, SCM_BOOL_F };
535 const struct block *block = NULL;
536 SCM block_scm = SCM_BOOL_F;
537 int domain = VAR_DOMAIN;
538 int block_arg_pos = -1, domain_arg_pos = -1;
539 struct field_of_this_result is_a_field_of_this;
540 struct symbol *symbol = NULL;
541 volatile struct gdb_exception except;
542 struct cleanup *cleanups;
544 gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi",
545 name_scm, &name, rest,
546 &block_arg_pos, &block_scm,
547 &domain_arg_pos, &domain);
549 cleanups = make_cleanup (xfree, name);
551 if (block_arg_pos >= 0)
555 block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
559 do_cleanups (cleanups);
560 gdbscm_throw (except_scm);
565 struct frame_info *selected_frame;
567 TRY_CATCH (except, RETURN_MASK_ALL)
569 selected_frame = get_selected_frame (_("no frame selected"));
570 block = get_frame_block (selected_frame, NULL);
572 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
575 TRY_CATCH (except, RETURN_MASK_ALL)
577 symbol = lookup_symbol (name, block, domain, &is_a_field_of_this);
579 do_cleanups (cleanups);
580 GDBSCM_HANDLE_GDB_EXCEPTION (except);
585 return scm_list_2 (syscm_scm_from_symbol (symbol),
586 scm_from_bool (is_a_field_of_this.type != NULL));
589 /* (lookup-global-symbol name [#:domain domain]) -> <gdb:symbol>
590 The result is #f if the symbol is not found. */
593 gdbscm_lookup_global_symbol (SCM name_scm, SCM rest)
596 SCM keywords[] = { domain_keyword, SCM_BOOL_F };
597 int domain_arg_pos = -1;
598 int domain = VAR_DOMAIN;
599 struct symbol *symbol = NULL;
600 volatile struct gdb_exception except;
601 struct cleanup *cleanups;
603 gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i",
604 name_scm, &name, rest,
605 &domain_arg_pos, &domain);
607 cleanups = make_cleanup (xfree, name);
609 TRY_CATCH (except, RETURN_MASK_ALL)
611 symbol = lookup_symbol_global (name, NULL, domain);
613 do_cleanups (cleanups);
614 GDBSCM_HANDLE_GDB_EXCEPTION (except);
619 return syscm_scm_from_symbol (symbol);
622 /* Initialize the Scheme symbol support. */
624 /* Note: The SYMBOL_ prefix on the integer constants here is present for
625 compatibility with the Python support. */
627 static const scheme_integer_constant symbol_integer_constants[] =
629 #define X(SYM) { "SYMBOL_" #SYM, SYM }
642 X (LOC_OPTIMIZED_OUT),
644 X (LOC_REGPARM_ADDR),
650 X (VARIABLES_DOMAIN),
651 X (FUNCTIONS_DOMAIN),
655 END_INTEGER_CONSTANTS
658 static const scheme_function symbol_functions[] =
660 { "symbol?", 1, 0, 0, gdbscm_symbol_p,
662 Return #t if the object is a <gdb:symbol> object." },
664 { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p,
666 Return #t if object is a valid <gdb:symbol> object.\n\
667 A valid symbol is a symbol that has not been freed.\n\
668 Symbols are freed when the objfile they come from is freed." },
670 { "symbol-type", 1, 0, 0, gdbscm_symbol_type,
672 Return the type of symbol." },
674 { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab,
676 Return the symbol table (<gdb:symtab>) containing symbol." },
678 { "symbol-line", 1, 0, 0, gdbscm_symbol_line,
680 Return the line number at which the symbol was defined." },
682 { "symbol-name", 1, 0, 0, gdbscm_symbol_name,
684 Return the name of the symbol as a string." },
686 { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name,
688 Return the linkage name of the symbol as a string." },
690 { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name,
692 Return the print name of the symbol as a string.\n\
693 This is either name or linkage-name, depending on whether the user\n\
694 asked GDB to display demangled or mangled names." },
696 { "symbol-addr-class", 1, 0, 0, gdbscm_symbol_addr_class,
698 Return the address class of the symbol." },
700 { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p,
702 Return #t if the symbol needs a frame to compute its value." },
704 { "symbol-argument?", 1, 0, 0, gdbscm_symbol_argument_p,
706 Return #t if the symbol is a function argument." },
708 { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p,
710 Return #t if the symbol is a constant." },
712 { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p,
714 Return #t if the symbol is a function." },
716 { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p,
718 Return #t if the symbol is a variable." },
720 { "symbol-value", 1, 0, 1, gdbscm_symbol_value,
722 Return the value of the symbol.\n\
724 Arguments: <gdb:symbol> [#:frame frame]" },
726 { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol,
728 Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\
730 Arguments: name [#:block block] [#:domain domain]\n\
731 name: a string containing the name of the symbol to lookup\n\
732 block: a <gdb:block> object\n\
733 domain: a SYMBOL_*_DOMAIN value" },
735 { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol,
737 Return <gdb:symbol> if found, otherwise #f.\n\
739 Arguments: name [#:domain domain]\n\
740 name: a string containing the name of the symbol to lookup\n\
741 domain: a SYMBOL_*_DOMAIN value" },
747 gdbscm_initialize_symbols (void)
750 = gdbscm_make_smob_type (symbol_smob_name, sizeof (symbol_smob));
751 scm_set_smob_free (symbol_smob_tag, syscm_free_symbol_smob);
752 scm_set_smob_print (symbol_smob_tag, syscm_print_symbol_smob);
754 gdbscm_define_integer_constants (symbol_integer_constants, 1);
755 gdbscm_define_functions (symbol_functions, 1);
757 block_keyword = scm_from_latin1_keyword ("block");
758 domain_keyword = scm_from_latin1_keyword ("domain");
759 frame_keyword = scm_from_latin1_keyword ("frame");
761 /* Register an objfile "free" callback so we can properly
762 invalidate symbols when an object file is about to be deleted. */
763 syscm_objfile_data_key
764 = register_objfile_data_with_cleanup (NULL, syscm_del_objfile_symbols);