/* Scheme interface to stack frames.
- Copyright (C) 2008-2014 Free Software Foundation, Inc.
+ Copyright (C) 2008-2016 Free Software Foundation, Inc.
This file is part of GDB.
#include "defs.h"
#include "block.h"
#include "frame.h"
-#include "exceptions.h"
#include "inferior.h"
#include "objfiles.h"
#include "symfile.h"
#include "symtab.h"
#include "stack.h"
+#include "user-regs.h"
#include "value.h"
#include "guile-internal.h"
static hashval_t
frscm_hash_frame_smob (const void *p)
{
- const frame_smob *f_smob = p;
+ const frame_smob *f_smob = (const frame_smob *) p;
const struct frame_id *fid = &f_smob->frame_id;
hashval_t hash = htab_hash_pointer (f_smob->inferior);
static int
frscm_eq_frame_smob (const void *ap, const void *bp)
{
- const frame_smob *a = ap;
- const frame_smob *b = bp;
+ const frame_smob *a = (const frame_smob *) ap;
+ const frame_smob *b = (const frame_smob *) bp;
return (frame_id_eq (a->frame_id, b->frame_id)
&& a->inferior == b->inferior
static htab_t
frscm_inferior_frame_map (struct inferior *inferior)
{
- htab_t htab = inferior_data (inferior, frscm_inferior_data_key);
+ htab_t htab = (htab_t) inferior_data (inferior, frscm_inferior_data_key);
if (htab == NULL)
{
return htab;
}
-/* The smob "mark" function for <gdb:frame>. */
-
-static SCM
-frscm_mark_frame_smob (SCM self)
-{
- frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self);
-
- /* Do this last. */
- return gdbscm_mark_eqable_gsmob (&f_smob->base);
-}
-
/* The smob "free" function for <gdb:frame>. */
static size_t
SCM f_scm;
htab_t htab;
eqable_gdb_smob **slot;
- volatile struct gdb_exception except;
struct frame_id frame_id = null_frame_id;
struct gdbarch *gdbarch = NULL;
int frame_id_is_next = 0;
if (*slot != NULL)
return (*slot)->containing_scm;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
/* Try to get the previous frame, to determine if this is the last frame
in a corrupt stack. If so, we need to store the frame_id of the next
}
gdbarch = get_frame_arch (frame);
}
- if (except.reason < 0)
- return gdbscm_scm_from_gdb_exception (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ return gdbscm_scm_from_gdb_exception (except);
+ }
+ END_CATCH
f_scm = frscm_make_frame_smob ();
f_smob = (frame_smob *) SCM_SMOB_DATA (f_scm);
Thus code working with frames has to handle both Scheme errors (e.g., the
object is not a frame) and GDB errors (e.g., the frame lookup failed).
- To help keep things clear we split gdbscm_scm_to_frame into two:
+ To help keep things clear we split what would be gdbscm_scm_to_frame
+ into two:
- gdbscm_get_frame_smob_arg_unsafe
+ frscm_get_frame_smob_arg_unsafe
- throws a Scheme error if object is not a frame,
or if the inferior is gone or is no longer current
- gdbscm_frame_smob_to_frame
+ frscm_frame_smob_to_frame
- may throw a gdb error if the conversion fails
- it's not clear when it will and won't throw a GDB error,
but for robustness' sake we assume that whenever we call out to GDB
static void
frscm_del_inferior_frames (struct inferior *inferior, void *datum)
{
- htab_t htab = datum;
+ htab_t htab = (htab_t) datum;
if (htab != NULL)
{
{
frame_smob *f_smob;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
return scm_from_bool (frame != NULL);
}
enum language lang = language_minimal;
struct frame_info *frame = NULL;
SCM result;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
if (frame != NULL)
find_frame_funname (frame, &name, &lang, NULL);
}
- if (except.reason < 0)
- xfree (name);
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ xfree (name);
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
frame_smob *f_smob;
enum frame_type type = NORMAL_FRAME;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
if (frame != NULL)
type = get_frame_type (frame);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
{
frame_smob *f_smob;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
{
frame_smob *f_smob;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
enum unwind_stop_reason stop_reason;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
frame_smob *f_smob;
CORE_ADDR pc = 0;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
if (frame != NULL)
pc = get_frame_pc (frame);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
gdbscm_frame_block (SCM self)
{
frame_smob *f_smob;
- struct block *block = NULL, *fn_block;
+ const struct block *block = NULL, *fn_block;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
if (frame != NULL)
block = get_frame_block (frame, NULL);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
if (block != NULL)
{
- struct symtab *st;
- SCM block_scm;
-
- st = SYMBOL_SYMTAB (BLOCK_FUNCTION (fn_block));
- return bkscm_scm_from_block (block, st->objfile);
+ return bkscm_scm_from_block
+ (block, symbol_objfile (BLOCK_FUNCTION (fn_block)));
}
return SCM_BOOL_F;
frame_smob *f_smob;
struct symbol *sym = NULL;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
if (frame != NULL)
sym = find_pc_function (get_frame_address_in_block (frame));
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
frame_smob *f_smob;
struct frame_info *prev = NULL;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
if (frame != NULL)
prev = get_prev_frame (frame);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
frame_smob *f_smob;
struct frame_info *next = NULL;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
if (frame != NULL)
next = get_next_frame (frame);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
frame_smob *f_smob;
struct symtab_and_line sal;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
if (frame != NULL)
find_frame_sal (frame, &sal);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
return stscm_scm_from_sal (sal);
}
+/* (frame-read-register <gdb:frame> string) -> <gdb:value>
+ The register argument must be a string. */
+
+static SCM
+gdbscm_frame_read_register (SCM self, SCM register_scm)
+{
+ char *register_str;
+ struct value *value = NULL;
+ struct frame_info *frame = NULL;
+ struct cleanup *cleanup;
+ frame_smob *f_smob;
+
+ f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+ gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "s",
+ register_scm, ®ister_str);
+ cleanup = make_cleanup (xfree, register_str);
+
+ TRY
+ {
+ int regnum;
+
+ frame = frscm_frame_smob_to_frame (f_smob);
+ if (frame)
+ {
+ regnum = user_reg_map_name_to_regnum (get_frame_arch (frame),
+ register_str,
+ strlen (register_str));
+ if (regnum >= 0)
+ value = value_of_register (regnum, frame);
+ }
+ }
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
+
+ do_cleanups (cleanup);
+
+ if (frame == NULL)
+ {
+ gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
+ _("<gdb:frame>"));
+ }
+
+ if (value == NULL)
+ {
+ gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, register_scm,
+ _("unknown register"));
+ }
+
+ return vlscm_scm_from_value (value);
+}
+
/* (frame-read-var <gdb:frame> <gdb:symbol>) -> <gdb:value>
(frame-read-var <gdb:frame> string [#:block <gdb:block>]) -> <gdb:value>
If the optional block argument is provided start the search from that block,
SCM block_scm = SCM_UNDEFINED;
struct frame_info *frame = NULL;
struct symbol *var = NULL;
+ const struct block *block = NULL;
struct value *value = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
char *var_name;
const struct block *block = NULL;
struct cleanup *cleanup;
- volatile struct gdb_exception except;
+ struct gdb_exception except = exception_none;
if (! SCM_UNBNDP (block_scm))
{
/* N.B. Between here and the call to do_cleanups, don't do anything
to cause a Scheme exception without performing the cleanup. */
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
+ struct block_symbol lookup_sym;
+
if (block == NULL)
block = get_frame_block (frame, NULL);
- var = lookup_symbol (var_name, block, VAR_DOMAIN, NULL);
+ lookup_sym = lookup_symbol (var_name, block, VAR_DOMAIN, NULL);
+ var = lookup_sym.symbol;
+ block = lookup_sym.block;
+ }
+ CATCH (ex, RETURN_MASK_ALL)
+ {
+ except = ex;
}
- if (except.reason < 0)
- do_cleanups (cleanup);
+ END_CATCH
+
+ do_cleanups (cleanup);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (var == NULL)
_("gdb:symbol or string"));
}
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
- value = read_var_value (var, frame);
+ value = read_var_value (var, block, frame);
+ }
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ END_CATCH
return vlscm_scm_from_value (value);
}
{
frame_smob *f_smob;
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = frscm_frame_smob_to_frame (f_smob);
if (frame != NULL)
select_frame (frame);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (frame == NULL)
{
gdbscm_newest_frame (void)
{
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = get_current_frame ();
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
return frscm_scm_from_frame_unsafe (frame, current_inferior ());
}
gdbscm_selected_frame (void)
{
struct frame_info *frame = NULL;
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
frame = get_selected_frame (_("No frame is currently selected"));
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
return frscm_scm_from_frame_unsafe (frame, current_inferior ());
}
if (reason < UNWIND_FIRST || reason > UNWIND_LAST)
scm_out_of_range (FUNC_NAME, reason_scm);
- str = frame_stop_reason_string (reason);
+ str = unwind_stop_reason_to_string ((enum unwind_stop_reason) reason);
return gdbscm_scm_from_c_string (str);
}
\f
static const scheme_function frame_functions[] =
{
- { "frame?", 1, 0, 0, gdbscm_frame_p,
+ { "frame?", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_p),
"\
Return #t if the object is a <gdb:frame> object." },
- { "frame-valid?", 1, 0, 0, gdbscm_frame_valid_p,
+ { "frame-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_valid_p),
"\
Return #t if the object is a valid <gdb:frame> object.\n\
Frames become invalid when the inferior returns to its caller." },
- { "frame-name", 1, 0, 0, gdbscm_frame_name,
+ { "frame-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_name),
"\
Return the name of the function corresponding to this frame,\n\
or #f if there is no function." },
- { "frame-arch", 1, 0, 0, gdbscm_frame_arch,
+ { "frame-arch", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_arch),
"\
Return the frame's architecture as a <gdb:arch> object." },
- { "frame-type", 1, 0, 0, gdbscm_frame_type,
+ { "frame-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_type),
"\
Return the frame type, namely one of the gdb:*_FRAME constants." },
- { "frame-unwind-stop-reason", 1, 0, 0, gdbscm_frame_unwind_stop_reason,
+ { "frame-unwind-stop-reason", 1, 0, 0,
+ as_a_scm_t_subr (gdbscm_frame_unwind_stop_reason),
"\
Return one of the gdb:FRAME_UNWIND_* constants explaining why\n\
it's not possible to find frames older than this." },
- { "frame-pc", 1, 0, 0, gdbscm_frame_pc,
+ { "frame-pc", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_pc),
"\
Return the frame's resume address." },
- { "frame-block", 1, 0, 0, gdbscm_frame_block,
+ { "frame-block", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_block),
"\
Return the frame's code block, or #f if one cannot be found." },
- { "frame-function", 1, 0, 0, gdbscm_frame_function,
+ { "frame-function", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_function),
"\
Return the <gdb:symbol> for the function corresponding to this frame,\n\
or #f if there isn't one." },
- { "frame-older", 1, 0, 0, gdbscm_frame_older,
+ { "frame-older", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_older),
"\
Return the frame immediately older (outer) to this frame,\n\
or #f if there isn't one." },
- { "frame-newer", 1, 0, 0, gdbscm_frame_newer,
+ { "frame-newer", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_newer),
"\
Return the frame immediately newer (inner) to this frame,\n\
or #f if there isn't one." },
- { "frame-sal", 1, 0, 0, gdbscm_frame_sal,
+ { "frame-sal", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_sal),
"\
Return the frame's symtab-and-line <gdb:sal> object." },
- { "frame-read-var", 2, 0, 1, gdbscm_frame_read_var,
+ { "frame-read-var", 2, 0, 1, as_a_scm_t_subr (gdbscm_frame_read_var),
"\
Return the value of the symbol in the frame.\n\
\n\
Arguments: <gdb:frame> <gdb:symbol>\n\
Or: <gdb:frame> string [#:block <gdb:block>]" },
- { "frame-select", 1, 0, 0, gdbscm_frame_select,
+ { "frame-read-register", 2, 0, 0,
+ as_a_scm_t_subr (gdbscm_frame_read_register),
+ "\
+Return the value of the register in the frame.\n\
+\n\
+ Arguments: <gdb:frame> string" },
+
+ { "frame-select", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_select),
"\
Select this frame." },
- { "newest-frame", 0, 0, 0, gdbscm_newest_frame,
+ { "newest-frame", 0, 0, 0, as_a_scm_t_subr (gdbscm_newest_frame),
"\
Return the newest frame." },
- { "selected-frame", 0, 0, 0, gdbscm_selected_frame,
+ { "selected-frame", 0, 0, 0, as_a_scm_t_subr (gdbscm_selected_frame),
"\
Return the selected frame." },
- { "unwind-stop-reason-string", 1, 0, 0, gdbscm_unwind_stop_reason_string,
+ { "unwind-stop-reason-string", 1, 0, 0,
+ as_a_scm_t_subr (gdbscm_unwind_stop_reason_string),
"\
Return a string explaining the unwind stop reason.\n\
\n\
{
frame_smob_tag
= gdbscm_make_smob_type (frame_smob_name, sizeof (frame_smob));
- scm_set_smob_mark (frame_smob_tag, frscm_mark_frame_smob);
scm_set_smob_free (frame_smob_tag, frscm_free_frame_smob);
scm_set_smob_print (frame_smob_tag, frscm_print_frame_smob);
projects / deliverable / binutils-gdb.git / blobdiff