492d29ea1c
This patch splits the TRY_CATCH macro into three, so that we go from
this:
~~~
volatile gdb_exception ex;
TRY_CATCH (ex, RETURN_MASK_ERROR)
{
}
if (ex.reason < 0)
{
}
~~~
to this:
~~~
TRY
{
}
CATCH (ex, RETURN_MASK_ERROR)
{
}
END_CATCH
~~~
Thus, we'll be getting rid of the local volatile exception object, and
declaring the caught exception in the catch block.
This allows reimplementing TRY/CATCH in terms of C++ exceptions when
building in C++ mode, while still allowing to build GDB in C mode
(using setjmp/longjmp), as a transition step.
TBC, after this patch, is it _not_ valid to have code between the TRY
and the CATCH blocks, like:
TRY
{
}
// some code here.
CATCH (ex, RETURN_MASK_ERROR)
{
}
END_CATCH
Just like it isn't valid to do that with C++'s native try/catch.
By switching to creating the exception object inside the CATCH block
scope, we can get rid of all the explicitly allocated volatile
exception objects all over the tree, and map the CATCH block more
directly to C++'s catch blocks.
The majority of the TRY_CATCH -> TRY+CATCH+END_CATCH conversion was
done with a script, rerun from scratch at every rebase, no manual
editing involved. After the mechanical conversion, a few places
needed manual intervention, to fix preexisting cases where we were
using the exception object outside of the TRY_CATCH block, and cases
where we were using "else" after a 'if (ex.reason) < 0)' [a CATCH
after this patch]. The result was folded into this patch so that GDB
still builds at each incremental step.
END_CATCH is necessary for two reasons:
First, because we name the exception object in the CATCH block, which
requires creating a scope, which in turn must be closed somewhere.
Declaring the exception variable in the initializer field of a for
block, like:
#define CATCH(EXCEPTION, mask) \
for (struct gdb_exception EXCEPTION; \
exceptions_state_mc_catch (&EXCEPTION, MASK); \
EXCEPTION = exception_none)
would avoid needing END_CATCH, but alas, in C mode, we build with C90,
which doesn't allow mixed declarations and code.
Second, because when TRY/CATCH are wired to real C++ try/catch, as
long as we need to handle cleanup chains, even if there's no CATCH
block that wants to catch the exception, we need for stop at every
frame in the unwind chain and run cleanups, then rethrow. That will
be done in END_CATCH.
After we require C++, we'll still need TRY/CATCH/END_CATCH until
cleanups are completely phased out -- TRY/CATCH in C++ mode will
save/restore the current cleanup chain, like in C mode, and END_CATCH
catches otherwise uncaugh exceptions, runs cleanups and rethrows, so
that C++ cleanups and exceptions can coexist.
IMO, this still makes the TRY/CATCH code look a bit more like a
newcomer would expect, so IMO worth it even if we weren't considering
C++.
gdb/ChangeLog.
2015-03-07 Pedro Alves <palves@redhat.com>
* common/common-exceptions.c (struct catcher) <exception>: No
longer a pointer to volatile exception. Now an exception value.
<mask>: Delete field.
(exceptions_state_mc_init): Remove all parameters. Adjust.
(exceptions_state_mc): No longer pop the catcher here.
(exceptions_state_mc_catch): New function.
(throw_exception): Adjust.
* common/common-exceptions.h (exceptions_state_mc_init): Remove
all parameters.
(exceptions_state_mc_catch): Declare.
(TRY_CATCH): Rename to ...
(TRY): ... this. Remove EXCEPTION and MASK parameters.
(CATCH, END_CATCH): New.
All callers adjusted.
gdb/gdbserver/ChangeLog:
2015-03-07 Pedro Alves <palves@redhat.com>
Adjust all callers of TRY_CATCH to use TRY/CATCH/END_CATCH
instead.
825 lines
21 KiB
C
825 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"));
|
||
|
||
value = read_var_value (symbol, 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);
|
||
}
|
||
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);
|
||
}
|
||
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);
|
||
}
|