1 /* Scheme interface to stack frames.
3 Copyright (C) 2008-2014 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
26 #include "exceptions.h"
33 #include "guile-internal.h"
35 /* The <gdb:frame> smob.
36 The typedef for this struct is in guile-internal.h. */
40 /* This always appears first. */
43 struct frame_id frame_id
;
44 struct gdbarch
*gdbarch
;
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
;
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. */
70 static const char frame_smob_name
[] = "gdb:frame";
72 /* The tag Guile knows the frame smob by. */
73 static scm_t_bits frame_smob_tag
;
75 /* Keywords used in argument passing. */
76 static SCM block_keyword
;
78 static const struct inferior_data
*frscm_inferior_data_key
;
80 /* Administrivia for frame smobs. */
82 /* Helper function to hash a frame_smob. */
85 frscm_hash_frame_smob (const void *p
)
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
);
91 if (fid
->stack_status
== FID_STACK_VALID
)
92 hash
= iterative_hash (&fid
->stack_addr
, sizeof (fid
->stack_addr
), hash
);
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
),
102 /* Helper function to compute equality of frame_smobs. */
105 frscm_eq_frame_smob (const void *ap
, const void *bp
)
107 const frame_smob
*a
= ap
;
108 const frame_smob
*b
= bp
;
110 return (frame_id_eq (a
->frame_id
, b
->frame_id
)
111 && a
->inferior
== b
->inferior
112 && a
->inferior
!= NULL
);
115 /* Return the frame -> SCM mapping table.
116 It is created if necessary. */
119 frscm_inferior_frame_map (struct inferior
*inferior
)
121 htab_t htab
= inferior_data (inferior
, frscm_inferior_data_key
);
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
);
133 /* The smob "mark" function for <gdb:frame>. */
136 frscm_mark_frame_smob (SCM self
)
138 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (self
);
141 return gdbscm_mark_eqable_gsmob (&f_smob
->base
);
144 /* The smob "free" function for <gdb:frame>. */
147 frscm_free_frame_smob (SCM self
)
149 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (self
);
151 if (f_smob
->inferior
!= NULL
)
153 htab_t htab
= frscm_inferior_frame_map (f_smob
->inferior
);
155 gdbscm_clear_eqable_gsmob_ptr_slot (htab
, &f_smob
->base
);
158 /* Not necessary, done to catch bugs. */
159 f_smob
->inferior
= NULL
;
164 /* The smob "print" function for <gdb:frame>. */
167 frscm_print_frame_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
169 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (self
);
170 struct ui_file
*strfile
;
173 gdbscm_printf (port
, "#<%s ", frame_smob_name
);
175 strfile
= mem_fileopen ();
176 fprint_frame_id (strfile
, f_smob
->frame_id
);
177 s
= ui_file_xstrdup (strfile
, NULL
);
178 gdbscm_printf (port
, "%s", s
);
179 ui_file_delete (strfile
);
182 scm_puts (">", port
);
184 scm_remember_upto_here_1 (self
);
186 /* Non-zero means success. */
190 /* Low level routine to create a <gdb:frame> object. */
193 frscm_make_frame_smob (void)
195 frame_smob
*f_smob
= (frame_smob
*)
196 scm_gc_malloc (sizeof (frame_smob
), frame_smob_name
);
199 f_smob
->frame_id
= null_frame_id
;
200 f_smob
->gdbarch
= NULL
;
201 f_smob
->inferior
= NULL
;
202 f_smob
->frame_id_is_next
= 0;
203 f_scm
= scm_new_smob (frame_smob_tag
, (scm_t_bits
) f_smob
);
204 gdbscm_init_eqable_gsmob (&f_smob
->base
, f_scm
);
209 /* Return non-zero if SCM is a <gdb:frame> object. */
212 frscm_is_frame (SCM scm
)
214 return SCM_SMOB_PREDICATE (frame_smob_tag
, scm
);
217 /* (frame? object) -> boolean */
220 gdbscm_frame_p (SCM scm
)
222 return scm_from_bool (frscm_is_frame (scm
));
225 /* Create a new <gdb:frame> object that encapsulates FRAME.
226 Returns a <gdb:exception> object if there is an error. */
229 frscm_scm_from_frame (struct frame_info
*frame
, struct inferior
*inferior
)
231 frame_smob
*f_smob
, f_smob_for_lookup
;
234 eqable_gdb_smob
**slot
;
235 volatile struct gdb_exception except
;
236 struct frame_id frame_id
= null_frame_id
;
237 struct gdbarch
*gdbarch
= NULL
;
238 int frame_id_is_next
= 0;
240 /* If we've already created a gsmob for this frame, return it.
241 This makes frames eq?-able. */
242 htab
= frscm_inferior_frame_map (inferior
);
243 f_smob_for_lookup
.frame_id
= get_frame_id (frame
);
244 f_smob_for_lookup
.inferior
= inferior
;
245 slot
= gdbscm_find_eqable_gsmob_ptr_slot (htab
, &f_smob_for_lookup
.base
);
247 return (*slot
)->containing_scm
;
249 TRY_CATCH (except
, RETURN_MASK_ALL
)
251 /* Try to get the previous frame, to determine if this is the last frame
252 in a corrupt stack. If so, we need to store the frame_id of the next
253 frame and not of this one (which is possibly invalid). */
254 if (get_prev_frame (frame
) == NULL
255 && get_frame_unwind_stop_reason (frame
) != UNWIND_NO_REASON
256 && get_next_frame (frame
) != NULL
)
258 frame_id
= get_frame_id (get_next_frame (frame
));
259 frame_id_is_next
= 1;
263 frame_id
= get_frame_id (frame
);
264 frame_id_is_next
= 0;
266 gdbarch
= get_frame_arch (frame
);
268 if (except
.reason
< 0)
269 return gdbscm_scm_from_gdb_exception (except
);
271 f_scm
= frscm_make_frame_smob ();
272 f_smob
= (frame_smob
*) SCM_SMOB_DATA (f_scm
);
273 f_smob
->frame_id
= frame_id
;
274 f_smob
->gdbarch
= gdbarch
;
275 f_smob
->inferior
= inferior
;
276 f_smob
->frame_id_is_next
= frame_id_is_next
;
278 gdbscm_fill_eqable_gsmob_ptr_slot (slot
, &f_smob
->base
);
283 /* Create a new <gdb:frame> object that encapsulates FRAME.
284 A Scheme exception is thrown if there is an error. */
287 frscm_scm_from_frame_unsafe (struct frame_info
*frame
,
288 struct inferior
*inferior
)
290 SCM f_scm
= frscm_scm_from_frame (frame
, inferior
);
292 if (gdbscm_is_exception (f_scm
))
293 gdbscm_throw (f_scm
);
298 /* Returns the <gdb:frame> object in SELF.
299 Throws an exception if SELF is not a <gdb:frame> object. */
302 frscm_get_frame_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
304 SCM_ASSERT_TYPE (frscm_is_frame (self
), self
, arg_pos
, func_name
,
310 /* There is no gdbscm_scm_to_frame function because translating
311 a frame SCM object to a struct frame_info * can throw a GDB error.
312 Thus code working with frames has to handle both Scheme errors (e.g., the
313 object is not a frame) and GDB errors (e.g., the frame lookup failed).
315 To help keep things clear we split gdbscm_scm_to_frame into two:
317 gdbscm_get_frame_smob_arg_unsafe
318 - throws a Scheme error if object is not a frame,
319 or if the inferior is gone or is no longer current
321 gdbscm_frame_smob_to_frame
322 - may throw a gdb error if the conversion fails
323 - it's not clear when it will and won't throw a GDB error,
324 but for robustness' sake we assume that whenever we call out to GDB
325 a GDB error may get thrown (and thus the call must be wrapped in a
328 /* Returns the frame_smob for the object wrapped by FRAME_SCM.
329 A Scheme error is thrown if FRAME_SCM is not a frame. */
332 frscm_get_frame_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
334 SCM f_scm
= frscm_get_frame_arg_unsafe (self
, arg_pos
, func_name
);
335 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (f_scm
);
337 if (f_smob
->inferior
== NULL
)
339 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
342 if (f_smob
->inferior
!= current_inferior ())
343 scm_misc_error (func_name
, _("inferior has changed"), SCM_EOL
);
348 /* Returns the frame_info object wrapped by F_SMOB.
349 If the frame doesn't exist anymore (the frame id doesn't
350 correspond to any frame in the inferior), returns NULL.
351 This function calls GDB routines, so don't assume a GDB error will
355 frscm_frame_smob_to_frame (frame_smob
*f_smob
)
357 struct frame_info
*frame
;
359 frame
= frame_find_by_id (f_smob
->frame_id
);
363 if (f_smob
->frame_id_is_next
)
364 frame
= get_prev_frame (frame
);
369 /* Helper function for frscm_del_inferior_frames to mark the frame
373 frscm_mark_frame_invalid (void **slot
, void *info
)
375 frame_smob
*f_smob
= (frame_smob
*) *slot
;
377 f_smob
->inferior
= NULL
;
381 /* This function is called when an inferior is about to be freed.
382 Invalidate the frame as further actions on the frame could result
383 in bad data. All access to the frame should be gated by
384 frscm_get_frame_smob_arg_unsafe which will raise an exception on
388 frscm_del_inferior_frames (struct inferior
*inferior
, void *datum
)
394 htab_traverse_noresize (htab
, frscm_mark_frame_invalid
, NULL
);
401 /* (frame-valid? <gdb:frame>) -> bool
402 Returns #t if the frame corresponding to the frame_id of this
403 object still exists in the inferior. */
406 gdbscm_frame_valid_p (SCM self
)
409 struct frame_info
*frame
= NULL
;
410 volatile struct gdb_exception except
;
412 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
414 TRY_CATCH (except
, RETURN_MASK_ALL
)
416 frame
= frscm_frame_smob_to_frame (f_smob
);
418 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
420 return scm_from_bool (frame
!= NULL
);
423 /* (frame-name <gdb:frame>) -> string
424 Returns the name of the function corresponding to this frame,
425 or #f if there is no function. */
428 gdbscm_frame_name (SCM self
)
432 enum language lang
= language_minimal
;
433 struct frame_info
*frame
= NULL
;
435 volatile struct gdb_exception except
;
437 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
439 TRY_CATCH (except
, RETURN_MASK_ALL
)
441 frame
= frscm_frame_smob_to_frame (f_smob
);
443 find_frame_funname (frame
, &name
, &lang
, NULL
);
445 if (except
.reason
< 0)
447 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
451 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
457 result
= gdbscm_scm_from_c_string (name
);
466 /* (frame-type <gdb:frame>) -> integer
467 Returns the frame type, namely one of the gdb:*_FRAME constants. */
470 gdbscm_frame_type (SCM self
)
473 enum frame_type type
= NORMAL_FRAME
;
474 struct frame_info
*frame
= NULL
;
475 volatile struct gdb_exception except
;
477 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
479 TRY_CATCH (except
, RETURN_MASK_ALL
)
481 frame
= frscm_frame_smob_to_frame (f_smob
);
483 type
= get_frame_type (frame
);
485 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
489 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
493 return scm_from_int (type
);
496 /* (frame-arch <gdb:frame>) -> <gdb:architecture>
497 Returns the frame's architecture as a gdb:architecture object. */
500 gdbscm_frame_arch (SCM self
)
503 struct frame_info
*frame
= NULL
;
504 volatile struct gdb_exception except
;
506 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
508 TRY_CATCH (except
, RETURN_MASK_ALL
)
510 frame
= frscm_frame_smob_to_frame (f_smob
);
512 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
516 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
520 return arscm_scm_from_arch (f_smob
->gdbarch
);
523 /* (frame-unwind-stop-reason <gdb:frame>) -> integer
524 Returns one of the gdb:FRAME_UNWIND_* constants. */
527 gdbscm_frame_unwind_stop_reason (SCM self
)
530 struct frame_info
*frame
= NULL
;
531 volatile struct gdb_exception except
;
532 enum unwind_stop_reason stop_reason
;
534 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
536 TRY_CATCH (except
, RETURN_MASK_ALL
)
538 frame
= frscm_frame_smob_to_frame (f_smob
);
540 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
544 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
548 stop_reason
= get_frame_unwind_stop_reason (frame
);
550 return scm_from_int (stop_reason
);
553 /* (frame-pc <gdb:frame>) -> integer
554 Returns the frame's resume address. */
557 gdbscm_frame_pc (SCM self
)
561 struct frame_info
*frame
= NULL
;
562 volatile struct gdb_exception except
;
564 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
566 TRY_CATCH (except
, RETURN_MASK_ALL
)
568 frame
= frscm_frame_smob_to_frame (f_smob
);
570 pc
= get_frame_pc (frame
);
572 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
576 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
580 return gdbscm_scm_from_ulongest (pc
);
583 /* (frame-block <gdb:frame>) -> <gdb:block>
584 Returns the frame's code block, or #f if one cannot be found. */
587 gdbscm_frame_block (SCM self
)
590 struct block
*block
= NULL
, *fn_block
;
591 struct frame_info
*frame
= NULL
;
592 volatile struct gdb_exception except
;
594 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
596 TRY_CATCH (except
, RETURN_MASK_ALL
)
598 frame
= frscm_frame_smob_to_frame (f_smob
);
600 block
= get_frame_block (frame
, NULL
);
602 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
606 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
610 for (fn_block
= block
;
611 fn_block
!= NULL
&& BLOCK_FUNCTION (fn_block
) == NULL
;
612 fn_block
= BLOCK_SUPERBLOCK (fn_block
))
615 if (block
== NULL
|| fn_block
== NULL
|| BLOCK_FUNCTION (fn_block
) == NULL
)
617 scm_misc_error (FUNC_NAME
, _("cannot find block for frame"),
626 st
= SYMBOL_SYMTAB (BLOCK_FUNCTION (fn_block
));
627 return bkscm_scm_from_block (block
, st
->objfile
);
633 /* (frame-function <gdb:frame>) -> <gdb:symbol>
634 Returns the symbol for the function corresponding to this frame,
635 or #f if there isn't one. */
638 gdbscm_frame_function (SCM self
)
641 struct symbol
*sym
= NULL
;
642 struct frame_info
*frame
= NULL
;
643 volatile struct gdb_exception except
;
645 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
647 TRY_CATCH (except
, RETURN_MASK_ALL
)
649 frame
= frscm_frame_smob_to_frame (f_smob
);
651 sym
= find_pc_function (get_frame_address_in_block (frame
));
653 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
657 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
662 return syscm_scm_from_symbol (sym
);
667 /* (frame-older <gdb:frame>) -> <gdb:frame>
668 Returns the frame immediately older (outer) to this frame,
669 or #f if there isn't one. */
672 gdbscm_frame_older (SCM self
)
675 struct frame_info
*prev
= NULL
;
676 struct frame_info
*frame
= NULL
;
677 volatile struct gdb_exception except
;
679 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
681 TRY_CATCH (except
, RETURN_MASK_ALL
)
683 frame
= frscm_frame_smob_to_frame (f_smob
);
685 prev
= get_prev_frame (frame
);
687 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
691 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
696 return frscm_scm_from_frame_unsafe (prev
, f_smob
->inferior
);
701 /* (frame-newer <gdb:frame>) -> <gdb:frame>
702 Returns the frame immediately newer (inner) to this frame,
703 or #f if there isn't one. */
706 gdbscm_frame_newer (SCM self
)
709 struct frame_info
*next
= NULL
;
710 struct frame_info
*frame
= NULL
;
711 volatile struct gdb_exception except
;
713 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
715 TRY_CATCH (except
, RETURN_MASK_ALL
)
717 frame
= frscm_frame_smob_to_frame (f_smob
);
719 next
= get_next_frame (frame
);
721 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
725 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
730 return frscm_scm_from_frame_unsafe (next
, f_smob
->inferior
);
735 /* (frame-sal <gdb:frame>) -> <gdb:sal>
736 Returns the frame's symtab and line. */
739 gdbscm_frame_sal (SCM self
)
742 struct symtab_and_line sal
;
743 struct frame_info
*frame
= NULL
;
744 volatile struct gdb_exception except
;
746 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
748 TRY_CATCH (except
, RETURN_MASK_ALL
)
750 frame
= frscm_frame_smob_to_frame (f_smob
);
752 find_frame_sal (frame
, &sal
);
754 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
758 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
762 return stscm_scm_from_sal (sal
);
765 /* (frame-read-var <gdb:frame> <gdb:symbol>) -> <gdb:value>
766 (frame-read-var <gdb:frame> string [#:block <gdb:block>]) -> <gdb:value>
767 If the optional block argument is provided start the search from that block,
768 otherwise search from the frame's current block (determined by examining
769 the resume address of the frame). The variable argument must be a string
770 or an instance of a <gdb:symbol>. The block argument must be an instance of
774 gdbscm_frame_read_var (SCM self
, SCM symbol_scm
, SCM rest
)
776 SCM keywords
[] = { block_keyword
, SCM_BOOL_F
};
779 int block_arg_pos
= -1;
780 SCM block_scm
= SCM_UNDEFINED
;
781 struct frame_info
*frame
= NULL
;
782 struct symbol
*var
= NULL
;
783 struct value
*value
= NULL
;
784 volatile struct gdb_exception except
;
786 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
788 TRY_CATCH (except
, RETURN_MASK_ALL
)
790 frame
= frscm_frame_smob_to_frame (f_smob
);
792 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
796 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
800 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG3
, keywords
, "#O",
801 rest
, &block_arg_pos
, &block_scm
);
803 if (syscm_is_symbol (symbol_scm
))
805 var
= syscm_get_valid_symbol_arg_unsafe (symbol_scm
, SCM_ARG2
,
807 SCM_ASSERT (SCM_UNBNDP (block_scm
), block_scm
, SCM_ARG3
, FUNC_NAME
);
809 else if (scm_is_string (symbol_scm
))
812 const struct block
*block
= NULL
;
813 struct cleanup
*cleanup
;
814 volatile struct gdb_exception except
;
816 if (! SCM_UNBNDP (block_scm
))
820 gdb_assert (block_arg_pos
> 0);
821 block
= bkscm_scm_to_block (block_scm
, block_arg_pos
, FUNC_NAME
,
824 gdbscm_throw (except_scm
);
827 var_name
= gdbscm_scm_to_c_string (symbol_scm
);
828 cleanup
= make_cleanup (xfree
, var_name
);
829 /* N.B. Between here and the call to do_cleanups, don't do anything
830 to cause a Scheme exception without performing the cleanup. */
832 TRY_CATCH (except
, RETURN_MASK_ALL
)
835 block
= get_frame_block (frame
, NULL
);
836 var
= lookup_symbol (var_name
, block
, VAR_DOMAIN
, NULL
);
838 if (except
.reason
< 0)
839 do_cleanups (cleanup
);
840 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
844 do_cleanups (cleanup
);
845 gdbscm_out_of_range_error (FUNC_NAME
, 0, symbol_scm
,
846 _("variable not found"));
849 do_cleanups (cleanup
);
853 /* Use SCM_ASSERT_TYPE for more consistent error messages. */
854 SCM_ASSERT_TYPE (0, symbol_scm
, SCM_ARG1
, FUNC_NAME
,
855 _("gdb:symbol or string"));
858 TRY_CATCH (except
, RETURN_MASK_ALL
)
860 value
= read_var_value (var
, frame
);
862 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
864 return vlscm_scm_from_value (value
);
867 /* (frame-select <gdb:frame>) -> unspecified
868 Select this frame. */
871 gdbscm_frame_select (SCM self
)
874 struct frame_info
*frame
= NULL
;
875 volatile struct gdb_exception except
;
877 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
879 TRY_CATCH (except
, RETURN_MASK_ALL
)
881 frame
= frscm_frame_smob_to_frame (f_smob
);
883 select_frame (frame
);
885 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
889 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
893 return SCM_UNSPECIFIED
;
896 /* (newest-frame) -> <gdb:frame>
897 Returns the newest frame. */
900 gdbscm_newest_frame (void)
902 struct frame_info
*frame
= NULL
;
903 volatile struct gdb_exception except
;
905 TRY_CATCH (except
, RETURN_MASK_ALL
)
907 frame
= get_current_frame ();
909 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
911 return frscm_scm_from_frame_unsafe (frame
, current_inferior ());
914 /* (selected-frame) -> <gdb:frame>
915 Returns the selected frame. */
918 gdbscm_selected_frame (void)
920 struct frame_info
*frame
= NULL
;
921 volatile struct gdb_exception except
;
923 TRY_CATCH (except
, RETURN_MASK_ALL
)
925 frame
= get_selected_frame (_("No frame is currently selected"));
927 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
929 return frscm_scm_from_frame_unsafe (frame
, current_inferior ());
932 /* (unwind-stop-reason-string integer) -> string
933 Return a string explaining the unwind stop reason. */
936 gdbscm_unwind_stop_reason_string (SCM reason_scm
)
941 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, NULL
, "i",
942 reason_scm
, &reason
);
944 if (reason
< UNWIND_FIRST
|| reason
> UNWIND_LAST
)
945 scm_out_of_range (FUNC_NAME
, reason_scm
);
947 str
= frame_stop_reason_string (reason
);
948 return gdbscm_scm_from_c_string (str
);
951 /* Initialize the Scheme frame support. */
953 static const scheme_integer_constant frame_integer_constants
[] =
955 #define ENTRY(X) { #X, X }
957 ENTRY (NORMAL_FRAME
),
959 ENTRY (INLINE_FRAME
),
960 ENTRY (TAILCALL_FRAME
),
961 ENTRY (SIGTRAMP_FRAME
),
963 ENTRY (SENTINEL_FRAME
),
967 #define SET(name, description) \
968 { "FRAME_" #name, name },
969 #include "unwind_stop_reasons.def"
972 END_INTEGER_CONSTANTS
975 static const scheme_function frame_functions
[] =
977 { "frame?", 1, 0, 0, gdbscm_frame_p
,
979 Return #t if the object is a <gdb:frame> object." },
981 { "frame-valid?", 1, 0, 0, gdbscm_frame_valid_p
,
983 Return #t if the object is a valid <gdb:frame> object.\n\
984 Frames become invalid when the inferior returns to its caller." },
986 { "frame-name", 1, 0, 0, gdbscm_frame_name
,
988 Return the name of the function corresponding to this frame,\n\
989 or #f if there is no function." },
991 { "frame-arch", 1, 0, 0, gdbscm_frame_arch
,
993 Return the frame's architecture as a <gdb:arch> object." },
995 { "frame-type", 1, 0, 0, gdbscm_frame_type
,
997 Return the frame type, namely one of the gdb:*_FRAME constants." },
999 { "frame-unwind-stop-reason", 1, 0, 0, gdbscm_frame_unwind_stop_reason
,
1001 Return one of the gdb:FRAME_UNWIND_* constants explaining why\n\
1002 it's not possible to find frames older than this." },
1004 { "frame-pc", 1, 0, 0, gdbscm_frame_pc
,
1006 Return the frame's resume address." },
1008 { "frame-block", 1, 0, 0, gdbscm_frame_block
,
1010 Return the frame's code block, or #f if one cannot be found." },
1012 { "frame-function", 1, 0, 0, gdbscm_frame_function
,
1014 Return the <gdb:symbol> for the function corresponding to this frame,\n\
1015 or #f if there isn't one." },
1017 { "frame-older", 1, 0, 0, gdbscm_frame_older
,
1019 Return the frame immediately older (outer) to this frame,\n\
1020 or #f if there isn't one." },
1022 { "frame-newer", 1, 0, 0, gdbscm_frame_newer
,
1024 Return the frame immediately newer (inner) to this frame,\n\
1025 or #f if there isn't one." },
1027 { "frame-sal", 1, 0, 0, gdbscm_frame_sal
,
1029 Return the frame's symtab-and-line <gdb:sal> object." },
1031 { "frame-read-var", 2, 0, 1, gdbscm_frame_read_var
,
1033 Return the value of the symbol in the frame.\n\
1035 Arguments: <gdb:frame> <gdb:symbol>\n\
1036 Or: <gdb:frame> string [#:block <gdb:block>]" },
1038 { "frame-select", 1, 0, 0, gdbscm_frame_select
,
1040 Select this frame." },
1042 { "newest-frame", 0, 0, 0, gdbscm_newest_frame
,
1044 Return the newest frame." },
1046 { "selected-frame", 0, 0, 0, gdbscm_selected_frame
,
1048 Return the selected frame." },
1050 { "unwind-stop-reason-string", 1, 0, 0, gdbscm_unwind_stop_reason_string
,
1052 Return a string explaining the unwind stop reason.\n\
1054 Arguments: integer (the result of frame-unwind-stop-reason)" },
1060 gdbscm_initialize_frames (void)
1063 = gdbscm_make_smob_type (frame_smob_name
, sizeof (frame_smob
));
1064 scm_set_smob_mark (frame_smob_tag
, frscm_mark_frame_smob
);
1065 scm_set_smob_free (frame_smob_tag
, frscm_free_frame_smob
);
1066 scm_set_smob_print (frame_smob_tag
, frscm_print_frame_smob
);
1068 gdbscm_define_integer_constants (frame_integer_constants
, 1);
1069 gdbscm_define_functions (frame_functions
, 1);
1071 block_keyword
= scm_from_latin1_keyword ("block");
1073 /* Register an inferior "free" callback so we can properly
1074 invalidate frames when an inferior file is about to be deleted. */
1075 frscm_inferior_data_key
1076 = register_inferior_data_with_cleanup (NULL
, frscm_del_inferior_frames
);