492d29ea1c
This patch splits the TRY_CATCH macro into three, so that we go from
this:
~~~
volatile gdb_exception ex;
TRY_CATCH (ex, RETURN_MASK_ERROR)
{
}
if (ex.reason < 0)
{
}
~~~
to this:
~~~
TRY
{
}
CATCH (ex, RETURN_MASK_ERROR)
{
}
END_CATCH
~~~
Thus, we'll be getting rid of the local volatile exception object, and
declaring the caught exception in the catch block.
This allows reimplementing TRY/CATCH in terms of C++ exceptions when
building in C++ mode, while still allowing to build GDB in C mode
(using setjmp/longjmp), as a transition step.
TBC, after this patch, is it _not_ valid to have code between the TRY
and the CATCH blocks, like:
TRY
{
}
// some code here.
CATCH (ex, RETURN_MASK_ERROR)
{
}
END_CATCH
Just like it isn't valid to do that with C++'s native try/catch.
By switching to creating the exception object inside the CATCH block
scope, we can get rid of all the explicitly allocated volatile
exception objects all over the tree, and map the CATCH block more
directly to C++'s catch blocks.
The majority of the TRY_CATCH -> TRY+CATCH+END_CATCH conversion was
done with a script, rerun from scratch at every rebase, no manual
editing involved. After the mechanical conversion, a few places
needed manual intervention, to fix preexisting cases where we were
using the exception object outside of the TRY_CATCH block, and cases
where we were using "else" after a 'if (ex.reason) < 0)' [a CATCH
after this patch]. The result was folded into this patch so that GDB
still builds at each incremental step.
END_CATCH is necessary for two reasons:
First, because we name the exception object in the CATCH block, which
requires creating a scope, which in turn must be closed somewhere.
Declaring the exception variable in the initializer field of a for
block, like:
#define CATCH(EXCEPTION, mask) \
for (struct gdb_exception EXCEPTION; \
exceptions_state_mc_catch (&EXCEPTION, MASK); \
EXCEPTION = exception_none)
would avoid needing END_CATCH, but alas, in C mode, we build with C90,
which doesn't allow mixed declarations and code.
Second, because when TRY/CATCH are wired to real C++ try/catch, as
long as we need to handle cleanup chains, even if there's no CATCH
block that wants to catch the exception, we need for stop at every
frame in the unwind chain and run cleanups, then rethrow. That will
be done in END_CATCH.
After we require C++, we'll still need TRY/CATCH/END_CATCH until
cleanups are completely phased out -- TRY/CATCH in C++ mode will
save/restore the current cleanup chain, like in C mode, and END_CATCH
catches otherwise uncaugh exceptions, runs cleanups and rethrows, so
that C++ cleanups and exceptions can coexist.
IMO, this still makes the TRY/CATCH code look a bit more like a
newcomer would expect, so IMO worth it even if we weren't considering
C++.
gdb/ChangeLog.
2015-03-07 Pedro Alves <palves@redhat.com>
* common/common-exceptions.c (struct catcher) <exception>: No
longer a pointer to volatile exception. Now an exception value.
<mask>: Delete field.
(exceptions_state_mc_init): Remove all parameters. Adjust.
(exceptions_state_mc): No longer pop the catcher here.
(exceptions_state_mc_catch): New function.
(throw_exception): Adjust.
* common/common-exceptions.h (exceptions_state_mc_init): Remove
all parameters.
(exceptions_state_mc_catch): Declare.
(TRY_CATCH): Rename to ...
(TRY): ... this. Remove EXCEPTION and MASK parameters.
(CATCH, END_CATCH): New.
All callers adjusted.
gdb/gdbserver/ChangeLog:
2015-03-07 Pedro Alves <palves@redhat.com>
Adjust all callers of TRY_CATCH to use TRY/CATCH/END_CATCH
instead.
1323 lines
34 KiB
C
1323 lines
34 KiB
C
/* Scheme interface to breakpoints.
|
||
|
||
Copyright (C) 2008-2015 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 "value.h"
|
||
#include "breakpoint.h"
|
||
#include "gdbcmd.h"
|
||
#include "gdbthread.h"
|
||
#include "observer.h"
|
||
#include "cli/cli-script.h"
|
||
#include "ada-lang.h"
|
||
#include "arch-utils.h"
|
||
#include "language.h"
|
||
#include "guile-internal.h"
|
||
|
||
/* The <gdb:breakpoint> smob.
|
||
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 not been
|
||
registered yet, or has been deleted. */
|
||
struct breakpoint *bp;
|
||
|
||
/* Backlink to our containing <gdb:breakpoint> smob.
|
||
This is needed when we are deleted, we need to unprotect the object
|
||
from GC. */
|
||
SCM containing_scm;
|
||
|
||
/* A stop condition or #f. */
|
||
SCM stop;
|
||
} breakpoint_smob;
|
||
|
||
static const char breakpoint_smob_name[] = "gdb:breakpoint";
|
||
|
||
/* The tag Guile knows the breakpoint smob by. */
|
||
static scm_t_bits breakpoint_smob_tag;
|
||
|
||
/* Variables used to pass information between the breakpoint_smob
|
||
constructor and the breakpoint-created hook function. */
|
||
static SCM pending_breakpoint_scm = SCM_BOOL_F;
|
||
|
||
/* Keywords used by create-breakpoint!. */
|
||
static SCM type_keyword;
|
||
static SCM wp_class_keyword;
|
||
static SCM internal_keyword;
|
||
|
||
/* Administrivia for breakpoint smobs. */
|
||
|
||
/* The smob "free" function for <gdb:breakpoint>. */
|
||
|
||
static size_t
|
||
bpscm_free_breakpoint_smob (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
|
||
|
||
if (bp_smob->bp)
|
||
bp_smob->bp->scm_bp_object = NULL;
|
||
|
||
/* Not necessary, done to catch bugs. */
|
||
bp_smob->bp = NULL;
|
||
bp_smob->containing_scm = SCM_UNDEFINED;
|
||
bp_smob->stop = SCM_UNDEFINED;
|
||
|
||
return 0;
|
||
}
|
||
|
||
/* Return the name of TYPE.
|
||
This doesn't handle all types, just the ones we export. */
|
||
|
||
static const char *
|
||
bpscm_type_to_string (enum bptype type)
|
||
{
|
||
switch (type)
|
||
{
|
||
case bp_none: return "BP_NONE";
|
||
case bp_breakpoint: return "BP_BREAKPOINT";
|
||
case bp_watchpoint: return "BP_WATCHPOINT";
|
||
case bp_hardware_watchpoint: return "BP_HARDWARE_WATCHPOINT";
|
||
case bp_read_watchpoint: return "BP_READ_WATCHPOINT";
|
||
case bp_access_watchpoint: return "BP_ACCESS_WATCHPOINT";
|
||
default: return "internal/other";
|
||
}
|
||
}
|
||
|
||
/* Return the name of ENABLE_STATE. */
|
||
|
||
static const char *
|
||
bpscm_enable_state_to_string (enum enable_state enable_state)
|
||
{
|
||
switch (enable_state)
|
||
{
|
||
case bp_disabled: return "disabled";
|
||
case bp_enabled: return "enabled";
|
||
case bp_call_disabled: return "call_disabled";
|
||
default: return "unknown";
|
||
}
|
||
}
|
||
|
||
/* The smob "print" function for <gdb:breakpoint>. */
|
||
|
||
static int
|
||
bpscm_print_breakpoint_smob (SCM self, SCM port, scm_print_state *pstate)
|
||
{
|
||
breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
|
||
struct breakpoint *b = bp_smob->bp;
|
||
|
||
gdbscm_printf (port, "#<%s", breakpoint_smob_name);
|
||
|
||
/* Only print what we export to the user.
|
||
The rest are possibly internal implementation details. */
|
||
|
||
gdbscm_printf (port, " #%d", bp_smob->number);
|
||
|
||
/* Careful, the breakpoint may be invalid. */
|
||
if (b != NULL)
|
||
{
|
||
gdbscm_printf (port, " %s %s %s",
|
||
bpscm_type_to_string (b->type),
|
||
bpscm_enable_state_to_string (b->enable_state),
|
||
b->silent ? "silent" : "noisy");
|
||
|
||
gdbscm_printf (port, " hit:%d", b->hit_count);
|
||
gdbscm_printf (port, " ignore:%d", b->ignore_count);
|
||
|
||
if (b->addr_string != NULL)
|
||
gdbscm_printf (port, " @%s", b->addr_string);
|
||
}
|
||
|
||
scm_puts (">", port);
|
||
|
||
scm_remember_upto_here_1 (self);
|
||
|
||
/* Non-zero means success. */
|
||
return 1;
|
||
}
|
||
|
||
/* Low level routine to create a <gdb:breakpoint> object. */
|
||
|
||
static SCM
|
||
bpscm_make_breakpoint_smob (void)
|
||
{
|
||
breakpoint_smob *bp_smob = (breakpoint_smob *)
|
||
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->stop = SCM_BOOL_F;
|
||
bp_scm = scm_new_smob (breakpoint_smob_tag, (scm_t_bits) bp_smob);
|
||
bp_smob->containing_scm = bp_scm;
|
||
gdbscm_init_gsmob (&bp_smob->base);
|
||
|
||
return bp_scm;
|
||
}
|
||
|
||
/* Return non-zero if we want a Scheme wrapper for breakpoint B.
|
||
If FROM_SCHEME is non-zero,this is called for a breakpoint created
|
||
by the user from Scheme. Otherwise it is zero. */
|
||
|
||
static int
|
||
bpscm_want_scm_wrapper_p (struct breakpoint *bp, int from_scheme)
|
||
{
|
||
/* Don't create <gdb:breakpoint> objects for internal GDB breakpoints. */
|
||
if (bp->number < 0 && !from_scheme)
|
||
return 0;
|
||
|
||
/* The others are not supported. */
|
||
if (bp->type != bp_breakpoint
|
||
&& bp->type != bp_watchpoint
|
||
&& bp->type != bp_hardware_watchpoint
|
||
&& bp->type != bp_read_watchpoint
|
||
&& bp->type != bp_access_watchpoint)
|
||
return 0;
|
||
|
||
return 1;
|
||
}
|
||
|
||
/* Install the Scheme side of a breakpoint, CONTAINING_SCM, in
|
||
the gdb side BP. */
|
||
|
||
static void
|
||
bpscm_attach_scm_to_breakpoint (struct breakpoint *bp, SCM containing_scm)
|
||
{
|
||
breakpoint_smob *bp_smob;
|
||
|
||
bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (containing_scm);
|
||
bp_smob->number = bp->number;
|
||
bp_smob->bp = bp;
|
||
bp_smob->containing_scm = containing_scm;
|
||
bp_smob->bp->scm_bp_object = bp_smob;
|
||
|
||
/* The owner of this breakpoint is not in GC-controlled memory, so we need
|
||
to protect it from GC until the breakpoint is deleted. */
|
||
scm_gc_protect_object (containing_scm);
|
||
}
|
||
|
||
/* Return non-zero if SCM is a breakpoint smob. */
|
||
|
||
static int
|
||
bpscm_is_breakpoint (SCM scm)
|
||
{
|
||
return SCM_SMOB_PREDICATE (breakpoint_smob_tag, scm);
|
||
}
|
||
|
||
/* (breakpoint? scm) -> boolean */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_p (SCM scm)
|
||
{
|
||
return scm_from_bool (bpscm_is_breakpoint (scm));
|
||
}
|
||
|
||
/* Returns the <gdb:breakpoint> object in SELF.
|
||
Throws an exception if SELF is not a <gdb:breakpoint> object. */
|
||
|
||
static SCM
|
||
bpscm_get_breakpoint_arg_unsafe (SCM self, int arg_pos, const char *func_name)
|
||
{
|
||
SCM_ASSERT_TYPE (bpscm_is_breakpoint (self), self, arg_pos, func_name,
|
||
breakpoint_smob_name);
|
||
|
||
return self;
|
||
}
|
||
|
||
/* Returns a pointer to the breakpoint smob of SELF.
|
||
Throws an exception if SELF is not a <gdb:breakpoint> object. */
|
||
|
||
static breakpoint_smob *
|
||
bpscm_get_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
|
||
const char *func_name)
|
||
{
|
||
SCM bp_scm = bpscm_get_breakpoint_arg_unsafe (self, arg_pos, func_name);
|
||
breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (bp_scm);
|
||
|
||
return bp_smob;
|
||
}
|
||
|
||
/* Return non-zero if breakpoint BP_SMOB is valid. */
|
||
|
||
static int
|
||
bpscm_is_valid (breakpoint_smob *bp_smob)
|
||
{
|
||
return bp_smob->bp != NULL;
|
||
}
|
||
|
||
/* Returns the breakpoint smob in SELF, verifying it's valid.
|
||
Throws an exception if SELF is not a <gdb:breakpoint> object,
|
||
or is invalid. */
|
||
|
||
static breakpoint_smob *
|
||
bpscm_get_valid_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
|
||
const char *func_name)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_breakpoint_smob_arg_unsafe (self, arg_pos, func_name);
|
||
|
||
if (!bpscm_is_valid (bp_smob))
|
||
{
|
||
gdbscm_invalid_object_error (func_name, arg_pos, self,
|
||
_("<gdb:breakpoint>"));
|
||
}
|
||
|
||
return bp_smob;
|
||
}
|
||
|
||
/* Breakpoint methods. */
|
||
|
||
/* (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_make_breakpoint (SCM location_scm, SCM rest)
|
||
{
|
||
const SCM keywords[] = {
|
||
type_keyword, wp_class_keyword, internal_keyword, SCM_BOOL_F
|
||
};
|
||
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;
|
||
int internal = 0;
|
||
SCM result;
|
||
breakpoint_smob *bp_smob;
|
||
|
||
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iit",
|
||
location_scm, &location, rest,
|
||
&type_arg_pos, &type,
|
||
&access_type_arg_pos, &access_type,
|
||
&internal_arg_pos, &internal);
|
||
|
||
result = bpscm_make_breakpoint_smob ();
|
||
bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (result);
|
||
|
||
s = location;
|
||
location = gdbscm_gc_xstrdup (s);
|
||
xfree (s);
|
||
|
||
switch (type)
|
||
{
|
||
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);
|
||
|
||
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 (),
|
||
location, 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);
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (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_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);
|
||
}
|
||
END_CATCH
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* iterate_over_breakpoints function for gdbscm_breakpoints. */
|
||
|
||
static int
|
||
bpscm_build_bp_list (struct breakpoint *bp, void *arg)
|
||
{
|
||
SCM *list = arg;
|
||
breakpoint_smob *bp_smob = bp->scm_bp_object;
|
||
|
||
/* Lazily create wrappers for breakpoints created outside Scheme. */
|
||
|
||
if (bp_smob == NULL)
|
||
{
|
||
if (bpscm_want_scm_wrapper_p (bp, 0))
|
||
{
|
||
SCM bp_scm;
|
||
|
||
bp_scm = bpscm_make_breakpoint_smob ();
|
||
bpscm_attach_scm_to_breakpoint (bp, bp_scm);
|
||
/* Refetch it. */
|
||
bp_smob = bp->scm_bp_object;
|
||
}
|
||
}
|
||
|
||
/* Not all breakpoints will have a companion Scheme object.
|
||
Only breakpoints that trigger the created_breakpoint observer call,
|
||
and satisfy certain conditions (see bpscm_want_scm_wrapper_p),
|
||
get a companion object (this includes Scheme-created breakpoints). */
|
||
|
||
if (bp_smob != NULL)
|
||
*list = scm_cons (bp_smob->containing_scm, *list);
|
||
|
||
return 0;
|
||
}
|
||
|
||
/* (breakpoints) -> list
|
||
Return a list of all breakpoints. */
|
||
|
||
static SCM
|
||
gdbscm_breakpoints (void)
|
||
{
|
||
SCM list = SCM_EOL;
|
||
|
||
/* If iterate_over_breakpoints returns non-NULL it means the iteration
|
||
terminated early.
|
||
In that case abandon building the list and return #f. */
|
||
if (iterate_over_breakpoints (bpscm_build_bp_list, &list) != NULL)
|
||
return SCM_BOOL_F;
|
||
|
||
return scm_reverse_x (list, SCM_EOL);
|
||
}
|
||
|
||
/* (breakpoint-valid? <gdb:breakpoint>) -> boolean
|
||
Returns #t if SELF is still valid. */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_valid_p (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
return scm_from_bool (bpscm_is_valid (bp_smob));
|
||
}
|
||
|
||
/* (breakpoint-enabled? <gdb:breakpoint>) -> boolean */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_enabled_p (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
return scm_from_bool (bp_smob->bp->enable_state == bp_enabled);
|
||
}
|
||
|
||
/* (set-breakpoint-enabled? <gdb:breakpoint> boolean) -> unspecified */
|
||
|
||
static SCM
|
||
gdbscm_set_breakpoint_enabled_x (SCM self, SCM newvalue)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
|
||
_("boolean"));
|
||
|
||
TRY
|
||
{
|
||
if (gdbscm_is_true (newvalue))
|
||
enable_breakpoint (bp_smob->bp);
|
||
else
|
||
disable_breakpoint (bp_smob->bp);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (breakpoint-silent? <gdb:breakpoint>) -> boolean */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_silent_p (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
return scm_from_bool (bp_smob->bp->silent);
|
||
}
|
||
|
||
/* (set-breakpoint-silent?! <gdb:breakpoint> boolean) -> unspecified */
|
||
|
||
static SCM
|
||
gdbscm_set_breakpoint_silent_x (SCM self, SCM newvalue)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
|
||
_("boolean"));
|
||
|
||
TRY
|
||
{
|
||
breakpoint_set_silent (bp_smob->bp, gdbscm_is_true (newvalue));
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (breakpoint-ignore-count <gdb:breakpoint>) -> integer */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_ignore_count (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
return scm_from_long (bp_smob->bp->ignore_count);
|
||
}
|
||
|
||
/* (set-breakpoint-ignore-count! <gdb:breakpoint> integer)
|
||
-> unspecified */
|
||
|
||
static SCM
|
||
gdbscm_set_breakpoint_ignore_count_x (SCM self, SCM newvalue)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
long value;
|
||
|
||
SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
|
||
newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
|
||
|
||
value = scm_to_long (newvalue);
|
||
if (value < 0)
|
||
value = 0;
|
||
|
||
TRY
|
||
{
|
||
set_ignore_count (bp_smob->number, (int) value, 0);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (breakpoint-hit-count <gdb:breakpoint>) -> integer */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_hit_count (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
return scm_from_long (bp_smob->bp->hit_count);
|
||
}
|
||
|
||
/* (set-breakpoint-hit-count! <gdb:breakpoint> integer) -> unspecified */
|
||
|
||
static SCM
|
||
gdbscm_set_breakpoint_hit_count_x (SCM self, SCM newvalue)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
long value;
|
||
|
||
SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
|
||
newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
|
||
|
||
value = scm_to_long (newvalue);
|
||
if (value < 0)
|
||
value = 0;
|
||
|
||
if (value != 0)
|
||
{
|
||
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
|
||
_("hit-count must be zero"));
|
||
}
|
||
|
||
bp_smob->bp->hit_count = 0;
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (breakpoint-thread <gdb:breakpoint>) -> integer */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_thread (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
if (bp_smob->bp->thread == -1)
|
||
return SCM_BOOL_F;
|
||
|
||
return scm_from_long (bp_smob->bp->thread);
|
||
}
|
||
|
||
/* (set-breakpoint-thread! <gdb:breakpoint> integer) -> unspecified */
|
||
|
||
static SCM
|
||
gdbscm_set_breakpoint_thread_x (SCM self, SCM newvalue)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
long id;
|
||
|
||
if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
|
||
{
|
||
id = scm_to_long (newvalue);
|
||
if (! valid_thread_id (id))
|
||
{
|
||
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
|
||
_("invalid thread id"));
|
||
}
|
||
}
|
||
else if (gdbscm_is_false (newvalue))
|
||
id = -1;
|
||
else
|
||
SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
|
||
|
||
breakpoint_set_thread (bp_smob->bp, id);
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (breakpoint-task <gdb:breakpoint>) -> integer */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_task (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
if (bp_smob->bp->task == 0)
|
||
return SCM_BOOL_F;
|
||
|
||
return scm_from_long (bp_smob->bp->task);
|
||
}
|
||
|
||
/* (set-breakpoint-task! <gdb:breakpoint> integer) -> unspecified */
|
||
|
||
static SCM
|
||
gdbscm_set_breakpoint_task_x (SCM self, SCM newvalue)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
long id;
|
||
int valid_id = 0;
|
||
|
||
if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
|
||
{
|
||
id = scm_to_long (newvalue);
|
||
|
||
TRY
|
||
{
|
||
valid_id = valid_task_id (id);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
if (! valid_id)
|
||
{
|
||
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
|
||
_("invalid task id"));
|
||
}
|
||
}
|
||
else if (gdbscm_is_false (newvalue))
|
||
id = 0;
|
||
else
|
||
SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
|
||
|
||
TRY
|
||
{
|
||
breakpoint_set_task (bp_smob->bp, id);
|
||
}
|
||
CATCH (except, RETURN_MASK_ALL)
|
||
{
|
||
GDBSCM_HANDLE_GDB_EXCEPTION (except);
|
||
}
|
||
END_CATCH
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (breakpoint-location <gdb:breakpoint>) -> string */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_location (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
char *str;
|
||
|
||
if (bp_smob->bp->type != bp_breakpoint)
|
||
return SCM_BOOL_F;
|
||
|
||
str = bp_smob->bp->addr_string;
|
||
if (! str)
|
||
str = "";
|
||
|
||
return gdbscm_scm_from_c_string (str);
|
||
}
|
||
|
||
/* (breakpoint-expression <gdb:breakpoint>) -> string
|
||
This is only valid for watchpoints.
|
||
Returns #f for non-watchpoints. */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_expression (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
char *str;
|
||
struct watchpoint *wp;
|
||
|
||
if (!is_watchpoint (bp_smob->bp))
|
||
return SCM_BOOL_F;
|
||
|
||
wp = (struct watchpoint *) bp_smob->bp;
|
||
|
||
str = wp->exp_string;
|
||
if (! str)
|
||
str = "";
|
||
|
||
return gdbscm_scm_from_c_string (str);
|
||
}
|
||
|
||
/* (breakpoint-condition <gdb:breakpoint>) -> string */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_condition (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
char *str;
|
||
|
||
str = bp_smob->bp->cond_string;
|
||
if (! str)
|
||
return SCM_BOOL_F;
|
||
|
||
return gdbscm_scm_from_c_string (str);
|
||
}
|
||
|
||
/* (set-breakpoint-condition! <gdb:breakpoint> string|#f)
|
||
-> unspecified */
|
||
|
||
static SCM
|
||
gdbscm_set_breakpoint_condition_x (SCM self, SCM newvalue)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
char *exp;
|
||
struct gdb_exception except = exception_none;
|
||
|
||
SCM_ASSERT_TYPE (scm_is_string (newvalue) || gdbscm_is_false (newvalue),
|
||
newvalue, SCM_ARG2, FUNC_NAME,
|
||
_("string or #f"));
|
||
|
||
if (gdbscm_is_false (newvalue))
|
||
exp = NULL;
|
||
else
|
||
exp = gdbscm_scm_to_c_string (newvalue);
|
||
|
||
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);
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (breakpoint-stop <gdb:breakpoint>) -> procedure or #f */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_stop (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
return bp_smob->stop;
|
||
}
|
||
|
||
/* (set-breakpoint-stop! <gdb:breakpoint> procedure|#f)
|
||
-> unspecified */
|
||
|
||
static SCM
|
||
gdbscm_set_breakpoint_stop_x (SCM self, SCM newvalue)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
const struct extension_language_defn *extlang = NULL;
|
||
|
||
SCM_ASSERT_TYPE (gdbscm_is_procedure (newvalue)
|
||
|| gdbscm_is_false (newvalue),
|
||
newvalue, SCM_ARG2, FUNC_NAME,
|
||
_("procedure or #f"));
|
||
|
||
if (bp_smob->bp->cond_string != NULL)
|
||
extlang = get_ext_lang_defn (EXT_LANG_GDB);
|
||
if (extlang == NULL)
|
||
extlang = get_breakpoint_cond_ext_lang (bp_smob->bp, EXT_LANG_GUILE);
|
||
if (extlang != NULL)
|
||
{
|
||
char *error_text
|
||
= xstrprintf (_("Only one stop condition allowed. There is"
|
||
" currently a %s stop condition defined for"
|
||
" this breakpoint."),
|
||
ext_lang_capitalized_name (extlang));
|
||
|
||
scm_dynwind_begin (0);
|
||
gdbscm_dynwind_xfree (error_text);
|
||
gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, error_text);
|
||
/* The following line, while unnecessary, is present for completeness
|
||
sake. */
|
||
scm_dynwind_end ();
|
||
}
|
||
|
||
bp_smob->stop = newvalue;
|
||
|
||
return SCM_UNSPECIFIED;
|
||
}
|
||
|
||
/* (breakpoint-commands <gdb:breakpoint>) -> string */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_commands (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
struct breakpoint *bp;
|
||
long length;
|
||
struct ui_file *string_file;
|
||
struct cleanup *chain;
|
||
SCM result;
|
||
char *cmdstr;
|
||
|
||
bp = bp_smob->bp;
|
||
|
||
if (bp->commands == NULL)
|
||
return SCM_BOOL_F;
|
||
|
||
string_file = mem_fileopen ();
|
||
chain = make_cleanup_ui_file_delete (string_file);
|
||
|
||
ui_out_redirect (current_uiout, string_file);
|
||
TRY
|
||
{
|
||
print_command_lines (current_uiout, breakpoint_commands (bp), 0);
|
||
}
|
||
ui_out_redirect (current_uiout, NULL);
|
||
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);
|
||
result = gdbscm_scm_from_c_string (cmdstr);
|
||
|
||
do_cleanups (chain);
|
||
return result;
|
||
}
|
||
|
||
/* (breakpoint-type <gdb:breakpoint>) -> integer */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_type (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
return scm_from_long (bp_smob->bp->type);
|
||
}
|
||
|
||
/* (breakpoint-visible? <gdb:breakpoint>) -> boolean */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_visible (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
return scm_from_bool (bp_smob->bp->number >= 0);
|
||
}
|
||
|
||
/* (breakpoint-number <gdb:breakpoint>) -> integer */
|
||
|
||
static SCM
|
||
gdbscm_breakpoint_number (SCM self)
|
||
{
|
||
breakpoint_smob *bp_smob
|
||
= bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
|
||
|
||
return scm_from_long (bp_smob->number);
|
||
}
|
||
|
||
/* Return TRUE if "stop" has been set for this breakpoint.
|
||
|
||
This is the extension_language_ops.breakpoint_has_cond "method". */
|
||
|
||
int
|
||
gdbscm_breakpoint_has_cond (const struct extension_language_defn *extlang,
|
||
struct breakpoint *b)
|
||
{
|
||
breakpoint_smob *bp_smob = b->scm_bp_object;
|
||
|
||
if (bp_smob == NULL)
|
||
return 0;
|
||
|
||
return gdbscm_is_procedure (bp_smob->stop);
|
||
}
|
||
|
||
/* Call the "stop" method in the breakpoint class.
|
||
This must only be called if gdbscm_breakpoint_has_cond returns true.
|
||
If the stop method returns #t, the inferior will be stopped at the
|
||
breakpoint. Otherwise the inferior will be allowed to continue
|
||
(assuming other conditions don't indicate "stop").
|
||
|
||
This is the extension_language_ops.breakpoint_cond_says_stop "method". */
|
||
|
||
enum ext_lang_bp_stop
|
||
gdbscm_breakpoint_cond_says_stop
|
||
(const struct extension_language_defn *extlang, struct breakpoint *b)
|
||
{
|
||
breakpoint_smob *bp_smob = b->scm_bp_object;
|
||
SCM predicate_result;
|
||
int stop;
|
||
|
||
if (bp_smob == NULL)
|
||
return EXT_LANG_BP_STOP_UNSET;
|
||
if (!gdbscm_is_procedure (bp_smob->stop))
|
||
return EXT_LANG_BP_STOP_UNSET;
|
||
|
||
stop = 1;
|
||
|
||
predicate_result
|
||
= gdbscm_safe_call_1 (bp_smob->stop, bp_smob->containing_scm, NULL);
|
||
|
||
if (gdbscm_is_exception (predicate_result))
|
||
; /* Exception already printed. */
|
||
/* If the "stop" function returns #f that means
|
||
the Scheme breakpoint wants GDB to continue. */
|
||
else if (gdbscm_is_false (predicate_result))
|
||
stop = 0;
|
||
|
||
return stop ? EXT_LANG_BP_STOP_YES : EXT_LANG_BP_STOP_NO;
|
||
}
|
||
|
||
/* Event callback functions. */
|
||
|
||
/* Callback that is used when a breakpoint is created.
|
||
For breakpoints created by Scheme, i.e., gdbscm_create_breakpoint_x, finish
|
||
object creation by connecting the Scheme wrapper to the gdb object.
|
||
We ignore breakpoints created from gdb or python here, we create the
|
||
Scheme wrapper for those when there's a need to, e.g.,
|
||
gdbscm_breakpoints. */
|
||
|
||
static void
|
||
bpscm_breakpoint_created (struct breakpoint *bp)
|
||
{
|
||
SCM bp_scm;
|
||
|
||
if (gdbscm_is_false (pending_breakpoint_scm))
|
||
return;
|
||
|
||
/* Verify our caller error checked the user's request. */
|
||
gdb_assert (bpscm_want_scm_wrapper_p (bp, 1));
|
||
|
||
bp_scm = pending_breakpoint_scm;
|
||
pending_breakpoint_scm = SCM_BOOL_F;
|
||
|
||
bpscm_attach_scm_to_breakpoint (bp, bp_scm);
|
||
}
|
||
|
||
/* Callback that is used when a breakpoint is deleted. This will
|
||
invalidate the corresponding Scheme object. */
|
||
|
||
static void
|
||
bpscm_breakpoint_deleted (struct breakpoint *b)
|
||
{
|
||
int num = b->number;
|
||
struct breakpoint *bp;
|
||
|
||
/* TODO: Why the lookup? We have B. */
|
||
|
||
bp = get_breakpoint (num);
|
||
if (bp)
|
||
{
|
||
breakpoint_smob *bp_smob = bp->scm_bp_object;
|
||
|
||
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);
|
||
}
|
||
}
|
||
}
|
||
|
||
/* Initialize the Scheme breakpoint code. */
|
||
|
||
static const scheme_integer_constant breakpoint_integer_constants[] =
|
||
{
|
||
{ "BP_NONE", bp_none },
|
||
{ "BP_BREAKPOINT", bp_breakpoint },
|
||
{ "BP_WATCHPOINT", bp_watchpoint },
|
||
{ "BP_HARDWARE_WATCHPOINT", bp_hardware_watchpoint },
|
||
{ "BP_READ_WATCHPOINT", bp_read_watchpoint },
|
||
{ "BP_ACCESS_WATCHPOINT", bp_access_watchpoint },
|
||
|
||
{ "WP_READ", hw_read },
|
||
{ "WP_WRITE", hw_write },
|
||
{ "WP_ACCESS", hw_access },
|
||
|
||
END_INTEGER_CONSTANTS
|
||
};
|
||
|
||
static const scheme_function breakpoint_functions[] =
|
||
{
|
||
{ "make-breakpoint", 1, 0, 1, gdbscm_make_breakpoint,
|
||
"\
|
||
Create a GDB breakpoint object.\n\
|
||
\n\
|
||
Arguments:\n\
|
||
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." },
|
||
|
||
{ "delete-breakpoint!", 1, 0, 0, gdbscm_delete_breakpoint_x,
|
||
"\
|
||
Delete the breakpoint from GDB." },
|
||
|
||
{ "breakpoints", 0, 0, 0, gdbscm_breakpoints,
|
||
"\
|
||
Return a list of all GDB breakpoints.\n\
|
||
\n\
|
||
Arguments: none" },
|
||
|
||
{ "breakpoint?", 1, 0, 0, gdbscm_breakpoint_p,
|
||
"\
|
||
Return #t if the object is a <gdb:breakpoint> object." },
|
||
|
||
{ "breakpoint-valid?", 1, 0, 0, gdbscm_breakpoint_valid_p,
|
||
"\
|
||
Return #t if the breakpoint has not been deleted from GDB." },
|
||
|
||
{ "breakpoint-number", 1, 0, 0, gdbscm_breakpoint_number,
|
||
"\
|
||
Return the breakpoint's number." },
|
||
|
||
{ "breakpoint-type", 1, 0, 0, gdbscm_breakpoint_type,
|
||
"\
|
||
Return the type of the breakpoint." },
|
||
|
||
{ "breakpoint-visible?", 1, 0, 0, gdbscm_breakpoint_visible,
|
||
"\
|
||
Return #t if the breakpoint is visible to the user." },
|
||
|
||
{ "breakpoint-location", 1, 0, 0, gdbscm_breakpoint_location,
|
||
"\
|
||
Return the location of the breakpoint as specified by the user." },
|
||
|
||
{ "breakpoint-expression", 1, 0, 0, gdbscm_breakpoint_expression,
|
||
"\
|
||
Return the expression of the breakpoint as specified by the user.\n\
|
||
Valid for watchpoints only, returns #f for non-watchpoints." },
|
||
|
||
{ "breakpoint-enabled?", 1, 0, 0, gdbscm_breakpoint_enabled_p,
|
||
"\
|
||
Return #t if the breakpoint is enabled." },
|
||
|
||
{ "set-breakpoint-enabled!", 2, 0, 0, gdbscm_set_breakpoint_enabled_x,
|
||
"\
|
||
Set the breakpoint's enabled state.\n\
|
||
\n\
|
||
Arguments: <gdb:breakpoint> boolean" },
|
||
|
||
{ "breakpoint-silent?", 1, 0, 0, gdbscm_breakpoint_silent_p,
|
||
"\
|
||
Return #t if the breakpoint is silent." },
|
||
|
||
{ "set-breakpoint-silent!", 2, 0, 0, gdbscm_set_breakpoint_silent_x,
|
||
"\
|
||
Set the breakpoint's silent state.\n\
|
||
\n\
|
||
Arguments: <gdb:breakpoint> boolean" },
|
||
|
||
{ "breakpoint-ignore-count", 1, 0, 0, gdbscm_breakpoint_ignore_count,
|
||
"\
|
||
Return the breakpoint's \"ignore\" count." },
|
||
|
||
{ "set-breakpoint-ignore-count!", 2, 0, 0,
|
||
gdbscm_set_breakpoint_ignore_count_x,
|
||
"\
|
||
Set the breakpoint's \"ignore\" count.\n\
|
||
\n\
|
||
Arguments: <gdb:breakpoint> count" },
|
||
|
||
{ "breakpoint-hit-count", 1, 0, 0, gdbscm_breakpoint_hit_count,
|
||
"\
|
||
Return the breakpoint's \"hit\" count." },
|
||
|
||
{ "set-breakpoint-hit-count!", 2, 0, 0, gdbscm_set_breakpoint_hit_count_x,
|
||
"\
|
||
Set the breakpoint's \"hit\" count. The value must be zero.\n\
|
||
\n\
|
||
Arguments: <gdb:breakpoint> 0" },
|
||
|
||
{ "breakpoint-thread", 1, 0, 0, gdbscm_breakpoint_thread,
|
||
"\
|
||
Return the breakpoint's thread id or #f if there isn't one." },
|
||
|
||
{ "set-breakpoint-thread!", 2, 0, 0, gdbscm_set_breakpoint_thread_x,
|
||
"\
|
||
Set the thread id for this breakpoint.\n\
|
||
\n\
|
||
Arguments: <gdb:breakpoint> thread-id" },
|
||
|
||
{ "breakpoint-task", 1, 0, 0, gdbscm_breakpoint_task,
|
||
"\
|
||
Return the breakpoint's Ada task-id or #f if there isn't one." },
|
||
|
||
{ "set-breakpoint-task!", 2, 0, 0, gdbscm_set_breakpoint_task_x,
|
||
"\
|
||
Set the breakpoint's Ada task-id.\n\
|
||
\n\
|
||
Arguments: <gdb:breakpoint> task-id" },
|
||
|
||
{ "breakpoint-condition", 1, 0, 0, gdbscm_breakpoint_condition,
|
||
"\
|
||
Return the breakpoint's condition as specified by the user.\n\
|
||
Return #f if there isn't one." },
|
||
|
||
{ "set-breakpoint-condition!", 2, 0, 0, gdbscm_set_breakpoint_condition_x,
|
||
"\
|
||
Set the breakpoint's condition.\n\
|
||
\n\
|
||
Arguments: <gdb:breakpoint> condition\n\
|
||
condition: a string" },
|
||
|
||
{ "breakpoint-stop", 1, 0, 0, gdbscm_breakpoint_stop,
|
||
"\
|
||
Return the breakpoint's stop predicate.\n\
|
||
Return #f if there isn't one." },
|
||
|
||
{ "set-breakpoint-stop!", 2, 0, 0, gdbscm_set_breakpoint_stop_x,
|
||
"\
|
||
Set the breakpoint's stop predicate.\n\
|
||
\n\
|
||
Arguments: <gdb:breakpoint> procedure\n\
|
||
procedure: A procedure of one argument, the breakpoint.\n\
|
||
Its result is true if program execution should stop." },
|
||
|
||
{ "breakpoint-commands", 1, 0, 0, gdbscm_breakpoint_commands,
|
||
"\
|
||
Return the breakpoint's commands." },
|
||
|
||
END_FUNCTIONS
|
||
};
|
||
|
||
void
|
||
gdbscm_initialize_breakpoints (void)
|
||
{
|
||
breakpoint_smob_tag
|
||
= gdbscm_make_smob_type (breakpoint_smob_name, sizeof (breakpoint_smob));
|
||
scm_set_smob_free (breakpoint_smob_tag, bpscm_free_breakpoint_smob);
|
||
scm_set_smob_print (breakpoint_smob_tag, bpscm_print_breakpoint_smob);
|
||
|
||
observer_attach_breakpoint_created (bpscm_breakpoint_created);
|
||
observer_attach_breakpoint_deleted (bpscm_breakpoint_deleted);
|
||
|
||
gdbscm_define_integer_constants (breakpoint_integer_constants, 1);
|
||
gdbscm_define_functions (breakpoint_functions, 1);
|
||
|
||
type_keyword = scm_from_latin1_keyword ("type");
|
||
wp_class_keyword = scm_from_latin1_keyword ("wp-class");
|
||
internal_keyword = scm_from_latin1_keyword ("internal");
|
||
}
|