1 /* Scheme interface to stack frames.
3 Copyright (C) 2008-2022 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 /* This is called when an inferior is about to be freed.
78 Invalidate the frame as further actions on the frame could result
79 in bad data. All access to the frame should be gated by
80 frscm_get_frame_smob_arg_unsafe which will raise an exception on
84 /* Helper function for frscm_del_inferior_frames to mark the frame
88 frscm_mark_frame_invalid (void **slot
, void *info
)
90 frame_smob
*f_smob
= (frame_smob
*) *slot
;
92 f_smob
->inferior
= NULL
;
96 void operator() (htab_t htab
)
98 gdb_assert (htab
!= nullptr);
99 htab_traverse_noresize (htab
, frscm_mark_frame_invalid
, NULL
);
104 static const registry
<inferior
>::key
<htab
, frscm_deleter
>
105 frscm_inferior_data_key
;
107 /* Administrivia for frame smobs. */
109 /* Helper function to hash a frame_smob. */
112 frscm_hash_frame_smob (const void *p
)
114 const frame_smob
*f_smob
= (const frame_smob
*) p
;
115 const struct frame_id
*fid
= &f_smob
->frame_id
;
116 hashval_t hash
= htab_hash_pointer (f_smob
->inferior
);
118 if (fid
->stack_status
== FID_STACK_VALID
)
119 hash
= iterative_hash (&fid
->stack_addr
, sizeof (fid
->stack_addr
), hash
);
120 if (fid
->code_addr_p
)
121 hash
= iterative_hash (&fid
->code_addr
, sizeof (fid
->code_addr
), hash
);
122 if (fid
->special_addr_p
)
123 hash
= iterative_hash (&fid
->special_addr
, sizeof (fid
->special_addr
),
129 /* Helper function to compute equality of frame_smobs. */
132 frscm_eq_frame_smob (const void *ap
, const void *bp
)
134 const frame_smob
*a
= (const frame_smob
*) ap
;
135 const frame_smob
*b
= (const frame_smob
*) bp
;
137 return (frame_id_eq (a
->frame_id
, b
->frame_id
)
138 && a
->inferior
== b
->inferior
139 && a
->inferior
!= NULL
);
142 /* Return the frame -> SCM mapping table.
143 It is created if necessary. */
146 frscm_inferior_frame_map (struct inferior
*inferior
)
148 htab_t htab
= frscm_inferior_data_key
.get (inferior
);
152 htab
= gdbscm_create_eqable_gsmob_ptr_map (frscm_hash_frame_smob
,
153 frscm_eq_frame_smob
);
154 frscm_inferior_data_key
.set (inferior
, htab
);
160 /* The smob "free" function for <gdb:frame>. */
163 frscm_free_frame_smob (SCM self
)
165 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (self
);
167 if (f_smob
->inferior
!= NULL
)
169 htab_t htab
= frscm_inferior_frame_map (f_smob
->inferior
);
171 gdbscm_clear_eqable_gsmob_ptr_slot (htab
, &f_smob
->base
);
174 /* Not necessary, done to catch bugs. */
175 f_smob
->inferior
= NULL
;
180 /* The smob "print" function for <gdb:frame>. */
183 frscm_print_frame_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
185 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (self
);
187 gdbscm_printf (port
, "#<%s %s>",
189 f_smob
->frame_id
.to_string ().c_str ());
190 scm_remember_upto_here_1 (self
);
192 /* Non-zero means success. */
196 /* Low level routine to create a <gdb:frame> object. */
199 frscm_make_frame_smob (void)
201 frame_smob
*f_smob
= (frame_smob
*)
202 scm_gc_malloc (sizeof (frame_smob
), frame_smob_name
);
205 f_smob
->frame_id
= null_frame_id
;
206 f_smob
->gdbarch
= NULL
;
207 f_smob
->inferior
= NULL
;
208 f_smob
->frame_id_is_next
= 0;
209 f_scm
= scm_new_smob (frame_smob_tag
, (scm_t_bits
) f_smob
);
210 gdbscm_init_eqable_gsmob (&f_smob
->base
, f_scm
);
215 /* Return non-zero if SCM is a <gdb:frame> object. */
218 frscm_is_frame (SCM scm
)
220 return SCM_SMOB_PREDICATE (frame_smob_tag
, scm
);
223 /* (frame? object) -> boolean */
226 gdbscm_frame_p (SCM scm
)
228 return scm_from_bool (frscm_is_frame (scm
));
231 /* Create a new <gdb:frame> object that encapsulates FRAME.
232 Returns a <gdb:exception> object if there is an error. */
235 frscm_scm_from_frame (struct frame_info
*frame
, struct inferior
*inferior
)
237 frame_smob
*f_smob
, f_smob_for_lookup
;
240 eqable_gdb_smob
**slot
;
241 struct frame_id frame_id
= null_frame_id
;
242 struct gdbarch
*gdbarch
= NULL
;
243 int frame_id_is_next
= 0;
245 /* If we've already created a gsmob for this frame, return it.
246 This makes frames eq?-able. */
247 htab
= frscm_inferior_frame_map (inferior
);
248 f_smob_for_lookup
.frame_id
= get_frame_id (frame
);
249 f_smob_for_lookup
.inferior
= inferior
;
250 slot
= gdbscm_find_eqable_gsmob_ptr_slot (htab
, &f_smob_for_lookup
.base
);
252 return (*slot
)->containing_scm
;
256 /* Try to get the previous frame, to determine if this is the last frame
257 in a corrupt stack. If so, we need to store the frame_id of the next
258 frame and not of this one (which is possibly invalid). */
259 if (get_prev_frame (frame
) == NULL
260 && get_frame_unwind_stop_reason (frame
) != UNWIND_NO_REASON
261 && get_next_frame (frame
) != NULL
)
263 frame_id
= get_frame_id (get_next_frame (frame
));
264 frame_id_is_next
= 1;
268 frame_id
= get_frame_id (frame
);
269 frame_id_is_next
= 0;
271 gdbarch
= get_frame_arch (frame
);
273 catch (const gdb_exception
&except
)
275 return gdbscm_scm_from_gdb_exception (unpack (except
));
278 f_scm
= frscm_make_frame_smob ();
279 f_smob
= (frame_smob
*) SCM_SMOB_DATA (f_scm
);
280 f_smob
->frame_id
= frame_id
;
281 f_smob
->gdbarch
= gdbarch
;
282 f_smob
->inferior
= inferior
;
283 f_smob
->frame_id_is_next
= frame_id_is_next
;
285 gdbscm_fill_eqable_gsmob_ptr_slot (slot
, &f_smob
->base
);
290 /* Create a new <gdb:frame> object that encapsulates FRAME.
291 A Scheme exception is thrown if there is an error. */
294 frscm_scm_from_frame_unsafe (struct frame_info
*frame
,
295 struct inferior
*inferior
)
297 SCM f_scm
= frscm_scm_from_frame (frame
, inferior
);
299 if (gdbscm_is_exception (f_scm
))
300 gdbscm_throw (f_scm
);
305 /* Returns the <gdb:frame> object in SELF.
306 Throws an exception if SELF is not a <gdb:frame> object. */
309 frscm_get_frame_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
311 SCM_ASSERT_TYPE (frscm_is_frame (self
), self
, arg_pos
, func_name
,
317 /* There is no gdbscm_scm_to_frame function because translating
318 a frame SCM object to a struct frame_info * can throw a GDB error.
319 Thus code working with frames has to handle both Scheme errors (e.g., the
320 object is not a frame) and GDB errors (e.g., the frame lookup failed).
322 To help keep things clear we split what would be gdbscm_scm_to_frame
325 frscm_get_frame_smob_arg_unsafe
326 - throws a Scheme error if object is not a frame,
327 or if the inferior is gone or is no longer current
329 frscm_frame_smob_to_frame
330 - may throw a gdb error if the conversion fails
331 - it's not clear when it will and won't throw a GDB error,
332 but for robustness' sake we assume that whenever we call out to GDB
333 a GDB error may get thrown (and thus the call must be wrapped in a
336 /* Returns the frame_smob for the object wrapped by FRAME_SCM.
337 A Scheme error is thrown if FRAME_SCM is not a frame. */
340 frscm_get_frame_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
342 SCM f_scm
= frscm_get_frame_arg_unsafe (self
, arg_pos
, func_name
);
343 frame_smob
*f_smob
= (frame_smob
*) SCM_SMOB_DATA (f_scm
);
345 if (f_smob
->inferior
== NULL
)
347 gdbscm_invalid_object_error (func_name
, arg_pos
, self
,
350 if (f_smob
->inferior
!= current_inferior ())
351 scm_misc_error (func_name
, _("inferior has changed"), SCM_EOL
);
356 /* Returns the frame_info object wrapped by F_SMOB.
357 If the frame doesn't exist anymore (the frame id doesn't
358 correspond to any frame in the inferior), returns NULL.
359 This function calls GDB routines, so don't assume a GDB error will
363 frscm_frame_smob_to_frame (frame_smob
*f_smob
)
365 struct frame_info
*frame
;
367 frame
= frame_find_by_id (f_smob
->frame_id
);
371 if (f_smob
->frame_id_is_next
)
372 frame
= get_prev_frame (frame
);
380 /* (frame-valid? <gdb:frame>) -> bool
381 Returns #t if the frame corresponding to the frame_id of this
382 object still exists in the inferior. */
385 gdbscm_frame_valid_p (SCM self
)
388 struct frame_info
*frame
= NULL
;
390 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
392 gdbscm_gdb_exception exc
{};
395 frame
= frscm_frame_smob_to_frame (f_smob
);
397 catch (const gdb_exception
&except
)
399 exc
= unpack (except
);
402 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
403 return scm_from_bool (frame
!= NULL
);
406 /* (frame-name <gdb:frame>) -> string
407 Returns the name of the function corresponding to this frame,
408 or #f if there is no function. */
411 gdbscm_frame_name (SCM self
)
414 gdb::unique_xmalloc_ptr
<char> name
;
415 enum language lang
= language_minimal
;
416 struct frame_info
*frame
= NULL
;
419 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
421 gdbscm_gdb_exception exc
{};
424 frame
= frscm_frame_smob_to_frame (f_smob
);
426 name
= find_frame_funname (frame
, &lang
, NULL
);
428 catch (const gdb_exception
&except
)
430 exc
= unpack (except
);
433 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
436 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
441 result
= gdbscm_scm_from_c_string (name
.get ());
448 /* (frame-type <gdb:frame>) -> integer
449 Returns the frame type, namely one of the gdb:*_FRAME constants. */
452 gdbscm_frame_type (SCM self
)
455 enum frame_type type
= NORMAL_FRAME
;
456 struct frame_info
*frame
= NULL
;
458 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
460 gdbscm_gdb_exception exc
{};
463 frame
= frscm_frame_smob_to_frame (f_smob
);
465 type
= get_frame_type (frame
);
467 catch (const gdb_exception
&except
)
469 exc
= unpack (except
);
472 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
475 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
479 return scm_from_int (type
);
482 /* (frame-arch <gdb:frame>) -> <gdb:architecture>
483 Returns the frame's architecture as a gdb:architecture object. */
486 gdbscm_frame_arch (SCM self
)
489 struct frame_info
*frame
= NULL
;
491 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
493 gdbscm_gdb_exception exc
{};
496 frame
= frscm_frame_smob_to_frame (f_smob
);
498 catch (const gdb_exception
&except
)
500 exc
= unpack (except
);
503 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
506 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
510 return arscm_scm_from_arch (f_smob
->gdbarch
);
513 /* (frame-unwind-stop-reason <gdb:frame>) -> integer
514 Returns one of the gdb:FRAME_UNWIND_* constants. */
517 gdbscm_frame_unwind_stop_reason (SCM self
)
520 struct frame_info
*frame
= NULL
;
521 enum unwind_stop_reason stop_reason
;
523 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
525 gdbscm_gdb_exception exc
{};
528 frame
= frscm_frame_smob_to_frame (f_smob
);
530 catch (const gdb_exception
&except
)
532 exc
= unpack (except
);
535 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
538 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
542 stop_reason
= get_frame_unwind_stop_reason (frame
);
544 return scm_from_int (stop_reason
);
547 /* (frame-pc <gdb:frame>) -> integer
548 Returns the frame's resume address. */
551 gdbscm_frame_pc (SCM self
)
555 struct frame_info
*frame
= NULL
;
557 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
559 gdbscm_gdb_exception exc
{};
562 frame
= frscm_frame_smob_to_frame (f_smob
);
564 pc
= get_frame_pc (frame
);
566 catch (const gdb_exception
&except
)
568 exc
= unpack (except
);
571 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
574 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
578 return gdbscm_scm_from_ulongest (pc
);
581 /* (frame-block <gdb:frame>) -> <gdb:block>
582 Returns the frame's code block, or #f if one cannot be found. */
585 gdbscm_frame_block (SCM self
)
588 const struct block
*block
= NULL
, *fn_block
;
589 struct frame_info
*frame
= NULL
;
591 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
593 gdbscm_gdb_exception exc
{};
596 frame
= frscm_frame_smob_to_frame (f_smob
);
598 block
= get_frame_block (frame
, NULL
);
600 catch (const gdb_exception
&except
)
602 exc
= unpack (except
);
605 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
608 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
612 for (fn_block
= block
;
613 fn_block
!= NULL
&& fn_block
->function () == NULL
;
614 fn_block
= fn_block
->superblock ())
617 if (block
== NULL
|| fn_block
== NULL
|| fn_block
->function () == NULL
)
619 scm_misc_error (FUNC_NAME
, _("cannot find block for frame"),
625 return bkscm_scm_from_block
626 (block
, fn_block
->function ()->objfile ());
632 /* (frame-function <gdb:frame>) -> <gdb:symbol>
633 Returns the symbol for the function corresponding to this frame,
634 or #f if there isn't one. */
637 gdbscm_frame_function (SCM self
)
640 struct symbol
*sym
= NULL
;
641 struct frame_info
*frame
= NULL
;
643 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
645 gdbscm_gdb_exception exc
{};
648 frame
= frscm_frame_smob_to_frame (f_smob
);
650 sym
= find_pc_function (get_frame_address_in_block (frame
));
652 catch (const gdb_exception
&except
)
654 exc
= unpack (except
);
657 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
660 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
665 return syscm_scm_from_symbol (sym
);
670 /* (frame-older <gdb:frame>) -> <gdb:frame>
671 Returns the frame immediately older (outer) to this frame,
672 or #f if there isn't one. */
675 gdbscm_frame_older (SCM self
)
678 struct frame_info
*prev
= NULL
;
679 struct frame_info
*frame
= NULL
;
681 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
683 gdbscm_gdb_exception exc
{};
686 frame
= frscm_frame_smob_to_frame (f_smob
);
688 prev
= get_prev_frame (frame
);
690 catch (const gdb_exception
&except
)
692 exc
= unpack (except
);
695 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
698 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
703 return frscm_scm_from_frame_unsafe (prev
, f_smob
->inferior
);
708 /* (frame-newer <gdb:frame>) -> <gdb:frame>
709 Returns the frame immediately newer (inner) to this frame,
710 or #f if there isn't one. */
713 gdbscm_frame_newer (SCM self
)
716 struct frame_info
*next
= NULL
;
717 struct frame_info
*frame
= NULL
;
719 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
721 gdbscm_gdb_exception exc
{};
724 frame
= frscm_frame_smob_to_frame (f_smob
);
726 next
= get_next_frame (frame
);
728 catch (const gdb_exception
&except
)
730 exc
= unpack (except
);
733 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
736 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
741 return frscm_scm_from_frame_unsafe (next
, f_smob
->inferior
);
746 /* (frame-sal <gdb:frame>) -> <gdb:sal>
747 Returns the frame's symtab and line. */
750 gdbscm_frame_sal (SCM self
)
753 struct symtab_and_line sal
;
754 struct frame_info
*frame
= NULL
;
756 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
758 gdbscm_gdb_exception exc
{};
761 frame
= frscm_frame_smob_to_frame (f_smob
);
763 sal
= find_frame_sal (frame
);
765 catch (const gdb_exception
&except
)
767 exc
= unpack (except
);
770 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
773 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
777 return stscm_scm_from_sal (sal
);
780 /* (frame-read-register <gdb:frame> string) -> <gdb:value>
781 The register argument must be a string. */
784 gdbscm_frame_read_register (SCM self
, SCM register_scm
)
787 struct value
*value
= NULL
;
788 struct frame_info
*frame
= NULL
;
791 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
792 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, NULL
, "s",
793 register_scm
, ®ister_str
);
795 gdbscm_gdb_exception except
{};
801 frame
= frscm_frame_smob_to_frame (f_smob
);
804 regnum
= user_reg_map_name_to_regnum (get_frame_arch (frame
),
806 strlen (register_str
));
808 value
= value_of_register (regnum
, frame
);
811 catch (const gdb_exception
&ex
)
813 except
= unpack (ex
);
816 xfree (register_str
);
817 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
821 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
827 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG2
, register_scm
,
828 _("unknown register"));
831 return vlscm_scm_from_value (value
);
834 /* (frame-read-var <gdb:frame> <gdb:symbol>) -> <gdb:value>
835 (frame-read-var <gdb:frame> string [#:block <gdb:block>]) -> <gdb:value>
836 If the optional block argument is provided start the search from that block,
837 otherwise search from the frame's current block (determined by examining
838 the resume address of the frame). The variable argument must be a string
839 or an instance of a <gdb:symbol>. The block argument must be an instance of
843 gdbscm_frame_read_var (SCM self
, SCM symbol_scm
, SCM rest
)
845 SCM keywords
[] = { block_keyword
, SCM_BOOL_F
};
847 int block_arg_pos
= -1;
848 SCM block_scm
= SCM_UNDEFINED
;
849 struct frame_info
*frame
= NULL
;
850 struct symbol
*var
= NULL
;
851 const struct block
*block
= NULL
;
852 struct value
*value
= NULL
;
854 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
856 gdbscm_gdb_exception exc
{};
859 frame
= frscm_frame_smob_to_frame (f_smob
);
861 catch (const gdb_exception
&except
)
863 exc
= unpack (except
);
866 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
869 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
873 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG3
, keywords
, "#O",
874 rest
, &block_arg_pos
, &block_scm
);
876 if (syscm_is_symbol (symbol_scm
))
878 var
= syscm_get_valid_symbol_arg_unsafe (symbol_scm
, SCM_ARG2
,
880 SCM_ASSERT (SCM_UNBNDP (block_scm
), block_scm
, SCM_ARG3
, FUNC_NAME
);
882 else if (scm_is_string (symbol_scm
))
884 gdbscm_gdb_exception except
{};
886 if (! SCM_UNBNDP (block_scm
))
890 gdb_assert (block_arg_pos
> 0);
891 block
= bkscm_scm_to_block (block_scm
, block_arg_pos
, FUNC_NAME
,
894 gdbscm_throw (except_scm
);
898 gdb::unique_xmalloc_ptr
<char> var_name
899 (gdbscm_scm_to_c_string (symbol_scm
));
900 /* N.B. Between here and the end of the scope, don't do anything
901 to cause a Scheme exception. */
905 struct block_symbol lookup_sym
;
908 block
= get_frame_block (frame
, NULL
);
909 lookup_sym
= lookup_symbol (var_name
.get (), block
, VAR_DOMAIN
,
911 var
= lookup_sym
.symbol
;
912 block
= lookup_sym
.block
;
914 catch (const gdb_exception
&ex
)
916 except
= unpack (ex
);
920 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
923 gdbscm_out_of_range_error (FUNC_NAME
, 0, symbol_scm
,
924 _("variable not found"));
928 /* Use SCM_ASSERT_TYPE for more consistent error messages. */
929 SCM_ASSERT_TYPE (0, symbol_scm
, SCM_ARG1
, FUNC_NAME
,
930 _("gdb:symbol or string"));
935 value
= read_var_value (var
, block
, frame
);
937 catch (const gdb_exception
&except
)
939 exc
= unpack (except
);
942 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
943 return vlscm_scm_from_value (value
);
946 /* (frame-select <gdb:frame>) -> unspecified
947 Select this frame. */
950 gdbscm_frame_select (SCM self
)
953 struct frame_info
*frame
= NULL
;
955 f_smob
= frscm_get_frame_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
957 gdbscm_gdb_exception exc
{};
960 frame
= frscm_frame_smob_to_frame (f_smob
);
962 select_frame (frame
);
964 catch (const gdb_exception
&except
)
966 exc
= unpack (except
);
969 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
972 gdbscm_invalid_object_error (FUNC_NAME
, SCM_ARG1
, self
,
976 return SCM_UNSPECIFIED
;
979 /* (newest-frame) -> <gdb:frame>
980 Returns the newest frame. */
983 gdbscm_newest_frame (void)
985 struct frame_info
*frame
= NULL
;
987 gdbscm_gdb_exception exc
{};
990 frame
= get_current_frame ();
992 catch (const gdb_exception
&except
)
994 exc
= unpack (except
);
997 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
998 return frscm_scm_from_frame_unsafe (frame
, current_inferior ());
1001 /* (selected-frame) -> <gdb:frame>
1002 Returns the selected frame. */
1005 gdbscm_selected_frame (void)
1007 struct frame_info
*frame
= NULL
;
1009 gdbscm_gdb_exception exc
{};
1012 frame
= get_selected_frame (_("No frame is currently selected"));
1014 catch (const gdb_exception
&except
)
1016 exc
= unpack (except
);
1019 GDBSCM_HANDLE_GDB_EXCEPTION (exc
);
1020 return frscm_scm_from_frame_unsafe (frame
, current_inferior ());
1023 /* (unwind-stop-reason-string integer) -> string
1024 Return a string explaining the unwind stop reason. */
1027 gdbscm_unwind_stop_reason_string (SCM reason_scm
)
1032 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, NULL
, "i",
1033 reason_scm
, &reason
);
1035 if (reason
< UNWIND_FIRST
|| reason
> UNWIND_LAST
)
1036 scm_out_of_range (FUNC_NAME
, reason_scm
);
1038 str
= unwind_stop_reason_to_string ((enum unwind_stop_reason
) reason
);
1039 return gdbscm_scm_from_c_string (str
);
1042 /* Initialize the Scheme frame support. */
1044 static const scheme_integer_constant frame_integer_constants
[] =
1046 #define ENTRY(X) { #X, X }
1048 ENTRY (NORMAL_FRAME
),
1049 ENTRY (DUMMY_FRAME
),
1050 ENTRY (INLINE_FRAME
),
1051 ENTRY (TAILCALL_FRAME
),
1052 ENTRY (SIGTRAMP_FRAME
),
1054 ENTRY (SENTINEL_FRAME
),
1058 #define SET(name, description) \
1059 { "FRAME_" #name, name },
1060 #include "unwind_stop_reasons.def"
1063 END_INTEGER_CONSTANTS
1066 static const scheme_function frame_functions
[] =
1068 { "frame?", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_p
),
1070 Return #t if the object is a <gdb:frame> object." },
1072 { "frame-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_valid_p
),
1074 Return #t if the object is a valid <gdb:frame> object.\n\
1075 Frames become invalid when the inferior returns to its caller." },
1077 { "frame-name", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_name
),
1079 Return the name of the function corresponding to this frame,\n\
1080 or #f if there is no function." },
1082 { "frame-arch", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_arch
),
1084 Return the frame's architecture as a <gdb:arch> object." },
1086 { "frame-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_type
),
1088 Return the frame type, namely one of the gdb:*_FRAME constants." },
1090 { "frame-unwind-stop-reason", 1, 0, 0,
1091 as_a_scm_t_subr (gdbscm_frame_unwind_stop_reason
),
1093 Return one of the gdb:FRAME_UNWIND_* constants explaining why\n\
1094 it's not possible to find frames older than this." },
1096 { "frame-pc", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_pc
),
1098 Return the frame's resume address." },
1100 { "frame-block", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_block
),
1102 Return the frame's code block, or #f if one cannot be found." },
1104 { "frame-function", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_function
),
1106 Return the <gdb:symbol> for the function corresponding to this frame,\n\
1107 or #f if there isn't one." },
1109 { "frame-older", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_older
),
1111 Return the frame immediately older (outer) to this frame,\n\
1112 or #f if there isn't one." },
1114 { "frame-newer", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_newer
),
1116 Return the frame immediately newer (inner) to this frame,\n\
1117 or #f if there isn't one." },
1119 { "frame-sal", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_sal
),
1121 Return the frame's symtab-and-line <gdb:sal> object." },
1123 { "frame-read-var", 2, 0, 1, as_a_scm_t_subr (gdbscm_frame_read_var
),
1125 Return the value of the symbol in the frame.\n\
1127 Arguments: <gdb:frame> <gdb:symbol>\n\
1128 Or: <gdb:frame> string [#:block <gdb:block>]" },
1130 { "frame-read-register", 2, 0, 0,
1131 as_a_scm_t_subr (gdbscm_frame_read_register
),
1133 Return the value of the register in the frame.\n\
1135 Arguments: <gdb:frame> string" },
1137 { "frame-select", 1, 0, 0, as_a_scm_t_subr (gdbscm_frame_select
),
1139 Select this frame." },
1141 { "newest-frame", 0, 0, 0, as_a_scm_t_subr (gdbscm_newest_frame
),
1143 Return the newest frame." },
1145 { "selected-frame", 0, 0, 0, as_a_scm_t_subr (gdbscm_selected_frame
),
1147 Return the selected frame." },
1149 { "unwind-stop-reason-string", 1, 0, 0,
1150 as_a_scm_t_subr (gdbscm_unwind_stop_reason_string
),
1152 Return a string explaining the unwind stop reason.\n\
1154 Arguments: integer (the result of frame-unwind-stop-reason)" },
1160 gdbscm_initialize_frames (void)
1163 = gdbscm_make_smob_type (frame_smob_name
, sizeof (frame_smob
));
1164 scm_set_smob_free (frame_smob_tag
, frscm_free_frame_smob
);
1165 scm_set_smob_print (frame_smob_tag
, frscm_print_frame_smob
);
1167 gdbscm_define_integer_constants (frame_integer_constants
, 1);
1168 gdbscm_define_functions (frame_functions
, 1);
1170 block_keyword
= scm_from_latin1_keyword ("block");