/* Scheme interface to symbols.
- Copyright (C) 2008-2014 Free Software Foundation, Inc.
+ Copyright (C) 2008-2019 Free Software Foundation, Inc.
This file is part of GDB.
#include "defs.h"
#include "block.h"
-#include "exceptions.h"
#include "frame.h"
#include "symtab.h"
#include "objfiles.h"
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;
+};
\f
/* Administrivia for symbol smobs. */
static hashval_t
syscm_hash_symbol_smob (const void *p)
{
- const symbol_smob *s_smob = p;
+ const symbol_smob *s_smob = (const symbol_smob *) p;
return htab_hash_pointer (s_smob->symbol);
}
static int
syscm_eq_symbol_smob (const void *ap, const void *bp)
{
- const symbol_smob *a = ap;
- const symbol_smob *b = bp;
+ const symbol_smob *a = (const symbol_smob *) ap;
+ const symbol_smob *b = (const symbol_smob *) 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_objfile_symbol_map (struct symbol *symbol)
+syscm_get_symbol_map (struct symbol *symbol)
{
- struct objfile *objfile = SYMBOL_SYMTAB (symbol)->objfile;
- htab_t htab = objfile_data (objfile, syscm_objfile_data_key);
+ htab_t htab;
- if (htab == NULL)
+ if (SYMBOL_OBJFILE_OWNED (symbol))
{
- htab = gdbscm_create_eqable_gsmob_ptr_map (syscm_hash_symbol_smob,
- syscm_eq_symbol_smob);
- set_objfile_data (objfile, syscm_objfile_data_key, htab);
- }
+ struct objfile *objfile = symbol_objfile (symbol);
- return htab;
-}
+ htab = (htab_t) 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
+ = (struct syscm_gdbarch_data *) gdbarch_data (gdbarch,
+ syscm_gdbarch_data_key);
-/* The smob "mark" function for <gdb:symbol>. */
+ htab = data->htab;
+ }
-static SCM
-syscm_mark_symbol_smob (SCM self)
-{
- return SCM_BOOL_F;
+ return htab;
}
/* The smob "free" function for <gdb:symbol>. */
if (s_smob->symbol != NULL)
{
- htab_t htab = syscm_objfile_symbol_map (s_smob->symbol);
+ htab_t htab = syscm_get_symbol_map (s_smob->symbol);
gdbscm_clear_eqable_gsmob_ptr_slot (htab, &s_smob->base);
}
gdbscm_printf (port, "#<%s ", symbol_smob_name);
gdbscm_printf (port, "%s",
s_smob->symbol != NULL
- ? SYMBOL_PRINT_NAME (s_smob->symbol)
+ ? s_smob->symbol->print_name ()
: "<invalid>");
if (pstate->writingp)
scm_puts (">", port);
/* If we've already created a gsmob for this symbol, return it.
This makes symbols eq?-able. */
- htab = syscm_objfile_symbol_map (symbol);
+ 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)
static void
syscm_del_objfile_symbols (struct objfile *objfile, void *datum)
{
- htab_t htab = datum;
+ htab_t htab = (htab_t) datum;
if (htab != NULL)
{
return tyscm_scm_from_type (SYMBOL_TYPE (symbol));
}
-/* (symbol-symtab <gdb:symbol>) -> <gdb:symtab>
- Return the symbol table of SELF. */
+/* (symbol-symtab <gdb:symbol>) -> <gdb: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)
= syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
const struct symbol *symbol = s_smob->symbol;
- return stscm_scm_from_symtab (SYMBOL_SYMTAB (symbol));
+ if (!SYMBOL_OBJFILE_OWNED (symbol))
+ return SCM_BOOL_F;
+ return stscm_scm_from_symtab (symbol_symtab (symbol));
}
/* (symbol-name <gdb:symbol>) -> string */
= 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));
+ return gdbscm_scm_from_c_string (symbol->natural_name ());
}
/* (symbol-linkage-name <gdb:symbol>) -> string */
= 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));
+ return gdbscm_scm_from_c_string (symbol->linkage_name ());
}
/* (symbol-print-name <gdb:symbol>) -> string */
= 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));
+ return gdbscm_scm_from_c_string (symbol->print_name ());
}
/* (symbol-addr-class <gdb:symbol>) -> integer */
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 class;
+ enum address_class theclass;
- class = SYMBOL_CLASS (symbol);
+ theclass = SYMBOL_CLASS (symbol);
- return scm_from_bool (class == LOC_CONST || class == LOC_CONST_BYTES);
+ return scm_from_bool (theclass == LOC_CONST || theclass == LOC_CONST_BYTES);
}
/* (symbol-function? <gdb:symbol>) -> boolean */
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 class;
+ enum address_class theclass;
- class = SYMBOL_CLASS (symbol);
+ theclass = SYMBOL_CLASS (symbol);
- return scm_from_bool (class == LOC_BLOCK);
+ return scm_from_bool (theclass == LOC_BLOCK);
}
/* (symbol-variable? <gdb:symbol>) -> boolean */
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 class;
+ enum address_class theclass;
- class = SYMBOL_CLASS (symbol);
+ theclass = SYMBOL_CLASS (symbol);
return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol)
- && (class == LOC_LOCAL || class == LOC_REGISTER
- || class == LOC_STATIC || class == LOC_COMPUTED
- || class == LOC_OPTIMIZED_OUT));
+ && (theclass == LOC_LOCAL || theclass == LOC_REGISTER
+ || theclass == LOC_STATIC || theclass == LOC_COMPUTED
+ || theclass == LOC_OPTIMIZED_OUT));
}
/* (symbol-needs-frame? <gdb:symbol>) -> boolean
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)
+ gdbscm_gdb_exception exc {};
+ try
{
result = symbol_read_needs_frame (symbol);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
+ }
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return scm_from_bool (result);
}
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);
_("cannot get the value of a typedef"));
}
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
if (f_smob != NULL)
{
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);
+ /* TODO: currently, we have no way to recover the block in which SYMBOL
+ was found, so we have no block to pass to read_var_value. This will
+ yield an incorrect value when symbol is not local to FRAME_INFO (this
+ can happen with nested functions). */
+ value = read_var_value (symbol, NULL, frame_info);
+ }
+ catch (const gdb_exception &except)
+ {
+ exc = unpack (except);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
return vlscm_scm_from_value (value);
}
\f
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;
&except_scm);
if (block == NULL)
{
- do_cleanups (cleanups);
+ xfree (name);
gdbscm_throw (except_scm);
}
}
{
struct frame_info *selected_frame;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception exc {};
+ try
{
selected_frame = get_selected_frame (_("no frame selected"));
block = get_frame_block (selected_frame, NULL);
}
- GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
+ catch (const gdb_exception &ex)
+ {
+ xfree (name);
+ exc = unpack (ex);
+ }
+ GDBSCM_HANDLE_GDB_EXCEPTION (exc);
}
- TRY_CATCH (except, RETURN_MASK_ALL)
+ gdbscm_gdb_exception except {};
+ try
+ {
+ symbol = lookup_symbol (name, block, (domain_enum) domain,
+ &is_a_field_of_this).symbol;
+ }
+ catch (const gdb_exception &ex)
{
- symbol = lookup_symbol (name, block, domain, &is_a_field_of_this);
+ except = unpack (ex);
}
- do_cleanups (cleanups);
+
+ xfree (name);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (symbol == NULL)
int domain_arg_pos = -1;
int domain = VAR_DOMAIN;
struct symbol *symbol = NULL;
- volatile struct gdb_exception except;
- struct cleanup *cleanups;
+ gdbscm_gdb_exception except {};
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)
+ try
{
- symbol = lookup_symbol_global (name, NULL, domain);
+ symbol = lookup_global_symbol (name, NULL, (domain_enum) domain).symbol;
}
- do_cleanups (cleanups);
+ catch (const gdb_exception &ex)
+ {
+ except = unpack (ex);
+ }
+
+ xfree (name);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (symbol == NULL)
static const scheme_function symbol_functions[] =
{
- { "symbol?", 1, 0, 0, gdbscm_symbol_p,
+ { "symbol?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_p),
"\
Return #t if the object is a <gdb:symbol> object." },
- { "symbol-valid?", 1, 0, 0, gdbscm_symbol_valid_p,
+ { "symbol-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_valid_p),
"\
Return #t if object is a valid <gdb:symbol> 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,
+ { "symbol-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_type),
"\
Return the type of symbol." },
- { "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab,
+ { "symbol-symtab", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_symtab),
"\
Return the symbol table (<gdb:symtab>) containing symbol." },
- { "symbol-line", 1, 0, 0, gdbscm_symbol_line,
+ { "symbol-line", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_line),
"\
Return the line number at which the symbol was defined." },
- { "symbol-name", 1, 0, 0, gdbscm_symbol_name,
+ { "symbol-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_name),
"\
Return the name of the symbol as a string." },
- { "symbol-linkage-name", 1, 0, 0, gdbscm_symbol_linkage_name,
+ { "symbol-linkage-name", 1, 0, 0,
+ as_a_scm_t_subr (gdbscm_symbol_linkage_name),
"\
Return the linkage name of the symbol as a string." },
- { "symbol-print-name", 1, 0, 0, gdbscm_symbol_print_name,
+ { "symbol-print-name", 1, 0, 0, as_a_scm_t_subr (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,
+ { "symbol-addr-class", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_addr_class),
"\
Return the address class of the symbol." },
- { "symbol-needs-frame?", 1, 0, 0, gdbscm_symbol_needs_frame_p,
+ { "symbol-needs-frame?", 1, 0, 0,
+ as_a_scm_t_subr (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,
+ { "symbol-argument?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_argument_p),
"\
Return #t if the symbol is a function argument." },
- { "symbol-constant?", 1, 0, 0, gdbscm_symbol_constant_p,
+ { "symbol-constant?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_constant_p),
"\
Return #t if the symbol is a constant." },
- { "symbol-function?", 1, 0, 0, gdbscm_symbol_function_p,
+ { "symbol-function?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_function_p),
"\
Return #t if the symbol is a function." },
- { "symbol-variable?", 1, 0, 0, gdbscm_symbol_variable_p,
+ { "symbol-variable?", 1, 0, 0, as_a_scm_t_subr (gdbscm_symbol_variable_p),
"\
Return #t if the symbol is a variable." },
- { "symbol-value", 1, 0, 1, gdbscm_symbol_value,
+ { "symbol-value", 1, 0, 1, as_a_scm_t_subr (gdbscm_symbol_value),
"\
Return the value of the symbol.\n\
\n\
Arguments: <gdb:symbol> [#:frame frame]" },
- { "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol,
+ { "lookup-symbol", 1, 0, 1, as_a_scm_t_subr (gdbscm_lookup_symbol),
"\
Return (<gdb:symbol> field-of-this?) if found, otherwise #f.\n\
\n\
block: a <gdb:block> object\n\
domain: a SYMBOL_*_DOMAIN value" },
- { "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol,
+ { "lookup-global-symbol", 1, 0, 1,
+ as_a_scm_t_subr (gdbscm_lookup_global_symbol),
"\
Return <gdb:symbol> if found, otherwise #f.\n\
\n\
{
symbol_smob_tag
= gdbscm_make_smob_type (symbol_smob_name, sizeof (symbol_smob));
- scm_set_smob_mark (symbol_smob_tag, syscm_mark_symbol_smob);
scm_set_smob_free (symbol_smob_tag, syscm_free_symbol_smob);
scm_set_smob_print (symbol_smob_tag, syscm_print_symbol_smob);
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);
}
projects / deliverable / binutils-gdb.git / blobdiff