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
)
106 /* The smob "free" function for <gdb:symbol>. */
109 syscm_free_symbol_smob (SCM self
)
111 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (self
);
113 if (s_smob
->symbol
!= NULL
)
115 htab_t htab
= syscm_objfile_symbol_map (s_smob
->symbol
);
117 gdbscm_clear_eqable_gsmob_ptr_slot (htab
, &s_smob
->base
);
120 /* Not necessary, done to catch bugs. */
121 s_smob
->symbol
= NULL
;
126 /* The smob "print" function for <gdb:symbol>. */
129 syscm_print_symbol_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
131 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (self
);
133 if (pstate
->writingp
)
134 gdbscm_printf (port
, "#<%s ", symbol_smob_name
);
135 gdbscm_printf (port
, "%s",
136 s_smob
->symbol
!= NULL
137 ? SYMBOL_PRINT_NAME (s_smob
->symbol
)
139 if (pstate
->writingp
)
140 scm_puts (">", port
);
142 scm_remember_upto_here_1 (self
);
144 /* Non-zero means success. */
148 /* Low level routine to create a <gdb:symbol> object. */
151 syscm_make_symbol_smob (void)
153 symbol_smob
*s_smob
= (symbol_smob
*)
154 scm_gc_malloc (sizeof (symbol_smob
), symbol_smob_name
);
157 s_smob
->symbol
= NULL
;
158 s_scm
= scm_new_smob (symbol_smob_tag
, (scm_t_bits
) s_smob
);
159 gdbscm_init_eqable_gsmob (&s_smob
->base
, s_scm
);
164 /* Return non-zero if SCM is a symbol smob. */
167 syscm_is_symbol (SCM scm
)
169 return SCM_SMOB_PREDICATE (symbol_smob_tag
, scm
);
172 /* (symbol? object) -> boolean */
175 gdbscm_symbol_p (SCM scm
)
177 return scm_from_bool (syscm_is_symbol (scm
));
180 /* Return the existing object that encapsulates SYMBOL, or create a new
181 <gdb:symbol> object. */
184 syscm_scm_from_symbol (struct symbol
*symbol
)
187 eqable_gdb_smob
**slot
;
188 symbol_smob
*s_smob
, s_smob_for_lookup
;
191 /* If we've already created a gsmob for this symbol, return it.
192 This makes symbols eq?-able. */
193 htab
= syscm_objfile_symbol_map (symbol
);
194 s_smob_for_lookup
.symbol
= symbol
;
195 slot
= gdbscm_find_eqable_gsmob_ptr_slot (htab
, &s_smob_for_lookup
.base
);
197 return (*slot
)->containing_scm
;
199 s_scm
= syscm_make_symbol_smob ();
200 s_smob
= (symbol_smob
*) SCM_SMOB_DATA (s_scm
);
201 s_smob
->symbol
= symbol
;
202 gdbscm_fill_eqable_gsmob_ptr_slot (slot
, &s_smob
->base
);
207 /* Returns the <gdb:symbol> object in SELF.
208 Throws an exception if SELF is not a <gdb:symbol> object. */
211 syscm_get_symbol_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
213 SCM_ASSERT_TYPE (syscm_is_symbol (self
), self
, arg_pos
, func_name
,
219 /* Returns a pointer to the symbol smob of SELF.
220 Throws an exception if SELF is not a <gdb:symbol> object. */
223 syscm_get_symbol_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
225 SCM s_scm
= syscm_get_symbol_arg_unsafe (self
, arg_pos
, func_name
);
226 symbol_smob
*s_smob
= (symbol_smob
*) SCM_SMOB_DATA (s_scm
);
231 /* Return non-zero if symbol S_SMOB is valid. */
234 syscm_is_valid (symbol_smob
*s_smob
)
236 return s_smob
->symbol
!= NULL
;
239 /* Throw a Scheme error if SELF is not a valid symbol smob.
240 Otherwise return a pointer to the symbol smob. */
243 syscm_get_valid_symbol_smob_arg_unsafe (SCM self
, int arg_pos
,
244 const char *func_name
)
247 = syscm_get_symbol_smob_arg_unsafe (self
, arg_pos
, func_name
);
249 if (!syscm_is_valid (s_smob
))
251 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
258 /* Throw a Scheme error if SELF is not a valid symbol smob.
259 Otherwise return a pointer to the symbol struct. */
262 syscm_get_valid_symbol_arg_unsafe (SCM self
, int arg_pos
,
263 const char *func_name
)
265 symbol_smob
*s_smob
= syscm_get_valid_symbol_smob_arg_unsafe (self
, arg_pos
,
268 return s_smob
->symbol
;
271 /* Helper function for syscm_del_objfile_symbols to mark the symbol
275 syscm_mark_symbol_invalid (void **slot
, void *info
)
277 symbol_smob
*s_smob
= (symbol_smob
*) *slot
;
279 s_smob
->symbol
= NULL
;
283 /* This function is called when an objfile is about to be freed.
284 Invalidate the symbol as further actions on the symbol would result
285 in bad data. All access to s_smob->symbol should be gated by
286 syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on
290 syscm_del_objfile_symbols (struct objfile
*objfile
, void *datum
)
296 htab_traverse_noresize (htab
, syscm_mark_symbol_invalid
, NULL
);
301 /* Symbol methods. */
303 /* (symbol-valid? <gdb:symbol>) -> boolean
304 Returns #t if SELF still exists in GDB. */
307 gdbscm_symbol_valid_p (SCM self
)
310 = syscm_get_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
312 return scm_from_bool (syscm_is_valid (s_smob
));
315 /* (symbol-type <gdb:symbol>) -> <gdb:type>
316 Return the type of SELF, or #f if SELF has no type. */
319 gdbscm_symbol_type (SCM self
)
322 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
323 const struct symbol
*symbol
= s_smob
->symbol
;
325 if (SYMBOL_TYPE (symbol
) == NULL
)
328 return tyscm_scm_from_type (SYMBOL_TYPE (symbol
));
331 /* (symbol-symtab <gdb:symbol>) -> <gdb:symtab>
332 Return the symbol table of SELF. */
335 gdbscm_symbol_symtab (SCM self
)
338 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
339 const struct symbol
*symbol
= s_smob
->symbol
;
341 return stscm_scm_from_symtab (SYMBOL_SYMTAB (symbol
));
344 /* (symbol-name <gdb:symbol>) -> string */
347 gdbscm_symbol_name (SCM self
)
350 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
351 const struct symbol
*symbol
= s_smob
->symbol
;
353 return gdbscm_scm_from_c_string (SYMBOL_NATURAL_NAME (symbol
));
356 /* (symbol-linkage-name <gdb:symbol>) -> string */
359 gdbscm_symbol_linkage_name (SCM self
)
362 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
363 const struct symbol
*symbol
= s_smob
->symbol
;
365 return gdbscm_scm_from_c_string (SYMBOL_LINKAGE_NAME (symbol
));
368 /* (symbol-print-name <gdb:symbol>) -> string */
371 gdbscm_symbol_print_name (SCM self
)
374 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
375 const struct symbol
*symbol
= s_smob
->symbol
;
377 return gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol
));
380 /* (symbol-addr-class <gdb:symbol>) -> integer */
383 gdbscm_symbol_addr_class (SCM self
)
386 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
387 const struct symbol
*symbol
= s_smob
->symbol
;
389 return scm_from_int (SYMBOL_CLASS (symbol
));
392 /* (symbol-argument? <gdb:symbol>) -> boolean */
395 gdbscm_symbol_argument_p (SCM self
)
398 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
399 const struct symbol
*symbol
= s_smob
->symbol
;
401 return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol
));
404 /* (symbol-constant? <gdb:symbol>) -> boolean */
407 gdbscm_symbol_constant_p (SCM self
)
410 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
411 const struct symbol
*symbol
= s_smob
->symbol
;
412 enum address_class
class;
414 class = SYMBOL_CLASS (symbol
);
416 return scm_from_bool (class == LOC_CONST
|| class == LOC_CONST_BYTES
);
419 /* (symbol-function? <gdb:symbol>) -> boolean */
422 gdbscm_symbol_function_p (SCM self
)
425 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
426 const struct symbol
*symbol
= s_smob
->symbol
;
427 enum address_class
class;
429 class = SYMBOL_CLASS (symbol
);
431 return scm_from_bool (class == LOC_BLOCK
);
434 /* (symbol-variable? <gdb:symbol>) -> boolean */
437 gdbscm_symbol_variable_p (SCM self
)
440 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
441 const struct symbol
*symbol
= s_smob
->symbol
;
442 enum address_class
class;
444 class = SYMBOL_CLASS (symbol
);
446 return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol
)
447 && (class == LOC_LOCAL
|| class == LOC_REGISTER
448 || class == LOC_STATIC
|| class == LOC_COMPUTED
449 || class == LOC_OPTIMIZED_OUT
));
452 /* (symbol-needs-frame? <gdb:symbol>) -> boolean
453 Return #t if the symbol needs a frame for evaluation. */
456 gdbscm_symbol_needs_frame_p (SCM self
)
459 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
460 struct symbol
*symbol
= s_smob
->symbol
;
461 volatile struct gdb_exception except
;
464 TRY_CATCH (except
, RETURN_MASK_ALL
)
466 result
= symbol_read_needs_frame (symbol
);
468 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
470 return scm_from_bool (result
);
473 /* (symbol-line <gdb:symbol>) -> integer
474 Return the line number at which the symbol was defined. */
477 gdbscm_symbol_line (SCM self
)
480 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
481 const struct symbol
*symbol
= s_smob
->symbol
;
483 return scm_from_int (SYMBOL_LINE (symbol
));
486 /* (symbol-value <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
487 Return the value of the symbol, or an error in various circumstances. */
490 gdbscm_symbol_value (SCM self
, SCM rest
)
493 = syscm_get_valid_symbol_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
494 struct symbol
*symbol
= s_smob
->symbol
;
495 SCM keywords
[] = { frame_keyword
, SCM_BOOL_F
};
497 SCM frame_scm
= SCM_BOOL_F
;
498 frame_smob
*f_smob
= NULL
;
499 struct frame_info
*frame_info
= NULL
;
500 struct value
*value
= NULL
;
501 volatile struct gdb_exception except
;
503 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, keywords
, "#O",
504 rest
, &frame_pos
, &frame_scm
);
505 if (!gdbscm_is_false (frame_scm
))
506 f_smob
= frscm_get_frame_smob_arg_unsafe (frame_scm
, frame_pos
, FUNC_NAME
);
508 if (SYMBOL_CLASS (symbol
) == LOC_TYPEDEF
)
510 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
511 _("cannot get the value of a typedef"));
514 TRY_CATCH (except
, RETURN_MASK_ALL
)
518 frame_info
= frscm_frame_smob_to_frame (f_smob
);
519 if (frame_info
== NULL
)
520 error (_("Invalid frame"));
523 if (symbol_read_needs_frame (symbol
) && frame_info
== NULL
)
524 error (_("Symbol requires a frame to compute its value"));
526 value
= read_var_value (symbol
, frame_info
);
528 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
530 return vlscm_scm_from_value (value
);
533 /* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
534 -> (<gdb:symbol> field-of-this?)
535 The result is #f if the symbol is not found.
536 See comment in lookup_symbol_in_language for field-of-this?. */
539 gdbscm_lookup_symbol (SCM name_scm
, SCM rest
)
542 SCM keywords
[] = { block_keyword
, domain_keyword
, SCM_BOOL_F
};
543 const struct block
*block
= NULL
;
544 SCM block_scm
= SCM_BOOL_F
;
545 int domain
= VAR_DOMAIN
;
546 int block_arg_pos
= -1, domain_arg_pos
= -1;
547 struct field_of_this_result is_a_field_of_this
;
548 struct symbol
*symbol
= NULL
;
549 volatile struct gdb_exception except
;
550 struct cleanup
*cleanups
;
552 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#Oi",
553 name_scm
, &name
, rest
,
554 &block_arg_pos
, &block_scm
,
555 &domain_arg_pos
, &domain
);
557 cleanups
= make_cleanup (xfree
, name
);
559 if (block_arg_pos
>= 0)
563 block
= bkscm_scm_to_block (block_scm
, block_arg_pos
, FUNC_NAME
,
567 do_cleanups (cleanups
);
568 gdbscm_throw (except_scm
);
573 struct frame_info
*selected_frame
;
575 TRY_CATCH (except
, RETURN_MASK_ALL
)
577 selected_frame
= get_selected_frame (_("no frame selected"));
578 block
= get_frame_block (selected_frame
, NULL
);
580 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
583 TRY_CATCH (except
, RETURN_MASK_ALL
)
585 symbol
= lookup_symbol (name
, block
, domain
, &is_a_field_of_this
);
587 do_cleanups (cleanups
);
588 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
593 return scm_list_2 (syscm_scm_from_symbol (symbol
),
594 scm_from_bool (is_a_field_of_this
.type
!= NULL
));
597 /* (lookup-global-symbol name [#:domain domain]) -> <gdb:symbol>
598 The result is #f if the symbol is not found. */
601 gdbscm_lookup_global_symbol (SCM name_scm
, SCM rest
)
604 SCM keywords
[] = { domain_keyword
, SCM_BOOL_F
};
605 int domain_arg_pos
= -1;
606 int domain
= VAR_DOMAIN
;
607 struct symbol
*symbol
= NULL
;
608 volatile struct gdb_exception except
;
609 struct cleanup
*cleanups
;
611 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, keywords
, "s#i",
612 name_scm
, &name
, rest
,
613 &domain_arg_pos
, &domain
);
615 cleanups
= make_cleanup (xfree
, name
);
617 TRY_CATCH (except
, RETURN_MASK_ALL
)
619 symbol
= lookup_symbol_global (name
, NULL
, domain
);
621 do_cleanups (cleanups
);
622 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
627 return syscm_scm_from_symbol (symbol
);
630 /* Initialize the Scheme symbol support. */
632 /* Note: The SYMBOL_ prefix on the integer constants here is present for
633 compatibility with the Python support. */
635 static const scheme_integer_constant symbol_integer_constants
[] =
637 #define X(SYM) { "SYMBOL_" #SYM, SYM }
650 X (LOC_OPTIMIZED_OUT
),
652 X (LOC_REGPARM_ADDR
),
658 X (VARIABLES_DOMAIN
),
659 X (FUNCTIONS_DOMAIN
),
663 END_INTEGER_CONSTANTS
666 static const scheme_function symbol_functions
[] =
668 { "symbol?", 1, 0, 0, gdbscm_symbol_p
,
670 Return #t if the object is a <gdb:symbol> object." },
672 { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p
,
674 Return #t if object is a valid <gdb:symbol> object.\n\
675 A valid symbol is a symbol that has not been freed.\n\
676 Symbols are freed when the objfile they come from is freed." },
678 { "symbol-type", 1, 0, 0, gdbscm_symbol_type
,
680 Return the type of symbol." },
682 { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab
,
684 Return the symbol table (<gdb:symtab>) containing symbol." },
686 { "symbol-line", 1, 0, 0, gdbscm_symbol_line
,
688 Return the line number at which the symbol was defined." },
690 { "symbol-name", 1, 0, 0, gdbscm_symbol_name
,
692 Return the name of the symbol as a string." },
694 { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name
,
696 Return the linkage name of the symbol as a string." },
698 { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name
,
700 Return the print name of the symbol as a string.\n\
701 This is either name or linkage-name, depending on whether the user\n\
702 asked GDB to display demangled or mangled names." },
704 { "symbol-addr-class", 1, 0, 0, gdbscm_symbol_addr_class
,
706 Return the address class of the symbol." },
708 { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p
,
710 Return #t if the symbol needs a frame to compute its value." },
712 { "symbol-argument?", 1, 0, 0, gdbscm_symbol_argument_p
,
714 Return #t if the symbol is a function argument." },
716 { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p
,
718 Return #t if the symbol is a constant." },
720 { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p
,
722 Return #t if the symbol is a function." },
724 { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p
,
726 Return #t if the symbol is a variable." },
728 { "symbol-value", 1, 0, 1, gdbscm_symbol_value
,
730 Return the value of the symbol.\n\
732 Arguments: <gdb:symbol> [#:frame frame]" },
734 { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol
,
736 Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\
738 Arguments: name [#:block block] [#:domain domain]\n\
739 name: a string containing the name of the symbol to lookup\n\
740 block: a <gdb:block> object\n\
741 domain: a SYMBOL_*_DOMAIN value" },
743 { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol
,
745 Return <gdb:symbol> if found, otherwise #f.\n\
747 Arguments: name [#:domain domain]\n\
748 name: a string containing the name of the symbol to lookup\n\
749 domain: a SYMBOL_*_DOMAIN value" },
755 gdbscm_initialize_symbols (void)
758 = gdbscm_make_smob_type (symbol_smob_name
, sizeof (symbol_smob
));
759 scm_set_smob_mark (symbol_smob_tag
, syscm_mark_symbol_smob
);
760 scm_set_smob_free (symbol_smob_tag
, syscm_free_symbol_smob
);
761 scm_set_smob_print (symbol_smob_tag
, syscm_print_symbol_smob
);
763 gdbscm_define_integer_constants (symbol_integer_constants
, 1);
764 gdbscm_define_functions (symbol_functions
, 1);
766 block_keyword
= scm_from_latin1_keyword ("block");
767 domain_keyword
= scm_from_latin1_keyword ("domain");
768 frame_keyword
= scm_from_latin1_keyword ("frame");
770 /* Register an objfile "free" callback so we can properly
771 invalidate symbols when an object file is about to be deleted. */
772 syscm_objfile_data_key
773 = register_objfile_data_with_cleanup (NULL
, syscm_del_objfile_symbols
);