forked from Imagelibrary/binutils-gdb
This patch starts from the desire to eliminate
make_cleanup_ui_file_delete, but then goes beyond. It makes ui_file &
friends a real C++ class hierarchy, and switches temporary
ui_file-like objects to stack-based allocation.
- mem_fileopen -> string_file
mem_fileopen is replaced with a new string_file class that is treated
as a value class created on the stack. This alone eliminates most
make_cleanup_ui_file_delete calls, and, simplifies code a whole lot
(diffstat shows around 1k loc dropped.)
string_file's internal buffer is a std::string, thus the "string" in
the name. This simplifies the implementation much, compared to
mem_fileopen, which managed growing its internal buffer manually.
- ui_file_as_string, ui_file_strdup, ui_file_obsavestring all gone
The new string_file class has a string() method that provides direct
writable access to the internal std::string buffer. This replaced
ui_file_as_string, which forced a copy of the same data the stream had
inside. With direct access via a writable reference, we can instead
move the string out of the string_stream, avoiding deep string
copying.
Related, ui_file_xstrdup calls are replaced with xstrdup'ping the
stream's string, and ui_file_obsavestring is replaced by
obstack_copy0.
With all those out of the way, getting rid of the weird ui_file_put
mechanism was possible.
- New ui_file::printf, ui_file::puts, etc. methods
These simplify / clarify client code. I considered splitting
client-code changes, like these, e.g.:
- stb = mem_fileopen ();
- fprintf_unfiltered (stb, "%s%s%s",
- _("The valid values are:\n"),
- regdesc,
- _("The default is \"std\"."));
+ string_file stb;
+ stb.printf ("%s%s%s",
+ _("The valid values are:\n"),
+ regdesc,
+ _("The default is \"std\"."));
In two steps, with the first step leaving fprintf_unfiltered (etc.)
calls in place, and only afterwards do a pass to change all those to
call stb.printf etc.. I didn't do that split, because (when I tried),
it turned out to be pointless make-work: the first pass would have to
touch the fprintf_unfiltered line anyway, to replace "stb" with
"&stb".
- gdb_fopen replaced with stack-based objects
This avoids the need for cleanups or unique_ptr's. I.e., this:
struct ui_file *file = gdb_fopen (filename, "w");
if (filename == NULL)
perror_with_name (filename);
cleanups = make_cleanup_ui_file_delete (file);
// use file.
do_cleanups (cleanups);
is replaced with this:
stdio_file file;
if (!file.open (filename, "w"))
perror_with_name (filename);
// use file.
- odd contorsions in null_file_write / null_file_fputs around when to
call to_fputs / to_write eliminated.
- Global null_stream object
A few places that were allocating a ui_file in order to print to
"nowhere" are adjusted to instead refer to a new 'null_stream' global
stream.
- TUI's tui_sfileopen eliminated. TUI's ui_file much simplified
The TUI's ui_file was serving a dual purpose. It supported being used
as string buffer, and supported being backed by a stdio FILE. The
string buffer part is gone, replaced by using of string_file. The
'FILE *' support is now much simplified, by making the TUI's ui_file
inherit from stdio_file.
gdb/ChangeLog:
2017-02-02 Pedro Alves <palves@redhat.com>
* ada-lang.c (type_as_string): Use string_file.
* ada-valprint.c (ada_print_floating): Use string_file.
* ada-varobj.c (ada_varobj_scalar_image)
(ada_varobj_get_value_image): Use string_file.
* aix-thread.c (aix_thread_extra_thread_info): Use string_file.
* arm-tdep.c (_initialize_arm_tdep): Use string_printf.
* breakpoint.c (update_inserted_breakpoint_locations)
(insert_breakpoint_locations, reattach_breakpoints)
(print_breakpoint_location, print_one_detail_ranged_breakpoint)
(print_it_watchpoint): Use string_file.
(save_breakpoints): Use stdio_file.
* c-exp.y (oper): Use string_file.
* cli/cli-logging.c (set_logging_redirect): Use ui_file_up and
tee_file.
(pop_output_files): Use delete.
(handle_redirections): Use stdio_file and tee_file.
* cli/cli-setshow.c (do_show_command): Use string_file.
* compile/compile-c-support.c (c_compute_program): Use
string_file.
* compile/compile-c-symbols.c (generate_vla_size): Take a
'string_file &' instead of a 'ui_file *'.
(generate_c_for_for_one_variable): Take a 'string_file &' instead
of a 'ui_file *'. Use string_file.
(generate_c_for_variable_locations): Take a 'string_file &'
instead of a 'ui_file *'.
* compile/compile-internal.h (generate_c_for_for_one_variable):
Take a 'string_file &' instead of a 'ui_file *'.
* compile/compile-loc2c.c (push, pushf, unary, binary)
(print_label, pushf_register_address, pushf_register)
(do_compile_dwarf_expr_to_c): Take a 'string_file &' instead of a
'ui_file *'. Adjust.
* compile/compile.c (compile_to_object): Use string_file.
* compile/compile.h (compile_dwarf_expr_to_c)
(compile_dwarf_bounds_to_c): Take a 'string_file &' instead of a
'ui_file *'.
* cp-support.c (inspect_type): Use string_file and obstack_copy0.
(replace_typedefs_qualified_name): Use string_file and
obstack_copy0.
* disasm.c (gdb_pretty_print_insn): Use string_file.
(gdb_disassembly): Adjust reference the null_stream global.
(do_ui_file_delete): Delete.
(gdb_insn_length): Use null_stream.
* dummy-frame.c (maintenance_print_dummy_frames): Use stdio_file.
* dwarf2loc.c (dwarf2_compile_property_to_c)
(locexpr_generate_c_location, loclist_generate_c_location): Take a
'string_file &' instead of a 'ui_file *'.
* dwarf2loc.h (dwarf2_compile_property_to_c): Likewise.
* dwarf2read.c (do_ui_file_peek_last): Delete.
(dwarf2_compute_name): Use string_file.
* event-top.c (gdb_setup_readline): Use stdio_file.
* gdbarch.sh (verify_gdbarch): Use string_file.
* gdbtypes.c (safe_parse_type): Use null_stream.
* guile/scm-breakpoint.c (gdbscm_breakpoint_commands): Use
string_file.
* guile/scm-disasm.c (gdbscm_print_insn_from_port): Take a
'string_file *' instead of a 'ui_file *'.
(gdbscm_arch_disassemble): Use string_file.
* guile/scm-frame.c (frscm_print_frame_smob): Use string_file.
* guile/scm-ports.c (class ioscm_file_port): Now a class that
inherits from ui_file.
(ioscm_file_port_delete, ioscm_file_port_rewind)
(ioscm_file_port_put): Delete.
(ioscm_file_port_write): Rename to ...
(ioscm_file_port::write): ... this. Remove file_port_magic
checks.
(ioscm_file_port_new): Delete.
(ioscm_with_output_to_port_worker): Use ioscm_file_port and
ui_file_up.
* guile/scm-type.c (tyscm_type_name): Use string_file.
* guile/scm-value.c (vlscm_print_value_smob, gdbscm_value_print):
Use string_file.
* infcmd.c (print_return_value_1): Use string_file.
* infrun.c (print_target_wait_results): Use string_file.
* language.c (add_language): Use string_file.
* location.c (explicit_to_string_internal): Use string_file.
* main.c (captured_main_1): Use null_file.
* maint.c (maintenance_print_architecture): Use stdio_file.
* mi/mi-cmd-stack.c (list_arg_or_local): Use string_file.
* mi/mi-common.h (struct mi_interp) <out, err, log, targ,
event_channel>: Change type to mi_console_file pointer.
* mi/mi-console.c (mi_console_file_fputs, mi_console_file_flush)
(mi_console_file_delete): Delete.
(struct mi_console_file): Delete.
(mi_console_file_magic): Delete.
(mi_console_file_new): Delete.
(mi_console_file::mi_console_file): New.
(mi_console_file_delete): Delete.
(mi_console_file_fputs): Delete.
(mi_console_file::write): New.
(mi_console_raw_packet): Delete.
(mi_console_file::flush): New.
(mi_console_file_flush): Delete.
(mi_console_set_raw): Rename to ...
(mi_console_file::set_raw): ... this.
* mi/mi-console.h (class mi_console_file): New class.
(mi_console_file_new, mi_console_set_raw): Delete.
* mi/mi-interp.c (mi_interpreter_init): Use mi_console_file.
(mi_set_logging): Use delete and tee_file. Adjust.
* mi/mi-main.c (output_register): Use string_file.
(mi_cmd_data_evaluate_expression): Use string_file.
(mi_cmd_data_read_memory): Use string_file.
(mi_cmd_execute, print_variable_or_computed): Use string_file.
* mi/mi-out.c (mi_ui_out::main_stream): New.
(mi_ui_out::rewind): Use main_stream and
string_file.
(mi_ui_out::put): Use main_stream and string_file.
(mi_ui_out::mi_ui_out): Remove 'stream' parameter.
Allocate a 'string_file' instead.
(mi_out_new): Don't allocate a mem_fileopen stream here.
* mi/mi-out.h (mi_ui_out::mi_ui_out): Remove 'stream' parameter.
(mi_ui_out::main_stream): Declare method.
* printcmd.c (eval_command): Use string_file.
* psymtab.c (maintenance_print_psymbols): Use stdio_file.
* python/py-arch.c (archpy_disassemble): Use string_file.
* python/py-breakpoint.c (bppy_get_commands): Use string_file.
* python/py-frame.c (frapy_str): Use string_file.
* python/py-framefilter.c (py_print_type, py_print_single_arg):
Use string_file.
* python/py-type.c (typy_str): Use string_file.
* python/py-unwind.c (unwind_infopy_str): Use string_file.
* python/py-value.c (valpy_str): Use string_file.
* record-btrace.c (btrace_insn_history): Use string_file.
* regcache.c (regcache_print): Use stdio_file.
* reggroups.c (maintenance_print_reggroups): Use stdio_file.
* remote.c (escape_buffer): Use string_file.
* rust-lang.c (rust_get_disr_info): Use string_file.
* serial.c (serial_open_ops_1): Use stdio_file.
(do_serial_close): Use delete.
* stack.c (print_frame_arg): Use string_file.
(print_frame_args): Remove local mem_fileopen stream, not used.
(print_frame): Use string_file.
* symmisc.c (maintenance_print_symbols): Use stdio_file.
* symtab.h (struct symbol_computed_ops) <generate_c_location>:
Take a 'string_file *' instead of a 'ui_file *'.
* top.c (new_ui): Use stdio_file and stderr_file.
(free_ui): Use delete.
(execute_command_to_string): Use string_file.
(quit_confirm): Use string_file.
* tracepoint.c (collection_list::append_exp): Use string_file.
* tui/tui-disasm.c (tui_disassemble): Use string_file.
* tui/tui-file.c: Don't include "ui-file.h".
(enum streamtype, struct tui_stream): Delete.
(tui_file_new, tui_file_delete, tui_fileopen, tui_sfileopen)
(tui_file_isatty, tui_file_rewind, tui_file_put): Delete.
(tui_file::tui_file): New method.
(tui_file_fputs): Delete.
(tui_file_get_strbuf): Delete.
(tui_file::puts): New method.
(tui_file_adjust_strbuf): Delete.
(tui_file_flush): Delete.
(tui_file::flush): New method.
* tui/tui-file.h: Tweak intro comment.
Include ui-file.h.
(tui_fileopen, tui_sfileopen, tui_file_get_strbuf)
(tui_file_adjust_strbuf): Delete declarations.
(class tui_file): New class.
* tui/tui-io.c (tui_initialize_io): Use tui_file.
* tui/tui-regs.c (tui_restore_gdbout): Use delete.
(tui_register_format): Use string_stream.
* tui/tui-stack.c (tui_make_status_line): Use string_file.
(tui_get_function_from_frame): Use string_file.
* typeprint.c (type_to_string): Use string_file.
* ui-file.c (struct ui_file, ui_file_magic, ui_file_new): Delete.
(null_stream): New global.
(ui_file_delete): Delete.
(ui_file::ui_file): New.
(null_file_isatty): Delete.
(ui_file::~ui_file): New.
(null_file_rewind): Delete.
(ui_file::printf): New.
(null_file_put): Delete.
(null_file_flush): Delete.
(ui_file::putstr): New.
(null_file_write): Delete.
(ui_file::putstrn): New.
(null_file_read): Delete.
(ui_file::putc): New.
(null_file_fputs): Delete.
(null_file_write_async_safe): Delete.
(ui_file::vprintf): New.
(null_file_delete): Delete.
(null_file::write): New.
(null_file_fseek): Delete.
(null_file::puts): New.
(ui_file_data): Delete.
(null_file::write_async_safe): New.
(gdb_flush, ui_file_isatty): Adjust.
(ui_file_put, ui_file_rewind): Delete.
(ui_file_write): Adjust.
(ui_file_write_for_put): Delete.
(ui_file_write_async_safe, ui_file_read): Adjust.
(ui_file_fseek): Delete.
(fputs_unfiltered): Adjust.
(set_ui_file_flush, set_ui_file_isatty, set_ui_file_rewind)
(set_ui_file_put, set_ui_file_write, set_ui_file_write_async_safe)
(set_ui_file_read, set_ui_file_fputs, set_ui_file_fseek)
(set_ui_file_data): Delete.
(string_file::~string_file, string_file::write)
(struct accumulated_ui_file, do_ui_file_xstrdup, ui_file_xstrdup)
(do_ui_file_as_string, ui_file_as_string): Delete.
(do_ui_file_obsavestring, ui_file_obsavestring): Delete.
(struct mem_file): Delete.
(mem_file_new): Delete.
(stdio_file::stdio_file): New.
(mem_file_delete): Delete.
(stdio_file::stdio_file): New.
(mem_fileopen): Delete.
(stdio_file::~stdio_file): New.
(mem_file_rewind): Delete.
(stdio_file::set_stream): New.
(mem_file_put): Delete.
(stdio_file::open): New.
(mem_file_write): Delete.
(stdio_file_magic, struct stdio_file): Delete.
(stdio_file_new, stdio_file_delete, stdio_file_flush): Delete.
(stdio_file::flush): New.
(stdio_file_read): Rename to ...
(stdio_file::read): ... this. Adjust.
(stdio_file_write): Rename to ...
(stdio_file::write): ... this. Adjust.
(stdio_file_write_async_safe): Rename to ...
(stdio_file::write_async_safe) ... this. Adjust.
(stdio_file_fputs): Rename to ...
(stdio_file::puts) ... this. Adjust.
(stdio_file_isatty): Delete.
(stdio_file_fseek): Delete.
(stdio_file::isatty): New.
(stderr_file_write): Rename to ...
(stderr_file::write) ... this. Adjust.
(stderr_file_fputs): Rename to ...
(stderr_file::puts) ... this. Adjust.
(stderr_fileopen, stdio_fileopen, gdb_fopen): Delete.
(stderr_file::stderr_file): New.
(tee_file_magic): Delete.
(struct tee_file): Delete.
(tee_file::tee_file): New.
(tee_file_new): Delete.
(tee_file::~tee_file): New.
(tee_file_delete): Delete.
(tee_file_flush): Rename to ...
(tee_file::flush): ... this. Adjust.
(tee_file_write): Rename to ...
(tee_file::write): ... this. Adjust.
(tee_file::write_async_safe): New.
(tee_file_fputs): Rename to ...
(tee_file::puts): ... this. Adjust.
(tee_file_isatty): Rename to ...
(tee_file::isatty): ... this. Adjust.
* ui-file.h (struct obstack, struct ui_file): Don't
forward-declare.
(ui_file_new, ui_file_flush_ftype, set_ui_file_flush)
(ui_file_write_ftype)
(set_ui_file_write, ui_file_fputs_ftype, set_ui_file_fputs)
(ui_file_write_async_safe_ftype, set_ui_file_write_async_safe)
(ui_file_read_ftype, set_ui_file_read, ui_file_isatty_ftype)
(set_ui_file_isatty, ui_file_rewind_ftype, set_ui_file_rewind)
(ui_file_put_method_ftype, ui_file_put_ftype, set_ui_file_put)
(ui_file_delete_ftype, set_ui_file_data, ui_file_fseek_ftype)
(set_ui_file_fseek): Delete.
(ui_file_data, ui_file_delete, ui_file_rewind)
(struct ui_file): New.
(ui_file_up): New.
(class null_file): New.
(null_stream): Declare.
(ui_file_write_for_put, ui_file_put): Delete.
(ui_file_xstrdup, ui_file_as_string, ui_file_obsavestring):
Delete.
(ui_file_fseek, mem_fileopen, stdio_fileopen, stderr_fileopen)
(gdb_fopen, tee_file_new): Delete.
(struct string_file): New.
(struct stdio_file): New.
(stdio_file_up): New.
(struct stderr_file): New.
(class tee_file): New.
* ui-out.c (ui_out::field_stream): Take a 'string_file &' instead
of a 'ui_file *'. Adjust.
* ui-out.h (class ui_out) <field_stream>: Likewise.
* utils.c (do_ui_file_delete, make_cleanup_ui_file_delete)
(null_stream): Delete.
(error_stream): Take a 'string_file &' instead of a 'ui_file *'.
Adjust.
* utils.h (struct ui_file): Delete forward declaration..
(make_cleanup_ui_file_delete, null_stream): Delete declarations.
(error_stream): Take a 'string_file &' instead of a
'ui_file *'.
* varobj.c (varobj_value_get_print_value): Use string_file.
* xtensa-tdep.c (xtensa_verify_config): Use string_file.
* gdbarch.c: Regenerate.
1182 lines
29 KiB
C
1182 lines
29 KiB
C
/* Scheme interface to stack frames.
|
||
|
||
Copyright (C) 2008-2017 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 "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"
|
||
|
||
/* The <gdb:frame> smob.
|
||
The typedef for this struct is in guile-internal.h. */
|
||
|
||
struct _frame_smob
|
||
{
|
||
/* This always appears first. */
|
||
eqable_gdb_smob base;
|
||
|
||
struct frame_id frame_id;
|
||
struct gdbarch *gdbarch;
|
||
|
||
/* Frames are tracked by inferior.
|
||
We need some place to put the eq?-able hash table, and this feels as
|
||
good a place as any. Frames in one inferior shouldn't be considered
|
||
equal to frames in a different inferior. The frame becomes invalid if
|
||
this becomes NULL (the inferior has been deleted from gdb).
|
||
It's easier to relax restrictions than impose them after the fact.
|
||
N.B. It is an outstanding question whether a frame survives reruns of
|
||
the inferior. Intuitively the answer is "No", but currently a frame
|
||
also survives, e.g., multiple invocations of the same function from
|
||
the same point. Even different threads can have the same frame, e.g.,
|
||
if a thread dies and a new thread gets the same stack. */
|
||
struct inferior *inferior;
|
||
|
||
/* Marks that the FRAME_ID member actually holds the ID of the frame next
|
||
to this, and not this frame's ID itself. This is a hack to permit Scheme
|
||
frame objects which represent invalid frames (i.e., the last frame_info
|
||
in a corrupt stack). The problem arises from the fact that this code
|
||
relies on FRAME_ID to uniquely identify a frame, which is not always true
|
||
for the last "frame" in a corrupt stack (it can have a null ID, or the
|
||
same ID as the previous frame). Whenever get_prev_frame returns NULL, we
|
||
record the frame_id of the next frame and set FRAME_ID_IS_NEXT to 1. */
|
||
int frame_id_is_next;
|
||
};
|
||
|
||
static const char frame_smob_name[] = "gdb:frame";
|
||
|
||
/* The tag Guile knows the frame smob by. */
|
||
static scm_t_bits frame_smob_tag;
|
||
|
||
/* Keywords used in argument passing. */
|
||
static SCM block_keyword;
|
||
|
||
static const struct inferior_data *frscm_inferior_data_key;
|
||
|
||
/* Administrivia for frame smobs. */
|
||
|
||
/* Helper function to hash a frame_smob. */
|
||
|
||
static hashval_t
|
||
frscm_hash_frame_smob (const void *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);
|
||
|
||
if (fid->stack_status == FID_STACK_VALID)
|
||
hash = iterative_hash (&fid->stack_addr, sizeof (fid->stack_addr), hash);
|
||
if (fid->code_addr_p)
|
||
hash = iterative_hash (&fid->code_addr, sizeof (fid->code_addr), hash);
|
||
if (fid->special_addr_p)
|
||
hash = iterative_hash (&fid->special_addr, sizeof (fid->special_addr),
|
||
hash);
|
||
|
||
return hash;
|
||
}
|
||
|
||
/* Helper function to compute equality of frame_smobs. */
|
||
|
||
static int
|
||
frscm_eq_frame_smob (const void *ap, const void *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
|
||
&& a->inferior != NULL);
|
||
}
|
||
|
||
/* Return the frame -> SCM mapping table.
|
||
It is created if necessary. */
|
||
|
||
static htab_t
|
||
frscm_inferior_frame_map (struct inferior *inferior)
|
||
{
|
||
htab_t htab = (htab_t) inferior_data (inferior, frscm_inferior_data_key);
|
||
|
||
if (htab == NULL)
|
||
{
|
||
htab = gdbscm_create_eqable_gsmob_ptr_map (frscm_hash_frame_smob,
|
||
frscm_eq_frame_smob);
|
||
set_inferior_data (inferior, frscm_inferior_data_key, htab);
|
||
}
|
||
|
||
return htab;
|
||
}
|
||
|
||
/* The smob "free" function for <gdb:frame>. */
|
||
|
||
static size_t
|
||
frscm_free_frame_smob (SCM self)
|
||
{
|
||
frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self);
|
||
|
||
if (f_smob->inferior != NULL)
|
||
{
|
||
htab_t htab = frscm_inferior_frame_map (f_smob->inferior);
|
||
|
||
gdbscm_clear_eqable_gsmob_ptr_slot (htab, &f_smob->base);
|
||
}
|
||
|
||
/* Not necessary, done to catch bugs. */
|
||
f_smob->inferior = NULL;
|
||
|
||
return 0;
|
||
}
|
||
|
||
/* The smob "print" function for <gdb:frame>. */
|
||
|
||
static int
|
||
frscm_print_frame_smob (SCM self, SCM port, scm_print_state *pstate)
|
||
{
|
||
frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self);
|
||
|
||
gdbscm_printf (port, "#<%s ", frame_smob_name);
|
||
|
||
string_file strfile;
|
||
fprint_frame_id (&strfile, f_smob->frame_id);
|
||
gdbscm_printf (port, "%s", strfile.c_str ());
|
||
|
||
scm_puts (">", port);
|
||
|
||
scm_remember_upto_here_1 (self);
|
||
|
||
/* Non-zero means success. */
|
||
return 1;
|
||
}
|
||
|
||
/* Low level routine to create a <gdb:frame> object. */
|
||
|
||
static SCM
|
||
frscm_make_frame_smob (void)
|
||
{
|
||
frame_smob *f_smob = (frame_smob *)
|
||
scm_gc_malloc (sizeof (frame_smob), frame_smob_name);
|
||
SCM f_scm;
|
||
|
||
f_smob->frame_id = null_frame_id;
|
||
f_smob->gdbarch = NULL;
|
||
f_smob->inferior = NULL;
|
||
f_smob->frame_id_is_next = 0;
|
||
f_scm = scm_new_smob (frame_smob_tag, (scm_t_bits) f_smob);
|
||
gdbscm_init_eqable_gsmob (&f_smob->base, f_scm);
|
||
|
||
return f_scm;
|
||
}
|
||
|
||
/* Return non-zero if SCM is a <gdb:frame> object. */
|
||
|
||
int
|
||
frscm_is_frame (SCM scm)
|
||
{
|
||
return SCM_SMOB_PREDICATE (frame_smob_tag, scm);
|
||
}
|
||
|
||
/* (frame? object) -> boolean */
|
||
|
||
static SCM
|
||
gdbscm_frame_p (SCM scm)
|
||
{
|
||
return scm_from_bool (frscm_is_frame (scm));
|
||
}
|
||
|
||
/* Create a new <gdb:frame> object that encapsulates FRAME.
|
||
Returns a <gdb:exception> object if there is an error. */
|
||
|
||
static SCM
|
||
frscm_scm_from_frame (struct frame_info *frame, struct inferior *inferior)
|
||
{
|
||
frame_smob *f_smob, f_smob_for_lookup;
|
||
SCM f_scm;
|
||
htab_t htab;
|
||
eqable_gdb_smob **slot;
|
||
struct frame_id frame_id = null_frame_id;
|
||
struct gdbarch *gdbarch = NULL;
|
||
int frame_id_is_next = 0;
|
||
|
||
/* If we've already created a gsmob for this frame, return it.
|
||
This makes frames eq?-able. */
|
||
htab = frscm_inferior_frame_map (inferior);
|
||
f_smob_for_lookup.frame_id = get_frame_id (frame);
|
||
f_smob_for_lookup.inferior = inferior;
|
||
slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &f_smob_for_lookup.base);
|
||
if (*slot != NULL)
|
||
return (*slot)->containing_scm;
|
||
|
||
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
|
||
frame and not of this one (which is possibly invalid). */
|
||
if (get_prev_frame (frame) == NULL
|
||
&& get_frame_unwind_stop_reason (frame) != UNWIND_NO_REASON
|
||
&& get_next_frame (frame) != NULL)
|
||
{
|
||
frame_id = get_frame_id (get_next_frame (frame));
|
||
frame_id_is_next = 1;
|
||
}
|
||
else
|
||
{
|
||
frame_id = get_frame_id (frame);
|
||
frame_id_is_next = 0;
|
||
}
|
||
gdbarch = get_frame_arch (frame);
|
||
}
|
||
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);
|
||
f_smob->frame_id = frame_id;
|
||
f_smob->gdbarch = gdbarch;
|
||
f_smob->inferior = inferior;
|
||
f_smob->frame_id_is_next = frame_id_is_next;
|
||
|
||
gdbscm_fill_eqable_gsmob_ptr_slot (slot, &f_smob->base);
|
||
|
||
return f_scm;
|
||
}
|
||
|
||
/* Create a new <gdb:frame> object that encapsulates FRAME.
|
||
A Scheme exception is thrown if there is an error. */
|
||
|
||
static SCM
|
||
frscm_scm_from_frame_unsafe (struct frame_info *frame,
|
||
struct inferior *inferior)
|
||
{
|
||
SCM f_scm = frscm_scm_from_frame (frame, inferior);
|
||
|
||
if (gdbscm_is_exception (f_scm))
|
||
gdbscm_throw (f_scm);
|
||
|
||
return f_scm;
|
||
}
|
||
|
||
/* Returns the <gdb:frame> object in SELF.
|
||
Throws an exception if SELF is not a <gdb:frame> object. */
|
||
|
||
static SCM
|
||
frscm_get_frame_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
||
{
|
||
SCM_ASSERT_TYPE (frscm_is_frame (self), self, arg_pos, func_name,
|
||
frame_smob_name);
|
||
|
||
return self;
|
||
}
|
||
|
||
/* There is no gdbscm_scm_to_frame function because translating
|
||
a frame SCM object to a struct frame_info * can throw a GDB error.
|
||
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 what would be gdbscm_scm_to_frame
|
||
into two:
|
||
|
||
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
|
||
|
||
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
|
||
a GDB error may get thrown (and thus the call must be wrapped in a
|
||
TRY_CATCH) */
|
||
|
||
/* Returns the frame_smob for the object wrapped by FRAME_SCM.
|
||
A Scheme error is thrown if FRAME_SCM is not a frame. */
|
||
|
||
frame_smob *
|
||
frscm_get_frame_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
||
{
|
||
SCM f_scm = frscm_get_frame_arg_unsafe (self, arg_pos, func_name);
|
||
frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (f_scm);
|
||
|
||
if (f_smob->inferior == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (func_name, arg_pos, self,
|
||
_("inferior"));
|
||
}
|
||
if (f_smob->inferior != current_inferior ())
|
||
scm_misc_error (func_name, _("inferior has changed"), SCM_EOL);
|
||
|
||
return f_smob;
|
||
}
|
||
|
||
/* Returns the frame_info object wrapped by F_SMOB.
|
||
If the frame doesn't exist anymore (the frame id doesn't
|
||
correspond to any frame in the inferior), returns NULL.
|
||
This function calls GDB routines, so don't assume a GDB error will
|
||
not be thrown. */
|
||
|
||
struct frame_info *
|
||
frscm_frame_smob_to_frame (frame_smob *f_smob)
|
||
{
|
||
struct frame_info *frame;
|
||
|
||
frame = frame_find_by_id (f_smob->frame_id);
|
||
if (frame == NULL)
|
||
return NULL;
|
||
|
||
if (f_smob->frame_id_is_next)
|
||
frame = get_prev_frame (frame);
|
||
|
||
return frame;
|
||
}
|
||
|
||
/* Helper function for frscm_del_inferior_frames to mark the frame
|
||
as invalid. */
|
||
|
||
static int
|
||
frscm_mark_frame_invalid (void **slot, void *info)
|
||
{
|
||
frame_smob *f_smob = (frame_smob *) *slot;
|
||
|
||
f_smob->inferior = NULL;
|
||
return 1;
|
||
}
|
||
|
||
/* This function is called when an inferior is about to be freed.
|
||
Invalidate the frame as further actions on the frame could result
|
||
in bad data. All access to the frame should be gated by
|
||
frscm_get_frame_smob_arg_unsafe which will raise an exception on
|
||
invalid frames. */
|
||
|
||
static void
|
||
frscm_del_inferior_frames (struct inferior *inferior, void *datum)
|
||
{
|
||
htab_t htab = (htab_t) datum;
|
||
|
||
if (htab != NULL)
|
||
{
|
||
htab_traverse_noresize (htab, frscm_mark_frame_invalid, NULL);
|
||
htab_delete (htab);
|
||
}
|
||
}
|
||
|
||
/* Frame methods. */
|
||
|
||
/* (frame-valid? <gdb:frame>) -> bool
|
||
Returns #t if the frame corresponding to the frame_id of this
|
||
object still exists in the inferior. */
|
||
|
||
static SCM
|
||
gdbscm_frame_valid_p (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return scm_from_bool (frame != NULL);
|
||
}
|
||
|
||
/* (frame-name <gdb:frame>) -> string
|
||
Returns the name of the function corresponding to this frame,
|
||
or #f if there is no function. */
|
||
|
||
static SCM
|
||
gdbscm_frame_name (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
char *name = NULL;
|
||
enum language lang = language_minimal;
|
||
struct frame_info *frame = NULL;
|
||
SCM result;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
if (frame != NULL)
|
||
find_frame_funname (frame, &name, &lang, NULL);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
xfree (name);
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
if (name != NULL)
|
||
{
|
||
result = gdbscm_scm_from_c_string (name);
|
||
xfree (name);
|
||
}
|
||
else
|
||
result = SCM_BOOL_F;
|
||
|
||
return result;
|
||
}
|
||
|
||
/* (frame-type <gdb:frame>) -> integer
|
||
Returns the frame type, namely one of the gdb:*_FRAME constants. */
|
||
|
||
static SCM
|
||
gdbscm_frame_type (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
enum frame_type type = NORMAL_FRAME;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
if (frame != NULL)
|
||
type = get_frame_type (frame);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
return scm_from_int (type);
|
||
}
|
||
|
||
/* (frame-arch <gdb:frame>) -> <gdb:architecture>
|
||
Returns the frame's architecture as a gdb:architecture object. */
|
||
|
||
static SCM
|
||
gdbscm_frame_arch (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
return arscm_scm_from_arch (f_smob->gdbarch);
|
||
}
|
||
|
||
/* (frame-unwind-stop-reason <gdb:frame>) -> integer
|
||
Returns one of the gdb:FRAME_UNWIND_* constants. */
|
||
|
||
static SCM
|
||
gdbscm_frame_unwind_stop_reason (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
struct frame_info *frame = NULL;
|
||
enum unwind_stop_reason stop_reason;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
stop_reason = get_frame_unwind_stop_reason (frame);
|
||
|
||
return scm_from_int (stop_reason);
|
||
}
|
||
|
||
/* (frame-pc <gdb:frame>) -> integer
|
||
Returns the frame's resume address. */
|
||
|
||
static SCM
|
||
gdbscm_frame_pc (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
CORE_ADDR pc = 0;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
if (frame != NULL)
|
||
pc = get_frame_pc (frame);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
return gdbscm_scm_from_ulongest (pc);
|
||
}
|
||
|
||
/* (frame-block <gdb:frame>) -> <gdb:block>
|
||
Returns the frame's code block, or #f if one cannot be found. */
|
||
|
||
static SCM
|
||
gdbscm_frame_block (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
const struct block *block = NULL, *fn_block;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
if (frame != NULL)
|
||
block = get_frame_block (frame, NULL);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
for (fn_block = block;
|
||
fn_block != NULL && BLOCK_FUNCTION (fn_block) == NULL;
|
||
fn_block = BLOCK_SUPERBLOCK (fn_block))
|
||
continue;
|
||
|
||
if (block == NULL || fn_block == NULL || BLOCK_FUNCTION (fn_block) == NULL)
|
||
{
|
||
scm_misc_error (FUNC_NAME, _("cannot find block for frame"),
|
||
scm_list_1 (self));
|
||
}
|
||
|
||
if (block != NULL)
|
||
{
|
||
return bkscm_scm_from_block
|
||
(block, symbol_objfile (BLOCK_FUNCTION (fn_block)));
|
||
}
|
||
|
||
return SCM_BOOL_F;
|
||
}
|
||
|
||
/* (frame-function <gdb:frame>) -> <gdb:symbol>
|
||
Returns the symbol for the function corresponding to this frame,
|
||
or #f if there isn't one. */
|
||
|
||
static SCM
|
||
gdbscm_frame_function (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
struct symbol *sym = NULL;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
if (frame != NULL)
|
||
sym = find_pc_function (get_frame_address_in_block (frame));
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
if (sym != NULL)
|
||
return syscm_scm_from_symbol (sym);
|
||
|
||
return SCM_BOOL_F;
|
||
}
|
||
|
||
/* (frame-older <gdb:frame>) -> <gdb:frame>
|
||
Returns the frame immediately older (outer) to this frame,
|
||
or #f if there isn't one. */
|
||
|
||
static SCM
|
||
gdbscm_frame_older (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
struct frame_info *prev = NULL;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
if (frame != NULL)
|
||
prev = get_prev_frame (frame);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
if (prev != NULL)
|
||
return frscm_scm_from_frame_unsafe (prev, f_smob->inferior);
|
||
|
||
return SCM_BOOL_F;
|
||
}
|
||
|
||
/* (frame-newer <gdb:frame>) -> <gdb:frame>
|
||
Returns the frame immediately newer (inner) to this frame,
|
||
or #f if there isn't one. */
|
||
|
||
static SCM
|
||
gdbscm_frame_newer (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
struct frame_info *next = NULL;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
if (frame != NULL)
|
||
next = get_next_frame (frame);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
if (next != NULL)
|
||
return frscm_scm_from_frame_unsafe (next, f_smob->inferior);
|
||
|
||
return SCM_BOOL_F;
|
||
}
|
||
|
||
/* (frame-sal <gdb:frame>) -> <gdb:sal>
|
||
Returns the frame's symtab and line. */
|
||
|
||
static SCM
|
||
gdbscm_frame_sal (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
struct symtab_and_line sal;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
if (frame != NULL)
|
||
find_frame_sal (frame, &sal);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
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,
|
||
otherwise search from the frame's current block (determined by examining
|
||
the resume address of the frame). The variable argument must be a string
|
||
or an instance of a <gdb:symbol>. The block argument must be an instance of
|
||
<gdb:block>. */
|
||
|
||
static SCM
|
||
gdbscm_frame_read_var (SCM self, SCM symbol_scm, SCM rest)
|
||
{
|
||
SCM keywords[] = { block_keyword, SCM_BOOL_F };
|
||
int rc;
|
||
frame_smob *f_smob;
|
||
int block_arg_pos = -1;
|
||
SCM block_scm = SCM_UNDEFINED;
|
||
struct frame_info *frame = NULL;
|
||
struct symbol *var = NULL;
|
||
const struct block *block = NULL;
|
||
struct value *value = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG3, keywords, "#O",
|
||
rest, &block_arg_pos, &block_scm);
|
||
|
||
if (syscm_is_symbol (symbol_scm))
|
||
{
|
||
var = syscm_get_valid_symbol_arg_unsafe (symbol_scm, SCM_ARG2,
|
||
FUNC_NAME);
|
||
SCM_ASSERT (SCM_UNBNDP (block_scm), block_scm, SCM_ARG3, FUNC_NAME);
|
||
}
|
||
else if (scm_is_string (symbol_scm))
|
||
{
|
||
char *var_name;
|
||
const struct block *block = NULL;
|
||
struct cleanup *cleanup;
|
||
struct gdb_exception except = exception_none;
|
||
|
||
if (! SCM_UNBNDP (block_scm))
|
||
{
|
||
SCM except_scm;
|
||
|
||
gdb_assert (block_arg_pos > 0);
|
||
block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
|
||
&except_scm);
|
||
if (block == NULL)
|
||
gdbscm_throw (except_scm);
|
||
}
|
||
|
||
var_name = gdbscm_scm_to_c_string (symbol_scm);
|
||
cleanup = make_cleanup (xfree, var_name);
|
||
/* N.B. Between here and the call to do_cleanups, don't do anything
|
||
to cause a Scheme exception without performing the cleanup. */
|
||
|
||
TRY
|
||
{
|
||
struct block_symbol lookup_sym;
|
||
|
||
if (block == NULL)
|
||
block = get_frame_block (frame, 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;
|
||
}
|
||
END_CATCH
|
||
|
||
do_cleanups (cleanup);
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
|
||
if (var == NULL)
|
||
{
|
||
do_cleanups (cleanup);
|
||
gdbscm_out_of_range_error (FUNC_NAME, 0, symbol_scm,
|
||
_("variable not found"));
|
||
}
|
||
|
||
do_cleanups (cleanup);
|
||
}
|
||
else
|
||
{
|
||
/* Use SCM_ASSERT_TYPE for more consistent error messages. */
|
||
SCM_ASSERT_TYPE (0, symbol_scm, SCM_ARG1, FUNC_NAME,
|
||
_("gdb:symbol or string"));
|
||
}
|
||
|
||
TRY
|
||
{
|
||
value = read_var_value (var, block, frame);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return vlscm_scm_from_value (value);
|
||
}
|
||
|
||
/* (frame-select <gdb:frame>) -> unspecified
|
||
Select this frame. */
|
||
|
||
static SCM
|
||
gdbscm_frame_select (SCM self)
|
||
{
|
||
frame_smob *f_smob;
|
||
struct frame_info *frame = NULL;
|
||
|
||
f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
TRY
|
||
{
|
||
frame = frscm_frame_smob_to_frame (f_smob);
|
||
if (frame != NULL)
|
||
select_frame (frame);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (frame == NULL)
|
||
{
|
||
gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
|
||
_("<gdb:frame>"));
|
||
}
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (newest-frame) -> <gdb:frame>
|
||
Returns the newest frame. */
|
||
|
||
static SCM
|
||
gdbscm_newest_frame (void)
|
||
{
|
||
struct frame_info *frame = NULL;
|
||
|
||
TRY
|
||
{
|
||
frame = get_current_frame ();
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return frscm_scm_from_frame_unsafe (frame, current_inferior ());
|
||
}
|
||
|
||
/* (selected-frame) -> <gdb:frame>
|
||
Returns the selected frame. */
|
||
|
||
static SCM
|
||
gdbscm_selected_frame (void)
|
||
{
|
||
struct frame_info *frame = NULL;
|
||
|
||
TRY
|
||
{
|
||
frame = get_selected_frame (_("No frame is currently selected"));
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return frscm_scm_from_frame_unsafe (frame, current_inferior ());
|
||
}
|
||
|
||
/* (unwind-stop-reason-string integer) -> string
|
||
Return a string explaining the unwind stop reason. */
|
||
|
||
static SCM
|
||
gdbscm_unwind_stop_reason_string (SCM reason_scm)
|
||
{
|
||
int reason;
|
||
const char *str;
|
||
|
||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i",
|
||
reason_scm, &reason);
|
||
|
||
if (reason < UNWIND_FIRST || reason > UNWIND_LAST)
|
||
scm_out_of_range (FUNC_NAME, reason_scm);
|
||
|
||
str = unwind_stop_reason_to_string ((enum unwind_stop_reason) reason);
|
||
return gdbscm_scm_from_c_string (str);
|
||
}
|
||
|
||
/* Initialize the Scheme frame support. */
|
||
|
||
static const scheme_integer_constant frame_integer_constants[] =
|
||
{
|
||
#define ENTRY(X) { #X, X }
|
||
|
||
ENTRY (NORMAL_FRAME),
|
||
ENTRY (DUMMY_FRAME),
|
||
ENTRY (INLINE_FRAME),
|
||
ENTRY (TAILCALL_FRAME),
|
||
ENTRY (SIGTRAMP_FRAME),
|
||
ENTRY (ARCH_FRAME),
|
||
ENTRY (SENTINEL_FRAME),
|
||
|
||
#undef ENTRY
|
||
|
||
#define SET(name, description) \
|
||
{ "FRAME_" #name, name },
|
||
#include "unwind_stop_reasons.def"
|
||
#undef SET
|
||
|
||
END_INTEGER_CONSTANTS
|
||
};
|
||
|
||
static const scheme_function frame_functions[] =
|
||
{
|
||
{ "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, 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, 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, as_a_scm_t_subr (gdbscm_frame_arch),
|
||
"\
|
||
Return the frame's architecture as a <gdb:arch> object." },
|
||
|
||
{ "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,
|
||
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, as_a_scm_t_subr (gdbscm_frame_pc),
|
||
"\
|
||
Return the frame's resume address." },
|
||
|
||
{ "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, 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, 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, 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, as_a_scm_t_subr (gdbscm_frame_sal),
|
||
"\
|
||
Return the frame's symtab-and-line <gdb:sal> object." },
|
||
|
||
{ "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-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, as_a_scm_t_subr (gdbscm_newest_frame),
|
||
"\
|
||
Return the newest 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,
|
||
as_a_scm_t_subr (gdbscm_unwind_stop_reason_string),
|
||
"\
|
||
Return a string explaining the unwind stop reason.\n\
|
||
\n\
|
||
Arguments: integer (the result of frame-unwind-stop-reason)" },
|
||
|
||
END_FUNCTIONS
|
||
};
|
||
|
||
void
|
||
gdbscm_initialize_frames (void)
|
||
{
|
||
frame_smob_tag
|
||
= gdbscm_make_smob_type (frame_smob_name, sizeof (frame_smob));
|
||
scm_set_smob_free (frame_smob_tag, frscm_free_frame_smob);
|
||
scm_set_smob_print (frame_smob_tag, frscm_print_frame_smob);
|
||
|
||
gdbscm_define_integer_constants (frame_integer_constants, 1);
|
||
gdbscm_define_functions (frame_functions, 1);
|
||
|
||
block_keyword = scm_from_latin1_keyword ("block");
|
||
|
||
/* Register an inferior "free" callback so we can properly
|
||
invalidate frames when an inferior file is about to be deleted. */
|
||
frscm_inferior_data_key
|
||
= register_inferior_data_with_cleanup (NULL, frscm_del_inferior_frames);
|
||
}
|