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 "mark" function for <gdb:symbol>. */
101 syscm_mark_symbol_smob (SCM self
)
103 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (self
);
106 return gdbscm_mark_eqable_gsmob (&s_smob
->base
);
109 /* The smob "free" function for <gdb:symbol>. */
112 syscm_free_symbol_smob (SCM self
)
114 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (self
);
116 if (s_smob
->symbol
!= NULL
)
118 htab_t htab
= syscm_objfile_symbol_map (s_smob
->symbol
);
120 gdbscm_clear_eqable_gsmob_ptr_slot (htab
, &s_smob
->base
);
123 /* Not necessary, done to catch bugs. */
124 s_smob
->symbol
= NULL
;
129 /* The smob "print" function for <gdb:symbol>. */
132 syscm_print_symbol_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
134 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (self
);
136 if (pstate
->writingp
)
137 gdbscm_printf (port
, "#<%s ", symbol_smob_name
);
138 gdbscm_printf (port
, "%s",
139 s_smob
->symbol
!= NULL
140 ? SYMBOL_PRINT_NAME (s_smob
->symbol
)
142 if (pstate
->writingp
)
143 scm_puts (">", port
);
145 scm_remember_upto_here_1 (self
);
147 /* Non-zero means success. */
151 /* Low level routine to create a <gdb:symbol> object. */
154 syscm_make_symbol_smob (void)
156 symbol_smob
*s_smob
= (symbol_smob
*)
157 scm_gc_malloc (sizeof (symbol_smob
), symbol_smob_name
);
160 s_smob
->symbol
= NULL
;
161 s_scm
= scm_new_smob (symbol_smob_tag
, (scm_t_bits
) s_smob
);
162 gdbscm_init_eqable_gsmob (&s_smob
->base
, s_scm
);
167 /* Return non-zero if SCM is a symbol smob. */
170 syscm_is_symbol (SCM scm
)
172 return SCM_SMOB_PREDICATE (symbol_smob_tag
, scm
);
175 /* (symbol? object) -> boolean */
178 gdbscm_symbol_p (SCM scm
)
180 return scm_from_bool (syscm_is_symbol (scm
));
183 /* Return the existing object that encapsulates SYMBOL, or create a new
184 <gdb:symbol> object. */
187 syscm_scm_from_symbol (struct symbol
*symbol
)
190 eqable_gdb_smob
**slot
;
191 symbol_smob
*s_smob
, s_smob_for_lookup
;
194 /* If we've already created a gsmob for this symbol, return it.
195 This makes symbols eq?-able. */
196 htab
= syscm_objfile_symbol_map (symbol
);
197 s_smob_for_lookup
.symbol
= symbol
;
198 slot
= gdbscm_find_eqable_gsmob_ptr_slot (htab
, &s_smob_for_lookup
.base
);
200 return (*slot
)->containing_scm
;
202 s_scm
= syscm_make_symbol_smob ();
203 s_smob
= (symbol_smob
*) SCM_SMOB_DATA (s_scm
);
204 s_smob
->symbol
= symbol
;
205 gdbscm_fill_eqable_gsmob_ptr_slot (slot
, &s_smob
->base
);
210 /* Returns the <gdb:symbol> object in SELF.
211 Throws an exception if SELF is not a <gdb:symbol> object. */
214 syscm_get_symbol_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
216 SCM_ASSERT_TYPE (syscm_is_symbol (self
), self
, arg_pos
, func_name
,
222 /* Returns a pointer to the symbol smob of SELF.
223 Throws an exception if SELF is not a <gdb:symbol> object. */
226 syscm_get_symbol_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
228 SCM s_scm
= syscm_get_symbol_arg_unsafe (self
, arg_pos
, func_name
);
229 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (s_scm
);
234 /* Return non-zero if symbol S_SMOB is valid. */
237 syscm_is_valid (symbol_smob
*s_smob
)
239 return s_smob
->symbol
!= NULL
;
242 /* Throw a Scheme error if SELF is not a valid symbol smob.
243 Otherwise return a pointer to the symbol smob. */
246 syscm_get_valid_symbol_smob_arg_unsafe (SCM self
, int arg_pos
,
247 const char *func_name
)
250 = syscm_get_symbol_smob_arg_unsafe (self
, arg_pos
, func_name
);
252 if (!syscm_is_valid (s_smob
))
254 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
261 /* Throw a Scheme error if SELF is not a valid symbol smob.
262 Otherwise return a pointer to the symbol struct. */
265 syscm_get_valid_symbol_arg_unsafe (SCM self
, int arg_pos
,
266 const char *func_name
)
268 symbol_smob
*s_smob
= syscm_get_valid_symbol_smob_arg_unsafe (self
, arg_pos
,
271 return s_smob
->symbol
;
274 /* Helper function for syscm_del_objfile_symbols to mark the symbol
278 syscm_mark_symbol_invalid (void **slot
, void *info
)
280 symbol_smob
*s_smob
= (symbol_smob
*) *slot
;
282 s_smob
->symbol
= NULL
;
286 /* This function is called when an objfile is about to be freed.
287 Invalidate the symbol as further actions on the symbol would result
288 in bad data. All access to s_smob->symbol should be gated by
289 syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on
293 syscm_del_objfile_symbols (struct objfile
*objfile
, void *datum
)
299 htab_traverse_noresize (htab
, syscm_mark_symbol_invalid
, NULL
);
304 /* Symbol methods. */
306 /* (symbol-valid? <gdb:symbol>) -> boolean
307 Returns #t if SELF still exists in GDB. */
310 gdbscm_symbol_valid_p (SCM self
)
313 = syscm_get_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
315 return scm_from_bool (syscm_is_valid (s_smob
));
318 /* (symbol-type <gdb:symbol>) -> <gdb:type>
319 Return the type of SELF, or #f if SELF has no type. */
322 gdbscm_symbol_type (SCM self
)
325 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
326 const struct symbol
*symbol
= s_smob
->symbol
;
328 if (SYMBOL_TYPE (symbol
) == NULL
)
331 return tyscm_scm_from_type (SYMBOL_TYPE (symbol
));
334 /* (symbol-symtab <gdb:symbol>) -> <gdb:symtab>
335 Return the symbol table of SELF. */
338 gdbscm_symbol_symtab (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 stscm_scm_from_symtab (SYMBOL_SYMTAB (symbol
));
347 /* (symbol-name <gdb:symbol>) -> string */
350 gdbscm_symbol_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_NATURAL_NAME (symbol
));
359 /* (symbol-linkage-name <gdb:symbol>) -> string */
362 gdbscm_symbol_linkage_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_LINKAGE_NAME (symbol
));
371 /* (symbol-print-name <gdb:symbol>) -> string */
374 gdbscm_symbol_print_name (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 gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol
));
383 /* (symbol-addr-class <gdb:symbol>) -> integer */
386 gdbscm_symbol_addr_class (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_int (SYMBOL_CLASS (symbol
));
395 /* (symbol-argument? <gdb:symbol>) -> boolean */
398 gdbscm_symbol_argument_p (SCM self
)
401 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
402 const struct symbol
*symbol
= s_smob
->symbol
;
404 return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol
));
407 /* (symbol-constant? <gdb:symbol>) -> boolean */
410 gdbscm_symbol_constant_p (SCM self
)
413 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
414 const struct symbol
*symbol
= s_smob
->symbol
;
415 enum address_class
class;
417 class = SYMBOL_CLASS (symbol
);
419 return scm_from_bool (class == LOC_CONST
|| class == LOC_CONST_BYTES
);
422 /* (symbol-function? <gdb:symbol>) -> boolean */
425 gdbscm_symbol_function_p (SCM self
)
428 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
429 const struct symbol
*symbol
= s_smob
->symbol
;
430 enum address_class
class;
432 class = SYMBOL_CLASS (symbol
);
434 return scm_from_bool (class == LOC_BLOCK
);
437 /* (symbol-variable? <gdb:symbol>) -> boolean */
440 gdbscm_symbol_variable_p (SCM self
)
443 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
444 const struct symbol
*symbol
= s_smob
->symbol
;
445 enum address_class
class;
447 class = SYMBOL_CLASS (symbol
);
449 return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol
)
450 && (class == LOC_LOCAL
|| class == LOC_REGISTER
451 || class == LOC_STATIC
|| class == LOC_COMPUTED
452 || class == LOC_OPTIMIZED_OUT
));
455 /* (symbol-needs-frame? <gdb:symbol>) -> boolean
456 Return #t if the symbol needs a frame for evaluation. */
459 gdbscm_symbol_needs_frame_p (SCM self
)
462 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
463 struct symbol
*symbol
= s_smob
->symbol
;
464 volatile struct gdb_exception except
;
467 TRY_CATCH (except
, RETURN_MASK_ALL
)
469 result
= symbol_read_needs_frame (symbol
);
471 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
473 return scm_from_bool (result
);
476 /* (symbol-line <gdb:symbol>) -> integer
477 Return the line number at which the symbol was defined. */
480 gdbscm_symbol_line (SCM self
)
483 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
484 const struct symbol
*symbol
= s_smob
->symbol
;
486 return scm_from_int (SYMBOL_LINE (symbol
));
489 /* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
490 Return the value of the symbol, or an error in various circumstances. */
493 gdbscm_symbol_value (SCM self
, SCM rest
)
496 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
497 struct symbol
*symbol
= s_smob
->symbol
;
498 SCM keywords
[] = { frame_keyword
, SCM_BOOL_F
};
500 SCM frame_scm
= SCM_BOOL_F
;
501 frame_smob
*f_smob
= NULL
;
502 struct frame_info
*frame_info
= NULL
;
503 struct value
*value
= NULL
;
504 volatile struct gdb_exception except
;
506 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, keywords
, "#O",
507 rest
, &frame_pos
, &frame_scm
);
508 if (!gdbscm_is_false (frame_scm
))
509 f_smob
= frscm_get_frame_smob_arg_unsafe (frame_scm
, frame_pos
, FUNC_NAME
);
511 if (SYMBOL_CLASS (symbol
) == LOC_TYPEDEF
)
513 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
514 _("cannot get the value of a typedef"));
517 TRY_CATCH (except
, RETURN_MASK_ALL
)
521 frame_info
= frscm_frame_smob_to_frame (f_smob
);
522 if (frame_info
== NULL
)
523 error (_("Invalid frame"));
526 if (symbol_read_needs_frame (symbol
) && frame_info
== NULL
)
527 error (_("Symbol requires a frame to compute its value"));
529 value
= read_var_value (symbol
, frame_info
);
531 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
533 return vlscm_scm_from_value (value
);
536 /* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
537 -> (<gdb:symbol> field-of-this?)
538 The result is #f if the symbol is not found.
539 See comment in lookup_symbol_in_language for field-of-this?. */
542 gdbscm_lookup_symbol (SCM name_scm
, SCM rest
)
545 SCM keywords
[] = { block_keyword
, domain_keyword
, SCM_BOOL_F
};
546 const struct block
*block
= NULL
;
547 SCM block_scm
= SCM_BOOL_F
;
548 int domain
= VAR_DOMAIN
;
549 int block_arg_pos
= -1, domain_arg_pos
= -1;
550 struct field_of_this_result is_a_field_of_this
;
551 struct symbol
*symbol
= NULL
;
552 volatile struct gdb_exception except
;
553 struct cleanup
*cleanups
;
555 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#Oi",
556 name_scm
, &name
, rest
,
557 &block_arg_pos
, &block_scm
,
558 &domain_arg_pos
, &domain
);
560 cleanups
= make_cleanup (xfree
, name
);
562 if (block_arg_pos
>= 0)
566 block
= bkscm_scm_to_block (block_scm
, block_arg_pos
, FUNC_NAME
,
570 do_cleanups (cleanups
);
571 gdbscm_throw (except_scm
);
576 struct frame_info
*selected_frame
;
578 TRY_CATCH (except
, RETURN_MASK_ALL
)
580 selected_frame
= get_selected_frame (_("no frame selected"));
581 block
= get_frame_block (selected_frame
, NULL
);
583 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
586 TRY_CATCH (except
, RETURN_MASK_ALL
)
588 symbol
= lookup_symbol (name
, block
, domain
, &is_a_field_of_this
);
590 do_cleanups (cleanups
);
591 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
596 return scm_list_2 (syscm_scm_from_symbol (symbol
),
597 scm_from_bool (is_a_field_of_this
.type
!= NULL
));
600 /* (lookup-global-symbol name [#:domain domain]) -> <gdb:symbol>
601 The result is #f if the symbol is not found. */
604 gdbscm_lookup_global_symbol (SCM name_scm
, SCM rest
)
607 SCM keywords
[] = { domain_keyword
, SCM_BOOL_F
};
608 int domain_arg_pos
= -1;
609 int domain
= VAR_DOMAIN
;
610 struct symbol
*symbol
= NULL
;
611 volatile struct gdb_exception except
;
612 struct cleanup
*cleanups
;
614 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#i",
615 name_scm
, &name
, rest
,
616 &domain_arg_pos
, &domain
);
618 cleanups
= make_cleanup (xfree
, name
);
620 TRY_CATCH (except
, RETURN_MASK_ALL
)
622 symbol
= lookup_symbol_global (name
, NULL
, domain
);
624 do_cleanups (cleanups
);
625 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
630 return syscm_scm_from_symbol (symbol
);
633 /* Initialize the Scheme symbol support. */
635 /* Note: The SYMBOL_ prefix on the integer constants here is present for
636 compatibility with the Python support. */
638 static const scheme_integer_constant symbol_integer_constants
[] =
640 #define X(SYM) { "SYMBOL_" #SYM, SYM }
653 X (LOC_OPTIMIZED_OUT
),
655 X (LOC_REGPARM_ADDR
),
661 X (VARIABLES_DOMAIN
),
662 X (FUNCTIONS_DOMAIN
),
666 END_INTEGER_CONSTANTS
669 static const scheme_function symbol_functions
[] =
671 { "symbol?", 1, 0, 0, gdbscm_symbol_p
,
673 Return #t if the object is a <gdb:symbol> object." },
675 { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p
,
677 Return #t if object is a valid <gdb:symbol> object.\n\
678 A valid symbol is a symbol that has not been freed.\n\
679 Symbols are freed when the objfile they come from is freed." },
681 { "symbol-type", 1, 0, 0, gdbscm_symbol_type
,
683 Return the type of symbol." },
685 { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab
,
687 Return the symbol table (<gdb:symtab>) containing symbol." },
689 { "symbol-line", 1, 0, 0, gdbscm_symbol_line
,
691 Return the line number at which the symbol was defined." },
693 { "symbol-name", 1, 0, 0, gdbscm_symbol_name
,
695 Return the name of the symbol as a string." },
697 { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name
,
699 Return the linkage name of the symbol as a string." },
701 { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name
,
703 Return the print name of the symbol as a string.\n\
704 This is either name or linkage-name, depending on whether the user\n\
705 asked GDB to display demangled or mangled names." },
707 { "symbol-addr-class", 1, 0, 0, gdbscm_symbol_addr_class
,
709 Return the address class of the symbol." },
711 { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p
,
713 Return #t if the symbol needs a frame to compute its value." },
715 { "symbol-argument?", 1, 0, 0, gdbscm_symbol_argument_p
,
717 Return #t if the symbol is a function argument." },
719 { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p
,
721 Return #t if the symbol is a constant." },
723 { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p
,
725 Return #t if the symbol is a function." },
727 { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p
,
729 Return #t if the symbol is a variable." },
731 { "symbol-value", 1, 0, 1, gdbscm_symbol_value
,
733 Return the value of the symbol.\n\
735 Arguments: <gdb:symbol> [#:frame frame]" },
737 { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol
,
739 Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\
741 Arguments: name [#:block block] [#:domain domain]\n\
742 name: a string containing the name of the symbol to lookup\n\
743 block: a <gdb:block> object\n\
744 domain: a SYMBOL_*_DOMAIN value" },
746 { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol
,
748 Return <gdb:symbol> if found, otherwise #f.\n\
750 Arguments: name [#:domain domain]\n\
751 name: a string containing the name of the symbol to lookup\n\
752 domain: a SYMBOL_*_DOMAIN value" },
758 gdbscm_initialize_symbols (void)
761 = gdbscm_make_smob_type (symbol_smob_name
, sizeof (symbol_smob
));
762 scm_set_smob_mark (symbol_smob_tag
, syscm_mark_symbol_smob
);
763 scm_set_smob_free (symbol_smob_tag
, syscm_free_symbol_smob
);
764 scm_set_smob_print (symbol_smob_tag
, syscm_print_symbol_smob
);
766 gdbscm_define_integer_constants (symbol_integer_constants
, 1);
767 gdbscm_define_functions (symbol_functions
, 1);
769 block_keyword
= scm_from_latin1_keyword ("block");
770 domain_keyword
= scm_from_latin1_keyword ("domain");
771 frame_keyword
= scm_from_latin1_keyword ("frame");
773 /* Register an objfile "free" callback so we can properly
774 invalidate symbols when an object file is about to be deleted. */
775 syscm_objfile_data_key
776 = register_objfile_data_with_cleanup (NULL
, syscm_del_objfile_symbols
);