1 /* Scheme interface to stack frames.
3 Copyright (C) 2008-2020 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. */
31 #include "user-regs.h"
33 #include "guile-internal.h"
35 /* The <gdb:frame> smob. */
39 /* This always appears first. */
42 struct frame_id frame_id
;
43 struct gdbarch
*gdbarch
;
45 /* Frames are tracked by inferior.
46 We need some place to put the eq?-able hash table, and this feels as
47 good a place as any. Frames in one inferior shouldn't be considered
48 equal to frames in a different inferior. The frame becomes invalid if
49 this becomes NULL (the inferior has been deleted from gdb).
50 It's easier to relax restrictions than impose them after the fact.
51 N.B. It is an outstanding question whether a frame survives reruns of
52 the inferior. Intuitively the answer is "No", but currently a frame
53 also survives, e.g., multiple invocations of the same function from
54 the same point. Even different threads can have the same frame, e.g.,
55 if a thread dies and a new thread gets the same stack. */
56 struct inferior
*inferior
;
58 /* Marks that the FRAME_ID member actually holds the ID of the frame next
59 to this, and not this frame's ID itself. This is a hack to permit Scheme
60 frame objects which represent invalid frames (i.e., the last frame_info
61 in a corrupt stack). The problem arises from the fact that this code
62 relies on FRAME_ID to uniquely identify a frame, which is not always true
63 for the last "frame" in a corrupt stack (it can have a null ID, or the
64 same ID as the previous frame). Whenever get_prev_frame returns NULL, we
65 record the frame_id of the next frame and set FRAME_ID_IS_NEXT to 1. */
69 static const char frame_smob_name
[] = "gdb:frame";
71 /* The tag Guile knows the frame smob by. */
72 static scm_t_bits frame_smob_tag
;
74 /* Keywords used in argument passing. */
75 static SCM block_keyword
;
77 static const struct inferior_data
*frscm_inferior_data_key
;
79 /* Administrivia for frame smobs. */
81 /* Helper function to hash a frame_smob. */
84 frscm_hash_frame_smob (const void *p
)
86 const frame_smob
*f_smob
= (const frame_smob
*) p
;
87 const struct frame_id
*fid
= &f_smob
->frame_id
;
88 hashval_t hash
= htab_hash_pointer (f_smob
->inferior
);
90 if (fid
->stack_status
== FID_STACK_VALID
)
91 hash
= iterative_hash (&fid
->stack_addr
, sizeof (fid
->stack_addr
), hash
);
93 hash
= iterative_hash (&fid
->code_addr
, sizeof (fid
->code_addr
), hash
);
94 if (fid
->special_addr_p
)
95 hash
= iterative_hash (&fid
->special_addr
, sizeof (fid
->special_addr
),
101 /* Helper function to compute equality of frame_smobs. */
104 frscm_eq_frame_smob (const void *ap
, const void *bp
)
106 const frame_smob
*a
= (const frame_smob
*) ap
;
107 const frame_smob
*b
= (const frame_smob
*) bp
;
109 return (frame_id_eq (a
->frame_id
, b
->frame_id
)
110 && a
->inferior
== b
->inferior
111 && a
->inferior
!= NULL
);
114 /* Return the frame -> SCM mapping table.
115 It is created if necessary. */
118 frscm_inferior_frame_map (struct inferior
*inferior
)
120 htab_t htab
= (htab_t
) inferior_data (inferior
, frscm_inferior_data_key
);
124 htab
= gdbscm_create_eqable_gsmob_ptr_map (frscm_hash_frame_smob
,
125 frscm_eq_frame_smob
);
126 set_inferior_data (inferior
, frscm_inferior_data_key
, htab
);
132 /* The smob "free" function for <gdb:frame>. */
135 frscm_free_frame_smob (SCM self
)
137 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (self
);
139 if (f_smob
->inferior
!= NULL
)
141 htab_t htab
= frscm_inferior_frame_map (f_smob
->inferior
);
143 gdbscm_clear_eqable_gsmob_ptr_slot (htab
, &f_smob
->base
);
146 /* Not necessary, done to catch bugs. */
147 f_smob
->inferior
= NULL
;
152 /* The smob "print" function for <gdb:frame>. */
155 frscm_print_frame_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
157 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (self
);
159 gdbscm_printf (port
, "#<%s ", frame_smob_name
);
162 fprint_frame_id (&strfile
, f_smob
->frame_id
);
163 gdbscm_printf (port
, "%s", strfile
.c_str ());
165 scm_puts (">", port
);
167 scm_remember_upto_here_1 (self
);
169 /* Non-zero means success. */
173 /* Low level routine to create a <gdb:frame> object. */
176 frscm_make_frame_smob (void)
178 frame_smob
*f_smob
= (frame_smob
*)
179 scm_gc_malloc (sizeof (frame_smob
), frame_smob_name
);
182 f_smob
->frame_id
= null_frame_id
;
183 f_smob
->gdbarch
= NULL
;
184 f_smob
->inferior
= NULL
;
185 f_smob
->frame_id_is_next
= 0;
186 f_scm
= scm_new_smob (frame_smob_tag
, (scm_t_bits
) f_smob
);
187 gdbscm_init_eqable_gsmob (&f_smob
->base
, f_scm
);
192 /* Return non-zero if SCM is a <gdb:frame> object. */
195 frscm_is_frame (SCM scm
)
197 return SCM_SMOB_PREDICATE (frame_smob_tag
, scm
);
200 /* (frame? object) -> boolean */
203 gdbscm_frame_p (SCM scm
)
205 return scm_from_bool (frscm_is_frame (scm
));
208 /* Create a new <gdb:frame> object that encapsulates FRAME.
209 Returns a <gdb:exception> object if there is an error. */
212 frscm_scm_from_frame (struct frame_info
*frame
, struct inferior
*inferior
)
214 frame_smob
*f_smob
, f_smob_for_lookup
;
217 eqable_gdb_smob
**slot
;
218 struct frame_id frame_id
= null_frame_id
;
219 struct gdbarch
*gdbarch
= NULL
;
220 int frame_id_is_next
= 0;
222 /* If we've already created a gsmob for this frame, return it.
223 This makes frames eq?-able. */
224 htab
= frscm_inferior_frame_map (inferior
);
225 f_smob_for_lookup
.frame_id
= get_frame_id (frame
);
226 f_smob_for_lookup
.inferior
= inferior
;
227 slot
= gdbscm_find_eqable_gsmob_ptr_slot (htab
, &f_smob_for_lookup
.base
);
229 return (*slot
)->containing_scm
;
233 /* Try to get the previous frame, to determine if this is the last frame
234 in a corrupt stack. If so, we need to store the frame_id of the next
235 frame and not of this one (which is possibly invalid). */
236 if (get_prev_frame (frame
) == NULL
237 && get_frame_unwind_stop_reason (frame
) != UNWIND_NO_REASON
238 && get_next_frame (frame
) != NULL
)
240 frame_id
= get_frame_id (get_next_frame (frame
));
241 frame_id_is_next
= 1;
245 frame_id
= get_frame_id (frame
);
246 frame_id_is_next
= 0;
248 gdbarch
= get_frame_arch (frame
);
250 catch (const gdb_exception
&except
)
252 return gdbscm_scm_from_gdb_exception (unpack (except
));
255 f_scm
= frscm_make_frame_smob ();
256 f_smob
= (frame_smob
*) SCM_SMOB_DATA (f_scm
);
257 f_smob
->frame_id
= frame_id
;
258 f_smob
->gdbarch
= gdbarch
;
259 f_smob
->inferior
= inferior
;
260 f_smob
->frame_id_is_next
= frame_id_is_next
;
262 gdbscm_fill_eqable_gsmob_ptr_slot (slot
, &f_smob
->base
);
267 /* Create a new <gdb:frame> object that encapsulates FRAME.
268 A Scheme exception is thrown if there is an error. */
271 frscm_scm_from_frame_unsafe (struct frame_info
*frame
,
272 struct inferior
*inferior
)
274 SCM f_scm
= frscm_scm_from_frame (frame
, inferior
);
276 if (gdbscm_is_exception (f_scm
))
277 gdbscm_throw (f_scm
);
282 /* Returns the <gdb:frame> object in SELF.
283 Throws an exception if SELF is not a <gdb:frame> object. */
286 frscm_get_frame_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
288 SCM_ASSERT_TYPE (frscm_is_frame (self
), self
, arg_pos
, func_name
,
294 /* There is no gdbscm_scm_to_frame function because translating
295 a frame SCM object to a struct frame_info * can throw a GDB error.
296 Thus code working with frames has to handle both Scheme errors (e.g., the
297 object is not a frame) and GDB errors (e.g., the frame lookup failed).
299 To help keep things clear we split what would be gdbscm_scm_to_frame
302 frscm_get_frame_smob_arg_unsafe
303 - throws a Scheme error if object is not a frame,
304 or if the inferior is gone or is no longer current
306 frscm_frame_smob_to_frame
307 - may throw a gdb error if the conversion fails
308 - it's not clear when it will and won't throw a GDB error,
309 but for robustness' sake we assume that whenever we call out to GDB
310 a GDB error may get thrown (and thus the call must be wrapped in a
313 /* Returns the frame_smob for the object wrapped by FRAME_SCM.
314 A Scheme error is thrown if FRAME_SCM is not a frame. */
317 frscm_get_frame_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
319 SCM f_scm
= frscm_get_frame_arg_unsafe (self
, arg_pos
, func_name
);
320 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (f_scm
);
322 if (f_smob
->inferior
== NULL
)
324 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
327 if (f_smob
->inferior
!= current_inferior ())
328 scm_misc_error (func_name
, _("inferior has changed"), SCM_EOL
);
333 /* Returns the frame_info object wrapped by F_SMOB.
334 If the frame doesn't exist anymore (the frame id doesn't
335 correspond to any frame in the inferior), returns NULL.
336 This function calls GDB routines, so don't assume a GDB error will
340 frscm_frame_smob_to_frame (frame_smob
*f_smob
)
342 struct frame_info
*frame
;
344 frame
= frame_find_by_id (f_smob
->frame_id
);
348 if (f_smob
->frame_id_is_next
)
349 frame
= get_prev_frame (frame
);
354 /* Helper function for frscm_del_inferior_frames to mark the frame
358 frscm_mark_frame_invalid (void **slot
, void *info
)
360 frame_smob
*f_smob
= (frame_smob
*) *slot
;
362 f_smob
->inferior
= NULL
;
366 /* This function is called when an inferior is about to be freed.
367 Invalidate the frame as further actions on the frame could result
368 in bad data. All access to the frame should be gated by
369 frscm_get_frame_smob_arg_unsafe which will raise an exception on
373 frscm_del_inferior_frames (struct inferior
*inferior
, void *datum
)
375 htab_t htab
= (htab_t
) datum
;
379 htab_traverse_noresize (htab
, frscm_mark_frame_invalid
, NULL
);
386 /* (frame-valid? <gdb:frame>) -> bool
387 Returns #t if the frame corresponding to the frame_id of this
388 object still exists in the inferior. */
391 gdbscm_frame_valid_p (SCM self
)
394 struct frame_info
*frame
= NULL
;
396 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
398 gdbscm_gdb_exception exc
{};
401 frame
= frscm_frame_smob_to_frame (f_smob
);
403 catch (const gdb_exception
&except
)
405 exc
= unpack (except
);
408 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
409 return scm_from_bool (frame
!= NULL
);
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. */
417 gdbscm_frame_name (SCM self
)
420 gdb::unique_xmalloc_ptr
<char> name
;
421 enum language lang
= language_minimal
;
422 struct frame_info
*frame
= NULL
;
425 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
427 gdbscm_gdb_exception exc
{};
430 frame
= frscm_frame_smob_to_frame (f_smob
);
432 name
= find_frame_funname (frame
, &lang
, NULL
);
434 catch (const gdb_exception
&except
)
436 exc
= unpack (except
);
439 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
442 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
447 result
= gdbscm_scm_from_c_string (name
.get ());
454 /* (frame-type <gdb:frame>) -> integer
455 Returns the frame type, namely one of the gdb:*_FRAME constants. */
458 gdbscm_frame_type (SCM self
)
461 enum frame_type type
= NORMAL_FRAME
;
462 struct frame_info
*frame
= NULL
;
464 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
466 gdbscm_gdb_exception exc
{};
469 frame
= frscm_frame_smob_to_frame (f_smob
);
471 type
= get_frame_type (frame
);
473 catch (const gdb_exception
&except
)
475 exc
= unpack (except
);
478 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
481 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
485 return scm_from_int (type
);
488 /* (frame-arch <gdb:frame>) -> <gdb:architecture>
489 Returns the frame's architecture as a gdb:architecture object. */
492 gdbscm_frame_arch (SCM self
)
495 struct frame_info
*frame
= NULL
;
497 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
499 gdbscm_gdb_exception exc
{};
502 frame
= frscm_frame_smob_to_frame (f_smob
);
504 catch (const gdb_exception
&except
)
506 exc
= unpack (except
);
509 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
512 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
516 return arscm_scm_from_arch (f_smob
->gdbarch
);
519 /* (frame-unwind-stop-reason <gdb:frame>) -> integer
520 Returns one of the gdb:FRAME_UNWIND_* constants. */
523 gdbscm_frame_unwind_stop_reason (SCM self
)
526 struct frame_info
*frame
= NULL
;
527 enum unwind_stop_reason stop_reason
;
529 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
531 gdbscm_gdb_exception exc
{};
534 frame
= frscm_frame_smob_to_frame (f_smob
);
536 catch (const gdb_exception
&except
)
538 exc
= unpack (except
);
541 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
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
;
563 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
565 gdbscm_gdb_exception exc
{};
568 frame
= frscm_frame_smob_to_frame (f_smob
);
570 pc
= get_frame_pc (frame
);
572 catch (const gdb_exception
&except
)
574 exc
= unpack (except
);
577 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
580 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
584 return gdbscm_scm_from_ulongest (pc
);
587 /* (frame-block <gdb:frame>) -> <gdb:block>
588 Returns the frame's code block, or #f if one cannot be found. */
591 gdbscm_frame_block (SCM self
)
594 const struct block
*block
= NULL
, *fn_block
;
595 struct frame_info
*frame
= NULL
;
597 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
599 gdbscm_gdb_exception exc
{};
602 frame
= frscm_frame_smob_to_frame (f_smob
);
604 block
= get_frame_block (frame
, NULL
);
606 catch (const gdb_exception
&except
)
608 exc
= unpack (except
);
611 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
614 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
618 for (fn_block
= block
;
619 fn_block
!= NULL
&& BLOCK_FUNCTION (fn_block
) == NULL
;
620 fn_block
= BLOCK_SUPERBLOCK (fn_block
))
623 if (block
== NULL
|| fn_block
== NULL
|| BLOCK_FUNCTION (fn_block
) == NULL
)
625 scm_misc_error (FUNC_NAME
, _("cannot find block for frame"),
631 return bkscm_scm_from_block
632 (block
, symbol_objfile (BLOCK_FUNCTION (fn_block
)));
638 /* (frame-function <gdb:frame>) -> <gdb:symbol>
639 Returns the symbol for the function corresponding to this frame,
640 or #f if there isn't one. */
643 gdbscm_frame_function (SCM self
)
646 struct symbol
*sym
= NULL
;
647 struct frame_info
*frame
= NULL
;
649 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
651 gdbscm_gdb_exception exc
{};
654 frame
= frscm_frame_smob_to_frame (f_smob
);
656 sym
= find_pc_function (get_frame_address_in_block (frame
));
658 catch (const gdb_exception
&except
)
660 exc
= unpack (except
);
663 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
666 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
671 return syscm_scm_from_symbol (sym
);
676 /* (frame-older <gdb:frame>) -> <gdb:frame>
677 Returns the frame immediately older (outer) to this frame,
678 or #f if there isn't one. */
681 gdbscm_frame_older (SCM self
)
684 struct frame_info
*prev
= NULL
;
685 struct frame_info
*frame
= NULL
;
687 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
689 gdbscm_gdb_exception exc
{};
692 frame
= frscm_frame_smob_to_frame (f_smob
);
694 prev
= get_prev_frame (frame
);
696 catch (const gdb_exception
&except
)
698 exc
= unpack (except
);
701 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
704 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
709 return frscm_scm_from_frame_unsafe (prev
, f_smob
->inferior
);
714 /* (frame-newer <gdb:frame>) -> <gdb:frame>
715 Returns the frame immediately newer (inner) to this frame,
716 or #f if there isn't one. */
719 gdbscm_frame_newer (SCM self
)
722 struct frame_info
*next
= NULL
;
723 struct frame_info
*frame
= NULL
;
725 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
727 gdbscm_gdb_exception exc
{};
730 frame
= frscm_frame_smob_to_frame (f_smob
);
732 next
= get_next_frame (frame
);
734 catch (const gdb_exception
&except
)
736 exc
= unpack (except
);
739 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
742 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
747 return frscm_scm_from_frame_unsafe (next
, f_smob
->inferior
);
752 /* (frame-sal <gdb:frame>) -> <gdb:sal>
753 Returns the frame's symtab and line. */
756 gdbscm_frame_sal (SCM self
)
759 struct symtab_and_line sal
;
760 struct frame_info
*frame
= NULL
;
762 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
764 gdbscm_gdb_exception exc
{};
767 frame
= frscm_frame_smob_to_frame (f_smob
);
769 sal
= find_frame_sal (frame
);
771 catch (const gdb_exception
&except
)
773 exc
= unpack (except
);
776 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
779 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
783 return stscm_scm_from_sal (sal
);
786 /* (frame-read-register <gdb:frame> string) -> <gdb:value>
787 The register argument must be a string. */
790 gdbscm_frame_read_register (SCM self
, SCM register_scm
)
793 struct value
*value
= NULL
;
794 struct frame_info
*frame
= NULL
;
797 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
798 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, NULL
, "s",
799 register_scm
, ®ister_str
);
801 gdbscm_gdb_exception except
{};
807 frame
= frscm_frame_smob_to_frame (f_smob
);
810 regnum
= user_reg_map_name_to_regnum (get_frame_arch (frame
),
812 strlen (register_str
));
814 value
= value_of_register (regnum
, frame
);
817 catch (const gdb_exception
&ex
)
819 except
= unpack (ex
);
822 xfree (register_str
);
823 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
827 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
833 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG2
, register_scm
,
834 _("unknown register"));
837 return vlscm_scm_from_value (value
);
840 /* (frame-read-var <gdb:frame> <gdb:symbol>) -> <gdb:value>
841 (frame-read-var <gdb:frame> string [#:block <gdb:block>]) -> <gdb:value>
842 If the optional block argument is provided start the search from that block,
843 otherwise search from the frame's current block (determined by examining
844 the resume address of the frame). The variable argument must be a string
845 or an instance of a <gdb:symbol>. The block argument must be an instance of
849 gdbscm_frame_read_var (SCM self
, SCM symbol_scm
, SCM rest
)
851 SCM keywords
[] = { block_keyword
, SCM_BOOL_F
};
853 int block_arg_pos
= -1;
854 SCM block_scm
= SCM_UNDEFINED
;
855 struct frame_info
*frame
= NULL
;
856 struct symbol
*var
= NULL
;
857 const struct block
*block
= NULL
;
858 struct value
*value
= NULL
;
860 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
862 gdbscm_gdb_exception exc
{};
865 frame
= frscm_frame_smob_to_frame (f_smob
);
867 catch (const gdb_exception
&except
)
869 exc
= unpack (except
);
872 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
875 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
879 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG3
, keywords
, "#O",
880 rest
, &block_arg_pos
, &block_scm
);
882 if (syscm_is_symbol (symbol_scm
))
884 var
= syscm_get_valid_symbol_arg_unsafe (symbol_scm
, SCM_ARG2
,
886 SCM_ASSERT (SCM_UNBNDP (block_scm
), block_scm
, SCM_ARG3
, FUNC_NAME
);
888 else if (scm_is_string (symbol_scm
))
890 gdbscm_gdb_exception except
{};
892 if (! SCM_UNBNDP (block_scm
))
896 gdb_assert (block_arg_pos
> 0);
897 block
= bkscm_scm_to_block (block_scm
, block_arg_pos
, FUNC_NAME
,
900 gdbscm_throw (except_scm
);
904 gdb::unique_xmalloc_ptr
<char> var_name
905 (gdbscm_scm_to_c_string (symbol_scm
));
906 /* N.B. Between here and the end of the scope, don't do anything
907 to cause a Scheme exception. */
911 struct block_symbol lookup_sym
;
914 block
= get_frame_block (frame
, NULL
);
915 lookup_sym
= lookup_symbol (var_name
.get (), block
, VAR_DOMAIN
,
917 var
= lookup_sym
.symbol
;
918 block
= lookup_sym
.block
;
920 catch (const gdb_exception
&ex
)
922 except
= unpack (ex
);
926 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
929 gdbscm_out_of_range_error (FUNC_NAME
, 0, symbol_scm
,
930 _("variable not found"));
934 /* Use SCM_ASSERT_TYPE for more consistent error messages. */
935 SCM_ASSERT_TYPE (0, symbol_scm
, SCM_ARG1
, FUNC_NAME
,
936 _("gdb:symbol or string"));
941 value
= read_var_value (var
, block
, frame
);
943 catch (const gdb_exception
&except
)
945 exc
= unpack (except
);
948 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
949 return vlscm_scm_from_value (value
);
952 /* (frame-select <gdb:frame>) -> unspecified
953 Select this frame. */
956 gdbscm_frame_select (SCM self
)
959 struct frame_info
*frame
= NULL
;
961 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
963 gdbscm_gdb_exception exc
{};
966 frame
= frscm_frame_smob_to_frame (f_smob
);
968 select_frame (frame
);
970 catch (const gdb_exception
&except
)
972 exc
= unpack (except
);
975 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
978 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
982 return SCM_UNSPECIFIED
;
985 /* (newest-frame) -> <gdb:frame>
986 Returns the newest frame. */
989 gdbscm_newest_frame (void)
991 struct frame_info
*frame
= NULL
;
993 gdbscm_gdb_exception exc
{};
996 frame
= get_current_frame ();
998 catch (const gdb_exception
&except
)
1000 exc
= unpack (except
);
1003 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
1004 return frscm_scm_from_frame_unsafe (frame
, current_inferior ());
1007 /* (selected-frame) -> <gdb:frame>
1008 Returns the selected frame. */
1011 gdbscm_selected_frame (void)
1013 struct frame_info
*frame
= NULL
;
1015 gdbscm_gdb_exception exc
{};
1018 frame
= get_selected_frame (_("No frame is currently selected"));
1020 catch (const gdb_exception
&except
)
1022 exc
= unpack (except
);
1025 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
1026 return frscm_scm_from_frame_unsafe (frame
, current_inferior ());
1029 /* (unwind-stop-reason-string integer) -> string
1030 Return a string explaining the unwind stop reason. */
1033 gdbscm_unwind_stop_reason_string (SCM reason_scm
)
1038 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, NULL
, "i",
1039 reason_scm
, &reason
);
1041 if (reason
< UNWIND_FIRST
|| reason
> UNWIND_LAST
)
1042 scm_out_of_range (FUNC_NAME
, reason_scm
);
1044 str
= unwind_stop_reason_to_string ((enum unwind_stop_reason
) reason
);
1045 return gdbscm_scm_from_c_string (str
);
1048 /* Initialize the Scheme frame support. */
1050 static const scheme_integer_constant frame_integer_constants
[] =
1052 #define ENTRY(X) { #X, X }
1054 ENTRY (NORMAL_FRAME
),
1055 ENTRY (DUMMY_FRAME
),
1056 ENTRY (INLINE_FRAME
),
1057 ENTRY (TAILCALL_FRAME
),
1058 ENTRY (SIGTRAMP_FRAME
),
1060 ENTRY (SENTINEL_FRAME
),
1064 #define SET(name, description) \
1065 { "FRAME_" #name, name },
1066 #include "unwind_stop_reasons.def"
1069 END_INTEGER_CONSTANTS
1072 static const scheme_function frame_functions
[] =
1074 { "frame?", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_p
),
1076 Return #t if the object is a <gdb:frame> object." },
1078 { "frame-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_valid_p
),
1080 Return #t if the object is a valid <gdb:frame> object.\n\
1081 Frames become invalid when the inferior returns to its caller." },
1083 { "frame-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_name
),
1085 Return the name of the function corresponding to this frame,\n\
1086 or #f if there is no function." },
1088 { "frame-arch", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_arch
),
1090 Return the frame's architecture as a <gdb:arch> object." },
1092 { "frame-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_type
),
1094 Return the frame type, namely one of the gdb:*_FRAME constants." },
1096 { "frame-unwind-stop-reason", 1, 0, 0,
1097 as_a_scm_t_subr (gdbscm_frame_unwind_stop_reason
),
1099 Return one of the gdb:FRAME_UNWIND_* constants explaining why\n\
1100 it's not possible to find frames older than this." },
1102 { "frame-pc", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_pc
),
1104 Return the frame's resume address." },
1106 { "frame-block", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_block
),
1108 Return the frame's code block, or #f if one cannot be found." },
1110 { "frame-function", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_function
),
1112 Return the <gdb:symbol> for the function corresponding to this frame,\n\
1113 or #f if there isn't one." },
1115 { "frame-older", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_older
),
1117 Return the frame immediately older (outer) to this frame,\n\
1118 or #f if there isn't one." },
1120 { "frame-newer", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_newer
),
1122 Return the frame immediately newer (inner) to this frame,\n\
1123 or #f if there isn't one." },
1125 { "frame-sal", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_sal
),
1127 Return the frame's symtab-and-line <gdb:sal> object." },
1129 { "frame-read-var", 2, 0, 1, as_a_scm_t_subr (gdbscm_frame_read_var
),
1131 Return the value of the symbol in the frame.\n\
1133 Arguments: <gdb:frame> <gdb:symbol>\n\
1134 Or: <gdb:frame> string [#:block <gdb:block>]" },
1136 { "frame-read-register", 2, 0, 0,
1137 as_a_scm_t_subr (gdbscm_frame_read_register
),
1139 Return the value of the register in the frame.\n\
1141 Arguments: <gdb:frame> string" },
1143 { "frame-select", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_select
),
1145 Select this frame." },
1147 { "newest-frame", 0, 0, 0, as_a_scm_t_subr (gdbscm_newest_frame
),
1149 Return the newest frame." },
1151 { "selected-frame", 0, 0, 0, as_a_scm_t_subr (gdbscm_selected_frame
),
1153 Return the selected frame." },
1155 { "unwind-stop-reason-string", 1, 0, 0,
1156 as_a_scm_t_subr (gdbscm_unwind_stop_reason_string
),
1158 Return a string explaining the unwind stop reason.\n\
1160 Arguments: integer (the result of frame-unwind-stop-reason)" },
1166 gdbscm_initialize_frames (void)
1169 = gdbscm_make_smob_type (frame_smob_name
, sizeof (frame_smob
));
1170 scm_set_smob_free (frame_smob_tag
, frscm_free_frame_smob
);
1171 scm_set_smob_print (frame_smob_tag
, frscm_print_frame_smob
);
1173 gdbscm_define_integer_constants (frame_integer_constants
, 1);
1174 gdbscm_define_functions (frame_functions
, 1);
1176 block_keyword
= scm_from_latin1_keyword ("block");
1178 /* Register an inferior "free" callback so we can properly
1179 invalidate frames when an inferior file is about to be deleted. */
1180 frscm_inferior_data_key
1181 = register_inferior_data_with_cleanup (NULL
, frscm_del_inferior_frames
);