mirror of
https://sourceware.org/git/binutils-gdb.git
synced 2024-12-21 04:42:53 +08:00
d7e747318f
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);
|
||
}
|