mirror of
https://sourceware.org/git/binutils-gdb.git
synced 2024-12-15 04:31:49 +08:00
63e43d3aed
GDB's current behavior when dealing with non-local references in the context of nested fuctions is approximative: - code using valops.c:value_of_variable read the first available stack frame that holds the corresponding variable (whereas there can be multiple candidates for this); - code directly relying on read_var_value will instead read non-local variables in frames where they are not even defined. This change adds the necessary context to symbol reads (to get the block they belong to) and to blocks (the static link property, if any) so that GDB can make the proper decisions when dealing with non-local varibale references. gdb/ChangeLog: * ada-lang.c (ada_read_var_value): Add a var_block argument and pass it to default_read_var_value. * block.c (block_static_link): New accessor. * block.h (block_static_link): Declare it. * buildsym.c (finish_block_internal): Add a static_link argument. If there is a static link, associate it to the new block. (finish_block): Add a static link argument and pass it to finish_block_internal. (end_symtab_get_static_block): Update calls to finish_block and to finish_block_internal. (end_symtab_with_blockvector): Update call to finish_block_internal. * buildsym.h: Forward-declare struct dynamic_prop. (struct context_stack): Add a static_link field. (finish_block): Add a static link argument. * c-exp.y: Remove an obsolete comment (evaluation of variables already start from the selected frame, and now they climb *up* the call stack) and propagate the block information to the produced expression. * d-exp.y: Likewise. * f-exp.y: Likewise. * go-exp.y: Likewise. * jv-exp.y: Likewise. * m2-exp.y: Likewise. * p-exp.y: Likewise. * coffread.c (coff_symtab_read): Update calls to finish_block. * dbxread.c (process_one_symbol): Likewise. * xcoffread.c (read_xcoff_symtab): Likewise. * compile/compile-c-symbols.c (convert_one_symbol): Promote the "sym" parameter to struct block_symbol, update its uses and pass its block to calls to read_var_value. (convert_symbol_sym): Update the calls to convert_one_symbol. * compile/compile-loc2c.c (do_compile_dwarf_expr_to_c): Update call to read_var_value. * dwarf2loc.c (block_op_get_frame_base): New. (dwarf2_block_frame_base_locexpr_funcs): Implement the get_frame_base method. (dwarf2_block_frame_base_loclist_funcs): Likewise. (dwarf2locexpr_baton_eval): Add a frame argument and use it instead of the selected frame in order to evaluate the expression. (dwarf2_evaluate_property): Add a frame argument. Update call to dwarf2_locexpr_baton_eval to provide a frame in available and to handle the absence of address stack. * dwarf2loc.h (dwarf2_evaluate_property): Add a frame argument. * dwarf2read.c (attr_to_dynamic_prop): Add a forward declaration. (read_func_scope): Record any available static link description. Update call to finish_block. (read_lexical_block_scope): Update call to finish_block. * findvar.c (follow_static_link): New. (get_hosting_frame): New. (default_read_var_value): Add a var_block argument. Use get_hosting_frame to handle non-local references. (read_var_value): Add a var_block argument and pass it to the LA_READ_VAR_VALUE method. * gdbtypes.c (resolve_dynamic_range): Update calls to dwarf2_evaluate_property. (resolve_dynamic_type_internal): Likewise. * guile/scm-frame.c (gdbscm_frame_read_var): Update call to read_var_value, passing it the block coming from symbol lookup. * guile/scm-symbol.c (gdbscm_symbol_value): Update call to read_var_value (TODO). * infcmd.c (finish_command_continuation): Update call to read_var_value, passing it the block coming from symbol lookup. * infrun.c (insert_exception_resume_breakpoint): Likewise. * language.h (struct language_defn): Add a var_block argument to the LA_READ_VAR_VALUE method. * objfiles.c (struct static_link_htab_entry): New. (static_link_htab_entry_hash): New. (static_link_htab_entry_eq): New. (objfile_register_static_link): New. (objfile_lookup_static_link): New. (free_objfile): Free the STATIC_LINKS hashed map if needed. * objfiles.h: Include hashtab.h. (struct objfile): Add a static_links field. (objfile_register_static_link): New. (objfile_lookup_static_link): New. * printcmd.c (print_variable_and_value): Update call to read_var_value. * python/py-finishbreakpoint.c (bpfinishpy_init): Likewise. * python/py-frame.c (frapy_read_var): Update call to read_var_value, passing it the block coming from symbol lookup. * python/py-framefilter.c (extract_sym): Add a sym_block parameter and set the pointed value to NULL (TODO). (enumerate_args): Update call to extract_sym. (enumerate_locals): Update calls to extract_sym and to read_var_value. * python/py-symbol.c (sympy_value): Update call to read_var_value (TODO). * stack.c (read_frame_local): Update call to read_var_value. (read_frame_arg): Likewise. (return_command): Likewise. * symtab.h (struct symbol_block_ops): Add a get_frame_base method. (struct symbol): Add a block field. (SYMBOL_BLOCK): New accessor. * valops.c (value_of_variable): Remove frame/block handling and pass the block argument to read_var_value, which does this job now. (value_struct_elt_for_reference): Update calls to read_var_value. (value_of_this): Pass the block found to read_var_value. * value.h (read_var_value): Add a var_block argument. (default_read_var_value): Likewise. gdb/testsuite/ChangeLog: * gdb.base/nested-subp1.exp: New file. * gdb.base/nested-subp1.c: New file. * gdb.base/nested-subp2.exp: New file. * gdb.base/nested-subp2.c: New file. * gdb.base/nested-subp3.exp: New file. * gdb.base/nested-subp3.c: New file.
829 lines
21 KiB
C
829 lines
21 KiB
C
/* 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 <http://www.gnu.org/licenses/>. */
|
||
|
||
/* 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 <gdb:symbol> 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 <gdb:symbol>. */
|
||
|
||
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 <gdb:symbol>. */
|
||
|
||
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)
|
||
: "<invalid>");
|
||
if (pstate->writingp)
|
||
scm_puts (">", port);
|
||
|
||
scm_remember_upto_here_1 (self);
|
||
|
||
/* Non-zero means success. */
|
||
return 1;
|
||
}
|
||
|
||
/* Low level routine to create a <gdb:symbol> 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
|
||
<gdb:symbol> 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 <gdb:symbol> object in SELF.
|
||
Throws an exception if SELF is not a <gdb:symbol> 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 <gdb:symbol> 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,
|
||
_("<gdb:symbol>"));
|
||
}
|
||
|
||
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? <gdb:symbol>) -> 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 <gdb:symbol>) -> <gdb: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 <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)
|
||
{
|
||
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 <gdb:symbol>) -> 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 <gdb:symbol>) -> 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 <gdb:symbol>) -> 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 <gdb:symbol>) -> 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? <gdb:symbol>) -> 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? <gdb:symbol>) -> 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? <gdb:symbol>) -> 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? <gdb:symbol>) -> 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? <gdb:symbol>) -> 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;
|
||
int result = 0;
|
||
|
||
TRY
|
||
{
|
||
result = symbol_read_needs_frame (symbol);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return scm_from_bool (result);
|
||
}
|
||
|
||
/* (symbol-line <gdb:symbol>) -> 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 <gdb:symbol> [#:frame <gdb:frame>]) -> <gdb:value>
|
||
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;
|
||
|
||
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
|
||
{
|
||
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"));
|
||
|
||
/* 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 (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return vlscm_scm_from_value (value);
|
||
}
|
||
|
||
/* (lookup-symbol name [#:block <gdb:block>] [#:domain domain])
|
||
-> (<gdb:symbol> 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;
|
||
struct cleanup *cleanups;
|
||
struct gdb_exception except = exception_none;
|
||
|
||
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
|
||
{
|
||
selected_frame = get_selected_frame (_("no frame selected"));
|
||
block = get_frame_block (selected_frame, NULL);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
|
||
}
|
||
END_CATCH
|
||
}
|
||
|
||
TRY
|
||
{
|
||
symbol = lookup_symbol (name, block, domain, &is_a_field_of_this).symbol;
|
||
}
|
||
CATCH (ex, RETURN_MASK_ALL)
|
||
{
|
||
except = ex;
|
||
}
|
||
END_CATCH
|
||
|
||
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]) -> <gdb:symbol>
|
||
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;
|
||
struct cleanup *cleanups;
|
||
struct gdb_exception except = exception_none;
|
||
|
||
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
|
||
{
|
||
symbol = lookup_global_symbol (name, NULL, domain).symbol;
|
||
}
|
||
CATCH (ex, RETURN_MASK_ALL)
|
||
{
|
||
except = ex;
|
||
}
|
||
END_CATCH
|
||
|
||
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 <gdb:symbol> object." },
|
||
|
||
{ "symbol-valid?", 1, 0, 0, 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,
|
||
"\
|
||
Return the type of symbol." },
|
||
|
||
{ "symbol-symtab", 1, 0, 0, gdbscm_symbol_symtab,
|
||
"\
|
||
Return the symbol table (<gdb:symtab>) 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: <gdb:symbol> [#:frame frame]" },
|
||
|
||
{ "lookup-symbol", 1, 0, 1, gdbscm_lookup_symbol,
|
||
"\
|
||
Return (<gdb:symbol> 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 <gdb:block> object\n\
|
||
domain: a SYMBOL_*_DOMAIN value" },
|
||
|
||
{ "lookup-global-symbol", 1, 0, 1, gdbscm_lookup_global_symbol,
|
||
"\
|
||
Return <gdb:symbol> 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);
|
||
}
|