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. */
29 #include "guile-internal.h"
31 /* The <gdb:symbol> smob. */
35 /* This always appears first. */
38 /* The GDB symbol structure this smob is wrapping. */
39 struct symbol
*symbol
;
42 static const char symbol_smob_name
[] = "gdb:symbol";
44 /* The tag Guile knows the symbol smob by. */
45 static scm_t_bits symbol_smob_tag
;
47 /* Keywords used in argument passing. */
48 static SCM block_keyword
;
49 static SCM domain_keyword
;
50 static SCM frame_keyword
;
52 static const struct objfile_data
*syscm_objfile_data_key
;
54 /* Administrivia for symbol smobs. */
56 /* Helper function to hash a symbol_smob. */
59 syscm_hash_symbol_smob (const void *p
)
61 const symbol_smob
*s_smob
= p
;
63 return htab_hash_pointer (s_smob
->symbol
);
66 /* Helper function to compute equality of symbol_smobs. */
69 syscm_eq_symbol_smob (const void *ap
, const void *bp
)
71 const symbol_smob
*a
= ap
;
72 const symbol_smob
*b
= bp
;
74 return (a
->symbol
== b
->symbol
75 && a
->symbol
!= NULL
);
78 /* Return the struct symbol pointer -> SCM mapping table.
79 It is created if necessary. */
82 syscm_objfile_symbol_map (struct symbol
*symbol
)
84 struct objfile
*objfile
= symbol_objfile (symbol
);
85 htab_t htab
= objfile_data (objfile
, syscm_objfile_data_key
);
89 htab
= gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob
,
90 syscm_eq_symbol_smob
);
91 set_objfile_data (objfile
, syscm_objfile_data_key
, htab
);
97 /* The smob "free" function for <gdb:symbol>. */
100 syscm_free_symbol_smob (SCM self
)
102 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (self
);
104 if (s_smob
->symbol
!= NULL
)
106 htab_t htab
= syscm_objfile_symbol_map (s_smob
->symbol
);
108 gdbscm_clear_eqable_gsmob_ptr_slot (htab
, &s_smob
->base
);
111 /* Not necessary, done to catch bugs. */
112 s_smob
->symbol
= NULL
;
117 /* The smob "print" function for <gdb:symbol>. */
120 syscm_print_symbol_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
122 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (self
);
124 if (pstate
->writingp
)
125 gdbscm_printf (port
, "#<%s ", symbol_smob_name
);
126 gdbscm_printf (port
, "%s",
127 s_smob
->symbol
!= NULL
128 ? SYMBOL_PRINT_NAME (s_smob
->symbol
)
130 if (pstate
->writingp
)
131 scm_puts (">", port
);
133 scm_remember_upto_here_1 (self
);
135 /* Non-zero means success. */
139 /* Low level routine to create a <gdb:symbol> object. */
142 syscm_make_symbol_smob (void)
144 symbol_smob
*s_smob
= (symbol_smob
*)
145 scm_gc_malloc (sizeof (symbol_smob
), symbol_smob_name
);
148 s_smob
->symbol
= NULL
;
149 s_scm
= scm_new_smob (symbol_smob_tag
, (scm_t_bits
) s_smob
);
150 gdbscm_init_eqable_gsmob (&s_smob
->base
, s_scm
);
155 /* Return non-zero if SCM is a symbol smob. */
158 syscm_is_symbol (SCM scm
)
160 return SCM_SMOB_PREDICATE (symbol_smob_tag
, scm
);
163 /* (symbol? object) -> boolean */
166 gdbscm_symbol_p (SCM scm
)
168 return scm_from_bool (syscm_is_symbol (scm
));
171 /* Return the existing object that encapsulates SYMBOL, or create a new
172 <gdb:symbol> object. */
175 syscm_scm_from_symbol (struct symbol
*symbol
)
178 eqable_gdb_smob
**slot
;
179 symbol_smob
*s_smob
, s_smob_for_lookup
;
182 /* If we've already created a gsmob for this symbol, return it.
183 This makes symbols eq?-able. */
184 htab
= syscm_objfile_symbol_map (symbol
);
185 s_smob_for_lookup
.symbol
= symbol
;
186 slot
= gdbscm_find_eqable_gsmob_ptr_slot (htab
, &s_smob_for_lookup
.base
);
188 return (*slot
)->containing_scm
;
190 s_scm
= syscm_make_symbol_smob ();
191 s_smob
= (symbol_smob
*) SCM_SMOB_DATA (s_scm
);
192 s_smob
->symbol
= symbol
;
193 gdbscm_fill_eqable_gsmob_ptr_slot (slot
, &s_smob
->base
);
198 /* Returns the <gdb:symbol> object in SELF.
199 Throws an exception if SELF is not a <gdb:symbol> object. */
202 syscm_get_symbol_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
204 SCM_ASSERT_TYPE (syscm_is_symbol (self
), self
, arg_pos
, func_name
,
210 /* Returns a pointer to the symbol smob of SELF.
211 Throws an exception if SELF is not a <gdb:symbol> object. */
214 syscm_get_symbol_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
216 SCM s_scm
= syscm_get_symbol_arg_unsafe (self
, arg_pos
, func_name
);
217 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (s_scm
);
222 /* Return non-zero if symbol S_SMOB is valid. */
225 syscm_is_valid (symbol_smob
*s_smob
)
227 return s_smob
->symbol
!= NULL
;
230 /* Throw a Scheme error if SELF is not a valid symbol smob.
231 Otherwise return a pointer to the symbol smob. */
234 syscm_get_valid_symbol_smob_arg_unsafe (SCM self
, int arg_pos
,
235 const char *func_name
)
238 = syscm_get_symbol_smob_arg_unsafe (self
, arg_pos
, func_name
);
240 if (!syscm_is_valid (s_smob
))
242 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
249 /* Throw a Scheme error if SELF is not a valid symbol smob.
250 Otherwise return a pointer to the symbol struct. */
253 syscm_get_valid_symbol_arg_unsafe (SCM self
, int arg_pos
,
254 const char *func_name
)
256 symbol_smob
*s_smob
= syscm_get_valid_symbol_smob_arg_unsafe (self
, arg_pos
,
259 return s_smob
->symbol
;
262 /* Helper function for syscm_del_objfile_symbols to mark the symbol
266 syscm_mark_symbol_invalid (void **slot
, void *info
)
268 symbol_smob
*s_smob
= (symbol_smob
*) *slot
;
270 s_smob
->symbol
= NULL
;
274 /* This function is called when an objfile is about to be freed.
275 Invalidate the symbol as further actions on the symbol would result
276 in bad data. All access to s_smob->symbol should be gated by
277 syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on
281 syscm_del_objfile_symbols (struct objfile
*objfile
, void *datum
)
287 htab_traverse_noresize (htab
, syscm_mark_symbol_invalid
, NULL
);
292 /* Symbol methods. */
294 /* (symbol-valid? <gdb:symbol>) -> boolean
295 Returns #t if SELF still exists in GDB. */
298 gdbscm_symbol_valid_p (SCM self
)
301 = syscm_get_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
303 return scm_from_bool (syscm_is_valid (s_smob
));
306 /* (symbol-type <gdb:symbol>) -> <gdb:type>
307 Return the type of SELF, or #f if SELF has no type. */
310 gdbscm_symbol_type (SCM self
)
313 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
314 const struct symbol
*symbol
= s_smob
->symbol
;
316 if (SYMBOL_TYPE (symbol
) == NULL
)
319 return tyscm_scm_from_type (SYMBOL_TYPE (symbol
));
322 /* (symbol-symtab <gdb:symbol>) -> <gdb:symtab>
323 Return the symbol table of SELF. */
326 gdbscm_symbol_symtab (SCM self
)
329 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
330 const struct symbol
*symbol
= s_smob
->symbol
;
332 return stscm_scm_from_symtab (symbol_symtab (symbol
));
335 /* (symbol-name <gdb:symbol>) -> string */
338 gdbscm_symbol_name (SCM self
)
341 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
342 const struct symbol
*symbol
= s_smob
->symbol
;
344 return gdbscm_scm_from_c_string (SYMBOL_NATURAL_NAME (symbol
));
347 /* (symbol-linkage-name <gdb:symbol>) -> string */
350 gdbscm_symbol_linkage_name (SCM self
)
353 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
354 const struct symbol
*symbol
= s_smob
->symbol
;
356 return gdbscm_scm_from_c_string (SYMBOL_LINKAGE_NAME (symbol
));
359 /* (symbol-print-name <gdb:symbol>) -> string */
362 gdbscm_symbol_print_name (SCM self
)
365 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
366 const struct symbol
*symbol
= s_smob
->symbol
;
368 return gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol
));
371 /* (symbol-addr-class <gdb:symbol>) -> integer */
374 gdbscm_symbol_addr_class (SCM self
)
377 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
378 const struct symbol
*symbol
= s_smob
->symbol
;
380 return scm_from_int (SYMBOL_CLASS (symbol
));
383 /* (symbol-argument? <gdb:symbol>) -> boolean */
386 gdbscm_symbol_argument_p (SCM self
)
389 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
390 const struct symbol
*symbol
= s_smob
->symbol
;
392 return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol
));
395 /* (symbol-constant? <gdb:symbol>) -> boolean */
398 gdbscm_symbol_constant_p (SCM self
)
401 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
402 const struct symbol
*symbol
= s_smob
->symbol
;
403 enum address_class
class;
405 class = SYMBOL_CLASS (symbol
);
407 return scm_from_bool (class == LOC_CONST
|| class == LOC_CONST_BYTES
);
410 /* (symbol-function? <gdb:symbol>) -> boolean */
413 gdbscm_symbol_function_p (SCM self
)
416 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
417 const struct symbol
*symbol
= s_smob
->symbol
;
418 enum address_class
class;
420 class = SYMBOL_CLASS (symbol
);
422 return scm_from_bool (class == LOC_BLOCK
);
425 /* (symbol-variable? <gdb:symbol>) -> boolean */
428 gdbscm_symbol_variable_p (SCM self
)
431 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
432 const struct symbol
*symbol
= s_smob
->symbol
;
433 enum address_class
class;
435 class = SYMBOL_CLASS (symbol
);
437 return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol
)
438 && (class == LOC_LOCAL
|| class == LOC_REGISTER
439 || class == LOC_STATIC
|| class == LOC_COMPUTED
440 || class == LOC_OPTIMIZED_OUT
));
443 /* (symbol-needs-frame? <gdb:symbol>) -> boolean
444 Return #t if the symbol needs a frame for evaluation. */
447 gdbscm_symbol_needs_frame_p (SCM self
)
450 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
451 struct symbol
*symbol
= s_smob
->symbol
;
452 volatile struct gdb_exception except
;
455 TRY_CATCH (except
, RETURN_MASK_ALL
)
457 result
= symbol_read_needs_frame (symbol
);
459 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
461 return scm_from_bool (result
);
464 /* (symbol-line <gdb:symbol>) -> integer
465 Return the line number at which the symbol was defined. */
468 gdbscm_symbol_line (SCM self
)
471 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
472 const struct symbol
*symbol
= s_smob
->symbol
;
474 return scm_from_int (SYMBOL_LINE (symbol
));
477 /* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
478 Return the value of the symbol, or an error in various circumstances. */
481 gdbscm_symbol_value (SCM self
, SCM rest
)
484 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
485 struct symbol
*symbol
= s_smob
->symbol
;
486 SCM keywords
[] = { frame_keyword
, SCM_BOOL_F
};
488 SCM frame_scm
= SCM_BOOL_F
;
489 frame_smob
*f_smob
= NULL
;
490 struct frame_info
*frame_info
= NULL
;
491 struct value
*value
= NULL
;
492 volatile struct gdb_exception except
;
494 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, keywords
, "#O",
495 rest
, &frame_pos
, &frame_scm
);
496 if (!gdbscm_is_false (frame_scm
))
497 f_smob
= frscm_get_frame_smob_arg_unsafe (frame_scm
, frame_pos
, FUNC_NAME
);
499 if (SYMBOL_CLASS (symbol
) == LOC_TYPEDEF
)
501 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
502 _("cannot get the value of a typedef"));
505 TRY_CATCH (except
, RETURN_MASK_ALL
)
509 frame_info
= frscm_frame_smob_to_frame (f_smob
);
510 if (frame_info
== NULL
)
511 error (_("Invalid frame"));
514 if (symbol_read_needs_frame (symbol
) && frame_info
== NULL
)
515 error (_("Symbol requires a frame to compute its value"));
517 value
= read_var_value (symbol
, frame_info
);
519 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
521 return vlscm_scm_from_value (value
);
524 /* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
525 -> (<gdb:symbol> field-of-this?)
526 The result is #f if the symbol is not found.
527 See comment in lookup_symbol_in_language for field-of-this?. */
530 gdbscm_lookup_symbol (SCM name_scm
, SCM rest
)
533 SCM keywords
[] = { block_keyword
, domain_keyword
, SCM_BOOL_F
};
534 const struct block
*block
= NULL
;
535 SCM block_scm
= SCM_BOOL_F
;
536 int domain
= VAR_DOMAIN
;
537 int block_arg_pos
= -1, domain_arg_pos
= -1;
538 struct field_of_this_result is_a_field_of_this
;
539 struct symbol
*symbol
= NULL
;
540 volatile struct gdb_exception except
;
541 struct cleanup
*cleanups
;
543 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#Oi",
544 name_scm
, &name
, rest
,
545 &block_arg_pos
, &block_scm
,
546 &domain_arg_pos
, &domain
);
548 cleanups
= make_cleanup (xfree
, name
);
550 if (block_arg_pos
>= 0)
554 block
= bkscm_scm_to_block (block_scm
, block_arg_pos
, FUNC_NAME
,
558 do_cleanups (cleanups
);
559 gdbscm_throw (except_scm
);
564 struct frame_info
*selected_frame
;
566 TRY_CATCH (except
, RETURN_MASK_ALL
)
568 selected_frame
= get_selected_frame (_("no frame selected"));
569 block
= get_frame_block (selected_frame
, NULL
);
571 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
574 TRY_CATCH (except
, RETURN_MASK_ALL
)
576 symbol
= lookup_symbol (name
, block
, domain
, &is_a_field_of_this
);
578 do_cleanups (cleanups
);
579 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
584 return scm_list_2 (syscm_scm_from_symbol (symbol
),
585 scm_from_bool (is_a_field_of_this
.type
!= NULL
));
588 /* (lookup-global-symbol name [#:domain domain]) -> <gdb:symbol>
589 The result is #f if the symbol is not found. */
592 gdbscm_lookup_global_symbol (SCM name_scm
, SCM rest
)
595 SCM keywords
[] = { domain_keyword
, SCM_BOOL_F
};
596 int domain_arg_pos
= -1;
597 int domain
= VAR_DOMAIN
;
598 struct symbol
*symbol
= NULL
;
599 volatile struct gdb_exception except
;
600 struct cleanup
*cleanups
;
602 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#i",
603 name_scm
, &name
, rest
,
604 &domain_arg_pos
, &domain
);
606 cleanups
= make_cleanup (xfree
, name
);
608 TRY_CATCH (except
, RETURN_MASK_ALL
)
610 symbol
= lookup_global_symbol (name
, NULL
, domain
);
612 do_cleanups (cleanups
);
613 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
618 return syscm_scm_from_symbol (symbol
);
621 /* Initialize the Scheme symbol support. */
623 /* Note: The SYMBOL_ prefix on the integer constants here is present for
624 compatibility with the Python support. */
626 static const scheme_integer_constant symbol_integer_constants
[] =
628 #define X(SYM) { "SYMBOL_" #SYM, SYM }
641 X (LOC_OPTIMIZED_OUT
),
643 X (LOC_REGPARM_ADDR
),
649 X (VARIABLES_DOMAIN
),
650 X (FUNCTIONS_DOMAIN
),
654 END_INTEGER_CONSTANTS
657 static const scheme_function symbol_functions
[] =
659 { "symbol?", 1, 0, 0, gdbscm_symbol_p
,
661 Return #t if the object is a <gdb:symbol> object." },
663 { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p
,
665 Return #t if object is a valid <gdb:symbol> object.\n\
666 A valid symbol is a symbol that has not been freed.\n\
667 Symbols are freed when the objfile they come from is freed." },
669 { "symbol-type", 1, 0, 0, gdbscm_symbol_type
,
671 Return the type of symbol." },
673 { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab
,
675 Return the symbol table (<gdb:symtab>) containing symbol." },
677 { "symbol-line", 1, 0, 0, gdbscm_symbol_line
,
679 Return the line number at which the symbol was defined." },
681 { "symbol-name", 1, 0, 0, gdbscm_symbol_name
,
683 Return the name of the symbol as a string." },
685 { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name
,
687 Return the linkage name of the symbol as a string." },
689 { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name
,
691 Return the print name of the symbol as a string.\n\
692 This is either name or linkage-name, depending on whether the user\n\
693 asked GDB to display demangled or mangled names." },
695 { "symbol-addr-class", 1, 0, 0, gdbscm_symbol_addr_class
,
697 Return the address class of the symbol." },
699 { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p
,
701 Return #t if the symbol needs a frame to compute its value." },
703 { "symbol-argument?", 1, 0, 0, gdbscm_symbol_argument_p
,
705 Return #t if the symbol is a function argument." },
707 { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p
,
709 Return #t if the symbol is a constant." },
711 { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p
,
713 Return #t if the symbol is a function." },
715 { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p
,
717 Return #t if the symbol is a variable." },
719 { "symbol-value", 1, 0, 1, gdbscm_symbol_value
,
721 Return the value of the symbol.\n\
723 Arguments: <gdb:symbol> [#:frame frame]" },
725 { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol
,
727 Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\
729 Arguments: name [#:block block] [#:domain domain]\n\
730 name: a string containing the name of the symbol to lookup\n\
731 block: a <gdb:block> object\n\
732 domain: a SYMBOL_*_DOMAIN value" },
734 { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol
,
736 Return <gdb:symbol> if found, otherwise #f.\n\
738 Arguments: name [#:domain domain]\n\
739 name: a string containing the name of the symbol to lookup\n\
740 domain: a SYMBOL_*_DOMAIN value" },
746 gdbscm_initialize_symbols (void)
749 = gdbscm_make_smob_type (symbol_smob_name
, sizeof (symbol_smob
));
750 scm_set_smob_free (symbol_smob_tag
, syscm_free_symbol_smob
);
751 scm_set_smob_print (symbol_smob_tag
, syscm_print_symbol_smob
);
753 gdbscm_define_integer_constants (symbol_integer_constants
, 1);
754 gdbscm_define_functions (symbol_functions
, 1);
756 block_keyword
= scm_from_latin1_keyword ("block");
757 domain_keyword
= scm_from_latin1_keyword ("domain");
758 frame_keyword
= scm_from_latin1_keyword ("frame");
760 /* Register an objfile "free" callback so we can properly
761 invalidate symbols when an object file is about to be deleted. */
762 syscm_objfile_data_key
763 = register_objfile_data_with_cleanup (NULL
, syscm_del_objfile_symbols
);