static SCM
gdbscm_execute_gdb_command (SCM command_scm, SCM rest)
{
int from_tty_arg_pos = -1, to_string_arg_pos = -1;
int from_tty = 0, to_string = 0;
volatile struct gdb_exception except;
const SCM keywords[] = { from_tty_keyword, to_string_keyword, SCM_BOOL_F };
char *command;
char *result = NULL;
struct cleanup *cleanups;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#tt",
command_scm, &command, rest,
&from_tty_arg_pos, &from_tty,
&to_string_arg_pos, &to_string);
/* Note: The contents of "command" may get modified while it is
executed. */
cleanups = make_cleanup (xfree, command);
TRY_CATCH (except, RETURN_MASK_ALL)
{
struct cleanup *inner_cleanups;
inner_cleanups = make_cleanup_restore_integer (&interpreter_async);
interpreter_async = 0;
prevent_dont_repeat ();
if (to_string)
result = execute_command_to_string (command, from_tty);
else
{
execute_command (command, from_tty);
result = NULL;
}
/* Do any commands attached to breakpoint we stopped at. */
bpstat_do_actions ();
do_cleanups (inner_cleanups);
}
do_cleanups (cleanups);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
if (result)
{
SCM r = gdbscm_scm_from_c_string (result);
xfree (result);
return r;
}
return SCM_UNSPECIFIED;
}
static SCM
gdbscm_delete_breakpoint_x (SCM self)
{
breakpoint_smob *bp_smob
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
TRY
{
delete_breakpoint (bp_smob->bp);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
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);
}
static SCM
gdbscm_symbol_needs_frame_p (SCM self)
{
symbol_smob *s_smob
= syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct symbol *symbol = s_smob->symbol;
int result = 0;
TRY
{
result = symbol_read_needs_frame (symbol);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
static SCM
gdbscm_register_parameter_x (SCM self)
{
param_smob *p_smob
= pascm_get_param_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
char *cmd_name;
struct cmd_list_element **set_list, **show_list;
if (pascm_is_valid (p_smob))
scm_misc_error (FUNC_NAME, _("parameter is already registered"), SCM_EOL);
cmd_name = gdbscm_parse_command_name (p_smob->name, FUNC_NAME, SCM_ARG1,
&set_list, &setlist);
xfree (cmd_name);
cmd_name = gdbscm_parse_command_name (p_smob->name, FUNC_NAME, SCM_ARG1,
&show_list, &showlist);
p_smob->cmd_name = gdbscm_gc_xstrdup (cmd_name);
xfree (cmd_name);
if (pascm_parameter_defined_p (p_smob->cmd_name, *set_list))
{
gdbscm_misc_error (FUNC_NAME, SCM_ARG1, self,
_("parameter exists, \"set\" command is already defined"));
}
if (pascm_parameter_defined_p (p_smob->cmd_name, *show_list))
{
gdbscm_misc_error (FUNC_NAME, SCM_ARG1, self,
_("parameter exists, \"show\" command is already defined"));
}
TRY
{
add_setshow_generic (p_smob->type, p_smob->cmd_class,
p_smob->cmd_name, p_smob,
p_smob->set_doc, p_smob->show_doc, p_smob->doc,
(gdbscm_is_procedure (p_smob->set_func)
? pascm_set_func : NULL),
(gdbscm_is_procedure (p_smob->show_func)
? pascm_show_func : NULL),
set_list, show_list,
&p_smob->set_command, &p_smob->show_command);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
static void
ioscm_write (SCM port, const void *data, size_t size)
{
/* If we're called on stdin, punt. */
if (scm_is_eq (port, input_port_scm))
return;
TRY
{
if (scm_is_eq (port, error_port_scm))
fputsn_filtered ((const char *) data, size, gdb_stderr);
else
fputsn_filtered ((const char *) data, size, gdb_stdout);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
static SCM
gdbscm_find_pc_line (SCM pc_scm)
{
ULONGEST pc_ull;
struct symtab_and_line sal;
init_sal (&sal); /* -Wall */
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "U", pc_scm, &pc_ull);
TRY
{
CORE_ADDR pc = (CORE_ADDR) pc_ull;
sal = find_pc_line (pc, 0);
}
CATCH (except, RETURN_MASK_ALL)
{
GDBSCM_HANDLE_GDB_EXCEPTION (except);
}
static SCM
gdbscm_register_breakpoint_x (SCM self)
{
breakpoint_smob *bp_smob
= bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct gdb_exception except = exception_none;
char *location, *copy;
struct event_location *eloc;
struct cleanup *cleanup;
/* We only support registering breakpoints created with make-breakpoint. */
if (!bp_smob->is_scheme_bkpt)
scm_misc_error (FUNC_NAME, _("not a Scheme breakpoint"), SCM_EOL);
if (bpscm_is_valid (bp_smob))
scm_misc_error (FUNC_NAME, _("breakpoint is already registered"), SCM_EOL);
pending_breakpoint_scm = self;
location = bp_smob->spec.location;
copy = location;
eloc = new_linespec_location (©);
cleanup = make_cleanup_delete_event_location (eloc);
TRY
{
int internal = bp_smob->spec.is_internal;
switch (bp_smob->spec.type)
{
case bp_breakpoint:
{
create_breakpoint (get_current_arch (),
eloc, NULL, -1, NULL,
0,
0, bp_breakpoint,
0,
AUTO_BOOLEAN_TRUE,
&bkpt_breakpoint_ops,
0, 1, internal, 0);
break;
}
case bp_watchpoint:
{
enum target_hw_bp_type access_type = bp_smob->spec.access_type;
if (access_type == hw_write)
watch_command_wrapper (location, 0, internal);
else if (access_type == hw_access)
awatch_command_wrapper (location, 0, internal);
else if (access_type == hw_read)
rwatch_command_wrapper (location, 0, internal);
else
gdb_assert_not_reached ("invalid access type");
break;
}
default:
gdb_assert_not_reached ("invalid breakpoint type");
}
}
CATCH (ex, RETURN_MASK_ALL)
{
except = ex;
}
END_CATCH
/* Ensure this gets reset, even if there's an error. */
pending_breakpoint_scm = SCM_BOOL_F;
GDBSCM_HANDLE_GDB_EXCEPTION (except);
do_cleanups (cleanup);
return SCM_UNSPECIFIED;
}