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