Commit | Line | Data |
---|---|---|
ed3ef339 DE |
1 | /* Scheme interface to stack frames. |
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 "block.h" | |
25 | #include "frame.h" | |
26 | #include "exceptions.h" | |
27 | #include "inferior.h" | |
28 | #include "objfiles.h" | |
29 | #include "symfile.h" | |
30 | #include "symtab.h" | |
31 | #include "stack.h" | |
32 | #include "value.h" | |
33 | #include "guile-internal.h" | |
34 | ||
35 | /* The <gdb:frame> smob. | |
36 | The typedef for this struct is in guile-internal.h. */ | |
37 | ||
38 | struct _frame_smob | |
39 | { | |
40 | /* This always appears first. */ | |
41 | eqable_gdb_smob base; | |
42 | ||
43 | struct frame_id frame_id; | |
44 | struct gdbarch *gdbarch; | |
45 | ||
46 | /* Frames are tracked by inferior. | |
47 | We need some place to put the eq?-able hash table, and this feels as | |
48 | good a place as any. Frames in one inferior shouldn't be considered | |
49 | equal to frames in a different inferior. The frame becomes invalid if | |
50 | this becomes NULL (the inferior has been deleted from gdb). | |
51 | It's easier to relax restrictions than impose them after the fact. | |
52 | N.B. It is an outstanding question whether a frame survives reruns of | |
53 | the inferior. Intuitively the answer is "No", but currently a frame | |
54 | also survives, e.g., multiple invocations of the same function from | |
55 | the same point. Even different threads can have the same frame, e.g., | |
56 | if a thread dies and a new thread gets the same stack. */ | |
57 | struct inferior *inferior; | |
58 | ||
59 | /* Marks that the FRAME_ID member actually holds the ID of the frame next | |
60 | to this, and not this frame's ID itself. This is a hack to permit Scheme | |
61 | frame objects which represent invalid frames (i.e., the last frame_info | |
62 | in a corrupt stack). The problem arises from the fact that this code | |
63 | relies on FRAME_ID to uniquely identify a frame, which is not always true | |
64 | for the last "frame" in a corrupt stack (it can have a null ID, or the | |
65 | same ID as the previous frame). Whenever get_prev_frame returns NULL, we | |
66 | record the frame_id of the next frame and set FRAME_ID_IS_NEXT to 1. */ | |
67 | int frame_id_is_next; | |
68 | }; | |
69 | ||
70 | static const char frame_smob_name[] = "gdb:frame"; | |
71 | ||
72 | /* The tag Guile knows the frame smob by. */ | |
73 | static scm_t_bits frame_smob_tag; | |
74 | ||
75 | /* Keywords used in argument passing. */ | |
76 | static SCM block_keyword; | |
77 | ||
78 | static const struct inferior_data *frscm_inferior_data_key; | |
79 | \f | |
80 | /* Administrivia for frame smobs. */ | |
81 | ||
82 | /* Helper function to hash a frame_smob. */ | |
83 | ||
84 | static hashval_t | |
85 | frscm_hash_frame_smob (const void *p) | |
86 | { | |
87 | const frame_smob *f_smob = p; | |
88 | const struct frame_id *fid = &f_smob->frame_id; | |
89 | hashval_t hash = htab_hash_pointer (f_smob->inferior); | |
90 | ||
91 | if (fid->stack_status == FID_STACK_VALID) | |
92 | hash = iterative_hash (&fid->stack_addr, sizeof (fid->stack_addr), hash); | |
93 | if (fid->code_addr_p) | |
94 | hash = iterative_hash (&fid->code_addr, sizeof (fid->code_addr), hash); | |
95 | if (fid->special_addr_p) | |
96 | hash = iterative_hash (&fid->special_addr, sizeof (fid->special_addr), | |
97 | hash); | |
98 | ||
99 | return hash; | |
100 | } | |
101 | ||
102 | /* Helper function to compute equality of frame_smobs. */ | |
103 | ||
104 | static int | |
105 | frscm_eq_frame_smob (const void *ap, const void *bp) | |
106 | { | |
107 | const frame_smob *a = ap; | |
108 | const frame_smob *b = bp; | |
109 | ||
110 | return (frame_id_eq (a->frame_id, b->frame_id) | |
111 | && a->inferior == b->inferior | |
112 | && a->inferior != NULL); | |
113 | } | |
114 | ||
115 | /* Return the frame -> SCM mapping table. | |
116 | It is created if necessary. */ | |
117 | ||
118 | static htab_t | |
119 | frscm_inferior_frame_map (struct inferior *inferior) | |
120 | { | |
121 | htab_t htab = inferior_data (inferior, frscm_inferior_data_key); | |
122 | ||
123 | if (htab == NULL) | |
124 | { | |
125 | htab = gdbscm_create_eqable_gsmob_ptr_map (frscm_hash_frame_smob, | |
126 | frscm_eq_frame_smob); | |
127 | set_inferior_data (inferior, frscm_inferior_data_key, htab); | |
128 | } | |
129 | ||
130 | return htab; | |
131 | } | |
132 | ||
ed3ef339 DE |
133 | /* The smob "free" function for <gdb:frame>. */ |
134 | ||
135 | static size_t | |
136 | frscm_free_frame_smob (SCM self) | |
137 | { | |
138 | frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self); | |
139 | ||
140 | if (f_smob->inferior != NULL) | |
141 | { | |
142 | htab_t htab = frscm_inferior_frame_map (f_smob->inferior); | |
143 | ||
144 | gdbscm_clear_eqable_gsmob_ptr_slot (htab, &f_smob->base); | |
145 | } | |
146 | ||
147 | /* Not necessary, done to catch bugs. */ | |
148 | f_smob->inferior = NULL; | |
149 | ||
150 | return 0; | |
151 | } | |
152 | ||
153 | /* The smob "print" function for <gdb:frame>. */ | |
154 | ||
155 | static int | |
156 | frscm_print_frame_smob (SCM self, SCM port, scm_print_state *pstate) | |
157 | { | |
158 | frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (self); | |
159 | struct ui_file *strfile; | |
160 | char *s; | |
161 | ||
162 | gdbscm_printf (port, "#<%s ", frame_smob_name); | |
163 | ||
164 | strfile = mem_fileopen (); | |
165 | fprint_frame_id (strfile, f_smob->frame_id); | |
166 | s = ui_file_xstrdup (strfile, NULL); | |
167 | gdbscm_printf (port, "%s", s); | |
168 | ui_file_delete (strfile); | |
169 | xfree (s); | |
170 | ||
171 | scm_puts (">", port); | |
172 | ||
173 | scm_remember_upto_here_1 (self); | |
174 | ||
175 | /* Non-zero means success. */ | |
176 | return 1; | |
177 | } | |
178 | ||
179 | /* Low level routine to create a <gdb:frame> object. */ | |
180 | ||
181 | static SCM | |
182 | frscm_make_frame_smob (void) | |
183 | { | |
184 | frame_smob *f_smob = (frame_smob *) | |
185 | scm_gc_malloc (sizeof (frame_smob), frame_smob_name); | |
186 | SCM f_scm; | |
187 | ||
188 | f_smob->frame_id = null_frame_id; | |
189 | f_smob->gdbarch = NULL; | |
190 | f_smob->inferior = NULL; | |
191 | f_smob->frame_id_is_next = 0; | |
192 | f_scm = scm_new_smob (frame_smob_tag, (scm_t_bits) f_smob); | |
1254eefc | 193 | gdbscm_init_eqable_gsmob (&f_smob->base, f_scm); |
ed3ef339 DE |
194 | |
195 | return f_scm; | |
196 | } | |
197 | ||
198 | /* Return non-zero if SCM is a <gdb:frame> object. */ | |
199 | ||
200 | int | |
201 | frscm_is_frame (SCM scm) | |
202 | { | |
203 | return SCM_SMOB_PREDICATE (frame_smob_tag, scm); | |
204 | } | |
205 | ||
206 | /* (frame? object) -> boolean */ | |
207 | ||
208 | static SCM | |
209 | gdbscm_frame_p (SCM scm) | |
210 | { | |
211 | return scm_from_bool (frscm_is_frame (scm)); | |
212 | } | |
213 | ||
214 | /* Create a new <gdb:frame> object that encapsulates FRAME. | |
215 | Returns a <gdb:exception> object if there is an error. */ | |
216 | ||
217 | static SCM | |
218 | frscm_scm_from_frame (struct frame_info *frame, struct inferior *inferior) | |
219 | { | |
220 | frame_smob *f_smob, f_smob_for_lookup; | |
221 | SCM f_scm; | |
222 | htab_t htab; | |
223 | eqable_gdb_smob **slot; | |
224 | volatile struct gdb_exception except; | |
225 | struct frame_id frame_id = null_frame_id; | |
226 | struct gdbarch *gdbarch = NULL; | |
227 | int frame_id_is_next = 0; | |
228 | ||
229 | /* If we've already created a gsmob for this frame, return it. | |
230 | This makes frames eq?-able. */ | |
231 | htab = frscm_inferior_frame_map (inferior); | |
232 | f_smob_for_lookup.frame_id = get_frame_id (frame); | |
233 | f_smob_for_lookup.inferior = inferior; | |
234 | slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &f_smob_for_lookup.base); | |
235 | if (*slot != NULL) | |
236 | return (*slot)->containing_scm; | |
237 | ||
238 | TRY_CATCH (except, RETURN_MASK_ALL) | |
239 | { | |
240 | /* Try to get the previous frame, to determine if this is the last frame | |
241 | in a corrupt stack. If so, we need to store the frame_id of the next | |
242 | frame and not of this one (which is possibly invalid). */ | |
243 | if (get_prev_frame (frame) == NULL | |
244 | && get_frame_unwind_stop_reason (frame) != UNWIND_NO_REASON | |
245 | && get_next_frame (frame) != NULL) | |
246 | { | |
247 | frame_id = get_frame_id (get_next_frame (frame)); | |
248 | frame_id_is_next = 1; | |
249 | } | |
250 | else | |
251 | { | |
252 | frame_id = get_frame_id (frame); | |
253 | frame_id_is_next = 0; | |
254 | } | |
255 | gdbarch = get_frame_arch (frame); | |
256 | } | |
257 | if (except.reason < 0) | |
258 | return gdbscm_scm_from_gdb_exception (except); | |
259 | ||
260 | f_scm = frscm_make_frame_smob (); | |
261 | f_smob = (frame_smob *) SCM_SMOB_DATA (f_scm); | |
262 | f_smob->frame_id = frame_id; | |
263 | f_smob->gdbarch = gdbarch; | |
264 | f_smob->inferior = inferior; | |
265 | f_smob->frame_id_is_next = frame_id_is_next; | |
266 | ||
1254eefc | 267 | gdbscm_fill_eqable_gsmob_ptr_slot (slot, &f_smob->base); |
ed3ef339 DE |
268 | |
269 | return f_scm; | |
270 | } | |
271 | ||
272 | /* Create a new <gdb:frame> object that encapsulates FRAME. | |
273 | A Scheme exception is thrown if there is an error. */ | |
274 | ||
275 | static SCM | |
276 | frscm_scm_from_frame_unsafe (struct frame_info *frame, | |
277 | struct inferior *inferior) | |
278 | { | |
279 | SCM f_scm = frscm_scm_from_frame (frame, inferior); | |
280 | ||
281 | if (gdbscm_is_exception (f_scm)) | |
282 | gdbscm_throw (f_scm); | |
283 | ||
284 | return f_scm; | |
285 | } | |
286 | ||
287 | /* Returns the <gdb:frame> object in SELF. | |
288 | Throws an exception if SELF is not a <gdb:frame> object. */ | |
289 | ||
290 | static SCM | |
291 | frscm_get_frame_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
292 | { | |
293 | SCM_ASSERT_TYPE (frscm_is_frame (self), self, arg_pos, func_name, | |
294 | frame_smob_name); | |
295 | ||
296 | return self; | |
297 | } | |
298 | ||
299 | /* There is no gdbscm_scm_to_frame function because translating | |
300 | a frame SCM object to a struct frame_info * can throw a GDB error. | |
301 | Thus code working with frames has to handle both Scheme errors (e.g., the | |
302 | object is not a frame) and GDB errors (e.g., the frame lookup failed). | |
303 | ||
304 | To help keep things clear we split gdbscm_scm_to_frame into two: | |
305 | ||
306 | gdbscm_get_frame_smob_arg_unsafe | |
307 | - throws a Scheme error if object is not a frame, | |
308 | or if the inferior is gone or is no longer current | |
309 | ||
310 | gdbscm_frame_smob_to_frame | |
311 | - may throw a gdb error if the conversion fails | |
312 | - it's not clear when it will and won't throw a GDB error, | |
313 | but for robustness' sake we assume that whenever we call out to GDB | |
314 | a GDB error may get thrown (and thus the call must be wrapped in a | |
315 | TRY_CATCH) */ | |
316 | ||
317 | /* Returns the frame_smob for the object wrapped by FRAME_SCM. | |
318 | A Scheme error is thrown if FRAME_SCM is not a frame. */ | |
319 | ||
320 | frame_smob * | |
321 | frscm_get_frame_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
322 | { | |
323 | SCM f_scm = frscm_get_frame_arg_unsafe (self, arg_pos, func_name); | |
324 | frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (f_scm); | |
325 | ||
326 | if (f_smob->inferior == NULL) | |
327 | { | |
328 | gdbscm_invalid_object_error (func_name, arg_pos, self, | |
329 | _("inferior")); | |
330 | } | |
331 | if (f_smob->inferior != current_inferior ()) | |
332 | scm_misc_error (func_name, _("inferior has changed"), SCM_EOL); | |
333 | ||
334 | return f_smob; | |
335 | } | |
336 | ||
337 | /* Returns the frame_info object wrapped by F_SMOB. | |
338 | If the frame doesn't exist anymore (the frame id doesn't | |
339 | correspond to any frame in the inferior), returns NULL. | |
340 | This function calls GDB routines, so don't assume a GDB error will | |
341 | not be thrown. */ | |
342 | ||
343 | struct frame_info * | |
344 | frscm_frame_smob_to_frame (frame_smob *f_smob) | |
345 | { | |
346 | struct frame_info *frame; | |
347 | ||
348 | frame = frame_find_by_id (f_smob->frame_id); | |
349 | if (frame == NULL) | |
350 | return NULL; | |
351 | ||
352 | if (f_smob->frame_id_is_next) | |
353 | frame = get_prev_frame (frame); | |
354 | ||
355 | return frame; | |
356 | } | |
357 | ||
358 | /* Helper function for frscm_del_inferior_frames to mark the frame | |
359 | as invalid. */ | |
360 | ||
361 | static int | |
362 | frscm_mark_frame_invalid (void **slot, void *info) | |
363 | { | |
364 | frame_smob *f_smob = (frame_smob *) *slot; | |
365 | ||
366 | f_smob->inferior = NULL; | |
367 | return 1; | |
368 | } | |
369 | ||
370 | /* This function is called when an inferior is about to be freed. | |
371 | Invalidate the frame as further actions on the frame could result | |
372 | in bad data. All access to the frame should be gated by | |
373 | frscm_get_frame_smob_arg_unsafe which will raise an exception on | |
374 | invalid frames. */ | |
375 | ||
376 | static void | |
377 | frscm_del_inferior_frames (struct inferior *inferior, void *datum) | |
378 | { | |
379 | htab_t htab = datum; | |
380 | ||
381 | if (htab != NULL) | |
382 | { | |
383 | htab_traverse_noresize (htab, frscm_mark_frame_invalid, NULL); | |
384 | htab_delete (htab); | |
385 | } | |
386 | } | |
387 | \f | |
388 | /* Frame methods. */ | |
389 | ||
390 | /* (frame-valid? <gdb:frame>) -> bool | |
391 | Returns #t if the frame corresponding to the frame_id of this | |
392 | object still exists in the inferior. */ | |
393 | ||
394 | static SCM | |
395 | gdbscm_frame_valid_p (SCM self) | |
396 | { | |
397 | frame_smob *f_smob; | |
398 | struct frame_info *frame = NULL; | |
399 | volatile struct gdb_exception except; | |
400 | ||
401 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
402 | ||
403 | TRY_CATCH (except, RETURN_MASK_ALL) | |
404 | { | |
405 | frame = frscm_frame_smob_to_frame (f_smob); | |
406 | } | |
407 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
408 | ||
409 | return scm_from_bool (frame != NULL); | |
410 | } | |
411 | ||
412 | /* (frame-name <gdb:frame>) -> string | |
413 | Returns the name of the function corresponding to this frame, | |
414 | or #f if there is no function. */ | |
415 | ||
416 | static SCM | |
417 | gdbscm_frame_name (SCM self) | |
418 | { | |
419 | frame_smob *f_smob; | |
420 | char *name = NULL; | |
421 | enum language lang = language_minimal; | |
422 | struct frame_info *frame = NULL; | |
423 | SCM result; | |
424 | volatile struct gdb_exception except; | |
425 | ||
426 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
427 | ||
428 | TRY_CATCH (except, RETURN_MASK_ALL) | |
429 | { | |
430 | frame = frscm_frame_smob_to_frame (f_smob); | |
431 | if (frame != NULL) | |
432 | find_frame_funname (frame, &name, &lang, NULL); | |
433 | } | |
434 | if (except.reason < 0) | |
435 | xfree (name); | |
436 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
437 | ||
438 | if (frame == NULL) | |
439 | { | |
440 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
441 | _("<gdb:frame>")); | |
442 | } | |
443 | ||
444 | if (name != NULL) | |
445 | { | |
446 | result = gdbscm_scm_from_c_string (name); | |
447 | xfree (name); | |
448 | } | |
449 | else | |
450 | result = SCM_BOOL_F; | |
451 | ||
452 | return result; | |
453 | } | |
454 | ||
455 | /* (frame-type <gdb:frame>) -> integer | |
456 | Returns the frame type, namely one of the gdb:*_FRAME constants. */ | |
457 | ||
458 | static SCM | |
459 | gdbscm_frame_type (SCM self) | |
460 | { | |
461 | frame_smob *f_smob; | |
462 | enum frame_type type = NORMAL_FRAME; | |
463 | struct frame_info *frame = NULL; | |
464 | volatile struct gdb_exception except; | |
465 | ||
466 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
467 | ||
468 | TRY_CATCH (except, RETURN_MASK_ALL) | |
469 | { | |
470 | frame = frscm_frame_smob_to_frame (f_smob); | |
471 | if (frame != NULL) | |
472 | type = get_frame_type (frame); | |
473 | } | |
474 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
475 | ||
476 | if (frame == NULL) | |
477 | { | |
478 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
479 | _("<gdb:frame>")); | |
480 | } | |
481 | ||
482 | return scm_from_int (type); | |
483 | } | |
484 | ||
485 | /* (frame-arch <gdb:frame>) -> <gdb:architecture> | |
486 | Returns the frame's architecture as a gdb:architecture object. */ | |
487 | ||
488 | static SCM | |
489 | gdbscm_frame_arch (SCM self) | |
490 | { | |
491 | frame_smob *f_smob; | |
492 | struct frame_info *frame = NULL; | |
493 | volatile struct gdb_exception except; | |
494 | ||
495 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
496 | ||
497 | TRY_CATCH (except, RETURN_MASK_ALL) | |
498 | { | |
499 | frame = frscm_frame_smob_to_frame (f_smob); | |
500 | } | |
501 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
502 | ||
503 | if (frame == NULL) | |
504 | { | |
505 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
506 | _("<gdb:frame>")); | |
507 | } | |
508 | ||
509 | return arscm_scm_from_arch (f_smob->gdbarch); | |
510 | } | |
511 | ||
512 | /* (frame-unwind-stop-reason <gdb:frame>) -> integer | |
513 | Returns one of the gdb:FRAME_UNWIND_* constants. */ | |
514 | ||
515 | static SCM | |
516 | gdbscm_frame_unwind_stop_reason (SCM self) | |
517 | { | |
518 | frame_smob *f_smob; | |
519 | struct frame_info *frame = NULL; | |
520 | volatile struct gdb_exception except; | |
521 | enum unwind_stop_reason stop_reason; | |
522 | ||
523 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
524 | ||
525 | TRY_CATCH (except, RETURN_MASK_ALL) | |
526 | { | |
527 | frame = frscm_frame_smob_to_frame (f_smob); | |
528 | } | |
529 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
530 | ||
531 | if (frame == NULL) | |
532 | { | |
533 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
534 | _("<gdb:frame>")); | |
535 | } | |
536 | ||
537 | stop_reason = get_frame_unwind_stop_reason (frame); | |
538 | ||
539 | return scm_from_int (stop_reason); | |
540 | } | |
541 | ||
542 | /* (frame-pc <gdb:frame>) -> integer | |
543 | Returns the frame's resume address. */ | |
544 | ||
545 | static SCM | |
546 | gdbscm_frame_pc (SCM self) | |
547 | { | |
548 | frame_smob *f_smob; | |
549 | CORE_ADDR pc = 0; | |
550 | struct frame_info *frame = NULL; | |
551 | volatile struct gdb_exception except; | |
552 | ||
553 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
554 | ||
555 | TRY_CATCH (except, RETURN_MASK_ALL) | |
556 | { | |
557 | frame = frscm_frame_smob_to_frame (f_smob); | |
558 | if (frame != NULL) | |
559 | pc = get_frame_pc (frame); | |
560 | } | |
561 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
562 | ||
563 | if (frame == NULL) | |
564 | { | |
565 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
566 | _("<gdb:frame>")); | |
567 | } | |
568 | ||
569 | return gdbscm_scm_from_ulongest (pc); | |
570 | } | |
571 | ||
572 | /* (frame-block <gdb:frame>) -> <gdb:block> | |
573 | Returns the frame's code block, or #f if one cannot be found. */ | |
574 | ||
575 | static SCM | |
576 | gdbscm_frame_block (SCM self) | |
577 | { | |
578 | frame_smob *f_smob; | |
3977b71f | 579 | const struct block *block = NULL, *fn_block; |
ed3ef339 DE |
580 | struct frame_info *frame = NULL; |
581 | volatile struct gdb_exception except; | |
582 | ||
583 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
584 | ||
585 | TRY_CATCH (except, RETURN_MASK_ALL) | |
586 | { | |
587 | frame = frscm_frame_smob_to_frame (f_smob); | |
588 | if (frame != NULL) | |
589 | block = get_frame_block (frame, NULL); | |
590 | } | |
591 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
592 | ||
593 | if (frame == NULL) | |
594 | { | |
595 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
596 | _("<gdb:frame>")); | |
597 | } | |
598 | ||
599 | for (fn_block = block; | |
600 | fn_block != NULL && BLOCK_FUNCTION (fn_block) == NULL; | |
601 | fn_block = BLOCK_SUPERBLOCK (fn_block)) | |
602 | continue; | |
603 | ||
604 | if (block == NULL || fn_block == NULL || BLOCK_FUNCTION (fn_block) == NULL) | |
605 | { | |
606 | scm_misc_error (FUNC_NAME, _("cannot find block for frame"), | |
607 | scm_list_1 (self)); | |
608 | } | |
609 | ||
610 | if (block != NULL) | |
611 | { | |
612 | struct symtab *st; | |
613 | SCM block_scm; | |
614 | ||
615 | st = SYMBOL_SYMTAB (BLOCK_FUNCTION (fn_block)); | |
616 | return bkscm_scm_from_block (block, st->objfile); | |
617 | } | |
618 | ||
619 | return SCM_BOOL_F; | |
620 | } | |
621 | ||
622 | /* (frame-function <gdb:frame>) -> <gdb:symbol> | |
623 | Returns the symbol for the function corresponding to this frame, | |
624 | or #f if there isn't one. */ | |
625 | ||
626 | static SCM | |
627 | gdbscm_frame_function (SCM self) | |
628 | { | |
629 | frame_smob *f_smob; | |
630 | struct symbol *sym = NULL; | |
631 | struct frame_info *frame = NULL; | |
632 | volatile struct gdb_exception except; | |
633 | ||
634 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
635 | ||
636 | TRY_CATCH (except, RETURN_MASK_ALL) | |
637 | { | |
638 | frame = frscm_frame_smob_to_frame (f_smob); | |
639 | if (frame != NULL) | |
640 | sym = find_pc_function (get_frame_address_in_block (frame)); | |
641 | } | |
642 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
643 | ||
644 | if (frame == NULL) | |
645 | { | |
646 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
647 | _("<gdb:frame>")); | |
648 | } | |
649 | ||
650 | if (sym != NULL) | |
651 | return syscm_scm_from_symbol (sym); | |
652 | ||
653 | return SCM_BOOL_F; | |
654 | } | |
655 | ||
656 | /* (frame-older <gdb:frame>) -> <gdb:frame> | |
657 | Returns the frame immediately older (outer) to this frame, | |
658 | or #f if there isn't one. */ | |
659 | ||
660 | static SCM | |
661 | gdbscm_frame_older (SCM self) | |
662 | { | |
663 | frame_smob *f_smob; | |
664 | struct frame_info *prev = NULL; | |
665 | struct frame_info *frame = NULL; | |
666 | volatile struct gdb_exception except; | |
667 | ||
668 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
669 | ||
670 | TRY_CATCH (except, RETURN_MASK_ALL) | |
671 | { | |
672 | frame = frscm_frame_smob_to_frame (f_smob); | |
673 | if (frame != NULL) | |
674 | prev = get_prev_frame (frame); | |
675 | } | |
676 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
677 | ||
678 | if (frame == NULL) | |
679 | { | |
680 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
681 | _("<gdb:frame>")); | |
682 | } | |
683 | ||
684 | if (prev != NULL) | |
685 | return frscm_scm_from_frame_unsafe (prev, f_smob->inferior); | |
686 | ||
687 | return SCM_BOOL_F; | |
688 | } | |
689 | ||
690 | /* (frame-newer <gdb:frame>) -> <gdb:frame> | |
691 | Returns the frame immediately newer (inner) to this frame, | |
692 | or #f if there isn't one. */ | |
693 | ||
694 | static SCM | |
695 | gdbscm_frame_newer (SCM self) | |
696 | { | |
697 | frame_smob *f_smob; | |
698 | struct frame_info *next = NULL; | |
699 | struct frame_info *frame = NULL; | |
700 | volatile struct gdb_exception except; | |
701 | ||
702 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
703 | ||
704 | TRY_CATCH (except, RETURN_MASK_ALL) | |
705 | { | |
706 | frame = frscm_frame_smob_to_frame (f_smob); | |
707 | if (frame != NULL) | |
708 | next = get_next_frame (frame); | |
709 | } | |
710 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
711 | ||
712 | if (frame == NULL) | |
713 | { | |
714 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
715 | _("<gdb:frame>")); | |
716 | } | |
717 | ||
718 | if (next != NULL) | |
719 | return frscm_scm_from_frame_unsafe (next, f_smob->inferior); | |
720 | ||
721 | return SCM_BOOL_F; | |
722 | } | |
723 | ||
724 | /* (frame-sal <gdb:frame>) -> <gdb:sal> | |
725 | Returns the frame's symtab and line. */ | |
726 | ||
727 | static SCM | |
728 | gdbscm_frame_sal (SCM self) | |
729 | { | |
730 | frame_smob *f_smob; | |
731 | struct symtab_and_line sal; | |
732 | struct frame_info *frame = NULL; | |
733 | volatile struct gdb_exception except; | |
734 | ||
735 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
736 | ||
737 | TRY_CATCH (except, RETURN_MASK_ALL) | |
738 | { | |
739 | frame = frscm_frame_smob_to_frame (f_smob); | |
740 | if (frame != NULL) | |
741 | find_frame_sal (frame, &sal); | |
742 | } | |
743 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
744 | ||
745 | if (frame == NULL) | |
746 | { | |
747 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
748 | _("<gdb:frame>")); | |
749 | } | |
750 | ||
751 | return stscm_scm_from_sal (sal); | |
752 | } | |
753 | ||
754 | /* (frame-read-var <gdb:frame> <gdb:symbol>) -> <gdb:value> | |
755 | (frame-read-var <gdb:frame> string [#:block <gdb:block>]) -> <gdb:value> | |
756 | If the optional block argument is provided start the search from that block, | |
757 | otherwise search from the frame's current block (determined by examining | |
758 | the resume address of the frame). The variable argument must be a string | |
759 | or an instance of a <gdb:symbol>. The block argument must be an instance of | |
760 | <gdb:block>. */ | |
761 | ||
762 | static SCM | |
763 | gdbscm_frame_read_var (SCM self, SCM symbol_scm, SCM rest) | |
764 | { | |
765 | SCM keywords[] = { block_keyword, SCM_BOOL_F }; | |
766 | int rc; | |
767 | frame_smob *f_smob; | |
768 | int block_arg_pos = -1; | |
769 | SCM block_scm = SCM_UNDEFINED; | |
770 | struct frame_info *frame = NULL; | |
771 | struct symbol *var = NULL; | |
772 | struct value *value = NULL; | |
773 | volatile struct gdb_exception except; | |
774 | ||
775 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
776 | ||
777 | TRY_CATCH (except, RETURN_MASK_ALL) | |
778 | { | |
779 | frame = frscm_frame_smob_to_frame (f_smob); | |
780 | } | |
781 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
782 | ||
783 | if (frame == NULL) | |
784 | { | |
785 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
786 | _("<gdb:frame>")); | |
787 | } | |
788 | ||
789 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG3, keywords, "#O", | |
790 | rest, &block_arg_pos, &block_scm); | |
791 | ||
792 | if (syscm_is_symbol (symbol_scm)) | |
793 | { | |
794 | var = syscm_get_valid_symbol_arg_unsafe (symbol_scm, SCM_ARG2, | |
795 | FUNC_NAME); | |
796 | SCM_ASSERT (SCM_UNBNDP (block_scm), block_scm, SCM_ARG3, FUNC_NAME); | |
797 | } | |
798 | else if (scm_is_string (symbol_scm)) | |
799 | { | |
800 | char *var_name; | |
801 | const struct block *block = NULL; | |
802 | struct cleanup *cleanup; | |
803 | volatile struct gdb_exception except; | |
804 | ||
805 | if (! SCM_UNBNDP (block_scm)) | |
806 | { | |
807 | SCM except_scm; | |
808 | ||
809 | gdb_assert (block_arg_pos > 0); | |
810 | block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME, | |
811 | &except_scm); | |
812 | if (block == NULL) | |
813 | gdbscm_throw (except_scm); | |
814 | } | |
815 | ||
816 | var_name = gdbscm_scm_to_c_string (symbol_scm); | |
817 | cleanup = make_cleanup (xfree, var_name); | |
818 | /* N.B. Between here and the call to do_cleanups, don't do anything | |
819 | to cause a Scheme exception without performing the cleanup. */ | |
820 | ||
821 | TRY_CATCH (except, RETURN_MASK_ALL) | |
822 | { | |
823 | if (block == NULL) | |
824 | block = get_frame_block (frame, NULL); | |
825 | var = lookup_symbol (var_name, block, VAR_DOMAIN, NULL); | |
826 | } | |
827 | if (except.reason < 0) | |
828 | do_cleanups (cleanup); | |
829 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
830 | ||
831 | if (var == NULL) | |
832 | { | |
833 | do_cleanups (cleanup); | |
834 | gdbscm_out_of_range_error (FUNC_NAME, 0, symbol_scm, | |
835 | _("variable not found")); | |
836 | } | |
837 | ||
838 | do_cleanups (cleanup); | |
839 | } | |
840 | else | |
841 | { | |
842 | /* Use SCM_ASSERT_TYPE for more consistent error messages. */ | |
843 | SCM_ASSERT_TYPE (0, symbol_scm, SCM_ARG1, FUNC_NAME, | |
844 | _("gdb:symbol or string")); | |
845 | } | |
846 | ||
847 | TRY_CATCH (except, RETURN_MASK_ALL) | |
848 | { | |
849 | value = read_var_value (var, frame); | |
850 | } | |
851 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
852 | ||
853 | return vlscm_scm_from_value (value); | |
854 | } | |
855 | ||
856 | /* (frame-select <gdb:frame>) -> unspecified | |
857 | Select this frame. */ | |
858 | ||
859 | static SCM | |
860 | gdbscm_frame_select (SCM self) | |
861 | { | |
862 | frame_smob *f_smob; | |
863 | struct frame_info *frame = NULL; | |
864 | volatile struct gdb_exception except; | |
865 | ||
866 | f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
867 | ||
868 | TRY_CATCH (except, RETURN_MASK_ALL) | |
869 | { | |
870 | frame = frscm_frame_smob_to_frame (f_smob); | |
871 | if (frame != NULL) | |
872 | select_frame (frame); | |
873 | } | |
874 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
875 | ||
876 | if (frame == NULL) | |
877 | { | |
878 | gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self, | |
879 | _("<gdb:frame>")); | |
880 | } | |
881 | ||
882 | return SCM_UNSPECIFIED; | |
883 | } | |
884 | ||
885 | /* (newest-frame) -> <gdb:frame> | |
886 | Returns the newest frame. */ | |
887 | ||
888 | static SCM | |
889 | gdbscm_newest_frame (void) | |
890 | { | |
891 | struct frame_info *frame = NULL; | |
892 | volatile struct gdb_exception except; | |
893 | ||
894 | TRY_CATCH (except, RETURN_MASK_ALL) | |
895 | { | |
896 | frame = get_current_frame (); | |
897 | } | |
898 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
899 | ||
900 | return frscm_scm_from_frame_unsafe (frame, current_inferior ()); | |
901 | } | |
902 | ||
903 | /* (selected-frame) -> <gdb:frame> | |
904 | Returns the selected frame. */ | |
905 | ||
906 | static SCM | |
907 | gdbscm_selected_frame (void) | |
908 | { | |
909 | struct frame_info *frame = NULL; | |
910 | volatile struct gdb_exception except; | |
911 | ||
912 | TRY_CATCH (except, RETURN_MASK_ALL) | |
913 | { | |
914 | frame = get_selected_frame (_("No frame is currently selected")); | |
915 | } | |
916 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
917 | ||
918 | return frscm_scm_from_frame_unsafe (frame, current_inferior ()); | |
919 | } | |
920 | ||
921 | /* (unwind-stop-reason-string integer) -> string | |
922 | Return a string explaining the unwind stop reason. */ | |
923 | ||
924 | static SCM | |
925 | gdbscm_unwind_stop_reason_string (SCM reason_scm) | |
926 | { | |
927 | int reason; | |
928 | const char *str; | |
929 | ||
930 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", | |
931 | reason_scm, &reason); | |
932 | ||
933 | if (reason < UNWIND_FIRST || reason > UNWIND_LAST) | |
934 | scm_out_of_range (FUNC_NAME, reason_scm); | |
935 | ||
70e38b8e | 936 | str = unwind_stop_reason_to_string (reason); |
ed3ef339 DE |
937 | return gdbscm_scm_from_c_string (str); |
938 | } | |
939 | \f | |
940 | /* Initialize the Scheme frame support. */ | |
941 | ||
942 | static const scheme_integer_constant frame_integer_constants[] = | |
943 | { | |
944 | #define ENTRY(X) { #X, X } | |
945 | ||
946 | ENTRY (NORMAL_FRAME), | |
947 | ENTRY (DUMMY_FRAME), | |
948 | ENTRY (INLINE_FRAME), | |
949 | ENTRY (TAILCALL_FRAME), | |
950 | ENTRY (SIGTRAMP_FRAME), | |
951 | ENTRY (ARCH_FRAME), | |
952 | ENTRY (SENTINEL_FRAME), | |
953 | ||
954 | #undef ENTRY | |
955 | ||
956 | #define SET(name, description) \ | |
957 | { "FRAME_" #name, name }, | |
958 | #include "unwind_stop_reasons.def" | |
959 | #undef SET | |
960 | ||
961 | END_INTEGER_CONSTANTS | |
962 | }; | |
963 | ||
964 | static const scheme_function frame_functions[] = | |
965 | { | |
966 | { "frame?", 1, 0, 0, gdbscm_frame_p, | |
967 | "\ | |
968 | Return #t if the object is a <gdb:frame> object." }, | |
969 | ||
970 | { "frame-valid?", 1, 0, 0, gdbscm_frame_valid_p, | |
971 | "\ | |
972 | Return #t if the object is a valid <gdb:frame> object.\n\ | |
973 | Frames become invalid when the inferior returns to its caller." }, | |
974 | ||
975 | { "frame-name", 1, 0, 0, gdbscm_frame_name, | |
976 | "\ | |
977 | Return the name of the function corresponding to this frame,\n\ | |
978 | or #f if there is no function." }, | |
979 | ||
980 | { "frame-arch", 1, 0, 0, gdbscm_frame_arch, | |
981 | "\ | |
982 | Return the frame's architecture as a <gdb:arch> object." }, | |
983 | ||
984 | { "frame-type", 1, 0, 0, gdbscm_frame_type, | |
985 | "\ | |
986 | Return the frame type, namely one of the gdb:*_FRAME constants." }, | |
987 | ||
988 | { "frame-unwind-stop-reason", 1, 0, 0, gdbscm_frame_unwind_stop_reason, | |
989 | "\ | |
990 | Return one of the gdb:FRAME_UNWIND_* constants explaining why\n\ | |
991 | it's not possible to find frames older than this." }, | |
992 | ||
993 | { "frame-pc", 1, 0, 0, gdbscm_frame_pc, | |
994 | "\ | |
995 | Return the frame's resume address." }, | |
996 | ||
997 | { "frame-block", 1, 0, 0, gdbscm_frame_block, | |
998 | "\ | |
999 | Return the frame's code block, or #f if one cannot be found." }, | |
1000 | ||
1001 | { "frame-function", 1, 0, 0, gdbscm_frame_function, | |
1002 | "\ | |
1003 | Return the <gdb:symbol> for the function corresponding to this frame,\n\ | |
1004 | or #f if there isn't one." }, | |
1005 | ||
1006 | { "frame-older", 1, 0, 0, gdbscm_frame_older, | |
1007 | "\ | |
1008 | Return the frame immediately older (outer) to this frame,\n\ | |
1009 | or #f if there isn't one." }, | |
1010 | ||
1011 | { "frame-newer", 1, 0, 0, gdbscm_frame_newer, | |
1012 | "\ | |
1013 | Return the frame immediately newer (inner) to this frame,\n\ | |
1014 | or #f if there isn't one." }, | |
1015 | ||
1016 | { "frame-sal", 1, 0, 0, gdbscm_frame_sal, | |
1017 | "\ | |
1018 | Return the frame's symtab-and-line <gdb:sal> object." }, | |
1019 | ||
1020 | { "frame-read-var", 2, 0, 1, gdbscm_frame_read_var, | |
1021 | "\ | |
1022 | Return the value of the symbol in the frame.\n\ | |
1023 | \n\ | |
1024 | Arguments: <gdb:frame> <gdb:symbol>\n\ | |
1025 | Or: <gdb:frame> string [#:block <gdb:block>]" }, | |
1026 | ||
1027 | { "frame-select", 1, 0, 0, gdbscm_frame_select, | |
1028 | "\ | |
1029 | Select this frame." }, | |
1030 | ||
1031 | { "newest-frame", 0, 0, 0, gdbscm_newest_frame, | |
1032 | "\ | |
1033 | Return the newest frame." }, | |
1034 | ||
1035 | { "selected-frame", 0, 0, 0, gdbscm_selected_frame, | |
1036 | "\ | |
1037 | Return the selected frame." }, | |
1038 | ||
1039 | { "unwind-stop-reason-string", 1, 0, 0, gdbscm_unwind_stop_reason_string, | |
1040 | "\ | |
1041 | Return a string explaining the unwind stop reason.\n\ | |
1042 | \n\ | |
1043 | Arguments: integer (the result of frame-unwind-stop-reason)" }, | |
1044 | ||
1045 | END_FUNCTIONS | |
1046 | }; | |
1047 | ||
1048 | void | |
1049 | gdbscm_initialize_frames (void) | |
1050 | { | |
1051 | frame_smob_tag | |
1052 | = gdbscm_make_smob_type (frame_smob_name, sizeof (frame_smob)); | |
ed3ef339 DE |
1053 | scm_set_smob_free (frame_smob_tag, frscm_free_frame_smob); |
1054 | scm_set_smob_print (frame_smob_tag, frscm_print_frame_smob); | |
1055 | ||
1056 | gdbscm_define_integer_constants (frame_integer_constants, 1); | |
1057 | gdbscm_define_functions (frame_functions, 1); | |
1058 | ||
1059 | block_keyword = scm_from_latin1_keyword ("block"); | |
1060 | ||
1061 | /* Register an inferior "free" callback so we can properly | |
1062 | invalidate frames when an inferior file is about to be deleted. */ | |
1063 | frscm_inferior_data_key | |
1064 | = register_inferior_data_with_cleanup (NULL, frscm_del_inferior_frames); | |
1065 | } |