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