gdb: remove iterate_over_breakpoints function
[deliverable/binutils-gdb.git] / gdb / guile / scm-breakpoint.c
CommitLineData
ed3ef339
DE
1/* Scheme interface to breakpoints.
2
3666a048 3 Copyright (C) 2008-2021 Free Software Foundation, Inc.
ed3ef339
DE
4
5 This file is part of GDB.
6
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
19
20/* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
22
23#include "defs.h"
24#include "value.h"
ed3ef339
DE
25#include "breakpoint.h"
26#include "gdbcmd.h"
27#include "gdbthread.h"
76727919 28#include "observable.h"
ed3ef339
DE
29#include "cli/cli-script.h"
30#include "ada-lang.h"
31#include "arch-utils.h"
32#include "language.h"
33#include "guile-internal.h"
f00aae0f 34#include "location.h"
ed3ef339
DE
35
36/* The <gdb:breakpoint> smob.
16f691fb
DE
37 N.B.: The name of this struct is known to breakpoint.h.
38
39 Note: Breakpoints are added to gdb using a two step process:
40 1) Call make-breakpoint to create a <gdb:breakpoint> object.
41 2) Call register-breakpoint! to add the breakpoint to gdb.
42 It is done this way so that the constructor, make-breakpoint, doesn't have
43 any side-effects. This means that the smob needs to store everything
44 that was passed to make-breakpoint. */
ed3ef339
DE
45
46typedef struct gdbscm_breakpoint_object
47{
48 /* This always appears first. */
49 gdb_smob base;
50
16f691fb
DE
51 /* Non-zero if this breakpoint was created with make-breakpoint. */
52 int is_scheme_bkpt;
53
54 /* For breakpoints created with make-breakpoint, these are the parameters
55 that were passed to make-breakpoint. These values are not used except
56 to register the breakpoint with GDB. */
57 struct
58 {
59 /* The string representation of the breakpoint.
60 Space for this lives in GC space. */
61 char *location;
62
63 /* The kind of breakpoint.
64 At the moment this can only be one of bp_breakpoint, bp_watchpoint. */
65 enum bptype type;
66
67 /* If a watchpoint, the kind of watchpoint. */
68 enum target_hw_bp_type access_type;
69
70 /* Non-zero if the breakpoint is an "internal" breakpoint. */
71 int is_internal;
72 } spec;
73
ed3ef339 74 /* The breakpoint number according to gdb.
16f691fb
DE
75 For breakpoints created from Scheme, this has the value -1 until the
76 breakpoint is registered with gdb.
ed3ef339
DE
77 This is recorded here because BP will be NULL when deleted. */
78 int number;
79
16f691fb
DE
80 /* The gdb breakpoint object, or NULL if the breakpoint has not been
81 registered yet, or has been deleted. */
ed3ef339
DE
82 struct breakpoint *bp;
83
84 /* Backlink to our containing <gdb:breakpoint> smob.
85 This is needed when we are deleted, we need to unprotect the object
86 from GC. */
87 SCM containing_scm;
88
89 /* A stop condition or #f. */
90 SCM stop;
91} breakpoint_smob;
92
93static const char breakpoint_smob_name[] = "gdb:breakpoint";
94
95/* The tag Guile knows the breakpoint smob by. */
96static scm_t_bits breakpoint_smob_tag;
97
98/* Variables used to pass information between the breakpoint_smob
99 constructor and the breakpoint-created hook function. */
100static SCM pending_breakpoint_scm = SCM_BOOL_F;
101
102/* Keywords used by create-breakpoint!. */
103static SCM type_keyword;
104static SCM wp_class_keyword;
105static SCM internal_keyword;
106\f
107/* Administrivia for breakpoint smobs. */
108
ed3ef339
DE
109/* The smob "free" function for <gdb:breakpoint>. */
110
111static size_t
112bpscm_free_breakpoint_smob (SCM self)
113{
114 breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
115
116 if (bp_smob->bp)
117 bp_smob->bp->scm_bp_object = NULL;
118
119 /* Not necessary, done to catch bugs. */
120 bp_smob->bp = NULL;
121 bp_smob->containing_scm = SCM_UNDEFINED;
122 bp_smob->stop = SCM_UNDEFINED;
123
124 return 0;
125}
126
127/* Return the name of TYPE.
128 This doesn't handle all types, just the ones we export. */
129
130static const char *
131bpscm_type_to_string (enum bptype type)
132{
133 switch (type)
134 {
135 case bp_none: return "BP_NONE";
136 case bp_breakpoint: return "BP_BREAKPOINT";
137 case bp_watchpoint: return "BP_WATCHPOINT";
138 case bp_hardware_watchpoint: return "BP_HARDWARE_WATCHPOINT";
139 case bp_read_watchpoint: return "BP_READ_WATCHPOINT";
140 case bp_access_watchpoint: return "BP_ACCESS_WATCHPOINT";
141 default: return "internal/other";
142 }
143}
144
145/* Return the name of ENABLE_STATE. */
146
147static const char *
148bpscm_enable_state_to_string (enum enable_state enable_state)
149{
150 switch (enable_state)
151 {
152 case bp_disabled: return "disabled";
153 case bp_enabled: return "enabled";
154 case bp_call_disabled: return "call_disabled";
ed3ef339
DE
155 default: return "unknown";
156 }
157}
158
159/* The smob "print" function for <gdb:breakpoint>. */
160
161static int
162bpscm_print_breakpoint_smob (SCM self, SCM port, scm_print_state *pstate)
163{
164 breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
165 struct breakpoint *b = bp_smob->bp;
166
167 gdbscm_printf (port, "#<%s", breakpoint_smob_name);
168
169 /* Only print what we export to the user.
170 The rest are possibly internal implementation details. */
171
172 gdbscm_printf (port, " #%d", bp_smob->number);
173
174 /* Careful, the breakpoint may be invalid. */
175 if (b != NULL)
176 {
177 gdbscm_printf (port, " %s %s %s",
178 bpscm_type_to_string (b->type),
179 bpscm_enable_state_to_string (b->enable_state),
180 b->silent ? "silent" : "noisy");
181
182 gdbscm_printf (port, " hit:%d", b->hit_count);
183 gdbscm_printf (port, " ignore:%d", b->ignore_count);
184
0618ecf6
AB
185 if (b->location != nullptr)
186 {
187 const char *str = event_location_to_string (b->location.get ());
188 if (str != nullptr)
189 gdbscm_printf (port, " @%s", str);
190 }
ed3ef339
DE
191 }
192
193 scm_puts (">", port);
194
195 scm_remember_upto_here_1 (self);
196
197 /* Non-zero means success. */
198 return 1;
199}
200
201/* Low level routine to create a <gdb:breakpoint> object. */
202
203static SCM
204bpscm_make_breakpoint_smob (void)
205{
206 breakpoint_smob *bp_smob = (breakpoint_smob *)
207 scm_gc_malloc (sizeof (breakpoint_smob), breakpoint_smob_name);
208 SCM bp_scm;
209
16f691fb 210 memset (bp_smob, 0, sizeof (*bp_smob));
ed3ef339 211 bp_smob->number = -1;
ed3ef339
DE
212 bp_smob->stop = SCM_BOOL_F;
213 bp_scm = scm_new_smob (breakpoint_smob_tag, (scm_t_bits) bp_smob);
214 bp_smob->containing_scm = bp_scm;
215 gdbscm_init_gsmob (&bp_smob->base);
216
217 return bp_scm;
218}
219
220/* Return non-zero if we want a Scheme wrapper for breakpoint B.
221 If FROM_SCHEME is non-zero,this is called for a breakpoint created
222 by the user from Scheme. Otherwise it is zero. */
223
224static int
225bpscm_want_scm_wrapper_p (struct breakpoint *bp, int from_scheme)
226{
227 /* Don't create <gdb:breakpoint> objects for internal GDB breakpoints. */
228 if (bp->number < 0 && !from_scheme)
229 return 0;
230
231 /* The others are not supported. */
232 if (bp->type != bp_breakpoint
233 && bp->type != bp_watchpoint
234 && bp->type != bp_hardware_watchpoint
235 && bp->type != bp_read_watchpoint
236 && bp->type != bp_access_watchpoint)
237 return 0;
238
239 return 1;
240}
241
242/* Install the Scheme side of a breakpoint, CONTAINING_SCM, in
243 the gdb side BP. */
244
245static void
246bpscm_attach_scm_to_breakpoint (struct breakpoint *bp, SCM containing_scm)
247{
248 breakpoint_smob *bp_smob;
249
250 bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (containing_scm);
251 bp_smob->number = bp->number;
252 bp_smob->bp = bp;
253 bp_smob->containing_scm = containing_scm;
254 bp_smob->bp->scm_bp_object = bp_smob;
255
256 /* The owner of this breakpoint is not in GC-controlled memory, so we need
257 to protect it from GC until the breakpoint is deleted. */
258 scm_gc_protect_object (containing_scm);
259}
260
261/* Return non-zero if SCM is a breakpoint smob. */
262
263static int
264bpscm_is_breakpoint (SCM scm)
265{
266 return SCM_SMOB_PREDICATE (breakpoint_smob_tag, scm);
267}
268
269/* (breakpoint? scm) -> boolean */
270
271static SCM
272gdbscm_breakpoint_p (SCM scm)
273{
274 return scm_from_bool (bpscm_is_breakpoint (scm));
275}
276
277/* Returns the <gdb:breakpoint> object in SELF.
278 Throws an exception if SELF is not a <gdb:breakpoint> object. */
279
280static SCM
281bpscm_get_breakpoint_arg_unsafe (SCM self, int arg_pos, const char *func_name)
282{
283 SCM_ASSERT_TYPE (bpscm_is_breakpoint (self), self, arg_pos, func_name,
284 breakpoint_smob_name);
285
286 return self;
287}
288
289/* Returns a pointer to the breakpoint smob of SELF.
290 Throws an exception if SELF is not a <gdb:breakpoint> object. */
291
292static breakpoint_smob *
293bpscm_get_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
294 const char *func_name)
295{
296 SCM bp_scm = bpscm_get_breakpoint_arg_unsafe (self, arg_pos, func_name);
297 breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (bp_scm);
298
299 return bp_smob;
300}
301
302/* Return non-zero if breakpoint BP_SMOB is valid. */
303
304static int
305bpscm_is_valid (breakpoint_smob *bp_smob)
306{
307 return bp_smob->bp != NULL;
308}
309
310/* Returns the breakpoint smob in SELF, verifying it's valid.
311 Throws an exception if SELF is not a <gdb:breakpoint> object,
312 or is invalid. */
313
314static breakpoint_smob *
315bpscm_get_valid_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
316 const char *func_name)
317{
318 breakpoint_smob *bp_smob
319 = bpscm_get_breakpoint_smob_arg_unsafe (self, arg_pos, func_name);
320
321 if (!bpscm_is_valid (bp_smob))
322 {
323 gdbscm_invalid_object_error (func_name, arg_pos, self,
324 _("<gdb:breakpoint>"));
325 }
326
327 return bp_smob;
328}
329\f
330/* Breakpoint methods. */
331
16f691fb
DE
332/* (make-breakpoint string [#:type integer] [#:wp-class integer]
333 [#:internal boolean) -> <gdb:breakpoint>
334
335 The result is the <gdb:breakpoint> Scheme object.
336 The breakpoint is not available to be used yet, however.
337 It must still be added to gdb with register-breakpoint!. */
ed3ef339
DE
338
339static SCM
16f691fb 340gdbscm_make_breakpoint (SCM location_scm, SCM rest)
ed3ef339
DE
341{
342 const SCM keywords[] = {
343 type_keyword, wp_class_keyword, internal_keyword, SCM_BOOL_F
344 };
16f691fb
DE
345 char *s;
346 char *location;
ed3ef339 347 int type_arg_pos = -1, access_type_arg_pos = -1, internal_arg_pos = -1;
f486487f
SM
348 enum bptype type = bp_breakpoint;
349 enum target_hw_bp_type access_type = hw_write;
ed3ef339
DE
350 int internal = 0;
351 SCM result;
16f691fb 352 breakpoint_smob *bp_smob;
ed3ef339
DE
353
354 gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iit",
16f691fb 355 location_scm, &location, rest,
ed3ef339
DE
356 &type_arg_pos, &type,
357 &access_type_arg_pos, &access_type,
358 &internal_arg_pos, &internal);
359
360 result = bpscm_make_breakpoint_smob ();
16f691fb
DE
361 bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (result);
362
363 s = location;
364 location = gdbscm_gc_xstrdup (s);
365 xfree (s);
366
367 switch (type)
368 {
369 case bp_breakpoint:
370 if (access_type_arg_pos > 0)
371 {
372 gdbscm_misc_error (FUNC_NAME, access_type_arg_pos,
373 scm_from_int (access_type),
374 _("access type with breakpoint is not allowed"));
375 }
376 break;
377 case bp_watchpoint:
378 switch (access_type)
379 {
380 case hw_write:
381 case hw_access:
382 case hw_read:
383 break;
384 default:
385 gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
386 scm_from_int (access_type),
387 _("invalid watchpoint class"));
388 }
389 break;
390 default:
391 gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
392 scm_from_int (type),
393 _("invalid breakpoint type"));
394 }
395
396 bp_smob->is_scheme_bkpt = 1;
397 bp_smob->spec.location = location;
398 bp_smob->spec.type = type;
399 bp_smob->spec.access_type = access_type;
400 bp_smob->spec.is_internal = internal;
401
402 return result;
403}
404
405/* (register-breakpoint! <gdb:breakpoint>) -> unspecified
406
407 It is an error to register a breakpoint created outside of Guile,
408 or an already-registered breakpoint. */
409
410static SCM
411gdbscm_register_breakpoint_x (SCM self)
412{
413 breakpoint_smob *bp_smob
414 = bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
680d7fd5 415 gdbscm_gdb_exception except {};
f2fc3015 416 const char *location, *copy;
16f691fb
DE
417
418 /* We only support registering breakpoints created with make-breakpoint. */
419 if (!bp_smob->is_scheme_bkpt)
420 scm_misc_error (FUNC_NAME, _("not a Scheme breakpoint"), SCM_EOL);
421
422 if (bpscm_is_valid (bp_smob))
423 scm_misc_error (FUNC_NAME, _("breakpoint is already registered"), SCM_EOL);
424
425 pending_breakpoint_scm = self;
f00aae0f 426 location = bp_smob->spec.location;
a96e36da 427 copy = skip_spaces (location);
a20714ff
PA
428 event_location_up eloc
429 = string_to_event_location_basic (&copy,
430 current_language,
431 symbol_name_match_type::WILD);
ed3ef339 432
a70b8144 433 try
ed3ef339 434 {
16f691fb 435 int internal = bp_smob->spec.is_internal;
ed3ef339 436
16f691fb 437 switch (bp_smob->spec.type)
ed3ef339
DE
438 {
439 case bp_breakpoint:
440 {
bac7c5cf
GB
441 const breakpoint_ops *ops =
442 breakpoint_ops_for_event_location (eloc.get (), false);
ed3ef339 443 create_breakpoint (get_current_arch (),
10a636cc 444 eloc.get (), NULL, -1, NULL, false,
ed3ef339
DE
445 0,
446 0, bp_breakpoint,
447 0,
448 AUTO_BOOLEAN_TRUE,
bac7c5cf 449 ops,
ed3ef339
DE
450 0, 1, internal, 0);
451 break;
452 }
453 case bp_watchpoint:
454 {
16f691fb
DE
455 enum target_hw_bp_type access_type = bp_smob->spec.access_type;
456
ed3ef339 457 if (access_type == hw_write)
16f691fb 458 watch_command_wrapper (location, 0, internal);
ed3ef339 459 else if (access_type == hw_access)
16f691fb 460 awatch_command_wrapper (location, 0, internal);
ed3ef339 461 else if (access_type == hw_read)
16f691fb 462 rwatch_command_wrapper (location, 0, internal);
ed3ef339 463 else
16f691fb 464 gdb_assert_not_reached ("invalid access type");
ed3ef339
DE
465 break;
466 }
467 default:
16f691fb 468 gdb_assert_not_reached ("invalid breakpoint type");
ed3ef339 469 }
ed3ef339 470 }
230d2906 471 catch (const gdb_exception &ex)
492d29ea 472 {
680d7fd5 473 except = unpack (ex);
492d29ea 474 }
492d29ea 475
ed3ef339
DE
476 /* Ensure this gets reset, even if there's an error. */
477 pending_breakpoint_scm = SCM_BOOL_F;
478 GDBSCM_HANDLE_GDB_EXCEPTION (except);
479
16f691fb 480 return SCM_UNSPECIFIED;
ed3ef339
DE
481}
482
16f691fb
DE
483/* (delete-breakpoint! <gdb:breakpoint>) -> unspecified
484 Scheme function which deletes (removes) the underlying GDB breakpoint
485 from GDB's list of breakpoints. This triggers the breakpoint_deleted
486 observer which will call gdbscm_breakpoint_deleted; that function cleans
487 up the Scheme bits. */
ed3ef339
DE
488
489static SCM
16f691fb 490gdbscm_delete_breakpoint_x (SCM self)
ed3ef339
DE
491{
492 breakpoint_smob *bp_smob
493 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
ed3ef339 494
680d7fd5 495 gdbscm_gdb_exception exc {};
a70b8144 496 try
ed3ef339
DE
497 {
498 delete_breakpoint (bp_smob->bp);
499 }
230d2906 500 catch (const gdb_exception &except)
492d29ea 501 {
680d7fd5 502 exc = unpack (except);
492d29ea 503 }
ed3ef339 504
680d7fd5 505 GDBSCM_HANDLE_GDB_EXCEPTION (exc);
ed3ef339
DE
506 return SCM_UNSPECIFIED;
507}
508
509/* iterate_over_breakpoints function for gdbscm_breakpoints. */
510
240edef6 511static void
95da600f 512bpscm_build_bp_list (struct breakpoint *bp, SCM *list)
ed3ef339 513{
ed3ef339
DE
514 breakpoint_smob *bp_smob = bp->scm_bp_object;
515
516 /* Lazily create wrappers for breakpoints created outside Scheme. */
517
518 if (bp_smob == NULL)
519 {
520 if (bpscm_want_scm_wrapper_p (bp, 0))
521 {
522 SCM bp_scm;
523
524 bp_scm = bpscm_make_breakpoint_smob ();
525 bpscm_attach_scm_to_breakpoint (bp, bp_scm);
526 /* Refetch it. */
527 bp_smob = bp->scm_bp_object;
528 }
529 }
530
531 /* Not all breakpoints will have a companion Scheme object.
532 Only breakpoints that trigger the created_breakpoint observer call,
533 and satisfy certain conditions (see bpscm_want_scm_wrapper_p),
534 get a companion object (this includes Scheme-created breakpoints). */
535
536 if (bp_smob != NULL)
537 *list = scm_cons (bp_smob->containing_scm, *list);
ed3ef339
DE
538}
539
540/* (breakpoints) -> list
541 Return a list of all breakpoints. */
542
543static SCM
544gdbscm_breakpoints (void)
545{
546 SCM list = SCM_EOL;
547
240edef6
SM
548 for (breakpoint *bp : all_breakpoints ())
549 bpscm_build_bp_list (bp, &list);
ed3ef339
DE
550
551 return scm_reverse_x (list, SCM_EOL);
552}
553
554/* (breakpoint-valid? <gdb:breakpoint>) -> boolean
555 Returns #t if SELF is still valid. */
556
557static SCM
558gdbscm_breakpoint_valid_p (SCM self)
559{
560 breakpoint_smob *bp_smob
561 = bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
562
563 return scm_from_bool (bpscm_is_valid (bp_smob));
564}
565
566/* (breakpoint-enabled? <gdb:breakpoint>) -> boolean */
567
568static SCM
569gdbscm_breakpoint_enabled_p (SCM self)
570{
571 breakpoint_smob *bp_smob
572 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
573
574 return scm_from_bool (bp_smob->bp->enable_state == bp_enabled);
575}
576
577/* (set-breakpoint-enabled? <gdb:breakpoint> boolean) -> unspecified */
578
579static SCM
580gdbscm_set_breakpoint_enabled_x (SCM self, SCM newvalue)
581{
582 breakpoint_smob *bp_smob
583 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
ed3ef339
DE
584
585 SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
586 _("boolean"));
587
680d7fd5 588 gdbscm_gdb_exception exc {};
a70b8144 589 try
ed3ef339
DE
590 {
591 if (gdbscm_is_true (newvalue))
592 enable_breakpoint (bp_smob->bp);
593 else
594 disable_breakpoint (bp_smob->bp);
595 }
230d2906 596 catch (const gdb_exception &except)
492d29ea 597 {
680d7fd5 598 exc = unpack (except);
492d29ea 599 }
ed3ef339 600
680d7fd5 601 GDBSCM_HANDLE_GDB_EXCEPTION (exc);
ed3ef339
DE
602 return SCM_UNSPECIFIED;
603}
604
605/* (breakpoint-silent? <gdb:breakpoint>) -> boolean */
606
607static SCM
608gdbscm_breakpoint_silent_p (SCM self)
609{
610 breakpoint_smob *bp_smob
611 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
612
613 return scm_from_bool (bp_smob->bp->silent);
614}
615
616/* (set-breakpoint-silent?! <gdb:breakpoint> boolean) -> unspecified */
617
618static SCM
619gdbscm_set_breakpoint_silent_x (SCM self, SCM newvalue)
620{
621 breakpoint_smob *bp_smob
622 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
ed3ef339
DE
623
624 SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
625 _("boolean"));
626
680d7fd5 627 gdbscm_gdb_exception exc {};
a70b8144 628 try
ed3ef339
DE
629 {
630 breakpoint_set_silent (bp_smob->bp, gdbscm_is_true (newvalue));
631 }
230d2906 632 catch (const gdb_exception &except)
492d29ea 633 {
680d7fd5 634 exc = unpack (except);
492d29ea 635 }
ed3ef339 636
680d7fd5 637 GDBSCM_HANDLE_GDB_EXCEPTION (exc);
ed3ef339
DE
638 return SCM_UNSPECIFIED;
639}
640
641/* (breakpoint-ignore-count <gdb:breakpoint>) -> integer */
642
643static SCM
644gdbscm_breakpoint_ignore_count (SCM self)
645{
646 breakpoint_smob *bp_smob
647 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
648
649 return scm_from_long (bp_smob->bp->ignore_count);
650}
651
652/* (set-breakpoint-ignore-count! <gdb:breakpoint> integer)
653 -> unspecified */
654
655static SCM
656gdbscm_set_breakpoint_ignore_count_x (SCM self, SCM newvalue)
657{
658 breakpoint_smob *bp_smob
659 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
660 long value;
ed3ef339
DE
661
662 SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
663 newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
664
665 value = scm_to_long (newvalue);
666 if (value < 0)
667 value = 0;
668
680d7fd5 669 gdbscm_gdb_exception exc {};
a70b8144 670 try
ed3ef339
DE
671 {
672 set_ignore_count (bp_smob->number, (int) value, 0);
673 }
230d2906 674 catch (const gdb_exception &except)
492d29ea 675 {
680d7fd5 676 exc = unpack (except);
492d29ea 677 }
ed3ef339 678
680d7fd5 679 GDBSCM_HANDLE_GDB_EXCEPTION (exc);
ed3ef339
DE
680 return SCM_UNSPECIFIED;
681}
682
683/* (breakpoint-hit-count <gdb:breakpoint>) -> integer */
684
685static SCM
686gdbscm_breakpoint_hit_count (SCM self)
687{
688 breakpoint_smob *bp_smob
689 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
690
691 return scm_from_long (bp_smob->bp->hit_count);
692}
693
694/* (set-breakpoint-hit-count! <gdb:breakpoint> integer) -> unspecified */
695
696static SCM
697gdbscm_set_breakpoint_hit_count_x (SCM self, SCM newvalue)
698{
699 breakpoint_smob *bp_smob
700 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
701 long value;
702
703 SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
704 newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
705
706 value = scm_to_long (newvalue);
707 if (value < 0)
708 value = 0;
709
710 if (value != 0)
711 {
712 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
713 _("hit-count must be zero"));
714 }
715
716 bp_smob->bp->hit_count = 0;
717
718 return SCM_UNSPECIFIED;
719}
720
721/* (breakpoint-thread <gdb:breakpoint>) -> integer */
722
723static SCM
724gdbscm_breakpoint_thread (SCM self)
725{
726 breakpoint_smob *bp_smob
727 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
728
729 if (bp_smob->bp->thread == -1)
730 return SCM_BOOL_F;
731
732 return scm_from_long (bp_smob->bp->thread);
733}
734
735/* (set-breakpoint-thread! <gdb:breakpoint> integer) -> unspecified */
736
737static SCM
738gdbscm_set_breakpoint_thread_x (SCM self, SCM newvalue)
739{
740 breakpoint_smob *bp_smob
741 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
742 long id;
743
744 if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
745 {
746 id = scm_to_long (newvalue);
5d5658a1 747 if (!valid_global_thread_id (id))
ed3ef339
DE
748 {
749 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
750 _("invalid thread id"));
751 }
752 }
753 else if (gdbscm_is_false (newvalue))
754 id = -1;
755 else
756 SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
757
758 breakpoint_set_thread (bp_smob->bp, id);
759
760 return SCM_UNSPECIFIED;
761}
762
763/* (breakpoint-task <gdb:breakpoint>) -> integer */
764
765static SCM
766gdbscm_breakpoint_task (SCM self)
767{
768 breakpoint_smob *bp_smob
769 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
770
771 if (bp_smob->bp->task == 0)
772 return SCM_BOOL_F;
773
774 return scm_from_long (bp_smob->bp->task);
775}
776
777/* (set-breakpoint-task! <gdb:breakpoint> integer) -> unspecified */
778
779static SCM
780gdbscm_set_breakpoint_task_x (SCM self, SCM newvalue)
781{
782 breakpoint_smob *bp_smob
783 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
784 long id;
785 int valid_id = 0;
ed3ef339
DE
786
787 if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
788 {
789 id = scm_to_long (newvalue);
790
680d7fd5 791 gdbscm_gdb_exception exc {};
a70b8144 792 try
ed3ef339
DE
793 {
794 valid_id = valid_task_id (id);
795 }
230d2906 796 catch (const gdb_exception &except)
492d29ea 797 {
680d7fd5 798 exc = unpack (except);
492d29ea 799 }
ed3ef339 800
680d7fd5 801 GDBSCM_HANDLE_GDB_EXCEPTION (exc);
ed3ef339
DE
802 if (! valid_id)
803 {
804 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
805 _("invalid task id"));
806 }
807 }
808 else if (gdbscm_is_false (newvalue))
809 id = 0;
810 else
811 SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
812
680d7fd5 813 gdbscm_gdb_exception exc {};
a70b8144 814 try
ed3ef339
DE
815 {
816 breakpoint_set_task (bp_smob->bp, id);
817 }
230d2906 818 catch (const gdb_exception &except)
492d29ea 819 {
680d7fd5 820 exc = unpack (except);
492d29ea 821 }
ed3ef339 822
680d7fd5 823 GDBSCM_HANDLE_GDB_EXCEPTION (exc);
ed3ef339
DE
824 return SCM_UNSPECIFIED;
825}
826
827/* (breakpoint-location <gdb:breakpoint>) -> string */
828
829static SCM
830gdbscm_breakpoint_location (SCM self)
831{
832 breakpoint_smob *bp_smob
833 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
f00aae0f 834 const char *str;
ed3ef339
DE
835
836 if (bp_smob->bp->type != bp_breakpoint)
837 return SCM_BOOL_F;
838
d28cd78a 839 str = event_location_to_string (bp_smob->bp->location.get ());
ed3ef339
DE
840 if (! str)
841 str = "";
842
843 return gdbscm_scm_from_c_string (str);
844}
845
846/* (breakpoint-expression <gdb:breakpoint>) -> string
847 This is only valid for watchpoints.
848 Returns #f for non-watchpoints. */
849
850static SCM
851gdbscm_breakpoint_expression (SCM self)
852{
853 breakpoint_smob *bp_smob
854 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
ed3ef339
DE
855 struct watchpoint *wp;
856
857 if (!is_watchpoint (bp_smob->bp))
858 return SCM_BOOL_F;
859
860 wp = (struct watchpoint *) bp_smob->bp;
861
a121b7c1 862 const char *str = wp->exp_string;
ed3ef339
DE
863 if (! str)
864 str = "";
865
866 return gdbscm_scm_from_c_string (str);
867}
868
869/* (breakpoint-condition <gdb:breakpoint>) -> string */
870
871static SCM
872gdbscm_breakpoint_condition (SCM self)
873{
874 breakpoint_smob *bp_smob
875 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
876 char *str;
877
878 str = bp_smob->bp->cond_string;
879 if (! str)
880 return SCM_BOOL_F;
881
882 return gdbscm_scm_from_c_string (str);
883}
884
885/* (set-breakpoint-condition! <gdb:breakpoint> string|#f)
886 -> unspecified */
887
888static SCM
889gdbscm_set_breakpoint_condition_x (SCM self, SCM newvalue)
890{
891 breakpoint_smob *bp_smob
892 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
ed3ef339
DE
893
894 SCM_ASSERT_TYPE (scm_is_string (newvalue) || gdbscm_is_false (newvalue),
895 newvalue, SCM_ARG2, FUNC_NAME,
896 _("string or #f"));
897
4c693332 898 return gdbscm_wrap ([=]
492d29ea 899 {
4c693332
PA
900 gdb::unique_xmalloc_ptr<char> exp
901 = (gdbscm_is_false (newvalue)
902 ? nullptr
903 : gdbscm_scm_to_c_string (newvalue));
492d29ea 904
733d554a 905 set_breakpoint_condition (bp_smob->bp, exp ? exp.get () : "", 0, false);
ed3ef339 906
4c693332
PA
907 return SCM_UNSPECIFIED;
908 });
ed3ef339
DE
909}
910
911/* (breakpoint-stop <gdb:breakpoint>) -> procedure or #f */
912
913static SCM
914gdbscm_breakpoint_stop (SCM self)
915{
916 breakpoint_smob *bp_smob
917 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
918
919 return bp_smob->stop;
920}
921
922/* (set-breakpoint-stop! <gdb:breakpoint> procedure|#f)
923 -> unspecified */
924
925static SCM
926gdbscm_set_breakpoint_stop_x (SCM self, SCM newvalue)
927{
928 breakpoint_smob *bp_smob
929 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
930 const struct extension_language_defn *extlang = NULL;
931
932 SCM_ASSERT_TYPE (gdbscm_is_procedure (newvalue)
933 || gdbscm_is_false (newvalue),
934 newvalue, SCM_ARG2, FUNC_NAME,
935 _("procedure or #f"));
936
937 if (bp_smob->bp->cond_string != NULL)
938 extlang = get_ext_lang_defn (EXT_LANG_GDB);
939 if (extlang == NULL)
940 extlang = get_breakpoint_cond_ext_lang (bp_smob->bp, EXT_LANG_GUILE);
941 if (extlang != NULL)
942 {
943 char *error_text
944 = xstrprintf (_("Only one stop condition allowed. There is"
945 " currently a %s stop condition defined for"
946 " this breakpoint."),
947 ext_lang_capitalized_name (extlang));
948
c6486df5 949 scm_dynwind_begin ((scm_t_dynwind_flags) 0);
ed3ef339
DE
950 gdbscm_dynwind_xfree (error_text);
951 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, error_text);
952 /* The following line, while unnecessary, is present for completeness
953 sake. */
954 scm_dynwind_end ();
955 }
956
957 bp_smob->stop = newvalue;
958
959 return SCM_UNSPECIFIED;
960}
961
962/* (breakpoint-commands <gdb:breakpoint>) -> string */
963
964static SCM
965gdbscm_breakpoint_commands (SCM self)
966{
967 breakpoint_smob *bp_smob
968 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
969 struct breakpoint *bp;
ed3ef339 970 SCM result;
ed3ef339
DE
971
972 bp = bp_smob->bp;
973
974 if (bp->commands == NULL)
975 return SCM_BOOL_F;
976
d7e74731 977 string_file buf;
ed3ef339 978
d7e74731 979 current_uiout->redirect (&buf);
680d7fd5 980 gdbscm_gdb_exception exc {};
a70b8144 981 try
ed3ef339
DE
982 {
983 print_command_lines (current_uiout, breakpoint_commands (bp), 0);
984 }
230d2906 985 catch (const gdb_exception &except)
ed3ef339 986 {
680d7fd5 987 exc = unpack (except);
ed3ef339
DE
988 }
989
73dcd72d 990 current_uiout->redirect (NULL);
680d7fd5 991 GDBSCM_HANDLE_GDB_EXCEPTION (exc);
d7e74731 992 result = gdbscm_scm_from_c_string (buf.c_str ());
ed3ef339 993
ed3ef339
DE
994 return result;
995}
996
997/* (breakpoint-type <gdb:breakpoint>) -> integer */
998
999static SCM
1000gdbscm_breakpoint_type (SCM self)
1001{
1002 breakpoint_smob *bp_smob
1003 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1004
1005 return scm_from_long (bp_smob->bp->type);
1006}
1007
1008/* (breakpoint-visible? <gdb:breakpoint>) -> boolean */
1009
1010static SCM
1011gdbscm_breakpoint_visible (SCM self)
1012{
1013 breakpoint_smob *bp_smob
1014 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1015
1016 return scm_from_bool (bp_smob->bp->number >= 0);
1017}
1018
1019/* (breakpoint-number <gdb:breakpoint>) -> integer */
1020
1021static SCM
1022gdbscm_breakpoint_number (SCM self)
1023{
1024 breakpoint_smob *bp_smob
1025 = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1026
1027 return scm_from_long (bp_smob->number);
1028}
1029\f
1030/* Return TRUE if "stop" has been set for this breakpoint.
1031
1032 This is the extension_language_ops.breakpoint_has_cond "method". */
1033
1034int
1035gdbscm_breakpoint_has_cond (const struct extension_language_defn *extlang,
1036 struct breakpoint *b)
1037{
1038 breakpoint_smob *bp_smob = b->scm_bp_object;
1039
1040 if (bp_smob == NULL)
1041 return 0;
1042
1043 return gdbscm_is_procedure (bp_smob->stop);
1044}
1045
1046/* Call the "stop" method in the breakpoint class.
1047 This must only be called if gdbscm_breakpoint_has_cond returns true.
1048 If the stop method returns #t, the inferior will be stopped at the
1049 breakpoint. Otherwise the inferior will be allowed to continue
1050 (assuming other conditions don't indicate "stop").
1051
1052 This is the extension_language_ops.breakpoint_cond_says_stop "method". */
1053
1054enum ext_lang_bp_stop
1055gdbscm_breakpoint_cond_says_stop
1056 (const struct extension_language_defn *extlang, struct breakpoint *b)
1057{
1058 breakpoint_smob *bp_smob = b->scm_bp_object;
1059 SCM predicate_result;
1060 int stop;
1061
1062 if (bp_smob == NULL)
1063 return EXT_LANG_BP_STOP_UNSET;
1064 if (!gdbscm_is_procedure (bp_smob->stop))
1065 return EXT_LANG_BP_STOP_UNSET;
1066
1067 stop = 1;
1068
1069 predicate_result
1070 = gdbscm_safe_call_1 (bp_smob->stop, bp_smob->containing_scm, NULL);
1071
1072 if (gdbscm_is_exception (predicate_result))
1073 ; /* Exception already printed. */
1074 /* If the "stop" function returns #f that means
1075 the Scheme breakpoint wants GDB to continue. */
1076 else if (gdbscm_is_false (predicate_result))
1077 stop = 0;
1078
1079 return stop ? EXT_LANG_BP_STOP_YES : EXT_LANG_BP_STOP_NO;
1080}
1081\f
1082/* Event callback functions. */
1083
1084/* Callback that is used when a breakpoint is created.
1085 For breakpoints created by Scheme, i.e., gdbscm_create_breakpoint_x, finish
1086 object creation by connecting the Scheme wrapper to the gdb object.
1087 We ignore breakpoints created from gdb or python here, we create the
1088 Scheme wrapper for those when there's a need to, e.g.,
1089 gdbscm_breakpoints. */
1090
1091static void
1092bpscm_breakpoint_created (struct breakpoint *bp)
1093{
1094 SCM bp_scm;
1095
1096 if (gdbscm_is_false (pending_breakpoint_scm))
1097 return;
1098
1099 /* Verify our caller error checked the user's request. */
1100 gdb_assert (bpscm_want_scm_wrapper_p (bp, 1));
1101
1102 bp_scm = pending_breakpoint_scm;
1103 pending_breakpoint_scm = SCM_BOOL_F;
1104
1105 bpscm_attach_scm_to_breakpoint (bp, bp_scm);
1106}
1107
1108/* Callback that is used when a breakpoint is deleted. This will
1109 invalidate the corresponding Scheme object. */
1110
1111static void
1112bpscm_breakpoint_deleted (struct breakpoint *b)
1113{
1114 int num = b->number;
1115 struct breakpoint *bp;
1116
1117 /* TODO: Why the lookup? We have B. */
1118
1119 bp = get_breakpoint (num);
1120 if (bp)
1121 {
1122 breakpoint_smob *bp_smob = bp->scm_bp_object;
1123
1124 if (bp_smob)
1125 {
1126 bp_smob->bp = NULL;
16f691fb
DE
1127 bp_smob->number = -1;
1128 bp_smob->stop = SCM_BOOL_F;
ed3ef339
DE
1129 scm_gc_unprotect_object (bp_smob->containing_scm);
1130 }
1131 }
1132}
1133\f
1134/* Initialize the Scheme breakpoint code. */
1135
1136static const scheme_integer_constant breakpoint_integer_constants[] =
1137{
1138 { "BP_NONE", bp_none },
1139 { "BP_BREAKPOINT", bp_breakpoint },
1140 { "BP_WATCHPOINT", bp_watchpoint },
1141 { "BP_HARDWARE_WATCHPOINT", bp_hardware_watchpoint },
1142 { "BP_READ_WATCHPOINT", bp_read_watchpoint },
1143 { "BP_ACCESS_WATCHPOINT", bp_access_watchpoint },
1144
1145 { "WP_READ", hw_read },
1146 { "WP_WRITE", hw_write },
1147 { "WP_ACCESS", hw_access },
1148
1149 END_INTEGER_CONSTANTS
1150};
1151
1152static const scheme_function breakpoint_functions[] =
1153{
72e02483 1154 { "make-breakpoint", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_breakpoint),
ed3ef339 1155 "\
16f691fb 1156Create a GDB breakpoint object.\n\
ed3ef339
DE
1157\n\
1158 Arguments:\n\
16f691fb
DE
1159 location [#:type <type>] [#:wp-class <wp-class>] [#:internal <bool>]\n\
1160 Returns:\n\
1161 <gdb:breakpoint object" },
1162
72e02483
PA
1163 { "register-breakpoint!", 1, 0, 0,
1164 as_a_scm_t_subr (gdbscm_register_breakpoint_x),
16f691fb
DE
1165 "\
1166Register a <gdb:breakpoint> object with GDB." },
ed3ef339 1167
72e02483 1168 { "delete-breakpoint!", 1, 0, 0, as_a_scm_t_subr (gdbscm_delete_breakpoint_x),
ed3ef339
DE
1169 "\
1170Delete the breakpoint from GDB." },
1171
72e02483 1172 { "breakpoints", 0, 0, 0, as_a_scm_t_subr (gdbscm_breakpoints),
ed3ef339
DE
1173 "\
1174Return a list of all GDB breakpoints.\n\
1175\n\
1176 Arguments: none" },
1177
72e02483 1178 { "breakpoint?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_p),
ed3ef339
DE
1179 "\
1180Return #t if the object is a <gdb:breakpoint> object." },
1181
72e02483 1182 { "breakpoint-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_valid_p),
ed3ef339
DE
1183 "\
1184Return #t if the breakpoint has not been deleted from GDB." },
1185
72e02483 1186 { "breakpoint-number", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_number),
ed3ef339
DE
1187 "\
1188Return the breakpoint's number." },
1189
72e02483 1190 { "breakpoint-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_type),
ed3ef339
DE
1191 "\
1192Return the type of the breakpoint." },
1193
72e02483 1194 { "breakpoint-visible?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_visible),
ed3ef339
DE
1195 "\
1196Return #t if the breakpoint is visible to the user." },
1197
72e02483
PA
1198 { "breakpoint-location", 1, 0, 0,
1199 as_a_scm_t_subr (gdbscm_breakpoint_location),
ed3ef339
DE
1200 "\
1201Return the location of the breakpoint as specified by the user." },
1202
72e02483
PA
1203 { "breakpoint-expression", 1, 0, 0,
1204 as_a_scm_t_subr (gdbscm_breakpoint_expression),
ed3ef339
DE
1205 "\
1206Return the expression of the breakpoint as specified by the user.\n\
1207Valid for watchpoints only, returns #f for non-watchpoints." },
1208
72e02483
PA
1209 { "breakpoint-enabled?", 1, 0, 0,
1210 as_a_scm_t_subr (gdbscm_breakpoint_enabled_p),
ed3ef339
DE
1211 "\
1212Return #t if the breakpoint is enabled." },
1213
72e02483
PA
1214 { "set-breakpoint-enabled!", 2, 0, 0,
1215 as_a_scm_t_subr (gdbscm_set_breakpoint_enabled_x),
ed3ef339
DE
1216 "\
1217Set the breakpoint's enabled state.\n\
1218\n\
5c6d4fb2 1219 Arguments: <gdb:breakpoint> boolean" },
ed3ef339 1220
72e02483 1221 { "breakpoint-silent?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_silent_p),
ed3ef339
DE
1222 "\
1223Return #t if the breakpoint is silent." },
1224
72e02483
PA
1225 { "set-breakpoint-silent!", 2, 0, 0,
1226 as_a_scm_t_subr (gdbscm_set_breakpoint_silent_x),
ed3ef339
DE
1227 "\
1228Set the breakpoint's silent state.\n\
1229\n\
1230 Arguments: <gdb:breakpoint> boolean" },
1231
72e02483
PA
1232 { "breakpoint-ignore-count", 1, 0, 0,
1233 as_a_scm_t_subr (gdbscm_breakpoint_ignore_count),
ed3ef339
DE
1234 "\
1235Return the breakpoint's \"ignore\" count." },
1236
1237 { "set-breakpoint-ignore-count!", 2, 0, 0,
72e02483 1238 as_a_scm_t_subr (gdbscm_set_breakpoint_ignore_count_x),
ed3ef339
DE
1239 "\
1240Set the breakpoint's \"ignore\" count.\n\
1241\n\
1242 Arguments: <gdb:breakpoint> count" },
1243
72e02483
PA
1244 { "breakpoint-hit-count", 1, 0, 0,
1245 as_a_scm_t_subr (gdbscm_breakpoint_hit_count),
ed3ef339
DE
1246 "\
1247Return the breakpoint's \"hit\" count." },
1248
72e02483
PA
1249 { "set-breakpoint-hit-count!", 2, 0, 0,
1250 as_a_scm_t_subr (gdbscm_set_breakpoint_hit_count_x),
ed3ef339
DE
1251 "\
1252Set the breakpoint's \"hit\" count. The value must be zero.\n\
1253\n\
1254 Arguments: <gdb:breakpoint> 0" },
1255
72e02483 1256 { "breakpoint-thread", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_thread),
ed3ef339 1257 "\
5d5658a1 1258Return the breakpoint's global thread id or #f if there isn't one." },
ed3ef339 1259
72e02483
PA
1260 { "set-breakpoint-thread!", 2, 0, 0,
1261 as_a_scm_t_subr (gdbscm_set_breakpoint_thread_x),
ed3ef339 1262 "\
5d5658a1 1263Set the global thread id for this breakpoint.\n\
ed3ef339 1264\n\
5d5658a1 1265 Arguments: <gdb:breakpoint> global-thread-id" },
ed3ef339 1266
72e02483 1267 { "breakpoint-task", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_task),
ed3ef339
DE
1268 "\
1269Return the breakpoint's Ada task-id or #f if there isn't one." },
1270
72e02483
PA
1271 { "set-breakpoint-task!", 2, 0, 0,
1272 as_a_scm_t_subr (gdbscm_set_breakpoint_task_x),
ed3ef339
DE
1273 "\
1274Set the breakpoint's Ada task-id.\n\
1275\n\
1276 Arguments: <gdb:breakpoint> task-id" },
1277
72e02483
PA
1278 { "breakpoint-condition", 1, 0, 0,
1279 as_a_scm_t_subr (gdbscm_breakpoint_condition),
ed3ef339
DE
1280 "\
1281Return the breakpoint's condition as specified by the user.\n\
1282Return #f if there isn't one." },
1283
72e02483
PA
1284 { "set-breakpoint-condition!", 2, 0, 0,
1285 as_a_scm_t_subr (gdbscm_set_breakpoint_condition_x),
ed3ef339
DE
1286 "\
1287Set the breakpoint's condition.\n\
1288\n\
1289 Arguments: <gdb:breakpoint> condition\n\
1290 condition: a string" },
1291
72e02483 1292 { "breakpoint-stop", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_stop),
ed3ef339
DE
1293 "\
1294Return the breakpoint's stop predicate.\n\
1295Return #f if there isn't one." },
1296
72e02483
PA
1297 { "set-breakpoint-stop!", 2, 0, 0,
1298 as_a_scm_t_subr (gdbscm_set_breakpoint_stop_x),
ed3ef339
DE
1299 "\
1300Set the breakpoint's stop predicate.\n\
1301\n\
1302 Arguments: <gdb:breakpoint> procedure\n\
1303 procedure: A procedure of one argument, the breakpoint.\n\
1304 Its result is true if program execution should stop." },
1305
72e02483
PA
1306 { "breakpoint-commands", 1, 0, 0,
1307 as_a_scm_t_subr (gdbscm_breakpoint_commands),
ed3ef339
DE
1308 "\
1309Return the breakpoint's commands." },
1310
1311 END_FUNCTIONS
1312};
1313
1314void
1315gdbscm_initialize_breakpoints (void)
1316{
1317 breakpoint_smob_tag
1318 = gdbscm_make_smob_type (breakpoint_smob_name, sizeof (breakpoint_smob));
ed3ef339
DE
1319 scm_set_smob_free (breakpoint_smob_tag, bpscm_free_breakpoint_smob);
1320 scm_set_smob_print (breakpoint_smob_tag, bpscm_print_breakpoint_smob);
1321
c90e7d63
SM
1322 gdb::observers::breakpoint_created.attach (bpscm_breakpoint_created,
1323 "scm-breakpoint");
1324 gdb::observers::breakpoint_deleted.attach (bpscm_breakpoint_deleted,
1325 "scm-breakpoint");
ed3ef339
DE
1326
1327 gdbscm_define_integer_constants (breakpoint_integer_constants, 1);
1328 gdbscm_define_functions (breakpoint_functions, 1);
1329
1330 type_keyword = scm_from_latin1_keyword ("type");
1331 wp_class_keyword = scm_from_latin1_keyword ("wp-class");
1332 internal_keyword = scm_from_latin1_keyword ("internal");
1333}
This page took 0.799082 seconds and 4 git commands to generate.