/* Scheme interface to symbols. Copyright (C) 2008-2015 Free Software Foundation, Inc. This file is part of GDB. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ /* See README file in this directory for implementation notes, coding conventions, et.al. */ #include "defs.h" #include "block.h" #include "frame.h" #include "symtab.h" #include "objfiles.h" #include "value.h" #include "guile-internal.h" /* The smob. */ typedef struct { /* This always appears first. */ eqable_gdb_smob base; /* The GDB symbol structure this smob is wrapping. */ struct symbol *symbol; } symbol_smob; static const char symbol_smob_name[] = "gdb:symbol"; /* The tag Guile knows the symbol smob by. */ static scm_t_bits symbol_smob_tag; /* Keywords used in argument passing. */ static SCM block_keyword; static SCM domain_keyword; static SCM frame_keyword; static const struct objfile_data *syscm_objfile_data_key; static struct gdbarch_data *syscm_gdbarch_data_key; struct syscm_gdbarch_data { /* Hash table to implement eqable gdbarch symbols. */ htab_t htab; }; /* Administrivia for symbol smobs. */ /* Helper function to hash a symbol_smob. */ static hashval_t syscm_hash_symbol_smob (const void *p) { const symbol_smob *s_smob = p; return htab_hash_pointer (s_smob->symbol); } /* Helper function to compute equality of symbol_smobs. */ static int syscm_eq_symbol_smob (const void *ap, const void *bp) { const symbol_smob *a = ap; const symbol_smob *b = bp; return (a->symbol == b->symbol && a->symbol != NULL); } static void * syscm_init_arch_symbols (struct gdbarch *gdbarch) { struct syscm_gdbarch_data *data = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct syscm_gdbarch_data); data->htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob, syscm_eq_symbol_smob); return data; } /* Return the struct symbol pointer -> SCM mapping table. It is created if necessary. */ static htab_t syscm_get_symbol_map (struct symbol *symbol) { htab_t htab; if (SYMBOL_OBJFILE_OWNED (symbol)) { struct objfile *objfile = symbol_objfile (symbol); htab = objfile_data (objfile, syscm_objfile_data_key); if (htab == NULL) { htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob, syscm_eq_symbol_smob); set_objfile_data (objfile, syscm_objfile_data_key, htab); } } else { struct gdbarch *gdbarch = symbol_arch (symbol); struct syscm_gdbarch_data *data = gdbarch_data (gdbarch, syscm_gdbarch_data_key); htab = data->htab; } return htab; } /* The smob "free" function for . */ static size_t syscm_free_symbol_smob (SCM self) { symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self); if (s_smob->symbol != NULL) { htab_t htab = syscm_get_symbol_map (s_smob->symbol); gdbscm_clear_eqable_gsmob_ptr_slot (htab, &s_smob->base); } /* Not necessary, done to catch bugs. */ s_smob->symbol = NULL; return 0; } /* The smob "print" function for . */ static int syscm_print_symbol_smob (SCM self, SCM port, scm_print_state *pstate) { symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (self); if (pstate->writingp) gdbscm_printf (port, "#<%s ", symbol_smob_name); gdbscm_printf (port, "%s", s_smob->symbol != NULL ? SYMBOL_PRINT_NAME (s_smob->symbol) : ""); if (pstate->writingp) scm_puts (">", port); scm_remember_upto_here_1 (self); /* Non-zero means success. */ return 1; } /* Low level routine to create a object. */ static SCM syscm_make_symbol_smob (void) { symbol_smob *s_smob = (symbol_smob *) scm_gc_malloc (sizeof (symbol_smob), symbol_smob_name); SCM s_scm; s_smob->symbol = NULL; s_scm = scm_new_smob (symbol_smob_tag, (scm_t_bits) s_smob); gdbscm_init_eqable_gsmob (&s_smob->base, s_scm); return s_scm; } /* Return non-zero if SCM is a symbol smob. */ int syscm_is_symbol (SCM scm) { return SCM_SMOB_PREDICATE (symbol_smob_tag, scm); } /* (symbol? object) -> boolean */ static SCM gdbscm_symbol_p (SCM scm) { return scm_from_bool (syscm_is_symbol (scm)); } /* Return the existing object that encapsulates SYMBOL, or create a new object. */ SCM syscm_scm_from_symbol (struct symbol *symbol) { htab_t htab; eqable_gdb_smob **slot; symbol_smob *s_smob, s_smob_for_lookup; SCM s_scm; /* If we've already created a gsmob for this symbol, return it. This makes symbols eq?-able. */ htab = syscm_get_symbol_map (symbol); s_smob_for_lookup.symbol = symbol; slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &s_smob_for_lookup.base); if (*slot != NULL) return (*slot)->containing_scm; s_scm = syscm_make_symbol_smob (); s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm); s_smob->symbol = symbol; gdbscm_fill_eqable_gsmob_ptr_slot (slot, &s_smob->base); return s_scm; } /* Returns the object in SELF. Throws an exception if SELF is not a object. */ static SCM syscm_get_symbol_arg_unsafe (SCM self, int arg_pos, const char *func_name) { SCM_ASSERT_TYPE (syscm_is_symbol (self), self, arg_pos, func_name, symbol_smob_name); return self; } /* Returns a pointer to the symbol smob of SELF. Throws an exception if SELF is not a object. */ static symbol_smob * syscm_get_symbol_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name) { SCM s_scm = syscm_get_symbol_arg_unsafe (self, arg_pos, func_name); symbol_smob *s_smob = (symbol_smob *) SCM_SMOB_DATA (s_scm); return s_smob; } /* Return non-zero if symbol S_SMOB is valid. */ static int syscm_is_valid (symbol_smob *s_smob) { return s_smob->symbol != NULL; } /* Throw a Scheme error if SELF is not a valid symbol smob. Otherwise return a pointer to the symbol smob. */ static symbol_smob * syscm_get_valid_symbol_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name) { symbol_smob *s_smob = syscm_get_symbol_smob_arg_unsafe (self, arg_pos, func_name); if (!syscm_is_valid (s_smob)) { gdbscm_invalid_object_error (func_name, arg_pos, self, _("")); } return s_smob; } /* Throw a Scheme error if SELF is not a valid symbol smob. Otherwise return a pointer to the symbol struct. */ struct symbol * syscm_get_valid_symbol_arg_unsafe (SCM self, int arg_pos, const char *func_name) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, arg_pos, func_name); return s_smob->symbol; } /* Helper function for syscm_del_objfile_symbols to mark the symbol as invalid. */ static int syscm_mark_symbol_invalid (void **slot, void *info) { symbol_smob *s_smob = (symbol_smob *) *slot; s_smob->symbol = NULL; return 1; } /* This function is called when an objfile is about to be freed. Invalidate the symbol as further actions on the symbol would result in bad data. All access to s_smob->symbol should be gated by syscm_get_valid_symbol_smob_arg_unsafe which will raise an exception on invalid symbols. */ static void syscm_del_objfile_symbols (struct objfile *objfile, void *datum) { htab_t htab = datum; if (htab != NULL) { htab_traverse_noresize (htab, syscm_mark_symbol_invalid, NULL); htab_delete (htab); } } /* Symbol methods. */ /* (symbol-valid? ) -> boolean Returns #t if SELF still exists in GDB. */ static SCM gdbscm_symbol_valid_p (SCM self) { symbol_smob *s_smob = syscm_get_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); return scm_from_bool (syscm_is_valid (s_smob)); } /* (symbol-type ) -> Return the type of SELF, or #f if SELF has no type. */ static SCM gdbscm_symbol_type (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; if (SYMBOL_TYPE (symbol) == NULL) return SCM_BOOL_F; return tyscm_scm_from_type (SYMBOL_TYPE (symbol)); } /* (symbol-symtab ) -> | #f Return the symbol table of SELF. If SELF does not have a symtab (it is arch-owned) return #f. */ static SCM gdbscm_symbol_symtab (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; if (!SYMBOL_OBJFILE_OWNED (symbol)) return SCM_BOOL_F; return stscm_scm_from_symtab (symbol_symtab (symbol)); } /* (symbol-name ) -> string */ static SCM gdbscm_symbol_name (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; return gdbscm_scm_from_c_string (SYMBOL_NATURAL_NAME (symbol)); } /* (symbol-linkage-name ) -> string */ static SCM gdbscm_symbol_linkage_name (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; return gdbscm_scm_from_c_string (SYMBOL_LINKAGE_NAME (symbol)); } /* (symbol-print-name ) -> string */ static SCM gdbscm_symbol_print_name (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; return gdbscm_scm_from_c_string (SYMBOL_PRINT_NAME (symbol)); } /* (symbol-addr-class ) -> integer */ static SCM gdbscm_symbol_addr_class (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; return scm_from_int (SYMBOL_CLASS (symbol)); } /* (symbol-argument? ) -> boolean */ static SCM gdbscm_symbol_argument_p (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol)); } /* (symbol-constant? ) -> boolean */ static SCM gdbscm_symbol_constant_p (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; enum address_class theclass; theclass = SYMBOL_CLASS (symbol); return scm_from_bool (theclass == LOC_CONST || theclass == LOC_CONST_BYTES); } /* (symbol-function? ) -> boolean */ static SCM gdbscm_symbol_function_p (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; enum address_class theclass; theclass = SYMBOL_CLASS (symbol); return scm_from_bool (theclass == LOC_BLOCK); } /* (symbol-variable? ) -> boolean */ static SCM gdbscm_symbol_variable_p (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; enum address_class theclass; theclass = SYMBOL_CLASS (symbol); return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol) && (theclass == LOC_LOCAL || theclass == LOC_REGISTER || theclass == LOC_STATIC || theclass == LOC_COMPUTED || theclass == LOC_OPTIMIZED_OUT)); } /* (symbol-needs-frame? ) -> boolean Return #t if the symbol needs a frame for evaluation. */ static SCM gdbscm_symbol_needs_frame_p (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); struct symbol *symbol = s_smob->symbol; volatile struct gdb_exception except; int result = 0; TRY_CATCH (except, RETURN_MASK_ALL) { result = symbol_read_needs_frame (symbol); } GDBSCM_HANDLE_GDB_EXCEPTION (except); return scm_from_bool (result); } /* (symbol-line ) -> integer Return the line number at which the symbol was defined. */ static SCM gdbscm_symbol_line (SCM self) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); const struct symbol *symbol = s_smob->symbol; return scm_from_int (SYMBOL_LINE (symbol)); } /* (symbol-value [#:frame ]) -> Return the value of the symbol, or an error in various circumstances. */ static SCM gdbscm_symbol_value (SCM self, SCM rest) { symbol_smob *s_smob = syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); struct symbol *symbol = s_smob->symbol; SCM keywords[] = { frame_keyword, SCM_BOOL_F }; int frame_pos = -1; SCM frame_scm = SCM_BOOL_F; frame_smob *f_smob = NULL; struct frame_info *frame_info = NULL; struct value *value = NULL; volatile struct gdb_exception except; gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", rest, &frame_pos, &frame_scm); if (!gdbscm_is_false (frame_scm)) f_smob = frscm_get_frame_smob_arg_unsafe (frame_scm, frame_pos, FUNC_NAME); if (SYMBOL_CLASS (symbol) == LOC_TYPEDEF) { gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, _("cannot get the value of a typedef")); } TRY_CATCH (except, RETURN_MASK_ALL) { if (f_smob != NULL) { frame_info = frscm_frame_smob_to_frame (f_smob); if (frame_info == NULL) error (_("Invalid frame")); } if (symbol_read_needs_frame (symbol) && frame_info == NULL) error (_("Symbol requires a frame to compute its value")); value = read_var_value (symbol, frame_info); } GDBSCM_HANDLE_GDB_EXCEPTION (except); return vlscm_scm_from_value (value); } /* (lookup-symbol name [#:block ] [#:domain domain]) -> ( field-of-this?) The result is #f if the symbol is not found. See comment in lookup_symbol_in_language for field-of-this?. */ static SCM gdbscm_lookup_symbol (SCM name_scm, SCM rest) { char *name; SCM keywords[] = { block_keyword, domain_keyword, SCM_BOOL_F }; const struct block *block = NULL; SCM block_scm = SCM_BOOL_F; int domain = VAR_DOMAIN; int block_arg_pos = -1, domain_arg_pos = -1; struct field_of_this_result is_a_field_of_this; struct symbol *symbol = NULL; volatile struct gdb_exception except; struct cleanup *cleanups; gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#Oi", name_scm, &name, rest, &block_arg_pos, &block_scm, &domain_arg_pos, &domain); cleanups = make_cleanup (xfree, name); if (block_arg_pos >= 0) { SCM except_scm; block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME, &except_scm); if (block == NULL) { do_cleanups (cleanups); gdbscm_throw (except_scm); } } else { struct frame_info *selected_frame; TRY_CATCH (except, RETURN_MASK_ALL) { selected_frame = get_selected_frame (_("no frame selected")); block = get_frame_block (selected_frame, NULL); } GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups); } TRY_CATCH (except, RETURN_MASK_ALL) { symbol = lookup_symbol (name, block, domain, &is_a_field_of_this); } do_cleanups (cleanups); GDBSCM_HANDLE_GDB_EXCEPTION (except); if (symbol == NULL) return SCM_BOOL_F; return scm_list_2 (syscm_scm_from_symbol (symbol), scm_from_bool (is_a_field_of_this.type != NULL)); } /* (lookup-global-symbol name [#:domain domain]) -> The result is #f if the symbol is not found. */ static SCM gdbscm_lookup_global_symbol (SCM name_scm, SCM rest) { char *name; SCM keywords[] = { domain_keyword, SCM_BOOL_F }; int domain_arg_pos = -1; int domain = VAR_DOMAIN; struct symbol *symbol = NULL; volatile struct gdb_exception except; struct cleanup *cleanups; gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#i", name_scm, &name, rest, &domain_arg_pos, &domain); cleanups = make_cleanup (xfree, name); TRY_CATCH (except, RETURN_MASK_ALL) { symbol = lookup_global_symbol (name, NULL, domain); } do_cleanups (cleanups); GDBSCM_HANDLE_GDB_EXCEPTION (except); if (symbol == NULL) return SCM_BOOL_F; return syscm_scm_from_symbol (symbol); } /* Initialize the Scheme symbol support. */ /* Note: The SYMBOL_ prefix on the integer constants here is present for compatibility with the Python support. */ static const scheme_integer_constant symbol_integer_constants[] = { #define X(SYM) { "SYMBOL_" #SYM, SYM } X (LOC_UNDEF), X (LOC_CONST), X (LOC_STATIC), X (LOC_REGISTER), X (LOC_ARG), X (LOC_REF_ARG), X (LOC_LOCAL), X (LOC_TYPEDEF), X (LOC_LABEL), X (LOC_BLOCK), X (LOC_CONST_BYTES), X (LOC_UNRESOLVED), X (LOC_OPTIMIZED_OUT), X (LOC_COMPUTED), X (LOC_REGPARM_ADDR), X (UNDEF_DOMAIN), X (VAR_DOMAIN), X (STRUCT_DOMAIN), X (LABEL_DOMAIN), X (VARIABLES_DOMAIN), X (FUNCTIONS_DOMAIN), X (TYPES_DOMAIN), #undef X END_INTEGER_CONSTANTS }; static const scheme_function symbol_functions[] = { { "symbol?", 1, 0, 0, gdbscm_symbol_p, "\ Return #t if the object is a object." }, { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p, "\ Return #t if object is a valid object.\n\ A valid symbol is a symbol that has not been freed.\n\ Symbols are freed when the objfile they come from is freed." }, { "symbol-type", 1, 0, 0, gdbscm_symbol_type, "\ Return the type of symbol." }, { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab, "\ Return the symbol table () containing symbol." }, { "symbol-line", 1, 0, 0, gdbscm_symbol_line, "\ Return the line number at which the symbol was defined." }, { "symbol-name", 1, 0, 0, gdbscm_symbol_name, "\ Return the name of the symbol as a string." }, { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name, "\ Return the linkage name of the symbol as a string." }, { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name, "\ Return the print name of the symbol as a string.\n\ This is either name or linkage-name, depending on whether the user\n\ asked GDB to display demangled or mangled names." }, { "symbol-addr-class", 1, 0, 0, gdbscm_symbol_addr_class, "\ Return the address class of the symbol." }, { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p, "\ Return #t if the symbol needs a frame to compute its value." }, { "symbol-argument?", 1, 0, 0, gdbscm_symbol_argument_p, "\ Return #t if the symbol is a function argument." }, { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p, "\ Return #t if the symbol is a constant." }, { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p, "\ Return #t if the symbol is a function." }, { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p, "\ Return #t if the symbol is a variable." }, { "symbol-value", 1, 0, 1, gdbscm_symbol_value, "\ Return the value of the symbol.\n\ \n\ Arguments: [#:frame frame]" }, { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol, "\ Return ( field-of-this?) if found, otherwise #f.\n\ \n\ Arguments: name [#:block block] [#:domain domain]\n\ name: a string containing the name of the symbol to lookup\n\ block: a object\n\ domain: a SYMBOL_*_DOMAIN value" }, { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol, "\ Return if found, otherwise #f.\n\ \n\ Arguments: name [#:domain domain]\n\ name: a string containing the name of the symbol to lookup\n\ domain: a SYMBOL_*_DOMAIN value" }, END_FUNCTIONS }; void gdbscm_initialize_symbols (void) { symbol_smob_tag = gdbscm_make_smob_type (symbol_smob_name, sizeof (symbol_smob)); scm_set_smob_free (symbol_smob_tag, syscm_free_symbol_smob); scm_set_smob_print (symbol_smob_tag, syscm_print_symbol_smob); gdbscm_define_integer_constants (symbol_integer_constants, 1); gdbscm_define_functions (symbol_functions, 1); block_keyword = scm_from_latin1_keyword ("block"); domain_keyword = scm_from_latin1_keyword ("domain"); frame_keyword = scm_from_latin1_keyword ("frame"); /* Register an objfile "free" callback so we can properly invalidate symbols when an object file is about to be deleted. */ syscm_objfile_data_key = register_objfile_data_with_cleanup (NULL, syscm_del_objfile_symbols); /* Arch-specific symbol data. */ syscm_gdbarch_data_key = gdbarch_data_register_post_init (syscm_init_arch_symbols); }