/* Scheme interface to breakpoints.
- Copyright (C) 2008-2014 Free Software Foundation, Inc.
+ Copyright (C) 2008-2015 Free Software Foundation, Inc.
This file is part of GDB.
#include "defs.h"
#include "value.h"
-#include "exceptions.h"
#include "breakpoint.h"
#include "gdbcmd.h"
#include "gdbthread.h"
#include "guile-internal.h"
/* The <gdb:breakpoint> smob.
- N.B.: The name of this struct is known to breakpoint.h. */
+ N.B.: The name of this struct is known to breakpoint.h.
+
+ Note: Breakpoints are added to gdb using a two step process:
+ 1) Call make-breakpoint to create a <gdb:breakpoint> object.
+ 2) Call register-breakpoint! to add the breakpoint to gdb.
+ It is done this way so that the constructor, make-breakpoint, doesn't have
+ any side-effects. This means that the smob needs to store everything
+ that was passed to make-breakpoint. */
typedef struct gdbscm_breakpoint_object
{
/* This always appears first. */
gdb_smob base;
+ /* Non-zero if this breakpoint was created with make-breakpoint. */
+ int is_scheme_bkpt;
+
+ /* For breakpoints created with make-breakpoint, these are the parameters
+ that were passed to make-breakpoint. These values are not used except
+ to register the breakpoint with GDB. */
+ struct
+ {
+ /* The string representation of the breakpoint.
+ Space for this lives in GC space. */
+ char *location;
+
+ /* The kind of breakpoint.
+ At the moment this can only be one of bp_breakpoint, bp_watchpoint. */
+ enum bptype type;
+
+ /* If a watchpoint, the kind of watchpoint. */
+ enum target_hw_bp_type access_type;
+
+ /* Non-zero if the breakpoint is an "internal" breakpoint. */
+ int is_internal;
+ } spec;
+
/* The breakpoint number according to gdb.
+ For breakpoints created from Scheme, this has the value -1 until the
+ breakpoint is registered with gdb.
This is recorded here because BP will be NULL when deleted. */
int number;
- /* The gdb breakpoint object, or NULL if the breakpoint has been deleted. */
+ /* The gdb breakpoint object, or NULL if the breakpoint has not been
+ registered yet, or has been deleted. */
struct breakpoint *bp;
/* Backlink to our containing <gdb:breakpoint> smob.
\f
/* Administrivia for breakpoint smobs. */
-/* The smob "mark" function for <gdb:breakpoint>. */
-
-static SCM
-bpscm_mark_breakpoint_smob (SCM self)
-{
- breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
-
- /* We don't mark containing_scm here. It is just a backlink to our
- container, and is gc'protected until the breakpoint is deleted. */
-
- scm_gc_mark (bp_smob->stop);
-
- /* Do this last. */
- return gdbscm_mark_gsmob (&bp_smob->base);
-}
-
/* The smob "free" function for <gdb:breakpoint>. */
static size_t
case bp_disabled: return "disabled";
case bp_enabled: return "enabled";
case bp_call_disabled: return "call_disabled";
- case bp_permanent: return "permanent";
default: return "unknown";
}
}
scm_gc_malloc (sizeof (breakpoint_smob), breakpoint_smob_name);
SCM bp_scm;
+ memset (bp_smob, 0, sizeof (*bp_smob));
bp_smob->number = -1;
- bp_smob->bp = NULL;
bp_smob->stop = SCM_BOOL_F;
bp_scm = scm_new_smob (breakpoint_smob_tag, (scm_t_bits) bp_smob);
bp_smob->containing_scm = bp_scm;
\f
/* Breakpoint methods. */
-/* (create-breakpoint! string [#:type integer] [#:wp-class integer]
- [#:internal boolean) -> <gdb:breakpoint> */
+/* (make-breakpoint string [#:type integer] [#:wp-class integer]
+ [#:internal boolean) -> <gdb:breakpoint>
+
+ The result is the <gdb:breakpoint> Scheme object.
+ The breakpoint is not available to be used yet, however.
+ It must still be added to gdb with register-breakpoint!. */
static SCM
-gdbscm_create_breakpoint_x (SCM spec_scm, SCM rest)
+gdbscm_make_breakpoint (SCM location_scm, SCM rest)
{
const SCM keywords[] = {
type_keyword, wp_class_keyword, internal_keyword, SCM_BOOL_F
};
- char *spec;
+ char *s;
+ char *location;
int type_arg_pos = -1, access_type_arg_pos = -1, internal_arg_pos = -1;
- int type = bp_breakpoint;
- int access_type = hw_write;
+ enum bptype type = bp_breakpoint;
+ enum target_hw_bp_type access_type = hw_write;
int internal = 0;
SCM result;
- volatile struct gdb_exception except;
+ breakpoint_smob *bp_smob;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iit",
- spec_scm, &spec, rest,
+ location_scm, &location, rest,
&type_arg_pos, &type,
&access_type_arg_pos, &access_type,
&internal_arg_pos, &internal);
result = bpscm_make_breakpoint_smob ();
- pending_breakpoint_scm = result;
+ bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (result);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ s = location;
+ location = gdbscm_gc_xstrdup (s);
+ xfree (s);
+
+ switch (type)
{
- struct cleanup *cleanup = make_cleanup (xfree, spec);
+ case bp_breakpoint:
+ if (access_type_arg_pos > 0)
+ {
+ gdbscm_misc_error (FUNC_NAME, access_type_arg_pos,
+ scm_from_int (access_type),
+ _("access type with breakpoint is not allowed"));
+ }
+ break;
+ case bp_watchpoint:
+ switch (access_type)
+ {
+ case hw_write:
+ case hw_access:
+ case hw_read:
+ break;
+ default:
+ gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
+ scm_from_int (access_type),
+ _("invalid watchpoint class"));
+ }
+ break;
+ default:
+ gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
+ scm_from_int (type),
+ _("invalid breakpoint type"));
+ }
+
+ bp_smob->is_scheme_bkpt = 1;
+ bp_smob->spec.location = location;
+ bp_smob->spec.type = type;
+ bp_smob->spec.access_type = access_type;
+ bp_smob->spec.is_internal = internal;
+
+ return result;
+}
+
+/* (register-breakpoint! <gdb:breakpoint>) -> unspecified
+
+ It is an error to register a breakpoint created outside of Guile,
+ or an already-registered breakpoint. */
+
+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;
+
+ /* 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);
- switch (type)
+ pending_breakpoint_scm = self;
+
+ TRY
+ {
+ char *location = bp_smob->spec.location;
+ int internal = bp_smob->spec.is_internal;
+
+ switch (bp_smob->spec.type)
{
case bp_breakpoint:
{
create_breakpoint (get_current_arch (),
- spec, NULL, -1, NULL,
+ location, NULL, -1, NULL,
0,
0, bp_breakpoint,
0,
}
case bp_watchpoint:
{
+ enum target_hw_bp_type access_type = bp_smob->spec.access_type;
+
if (access_type == hw_write)
- watch_command_wrapper (spec, 0, internal);
+ watch_command_wrapper (location, 0, internal);
else if (access_type == hw_access)
- awatch_command_wrapper (spec, 0, internal);
+ awatch_command_wrapper (location, 0, internal);
else if (access_type == hw_read)
- rwatch_command_wrapper (spec, 0, internal);
+ rwatch_command_wrapper (location, 0, internal);
else
- error (_("Invalid watchpoint access type"));
+ gdb_assert_not_reached ("invalid access type");
break;
}
default:
- error (_("Invalid breakpoint type"));
+ gdb_assert_not_reached ("invalid breakpoint type");
}
-
- do_cleanups (cleanup);
}
+ 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);
- return result;
+ return SCM_UNSPECIFIED;
}
-/* (breakpoint-delete! <gdb:breakpoint>) -> unspecified
- Scheme function which deletes the underlying GDB breakpoint. This
- triggers the breakpoint_deleted observer which will call
- gdbscm_breakpoint_deleted; that function cleans up the Scheme sections. */
+/* (delete-breakpoint! <gdb:breakpoint>) -> unspecified
+ Scheme function which deletes (removes) the underlying GDB breakpoint
+ from GDB's list of breakpoints. This triggers the breakpoint_deleted
+ observer which will call gdbscm_breakpoint_deleted; that function cleans
+ up the Scheme bits. */
static SCM
-gdbscm_breakpoint_delete_x (SCM self)
+gdbscm_delete_breakpoint_x (SCM self)
{
breakpoint_smob *bp_smob
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- volatile struct gdb_exception except;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
delete_breakpoint (bp_smob->bp);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
return SCM_UNSPECIFIED;
}
{
breakpoint_smob *bp_smob
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- volatile struct gdb_exception except;
SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
_("boolean"));
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
if (gdbscm_is_true (newvalue))
enable_breakpoint (bp_smob->bp);
else
disable_breakpoint (bp_smob->bp);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
return SCM_UNSPECIFIED;
}
{
breakpoint_smob *bp_smob
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
- volatile struct gdb_exception except;
SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
_("boolean"));
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
breakpoint_set_silent (bp_smob->bp, gdbscm_is_true (newvalue));
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
return SCM_UNSPECIFIED;
}
breakpoint_smob *bp_smob
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
long value;
- volatile struct gdb_exception except;
SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
if (value < 0)
value = 0;
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
set_ignore_count (bp_smob->number, (int) value, 0);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
return SCM_UNSPECIFIED;
}
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
long id;
int valid_id = 0;
- volatile struct gdb_exception except;
if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
{
id = scm_to_long (newvalue);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
valid_id = valid_task_id (id);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
if (! valid_id)
{
else
SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
breakpoint_set_task (bp_smob->bp, id);
}
- GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ CATCH (except, RETURN_MASK_ALL)
+ {
+ GDBSCM_HANDLE_GDB_EXCEPTION (except);
+ }
+ END_CATCH
return SCM_UNSPECIFIED;
}
breakpoint_smob *bp_smob
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
char *exp;
- volatile struct gdb_exception except;
+ struct gdb_exception except = exception_none;
SCM_ASSERT_TYPE (scm_is_string (newvalue) || gdbscm_is_false (newvalue),
newvalue, SCM_ARG2, FUNC_NAME,
else
exp = gdbscm_scm_to_c_string (newvalue);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
set_breakpoint_condition (bp_smob->bp, exp ? exp : "", 0);
}
+ CATCH (ex, RETURN_MASK_ALL)
+ {
+ except = ex;
+ }
+ END_CATCH
+
xfree (exp);
GDBSCM_HANDLE_GDB_EXCEPTION (except);
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
struct breakpoint *bp;
long length;
- volatile struct gdb_exception except;
struct ui_file *string_file;
struct cleanup *chain;
SCM result;
chain = make_cleanup_ui_file_delete (string_file);
ui_out_redirect (current_uiout, string_file);
- TRY_CATCH (except, RETURN_MASK_ALL)
+ TRY
{
print_command_lines (current_uiout, breakpoint_commands (bp), 0);
}
ui_out_redirect (current_uiout, NULL);
- if (except.reason < 0)
+ CATCH (except, RETURN_MASK_ALL)
{
do_cleanups (chain);
gdbscm_throw_gdb_exception (except);
}
+ END_CATCH
cmdstr = ui_file_xstrdup (string_file, &length);
make_cleanup (xfree, cmdstr);
if (bp_smob)
{
bp_smob->bp = NULL;
+ bp_smob->number = -1;
+ bp_smob->stop = SCM_BOOL_F;
scm_gc_unprotect_object (bp_smob->containing_scm);
}
}
static const scheme_function breakpoint_functions[] =
{
- { "create-breakpoint!", 1, 0, 1, gdbscm_create_breakpoint_x,
+ { "make-breakpoint", 1, 0, 1, gdbscm_make_breakpoint,
"\
-Create and install a GDB breakpoint object.\n\
+Create a GDB breakpoint object.\n\
\n\
Arguments:\n\
- location [#:type <type>] [#:wp-class <wp-class>] [#:internal <bool>]" },
+ location [#:type <type>] [#:wp-class <wp-class>] [#:internal <bool>]\n\
+ Returns:\n\
+ <gdb:breakpoint object" },
+
+ { "register-breakpoint!", 1, 0, 0, gdbscm_register_breakpoint_x,
+ "\
+Register a <gdb:breakpoint> object with GDB." },
- { "breakpoint-delete!", 1, 0, 0, gdbscm_breakpoint_delete_x,
+ { "delete-breakpoint!", 1, 0, 0, gdbscm_delete_breakpoint_x,
"\
Delete the breakpoint from GDB." },
{
breakpoint_smob_tag
= gdbscm_make_smob_type (breakpoint_smob_name, sizeof (breakpoint_smob));
- scm_set_smob_mark (breakpoint_smob_tag, bpscm_mark_breakpoint_smob);
scm_set_smob_free (breakpoint_smob_tag, bpscm_free_breakpoint_smob);
scm_set_smob_print (breakpoint_smob_tag, bpscm_print_breakpoint_smob);
projects / binutils-gdb.git / blobdiff