GDB (xrefs)
scm-frame.c
Go to the documentation of this file.
1 /* Scheme interface to stack frames.
2 
3  Copyright (C) 2008-2015 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 "inferior.h"
27 #include "objfiles.h"
28 #include "symfile.h"
29 #include "symtab.h"
30 #include "stack.h"
31 #include "user-regs.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 
39 {
40  /* This always appears first. */
42 
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. */
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 
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
120 {
121  htab_t htab = inferior_data (inferior, frscm_inferior_data_key);
122 
123  if (htab == NULL)
124  {
127  set_inferior_data (inferior, frscm_inferior_data_key, htab);
128  }
129 
130  return htab;
131 }
132 
133 /* The smob "free" function for <gdb:frame>. */
134 
135 static size_t
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
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);
193  gdbscm_init_eqable_gsmob (&f_smob->base, f_scm);
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
219 {
220  frame_smob *f_smob, f_smob_for_lookup;
221  SCM f_scm;
222  htab_t htab;
223  eqable_gdb_smob **slot;
224  struct frame_id frame_id = null_frame_id;
225  struct gdbarch *gdbarch = NULL;
226  int frame_id_is_next = 0;
227 
228  /* If we've already created a gsmob for this frame, return it.
229  This makes frames eq?-able. */
230  htab = frscm_inferior_frame_map (inferior);
231  f_smob_for_lookup.frame_id = get_frame_id (frame);
232  f_smob_for_lookup.inferior = inferior;
233  slot = gdbscm_find_eqable_gsmob_ptr_slot (htab, &f_smob_for_lookup.base);
234  if (*slot != NULL)
235  return (*slot)->containing_scm;
236 
237  TRY
238  {
239  /* Try to get the previous frame, to determine if this is the last frame
240  in a corrupt stack. If so, we need to store the frame_id of the next
241  frame and not of this one (which is possibly invalid). */
242  if (get_prev_frame (frame) == NULL
243  && get_frame_unwind_stop_reason (frame) != UNWIND_NO_REASON
244  && get_next_frame (frame) != NULL)
245  {
246  frame_id = get_frame_id (get_next_frame (frame));
247  frame_id_is_next = 1;
248  }
249  else
250  {
251  frame_id = get_frame_id (frame);
252  frame_id_is_next = 0;
253  }
254  gdbarch = get_frame_arch (frame);
255  }
256  CATCH (except, RETURN_MASK_ALL)
257  {
258  return gdbscm_scm_from_gdb_exception (except);
259  }
260  END_CATCH
261 
262  f_scm = frscm_make_frame_smob ();
263  f_smob = (frame_smob *) SCM_SMOB_DATA (f_scm);
264  f_smob->frame_id = frame_id;
265  f_smob->gdbarch = gdbarch;
266  f_smob->inferior = inferior;
267  f_smob->frame_id_is_next = frame_id_is_next;
268 
269  gdbscm_fill_eqable_gsmob_ptr_slot (slot, &f_smob->base);
270 
271  return f_scm;
272 }
273 
274 /* Create a new <gdb:frame> object that encapsulates FRAME.
275  A Scheme exception is thrown if there is an error. */
276 
277 static SCM
279  struct inferior *inferior)
280 {
281  SCM f_scm = frscm_scm_from_frame (frame, inferior);
282 
283  if (gdbscm_is_exception (f_scm))
284  gdbscm_throw (f_scm);
285 
286  return f_scm;
287 }
288 
289 /* Returns the <gdb:frame> object in SELF.
290  Throws an exception if SELF is not a <gdb:frame> object. */
291 
292 static SCM
293 frscm_get_frame_arg_unsafe (SCM self, int arg_pos, const char *func_name)
294 {
295  SCM_ASSERT_TYPE (frscm_is_frame (self), self, arg_pos, func_name,
297 
298  return self;
299 }
300 
301 /* There is no gdbscm_scm_to_frame function because translating
302  a frame SCM object to a struct frame_info * can throw a GDB error.
303  Thus code working with frames has to handle both Scheme errors (e.g., the
304  object is not a frame) and GDB errors (e.g., the frame lookup failed).
305 
306  To help keep things clear we split what would be gdbscm_scm_to_frame
307  into two:
308 
309  frscm_get_frame_smob_arg_unsafe
310  - throws a Scheme error if object is not a frame,
311  or if the inferior is gone or is no longer current
312 
313  frscm_frame_smob_to_frame
314  - may throw a gdb error if the conversion fails
315  - it's not clear when it will and won't throw a GDB error,
316  but for robustness' sake we assume that whenever we call out to GDB
317  a GDB error may get thrown (and thus the call must be wrapped in a
318  TRY_CATCH) */
319 
320 /* Returns the frame_smob for the object wrapped by FRAME_SCM.
321  A Scheme error is thrown if FRAME_SCM is not a frame. */
322 
323 frame_smob *
324 frscm_get_frame_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
325 {
326  SCM f_scm = frscm_get_frame_arg_unsafe (self, arg_pos, func_name);
327  frame_smob *f_smob = (frame_smob *) SCM_SMOB_DATA (f_scm);
328 
329  if (f_smob->inferior == NULL)
330  {
331  gdbscm_invalid_object_error (func_name, arg_pos, self,
332  _("inferior"));
333  }
334  if (f_smob->inferior != current_inferior ())
335  scm_misc_error (func_name, _("inferior has changed"), SCM_EOL);
336 
337  return f_smob;
338 }
339 
340 /* Returns the frame_info object wrapped by F_SMOB.
341  If the frame doesn't exist anymore (the frame id doesn't
342  correspond to any frame in the inferior), returns NULL.
343  This function calls GDB routines, so don't assume a GDB error will
344  not be thrown. */
345 
346 struct frame_info *
348 {
349  struct frame_info *frame;
350 
351  frame = frame_find_by_id (f_smob->frame_id);
352  if (frame == NULL)
353  return NULL;
354 
355  if (f_smob->frame_id_is_next)
356  frame = get_prev_frame (frame);
357 
358  return frame;
359 }
360 
361 /* Helper function for frscm_del_inferior_frames to mark the frame
362  as invalid. */
363 
364 static int
365 frscm_mark_frame_invalid (void **slot, void *info)
366 {
367  frame_smob *f_smob = (frame_smob *) *slot;
368 
369  f_smob->inferior = NULL;
370  return 1;
371 }
372 
373 /* This function is called when an inferior is about to be freed.
374  Invalidate the frame as further actions on the frame could result
375  in bad data. All access to the frame should be gated by
376  frscm_get_frame_smob_arg_unsafe which will raise an exception on
377  invalid frames. */
378 
379 static void
381 {
382  htab_t htab = datum;
383 
384  if (htab != NULL)
385  {
386  htab_traverse_noresize (htab, frscm_mark_frame_invalid, NULL);
387  htab_delete (htab);
388  }
389 }
390 
391 /* Frame methods. */
392 
393 /* (frame-valid? <gdb:frame>) -> bool
394  Returns #t if the frame corresponding to the frame_id of this
395  object still exists in the inferior. */
396 
397 static SCM
399 {
400  frame_smob *f_smob;
401  struct frame_info *frame = NULL;
402 
403  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
404 
405  TRY
406  {
407  frame = frscm_frame_smob_to_frame (f_smob);
408  }
409  CATCH (except, RETURN_MASK_ALL)
410  {
412  }
413  END_CATCH
414 
415  return scm_from_bool (frame != NULL);
416 }
417 
418 /* (frame-name <gdb:frame>) -> string
419  Returns the name of the function corresponding to this frame,
420  or #f if there is no function. */
421 
422 static SCM
424 {
425  frame_smob *f_smob;
426  char *name = NULL;
427  enum language lang = language_minimal;
428  struct frame_info *frame = NULL;
429  SCM result;
430 
431  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
432 
433  TRY
434  {
435  frame = frscm_frame_smob_to_frame (f_smob);
436  if (frame != NULL)
437  find_frame_funname (frame, &name, &lang, NULL);
438  }
439  CATCH (except, RETURN_MASK_ALL)
440  {
441  xfree (name);
443  }
444  END_CATCH
445 
446  if (frame == NULL)
447  {
448  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
449  _("<gdb:frame>"));
450  }
451 
452  if (name != NULL)
453  {
454  result = gdbscm_scm_from_c_string (name);
455  xfree (name);
456  }
457  else
458  result = SCM_BOOL_F;
459 
460  return result;
461 }
462 
463 /* (frame-type <gdb:frame>) -> integer
464  Returns the frame type, namely one of the gdb:*_FRAME constants. */
465 
466 static SCM
468 {
469  frame_smob *f_smob;
471  struct frame_info *frame = NULL;
472 
473  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
474 
475  TRY
476  {
477  frame = frscm_frame_smob_to_frame (f_smob);
478  if (frame != NULL)
479  type = get_frame_type (frame);
480  }
481  CATCH (except, RETURN_MASK_ALL)
482  {
484  }
485  END_CATCH
486 
487  if (frame == NULL)
488  {
489  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
490  _("<gdb:frame>"));
491  }
492 
493  return scm_from_int (type);
494 }
495 
496 /* (frame-arch <gdb:frame>) -> <gdb:architecture>
497  Returns the frame's architecture as a gdb:architecture object. */
498 
499 static SCM
501 {
502  frame_smob *f_smob;
503  struct frame_info *frame = NULL;
504 
505  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
506 
507  TRY
508  {
509  frame = frscm_frame_smob_to_frame (f_smob);
510  }
511  CATCH (except, RETURN_MASK_ALL)
512  {
514  }
515  END_CATCH
516 
517  if (frame == NULL)
518  {
519  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
520  _("<gdb:frame>"));
521  }
522 
523  return arscm_scm_from_arch (f_smob->gdbarch);
524 }
525 
526 /* (frame-unwind-stop-reason <gdb:frame>) -> integer
527  Returns one of the gdb:FRAME_UNWIND_* constants. */
528 
529 static SCM
531 {
532  frame_smob *f_smob;
533  struct frame_info *frame = NULL;
535 
536  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
537 
538  TRY
539  {
540  frame = frscm_frame_smob_to_frame (f_smob);
541  }
542  CATCH (except, RETURN_MASK_ALL)
543  {
545  }
546  END_CATCH
547 
548  if (frame == NULL)
549  {
550  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
551  _("<gdb:frame>"));
552  }
553 
554  stop_reason = get_frame_unwind_stop_reason (frame);
555 
556  return scm_from_int (stop_reason);
557 }
558 
559 /* (frame-pc <gdb:frame>) -> integer
560  Returns the frame's resume address. */
561 
562 static SCM
563 gdbscm_frame_pc (SCM self)
564 {
565  frame_smob *f_smob;
566  CORE_ADDR pc = 0;
567  struct frame_info *frame = NULL;
568 
569  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
570 
571  TRY
572  {
573  frame = frscm_frame_smob_to_frame (f_smob);
574  if (frame != NULL)
575  pc = get_frame_pc (frame);
576  }
577  CATCH (except, RETURN_MASK_ALL)
578  {
580  }
581  END_CATCH
582 
583  if (frame == NULL)
584  {
585  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
586  _("<gdb:frame>"));
587  }
588 
589  return gdbscm_scm_from_ulongest (pc);
590 }
591 
592 /* (frame-block <gdb:frame>) -> <gdb:block>
593  Returns the frame's code block, or #f if one cannot be found. */
594 
595 static SCM
597 {
598  frame_smob *f_smob;
599  const struct block *block = NULL, *fn_block;
600  struct frame_info *frame = NULL;
601 
602  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
603 
604  TRY
605  {
606  frame = frscm_frame_smob_to_frame (f_smob);
607  if (frame != NULL)
608  block = get_frame_block (frame, NULL);
609  }
610  CATCH (except, RETURN_MASK_ALL)
611  {
613  }
614  END_CATCH
615 
616  if (frame == NULL)
617  {
618  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
619  _("<gdb:frame>"));
620  }
621 
622  for (fn_block = block;
623  fn_block != NULL && BLOCK_FUNCTION (fn_block) == NULL;
624  fn_block = BLOCK_SUPERBLOCK (fn_block))
625  continue;
626 
627  if (block == NULL || fn_block == NULL || BLOCK_FUNCTION (fn_block) == NULL)
628  {
629  scm_misc_error (FUNC_NAME, _("cannot find block for frame"),
630  scm_list_1 (self));
631  }
632 
633  if (block != NULL)
634  {
635  return bkscm_scm_from_block
636  (block, symbol_objfile (BLOCK_FUNCTION (fn_block)));
637  }
638 
639  return SCM_BOOL_F;
640 }
641 
642 /* (frame-function <gdb:frame>) -> <gdb:symbol>
643  Returns the symbol for the function corresponding to this frame,
644  or #f if there isn't one. */
645 
646 static SCM
648 {
649  frame_smob *f_smob;
650  struct symbol *sym = NULL;
651  struct frame_info *frame = NULL;
652 
653  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
654 
655  TRY
656  {
657  frame = frscm_frame_smob_to_frame (f_smob);
658  if (frame != NULL)
660  }
661  CATCH (except, RETURN_MASK_ALL)
662  {
664  }
665  END_CATCH
666 
667  if (frame == NULL)
668  {
669  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
670  _("<gdb:frame>"));
671  }
672 
673  if (sym != NULL)
674  return syscm_scm_from_symbol (sym);
675 
676  return SCM_BOOL_F;
677 }
678 
679 /* (frame-older <gdb:frame>) -> <gdb:frame>
680  Returns the frame immediately older (outer) to this frame,
681  or #f if there isn't one. */
682 
683 static SCM
685 {
686  frame_smob *f_smob;
687  struct frame_info *prev = NULL;
688  struct frame_info *frame = NULL;
689 
690  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
691 
692  TRY
693  {
694  frame = frscm_frame_smob_to_frame (f_smob);
695  if (frame != NULL)
696  prev = get_prev_frame (frame);
697  }
698  CATCH (except, RETURN_MASK_ALL)
699  {
701  }
702  END_CATCH
703 
704  if (frame == NULL)
705  {
706  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
707  _("<gdb:frame>"));
708  }
709 
710  if (prev != NULL)
711  return frscm_scm_from_frame_unsafe (prev, f_smob->inferior);
712 
713  return SCM_BOOL_F;
714 }
715 
716 /* (frame-newer <gdb:frame>) -> <gdb:frame>
717  Returns the frame immediately newer (inner) to this frame,
718  or #f if there isn't one. */
719 
720 static SCM
722 {
723  frame_smob *f_smob;
724  struct frame_info *next = NULL;
725  struct frame_info *frame = NULL;
726 
727  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
728 
729  TRY
730  {
731  frame = frscm_frame_smob_to_frame (f_smob);
732  if (frame != NULL)
733  next = get_next_frame (frame);
734  }
735  CATCH (except, RETURN_MASK_ALL)
736  {
738  }
739  END_CATCH
740 
741  if (frame == NULL)
742  {
743  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
744  _("<gdb:frame>"));
745  }
746 
747  if (next != NULL)
748  return frscm_scm_from_frame_unsafe (next, f_smob->inferior);
749 
750  return SCM_BOOL_F;
751 }
752 
753 /* (frame-sal <gdb:frame>) -> <gdb:sal>
754  Returns the frame's symtab and line. */
755 
756 static SCM
758 {
759  frame_smob *f_smob;
760  struct symtab_and_line sal;
761  struct frame_info *frame = NULL;
762 
763  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
764 
765  TRY
766  {
767  frame = frscm_frame_smob_to_frame (f_smob);
768  if (frame != NULL)
769  find_frame_sal (frame, &sal);
770  }
771  CATCH (except, RETURN_MASK_ALL)
772  {
774  }
775  END_CATCH
776 
777  if (frame == NULL)
778  {
779  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
780  _("<gdb:frame>"));
781  }
782 
783  return stscm_scm_from_sal (sal);
784 }
785 
786 /* (frame-read-register <gdb:frame> string) -> <gdb:value>
787  The register argument must be a string. */
788 
789 static SCM
790 gdbscm_frame_read_register (SCM self, SCM register_scm)
791 {
792  char *register_str;
793  struct value *value = NULL;
794  struct frame_info *frame = NULL;
795  struct cleanup *cleanup;
796  frame_smob *f_smob;
797 
798  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
799  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "s",
800  register_scm, &register_str);
801  cleanup = make_cleanup (xfree, register_str);
802 
803  TRY
804  {
805  int regnum;
806 
807  frame = frscm_frame_smob_to_frame (f_smob);
808  if (frame)
809  {
811  register_str,
812  strlen (register_str));
813  if (regnum >= 0)
814  value = value_of_register (regnum, frame);
815  }
816  }
817  CATCH (except, RETURN_MASK_ALL)
818  {
820  }
821  END_CATCH
822 
823  do_cleanups (cleanup);
824 
825  if (frame == NULL)
826  {
827  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
828  _("<gdb:frame>"));
829  }
830 
831  if (value == NULL)
832  {
833  gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, register_scm,
834  _("unknown register"));
835  }
836 
837  return vlscm_scm_from_value (value);
838 }
839 
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
846  <gdb:block>. */
847 
848 static SCM
849 gdbscm_frame_read_var (SCM self, SCM symbol_scm, SCM rest)
850 {
851  SCM keywords[] = { block_keyword, SCM_BOOL_F };
852  int rc;
853  frame_smob *f_smob;
854  int block_arg_pos = -1;
855  SCM block_scm = SCM_UNDEFINED;
856  struct frame_info *frame = NULL;
857  struct symbol *var = NULL;
858  struct value *value = NULL;
859 
860  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
861 
862  TRY
863  {
864  frame = frscm_frame_smob_to_frame (f_smob);
865  }
866  CATCH (except, RETURN_MASK_ALL)
867  {
869  }
870  END_CATCH
871 
872  if (frame == NULL)
873  {
874  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
875  _("<gdb:frame>"));
876  }
877 
878  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG3, keywords, "#O",
879  rest, &block_arg_pos, &block_scm);
880 
881  if (syscm_is_symbol (symbol_scm))
882  {
883  var = syscm_get_valid_symbol_arg_unsafe (symbol_scm, SCM_ARG2,
884  FUNC_NAME);
885  SCM_ASSERT (SCM_UNBNDP (block_scm), block_scm, SCM_ARG3, FUNC_NAME);
886  }
887  else if (scm_is_string (symbol_scm))
888  {
889  char *var_name;
890  const struct block *block = NULL;
891  struct cleanup *cleanup;
892  struct gdb_exception except = exception_none;
893 
894  if (! SCM_UNBNDP (block_scm))
895  {
896  SCM except_scm;
897 
898  gdb_assert (block_arg_pos > 0);
899  block = bkscm_scm_to_block (block_scm, block_arg_pos, FUNC_NAME,
900  &except_scm);
901  if (block == NULL)
902  gdbscm_throw (except_scm);
903  }
904 
905  var_name = gdbscm_scm_to_c_string (symbol_scm);
906  cleanup = make_cleanup (xfree, var_name);
907  /* N.B. Between here and the call to do_cleanups, don't do anything
908  to cause a Scheme exception without performing the cleanup. */
909 
910  TRY
911  {
912  if (block == NULL)
913  block = get_frame_block (frame, NULL);
914  var = lookup_symbol (var_name, block, VAR_DOMAIN, NULL);
915  }
916  CATCH (ex, RETURN_MASK_ALL)
917  {
918  except = ex;
919  }
920  END_CATCH
921 
922  do_cleanups (cleanup);
924 
925  if (var == NULL)
926  {
927  do_cleanups (cleanup);
928  gdbscm_out_of_range_error (FUNC_NAME, 0, symbol_scm,
929  _("variable not found"));
930  }
931 
932  do_cleanups (cleanup);
933  }
934  else
935  {
936  /* Use SCM_ASSERT_TYPE for more consistent error messages. */
937  SCM_ASSERT_TYPE (0, symbol_scm, SCM_ARG1, FUNC_NAME,
938  _("gdb:symbol or string"));
939  }
940 
941  TRY
942  {
943  value = read_var_value (var, frame);
944  }
945  CATCH (except, RETURN_MASK_ALL)
946  {
948  }
949  END_CATCH
950 
951  return vlscm_scm_from_value (value);
952 }
953 
954 /* (frame-select <gdb:frame>) -> unspecified
955  Select this frame. */
956 
957 static SCM
959 {
960  frame_smob *f_smob;
961  struct frame_info *frame = NULL;
962 
963  f_smob = frscm_get_frame_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
964 
965  TRY
966  {
967  frame = frscm_frame_smob_to_frame (f_smob);
968  if (frame != NULL)
969  select_frame (frame);
970  }
971  CATCH (except, RETURN_MASK_ALL)
972  {
974  }
975  END_CATCH
976 
977  if (frame == NULL)
978  {
979  gdbscm_invalid_object_error (FUNC_NAME, SCM_ARG1, self,
980  _("<gdb:frame>"));
981  }
982 
983  return SCM_UNSPECIFIED;
984 }
985 
986 /* (newest-frame) -> <gdb:frame>
987  Returns the newest frame. */
988 
989 static SCM
991 {
992  struct frame_info *frame = NULL;
993 
994  TRY
995  {
996  frame = get_current_frame ();
997  }
998  CATCH (except, RETURN_MASK_ALL)
999  {
1000  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1001  }
1002  END_CATCH
1003 
1004  return frscm_scm_from_frame_unsafe (frame, current_inferior ());
1005 }
1006 
1007 /* (selected-frame) -> <gdb:frame>
1008  Returns the selected frame. */
1009 
1010 static SCM
1012 {
1013  struct frame_info *frame = NULL;
1014 
1015  TRY
1016  {
1017  frame = get_selected_frame (_("No frame is currently selected"));
1018  }
1019  CATCH (except, RETURN_MASK_ALL)
1020  {
1021  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1022  }
1023  END_CATCH
1024 
1025  return frscm_scm_from_frame_unsafe (frame, current_inferior ());
1026 }
1027 
1028 /* (unwind-stop-reason-string integer) -> string
1029  Return a string explaining the unwind stop reason. */
1030 
1031 static SCM
1033 {
1034  int reason;
1035  const char *str;
1036 
1037  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i",
1038  reason_scm, &reason);
1039 
1040  if (reason < UNWIND_FIRST || reason > UNWIND_LAST)
1041  scm_out_of_range (FUNC_NAME, reason_scm);
1042 
1043  str = unwind_stop_reason_to_string (reason);
1044  return gdbscm_scm_from_c_string (str);
1045 }
1046 
1047 /* Initialize the Scheme frame support. */
1048 
1049 static const scheme_integer_constant frame_integer_constants[] =
1050 {
1051 #define ENTRY(X) { #X, X }
1052 
1053  ENTRY (NORMAL_FRAME),
1054  ENTRY (DUMMY_FRAME),
1055  ENTRY (INLINE_FRAME),
1058  ENTRY (ARCH_FRAME),
1060 
1061 #undef ENTRY
1062 
1063 #define SET(name, description) \
1064  { "FRAME_" #name, name },
1065 #include "unwind_stop_reasons.def"
1066 #undef SET
1067 
1069 };
1070 
1071 static const scheme_function frame_functions[] =
1072 {
1073  { "frame?", 1, 0, 0, gdbscm_frame_p,
1074  "\
1075 Return #t if the object is a <gdb:frame> object." },
1076 
1077  { "frame-valid?", 1, 0, 0, gdbscm_frame_valid_p,
1078  "\
1079 Return #t if the object is a valid <gdb:frame> object.\n\
1080 Frames become invalid when the inferior returns to its caller." },
1081 
1082  { "frame-name", 1, 0, 0, gdbscm_frame_name,
1083  "\
1084 Return the name of the function corresponding to this frame,\n\
1085 or #f if there is no function." },
1086 
1087  { "frame-arch", 1, 0, 0, gdbscm_frame_arch,
1088  "\
1089 Return the frame's architecture as a <gdb:arch> object." },
1090 
1091  { "frame-type", 1, 0, 0, gdbscm_frame_type,
1092  "\
1093 Return the frame type, namely one of the gdb:*_FRAME constants." },
1094 
1095  { "frame-unwind-stop-reason", 1, 0, 0, gdbscm_frame_unwind_stop_reason,
1096  "\
1097 Return one of the gdb:FRAME_UNWIND_* constants explaining why\n\
1098 it's not possible to find frames older than this." },
1099 
1100  { "frame-pc", 1, 0, 0, gdbscm_frame_pc,
1101  "\
1102 Return the frame's resume address." },
1103 
1104  { "frame-block", 1, 0, 0, gdbscm_frame_block,
1105  "\
1106 Return the frame's code block, or #f if one cannot be found." },
1107 
1108  { "frame-function", 1, 0, 0, gdbscm_frame_function,
1109  "\
1110 Return the <gdb:symbol> for the function corresponding to this frame,\n\
1111 or #f if there isn't one." },
1112 
1113  { "frame-older", 1, 0, 0, gdbscm_frame_older,
1114  "\
1115 Return the frame immediately older (outer) to this frame,\n\
1116 or #f if there isn't one." },
1117 
1118  { "frame-newer", 1, 0, 0, gdbscm_frame_newer,
1119  "\
1120 Return the frame immediately newer (inner) to this frame,\n\
1121 or #f if there isn't one." },
1122 
1123  { "frame-sal", 1, 0, 0, gdbscm_frame_sal,
1124  "\
1125 Return the frame's symtab-and-line <gdb:sal> object." },
1126 
1127  { "frame-read-var", 2, 0, 1, gdbscm_frame_read_var,
1128  "\
1129 Return the value of the symbol in the frame.\n\
1130 \n\
1131  Arguments: <gdb:frame> <gdb:symbol>\n\
1132  Or: <gdb:frame> string [#:block <gdb:block>]" },
1133 
1134  { "frame-read-register", 2, 0, 0, gdbscm_frame_read_register,
1135  "\
1136 Return the value of the register in the frame.\n\
1137 \n\
1138  Arguments: <gdb:frame> string" },
1139 
1140  { "frame-select", 1, 0, 0, gdbscm_frame_select,
1141  "\
1142 Select this frame." },
1143 
1144  { "newest-frame", 0, 0, 0, gdbscm_newest_frame,
1145  "\
1146 Return the newest frame." },
1147 
1148  { "selected-frame", 0, 0, 0, gdbscm_selected_frame,
1149  "\
1150 Return the selected frame." },
1151 
1152  { "unwind-stop-reason-string", 1, 0, 0, gdbscm_unwind_stop_reason_string,
1153  "\
1154 Return a string explaining the unwind stop reason.\n\
1155 \n\
1156  Arguments: integer (the result of frame-unwind-stop-reason)" },
1157 
1159 };
1160 
1161 void
1163 {
1166  scm_set_smob_free (frame_smob_tag, frscm_free_frame_smob);
1167  scm_set_smob_print (frame_smob_tag, frscm_print_frame_smob);
1168 
1169  gdbscm_define_integer_constants (frame_integer_constants, 1);
1170  gdbscm_define_functions (frame_functions, 1);
1171 
1172  block_keyword = scm_from_latin1_keyword ("block");
1173 
1174  /* Register an inferior "free" callback so we can properly
1175  invalidate frames when an inferior file is about to be deleted. */
1177  = register_inferior_data_with_cleanup (NULL, frscm_del_inferior_frames);
1178 }
struct frame_info * frame_find_by_id(struct frame_id id)
Definition: frame.c:733
unsigned int special_addr_p
Definition: frame.h:152
CORE_ADDR special_addr
Definition: frame.h:147
SCM stscm_scm_from_sal(struct symtab_and_line sal)
Definition: scm-symtab.c:448
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
static const char frame_smob_name[]
Definition: scm-frame.c:70
CORE_ADDR get_frame_address_in_block(struct frame_info *this_frame)
Definition: frame.c:2248
struct frame_info * get_selected_frame(const char *message)
Definition: frame.c:1535
__extension__ enum frame_id_stack_status stack_status
Definition: frame.h:150
CORE_ADDR get_frame_pc(struct frame_info *frame)
Definition: frame.c:2217
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
struct frame_info * get_current_frame(void)
Definition: frame.c:1461
bfd_vma CORE_ADDR
Definition: common-types.h:41
static SCM frscm_scm_from_frame_unsafe(struct frame_info *frame, struct inferior *inferior)
Definition: scm-frame.c:278
static SCM gdbscm_frame_unwind_stop_reason(SCM self)
Definition: scm-frame.c:530
CORE_ADDR code_addr
Definition: frame.h:135
struct frame_id frame_id
Definition: scm-frame.c:43
SCM gdbscm_scm_from_ulongest(ULONGEST l)
Definition: scm-utils.c:552
void xfree(void *)
Definition: common-utils.c:97
static SCM gdbscm_frame_read_var(SCM self, SCM symbol_scm, SCM rest)
Definition: scm-frame.c:849
struct frame_info * get_prev_frame(struct frame_info *this_frame)
Definition: frame.c:2122
if(!(yy_init))
Definition: ada-lex.c:1072
SCM syscm_scm_from_symbol(struct symbol *symbol)
Definition: scm-symbol.c:206
static SCM gdbscm_frame_block(SCM self)
Definition: scm-frame.c:596
char * ui_file_xstrdup(struct ui_file *file, long *length)
Definition: ui-file.c:345
char * gdbscm_scm_to_c_string(SCM string)
Definition: scm-string.c:55
static int frscm_eq_frame_smob(const void *ap, const void *bp)
Definition: scm-frame.c:105
void ui_file_delete(struct ui_file *file)
Definition: ui-file.c:76
static void frscm_del_inferior_frames(struct inferior *inferior, void *datum)
Definition: scm-frame.c:380
void select_frame(struct frame_info *fi)
Definition: frame.c:1574
const struct frame_id null_frame_id
Definition: frame.c:506
static SCM gdbscm_frame_pc(SCM self)
Definition: scm-frame.c:563
static SCM gdbscm_frame_select(SCM self)
Definition: scm-frame.c:958
#define FUNC_NAME
const struct gdb_exception exception_none
void find_frame_funname(struct frame_info *frame, char **funname, enum language *funlang, struct symbol **funcp)
Definition: stack.c:1053
frame_smob * frscm_get_frame_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-frame.c:324
struct value * read_var_value(struct symbol *var, struct frame_info *frame)
Definition: findvar.c:613
unwind_stop_reason
Definition: frame.h:486
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:102
static SCM gdbscm_unwind_stop_reason_string(SCM reason_scm)
Definition: scm-frame.c:1032
#define _(String)
Definition: gdb_locale.h:40
static SCM gdbscm_newest_frame(void)
Definition: scm-frame.c:990
static scm_t_bits frame_smob_tag
Definition: scm-frame.c:73
#define END_CATCH
static SCM gdbscm_selected_frame(void)
Definition: scm-frame.c:1011
SCM vlscm_scm_from_value(struct value *value)
Definition: scm-value.c:258
int gdbscm_is_exception(SCM scm)
struct objfile * symbol_objfile(const struct symbol *symbol)
Definition: symtab.c:6231
static htab_t frscm_inferior_frame_map(struct inferior *inferior)
Definition: scm-frame.c:119
#define BLOCK_FUNCTION(bl)
Definition: block.h:118
#define TRY
int frame_id_eq(struct frame_id l, struct frame_id r)
Definition: frame.c:604
void find_frame_sal(struct frame_info *frame, struct symtab_and_line *sal)
Definition: frame.c:2328
const char * unwind_stop_reason_to_string(enum unwind_stop_reason reason)
Definition: frame.c:2610
void gdbscm_initialize_frames(void)
Definition: scm-frame.c:1162
const char *const name
Definition: aarch64-tdep.c:68
enum frame_type get_frame_type(struct frame_info *frame)
Definition: frame.c:2463
struct frame_id get_frame_id(struct frame_info *fi)
Definition: frame.c:473
#define CATCH(EXCEPTION, MASK)
static const struct inferior_data * frscm_inferior_data_key
Definition: scm-frame.c:78
SCM bkscm_scm_from_block(const struct block *block, struct objfile *objfile)
Definition: scm-block.c:210
static SCM gdbscm_frame_name(SCM self)
Definition: scm-frame.c:423
static struct parser_state * pstate
Definition: ada-exp.c:149
int frscm_is_frame(SCM scm)
Definition: scm-frame.c:201
SCM gdbscm_scm_from_c_string(const char *string)
Definition: scm-string.c:44
enum unwind_stop_reason get_frame_unwind_stop_reason(struct frame_info *frame)
Definition: frame.c:2598
struct symbol * find_pc_function(CORE_ADDR pc)
Definition: blockframe.c:150
const struct block * get_frame_block(struct frame_info *frame, CORE_ADDR *addr_in_block)
Definition: blockframe.c:55
frame_type
Definition: frame.h:231
static SCM gdbscm_frame_p(SCM scm)
Definition: scm-frame.c:209
SCM gdbscm_scm_from_gdb_exception(struct gdb_exception exception)
struct frame_info * prev
Definition: frame.c:140
eqable_gdb_smob base
Definition: scm-frame.c:41
struct cleanup * make_cleanup(make_cleanup_ftype *function, void *arg)
Definition: cleanups.c:117
struct inferior * inferior
Definition: scm-frame.c:57
Definition: gdbtypes.h:749
int syscm_is_symbol(SCM scm)
Definition: scm-symbol.c:189
#define BLOCK_SUPERBLOCK(bl)
Definition: block.h:119
void gdbscm_throw(SCM exception) ATTRIBUTE_NORETURN
#define gdb_assert(expr)
Definition: gdb_assert.h:33
#define ENTRY(X)
static SCM gdbscm_frame_sal(SCM self)
Definition: scm-frame.c:757
CORE_ADDR stack_addr
Definition: frame.h:120
int regnum
Definition: aarch64-tdep.c:69
void gdbscm_clear_eqable_gsmob_ptr_slot(htab_t htab, eqable_gdb_smob *base)
Definition: scm-gsmob.c:263
int user_reg_map_name_to_regnum(struct gdbarch *gdbarch, const char *name, int len)
Definition: user-regs.c:129
struct ui_file * mem_fileopen(void)
Definition: ui-file.c:427
static int frscm_mark_frame_invalid(void **slot, void *info)
Definition: scm-frame.c:365
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
Definition: block.h:60
Definition: value.c:172
unsigned long hash(const void *addr, int length)
Definition: bcache.c:98
unsigned int code_addr_p
Definition: frame.h:151
htab_t gdbscm_create_eqable_gsmob_ptr_map(htab_hash hash_fn, htab_eq eq_fn)
Definition: scm-gsmob.c:225
void gdbscm_init_eqable_gsmob(eqable_gdb_smob *base, SCM containing_scm)
Definition: scm-gsmob.c:135
static size_t frscm_free_frame_smob(SCM self)
Definition: scm-frame.c:136
struct frame_info * get_next_frame(struct frame_info *this_frame)
Definition: frame.c:1668
void gdbscm_define_integer_constants(const scheme_integer_constant *, int is_public)
Definition: scm-utils.c:63
#define END_FUNCTIONS
const struct block * bkscm_scm_to_block(SCM block_scm, int arg_pos, const char *func_name, SCM *excp)
Definition: scm-block.c:317
void gdbscm_invalid_object_error(const char *subr, int arg_pos, SCM bad_value, const char *error) ATTRIBUTE_NORETURN
static hashval_t frscm_hash_frame_smob(const void *p)
Definition: scm-frame.c:85
enum unwind_stop_reason stop_reason
Definition: frame.c:144
eqable_gdb_smob ** gdbscm_find_eqable_gsmob_ptr_slot(htab_t htab, eqable_gdb_smob *base)
Definition: scm-gsmob.c:238
struct value * value_of_register(int regnum, struct frame_info *frame)
Definition: findvar.c:260
void gdbscm_out_of_range_error(const char *subr, int arg_pos, SCM bad_value, const char *error) ATTRIBUTE_NORETURN
struct symbol * lookup_symbol(const char *name, const struct block *block, domain_enum domain, struct field_of_this_result *is_a_field_of_this)
Definition: symtab.c:1967
struct frame_info * frscm_frame_smob_to_frame(frame_smob *f_smob)
Definition: scm-frame.c:347
void gdbscm_parse_function_args(const char *function_name, int beginning_arg_pos, const SCM *keywords, const char *format,...)
Definition: scm-utils.c:377
static SCM gdbscm_frame_function(SCM self)
Definition: scm-frame.c:647
static SCM block_keyword
Definition: scm-frame.c:76
struct symbol * syscm_get_valid_symbol_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-symbol.c:284
void gdbscm_fill_eqable_gsmob_ptr_slot(eqable_gdb_smob **slot, eqable_gdb_smob *base)
Definition: scm-gsmob.c:249
void fprint_frame_id(struct ui_file *file, struct frame_id id)
Definition: frame.c:318
static int frscm_print_frame_smob(SCM self, SCM port, scm_print_state *pstate)
Definition: scm-frame.c:156
static SCM gdbscm_frame_arch(SCM self)
Definition: scm-frame.c:500
static SCM gdbscm_frame_valid_p(SCM self)
Definition: scm-frame.c:398
struct inferior * current_inferior(void)
Definition: inferior.c:57
static SCM frscm_make_frame_smob(void)
Definition: scm-frame.c:182
#define GDBSCM_HANDLE_GDB_EXCEPTION(exception)
language
Definition: defs.h:167
Definition: symtab.h:703
struct frame_info * next
Definition: frame.c:138
static SCM gdbscm_frame_type(SCM self)
Definition: scm-frame.c:467
static SCM gdbscm_frame_older(SCM self)
Definition: scm-frame.c:684
static SCM frscm_get_frame_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-frame.c:293
static SCM gdbscm_frame_newer(SCM self)
Definition: scm-frame.c:721
static SCM gdbscm_frame_read_register(SCM self, SCM register_scm)
Definition: scm-frame.c:790
static SCM frscm_scm_from_frame(struct frame_info *frame, struct inferior *inferior)
Definition: scm-frame.c:218
SCM arscm_scm_from_arch(struct gdbarch *gdbarch)
Definition: scm-arch.c:128
struct gdbarch * get_frame_arch(struct frame_info *this_frame)
Definition: frame.c:2535
int frame_id_is_next
Definition: scm-frame.c:67
void do_cleanups(struct cleanup *old_chain)
Definition: cleanups.c:175
#define END_INTEGER_CONSTANTS
struct gdbarch * gdbarch
Definition: scm-frame.c:44