binutils-gdb/gdb/guile/scm-symbol.c
Pierre-Marie de Rodat 63e43d3aed DWARF: handle non-local references in nested functions
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.
2015-08-25 08:13:28 -04:00

829 lines
21 KiB
C
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/* 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);
}