GDB (xrefs)
scm-value.c
Go to the documentation of this file.
1 /* Scheme interface to values.
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 "arch-utils.h"
25 #include "charset.h"
26 #include "cp-abi.h"
27 #include "infcall.h"
28 #include "symtab.h" /* Needed by language.h. */
29 #include "language.h"
30 #include "valprint.h"
31 #include "value.h"
32 #include "guile-internal.h"
33 
34 /* The <gdb:value> smob. */
35 
36 typedef struct _value_smob
37 {
38  /* This always appears first. */
40 
41  /* Doubly linked list of values in values_in_scheme.
42  IWBN to use a chained_gdb_smob instead, which is doable, it just requires
43  a bit more casting than normal. */
44  struct _value_smob *next;
45  struct _value_smob *prev;
46 
47  struct value *value;
48 
49  /* These are cached here to avoid making multiple copies of them.
50  Plus computing the dynamic_type can be a bit expensive.
51  We use #f to indicate that the value doesn't exist (e.g. value doesn't
52  have an address), so we need another value to indicate that we haven't
53  computed the value yet. For this we use SCM_UNDEFINED. */
54  SCM address;
55  SCM type;
57 } value_smob;
58 
59 static const char value_smob_name[] = "gdb:value";
60 
61 /* The tag Guile knows the value smob by. */
62 static scm_t_bits value_smob_tag;
63 
64 /* List of all values which are currently exposed to Scheme. It is
65  maintained so that when an objfile is discarded, preserve_values
66  can copy the values' types if needed. */
68 
69 /* Keywords used by Scheme procedures in this file. */
70 static SCM type_keyword;
71 static SCM encoding_keyword;
72 static SCM errors_keyword;
73 static SCM length_keyword;
74 
75 /* Possible #:errors values. */
76 static SCM error_symbol;
77 static SCM escape_symbol;
78 static SCM substitute_symbol;
79 
80 /* Administrivia for value smobs. */
81 
82 /* Iterate over all the <gdb:value> objects, calling preserve_one_value on
83  each.
84  This is the extension_language_ops.preserve_values "method". */
85 
86 void
88  struct objfile *objfile, htab_t copied_types)
89 {
90  value_smob *iter;
91 
92  for (iter = values_in_scheme; iter; iter = iter->next)
93  preserve_one_value (iter->value, objfile, copied_types);
94 }
95 
96 /* Helper to add a value_smob to the global list. */
97 
98 static void
100 {
101  v_smob->next = values_in_scheme;
102  if (v_smob->next)
103  v_smob->next->prev = v_smob;
104  v_smob->prev = NULL;
105  values_in_scheme = v_smob;
106 }
107 
108 /* Helper to remove a value_smob from the global list. */
109 
110 static void
112 {
113  /* Remove SELF from the global list. */
114  if (v_smob->prev)
115  v_smob->prev->next = v_smob->next;
116  else
117  {
118  gdb_assert (values_in_scheme == v_smob);
119  values_in_scheme = v_smob->next;
120  }
121  if (v_smob->next)
122  v_smob->next->prev = v_smob->prev;
123 }
124 
125 /* The smob "free" function for <gdb:value>. */
126 
127 static size_t
129 {
130  value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
131 
132  vlscm_forget_value_smob (v_smob);
133  value_free (v_smob->value);
134 
135  return 0;
136 }
137 
138 /* The smob "print" function for <gdb:value>. */
139 
140 static int
141 vlscm_print_value_smob (SCM self, SCM port, scm_print_state *pstate)
142 {
143  value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
144  char *s = NULL;
145  struct value_print_options opts;
146 
147  if (pstate->writingp)
148  gdbscm_printf (port, "#<%s ", value_smob_name);
149 
150  get_user_print_options (&opts);
151  opts.deref_ref = 0;
152 
153  /* pstate->writingp = zero if invoked by display/~A, and nonzero if
154  invoked by write/~S. What to do here may need to evolve.
155  IWBN if we could pass an argument to format that would we could use
156  instead of writingp. */
157  opts.raw = !!pstate->writingp;
158 
159  TRY
160  {
161  struct ui_file *stb = mem_fileopen ();
162  struct cleanup *old_chain = make_cleanup_ui_file_delete (stb);
163 
164  common_val_print (v_smob->value, stb, 0, &opts, current_language);
165  s = ui_file_xstrdup (stb, NULL);
166 
167  do_cleanups (old_chain);
168  }
169  CATCH (except, RETURN_MASK_ALL)
170  {
172  }
173  END_CATCH
174 
175  if (s != NULL)
176  {
177  scm_puts (s, port);
178  xfree (s);
179  }
180 
181  if (pstate->writingp)
182  scm_puts (">", port);
183 
184  scm_remember_upto_here_1 (self);
185 
186  /* Non-zero means success. */
187  return 1;
188 }
189 
190 /* The smob "equalp" function for <gdb:value>. */
191 
192 static SCM
193 vlscm_equal_p_value_smob (SCM v1, SCM v2)
194 {
195  const value_smob *v1_smob = (value_smob *) SCM_SMOB_DATA (v1);
196  const value_smob *v2_smob = (value_smob *) SCM_SMOB_DATA (v2);
197  int result = 0;
198 
199  TRY
200  {
201  result = value_equal (v1_smob->value, v2_smob->value);
202  }
203  CATCH (except, RETURN_MASK_ALL)
204  {
206  }
207  END_CATCH
208 
209  return scm_from_bool (result);
210 }
211 
212 /* Low level routine to create a <gdb:value> object. */
213 
214 static SCM
216 {
217  value_smob *v_smob = (value_smob *)
218  scm_gc_malloc (sizeof (value_smob), value_smob_name);
219  SCM v_scm;
220 
221  /* These must be filled in by the caller. */
222  v_smob->value = NULL;
223  v_smob->prev = NULL;
224  v_smob->next = NULL;
225 
226  /* These are lazily computed. */
227  v_smob->address = SCM_UNDEFINED;
228  v_smob->type = SCM_UNDEFINED;
229  v_smob->dynamic_type = SCM_UNDEFINED;
230 
231  v_scm = scm_new_smob (value_smob_tag, (scm_t_bits) v_smob);
232  gdbscm_init_gsmob (&v_smob->base);
233 
234  return v_scm;
235 }
236 
237 /* Return non-zero if SCM is a <gdb:value> object. */
238 
239 int
240 vlscm_is_value (SCM scm)
241 {
242  return SCM_SMOB_PREDICATE (value_smob_tag, scm);
243 }
244 
245 /* (value? object) -> boolean */
246 
247 static SCM
248 gdbscm_value_p (SCM scm)
249 {
250  return scm_from_bool (vlscm_is_value (scm));
251 }
252 
253 /* Create a new <gdb:value> object that encapsulates VALUE.
254  The value is released from the all_values chain so its lifetime is not
255  bound to the execution of a command. */
256 
257 SCM
259 {
260  /* N.B. It's important to not cause any side-effects until we know the
261  conversion worked. */
262  SCM v_scm = vlscm_make_value_smob ();
263  value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
264 
265  v_smob->value = value;
266  release_value_or_incref (value);
268 
269  return v_scm;
270 }
271 
272 /* Returns the <gdb:value> object in SELF.
273  Throws an exception if SELF is not a <gdb:value> object. */
274 
275 static SCM
276 vlscm_get_value_arg_unsafe (SCM self, int arg_pos, const char *func_name)
277 {
278  SCM_ASSERT_TYPE (vlscm_is_value (self), self, arg_pos, func_name,
280 
281  return self;
282 }
283 
284 /* Returns a pointer to the value smob of SELF.
285  Throws an exception if SELF is not a <gdb:value> object. */
286 
287 static value_smob *
288 vlscm_get_value_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
289 {
290  SCM v_scm = vlscm_get_value_arg_unsafe (self, arg_pos, func_name);
291  value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
292 
293  return v_smob;
294 }
295 
296 /* Return the value field of V_SCM, an object of type <gdb:value>.
297  This exists so that we don't have to export the struct's contents. */
298 
299 struct value *
301 {
302  value_smob *v_smob;
303 
304  gdb_assert (vlscm_is_value (v_scm));
305  v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
306  return v_smob->value;
307 }
308 
309 /* Value methods. */
310 
311 /* (make-value x [#:type type]) -> <gdb:value> */
312 
313 static SCM
314 gdbscm_make_value (SCM x, SCM rest)
315 {
316  struct gdbarch *gdbarch = get_current_arch ();
317  const struct language_defn *language = current_language;
318  const SCM keywords[] = { type_keyword, SCM_BOOL_F };
319  int type_arg_pos = -1;
320  SCM type_scm = SCM_UNDEFINED;
321  SCM except_scm, result;
322  type_smob *t_smob;
323  struct type *type = NULL;
324  struct value *value;
325  struct cleanup *cleanups;
326 
327  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", rest,
328  &type_arg_pos, &type_scm);
329 
330  if (type_arg_pos > 0)
331  {
332  t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, type_arg_pos,
333  FUNC_NAME);
334  type = tyscm_type_smob_type (t_smob);
335  }
336 
338 
339  value = vlscm_convert_typed_value_from_scheme (FUNC_NAME, SCM_ARG1, x,
340  type_arg_pos, type_scm, type,
341  &except_scm,
342  gdbarch, language);
343  if (value == NULL)
344  {
345  do_cleanups (cleanups);
346  gdbscm_throw (except_scm);
347  }
348 
349  result = vlscm_scm_from_value (value);
350 
351  do_cleanups (cleanups);
352 
353  if (gdbscm_is_exception (result))
354  gdbscm_throw (result);
355  return result;
356 }
357 
358 /* (make-lazy-value <gdb:type> address) -> <gdb:value> */
359 
360 static SCM
361 gdbscm_make_lazy_value (SCM type_scm, SCM address_scm)
362 {
363  type_smob *t_smob;
364  struct type *type;
365  ULONGEST address;
366  struct value *value = NULL;
367  SCM result;
368  struct cleanup *cleanups;
369 
370  t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG1, FUNC_NAME);
371  type = tyscm_type_smob_type (t_smob);
372 
373  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "U",
374  address_scm, &address);
375 
377 
378  /* There's no (current) need to wrap this in a TRY_CATCH, but for consistency
379  and future-proofing we do. */
380  TRY
381  {
382  value = value_from_contents_and_address (type, NULL, address);
383  }
384  CATCH (except, RETURN_MASK_ALL)
385  {
387  }
388  END_CATCH
389 
390  result = vlscm_scm_from_value (value);
391 
392  do_cleanups (cleanups);
393 
394  if (gdbscm_is_exception (result))
395  gdbscm_throw (result);
396  return result;
397 }
398 
399 /* (value-optimized-out? <gdb:value>) -> boolean */
400 
401 static SCM
403 {
404  value_smob *v_smob
405  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
406  struct value *value = v_smob->value;
407  int opt = 0;
408 
409  TRY
410  {
411  opt = value_optimized_out (value);
412  }
413  CATCH (except, RETURN_MASK_ALL)
414  {
416  }
417  END_CATCH
418 
419  return scm_from_bool (opt);
420 }
421 
422 /* (value-address <gdb:value>) -> integer
423  Returns #f if the value doesn't have one. */
424 
425 static SCM
427 {
428  value_smob *v_smob
429  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
430  struct value *value = v_smob->value;
431 
432  if (SCM_UNBNDP (v_smob->address))
433  {
434  struct value *res_val = NULL;
435  struct cleanup *cleanup
437  SCM address;
438 
439  TRY
440  {
441  res_val = value_addr (value);
442  }
443  CATCH (except, RETURN_MASK_ALL)
444  {
445  address = SCM_BOOL_F;
446  }
447  END_CATCH
448 
449  if (res_val != NULL)
450  address = vlscm_scm_from_value (res_val);
451 
452  do_cleanups (cleanup);
453 
454  if (gdbscm_is_exception (address))
455  gdbscm_throw (address);
456 
457  v_smob->address = address;
458  }
459 
460  return v_smob->address;
461 }
462 
463 /* (value-dereference <gdb:value>) -> <gdb:value>
464  Given a value of a pointer type, apply the C unary * operator to it. */
465 
466 static SCM
468 {
469  value_smob *v_smob
470  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
471  struct value *value = v_smob->value;
472  SCM result;
473  struct value *res_val = NULL;
474  struct cleanup *cleanups;
475 
477 
478  TRY
479  {
480  res_val = value_ind (value);
481  }
482  CATCH (except, RETURN_MASK_ALL)
483  {
485  }
486  END_CATCH
487 
488  result = vlscm_scm_from_value (res_val);
489 
490  do_cleanups (cleanups);
491 
492  if (gdbscm_is_exception (result))
493  gdbscm_throw (result);
494 
495  return result;
496 }
497 
498 /* (value-referenced-value <gdb:value>) -> <gdb:value>
499  Given a value of a reference type, return the value referenced.
500  The difference between this function and gdbscm_value_dereference is that
501  the latter applies * unary operator to a value, which need not always
502  result in the value referenced.
503  For example, for a value which is a reference to an 'int' pointer ('int *'),
504  gdbscm_value_dereference will result in a value of type 'int' while
505  gdbscm_value_referenced_value will result in a value of type 'int *'. */
506 
507 static SCM
509 {
510  value_smob *v_smob
511  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
512  struct value *value = v_smob->value;
513  SCM result;
514  struct value *res_val = NULL;
515  struct cleanup *cleanups;
516 
518 
519  TRY
520  {
521  switch (TYPE_CODE (check_typedef (value_type (value))))
522  {
523  case TYPE_CODE_PTR:
524  res_val = value_ind (value);
525  break;
526  case TYPE_CODE_REF:
527  res_val = coerce_ref (value);
528  break;
529  default:
530  error (_("Trying to get the referenced value from a value which is"
531  " neither a pointer nor a reference"));
532  }
533  }
534  CATCH (except, RETURN_MASK_ALL)
535  {
537  }
538  END_CATCH
539 
540  result = vlscm_scm_from_value (res_val);
541 
542  do_cleanups (cleanups);
543 
544  if (gdbscm_is_exception (result))
545  gdbscm_throw (result);
546 
547  return result;
548 }
549 
550 /* (value-type <gdb:value>) -> <gdb:type> */
551 
552 static SCM
554 {
555  value_smob *v_smob
556  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
557  struct value *value = v_smob->value;
558 
559  if (SCM_UNBNDP (v_smob->type))
560  v_smob->type = tyscm_scm_from_type (value_type (value));
561 
562  return v_smob->type;
563 }
564 
565 /* (value-dynamic-type <gdb:value>) -> <gdb:type> */
566 
567 static SCM
569 {
570  value_smob *v_smob
571  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
572  struct value *value = v_smob->value;
573  struct type *type = NULL;
574 
575  if (! SCM_UNBNDP (v_smob->dynamic_type))
576  return v_smob->dynamic_type;
577 
578  TRY
579  {
580  struct cleanup *cleanup
582 
583  type = value_type (value);
584  CHECK_TYPEDEF (type);
585 
586  if (((TYPE_CODE (type) == TYPE_CODE_PTR)
587  || (TYPE_CODE (type) == TYPE_CODE_REF))
589  {
590  struct value *target;
591  int was_pointer = TYPE_CODE (type) == TYPE_CODE_PTR;
592 
593  if (was_pointer)
594  target = value_ind (value);
595  else
596  target = coerce_ref (value);
597  type = value_rtti_type (target, NULL, NULL, NULL);
598 
599  if (type)
600  {
601  if (was_pointer)
602  type = lookup_pointer_type (type);
603  else
604  type = lookup_reference_type (type);
605  }
606  }
607  else if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
608  type = value_rtti_type (value, NULL, NULL, NULL);
609  else
610  {
611  /* Re-use object's static type. */
612  type = NULL;
613  }
614 
615  do_cleanups (cleanup);
616  }
617  CATCH (except, RETURN_MASK_ALL)
618  {
620  }
621  END_CATCH
622 
623  if (type == NULL)
624  v_smob->dynamic_type = gdbscm_value_type (self);
625  else
626  v_smob->dynamic_type = tyscm_scm_from_type (type);
627 
628  return v_smob->dynamic_type;
629 }
630 
631 /* A helper function that implements the various cast operators. */
632 
633 static SCM
634 vlscm_do_cast (SCM self, SCM type_scm, enum exp_opcode op,
635  const char *func_name)
636 {
637  value_smob *v_smob
638  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
639  struct value *value = v_smob->value;
640  type_smob *t_smob
641  = tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG2, FUNC_NAME);
642  struct type *type = tyscm_type_smob_type (t_smob);
643  SCM result;
644  struct value *res_val = NULL;
645  struct cleanup *cleanups;
646 
648 
649  TRY
650  {
651  if (op == UNOP_DYNAMIC_CAST)
652  res_val = value_dynamic_cast (type, value);
653  else if (op == UNOP_REINTERPRET_CAST)
654  res_val = value_reinterpret_cast (type, value);
655  else
656  {
657  gdb_assert (op == UNOP_CAST);
658  res_val = value_cast (type, value);
659  }
660  }
661  CATCH (except, RETURN_MASK_ALL)
662  {
664  }
665  END_CATCH
666 
667  gdb_assert (res_val != NULL);
668  result = vlscm_scm_from_value (res_val);
669 
670  do_cleanups (cleanups);
671 
672  if (gdbscm_is_exception (result))
673  gdbscm_throw (result);
674 
675  return result;
676 }
677 
678 /* (value-cast <gdb:value> <gdb:type>) -> <gdb:value> */
679 
680 static SCM
682 {
683  return vlscm_do_cast (self, new_type, UNOP_CAST, FUNC_NAME);
684 }
685 
686 /* (value-dynamic-cast <gdb:value> <gdb:type>) -> <gdb:value> */
687 
688 static SCM
690 {
691  return vlscm_do_cast (self, new_type, UNOP_DYNAMIC_CAST, FUNC_NAME);
692 }
693 
694 /* (value-reinterpret-cast <gdb:value> <gdb:type>) -> <gdb:value> */
695 
696 static SCM
698 {
699  return vlscm_do_cast (self, new_type, UNOP_REINTERPRET_CAST, FUNC_NAME);
700 }
701 
702 /* (value-field <gdb:value> string) -> <gdb:value>
703  Given string name of an element inside structure, return its <gdb:value>
704  object. */
705 
706 static SCM
707 gdbscm_value_field (SCM self, SCM field_scm)
708 {
709  value_smob *v_smob
710  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
711  struct value *value = v_smob->value;
712  char *field = NULL;
713  struct value *res_val = NULL;
714  SCM result;
715  struct cleanup *cleanups;
716 
717  SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
718  _("string"));
719 
721 
722  field = gdbscm_scm_to_c_string (field_scm);
723  make_cleanup (xfree, field);
724 
725  TRY
726  {
727  struct value *tmp = value;
728 
729  res_val = value_struct_elt (&tmp, NULL, field, NULL, NULL);
730  }
731  CATCH (except, RETURN_MASK_ALL)
732  {
734  }
735  END_CATCH
736 
737  gdb_assert (res_val != NULL);
738  result = vlscm_scm_from_value (res_val);
739 
740  do_cleanups (cleanups);
741 
742  if (gdbscm_is_exception (result))
743  gdbscm_throw (result);
744 
745  return result;
746 }
747 
748 /* (value-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
749  Return the specified value in an array. */
750 
751 static SCM
752 gdbscm_value_subscript (SCM self, SCM index_scm)
753 {
754  value_smob *v_smob
755  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
756  struct value *value = v_smob->value;
757  struct value *index = NULL;
758  struct value *res_val = NULL;
759  struct type *type = value_type (value);
760  struct gdbarch *gdbarch;
761  SCM result, except_scm;
762  struct cleanup *cleanups;
763 
764  /* The sequencing here, as everywhere else, is important.
765  We can't have existing cleanups when a Scheme exception is thrown. */
766 
767  SCM_ASSERT (type != NULL, self, SCM_ARG2, FUNC_NAME);
768  gdbarch = get_type_arch (type);
769 
771 
772  index = vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
773  &except_scm,
774  gdbarch, current_language);
775  if (index == NULL)
776  {
777  do_cleanups (cleanups);
778  gdbscm_throw (except_scm);
779  }
780 
781  TRY
782  {
783  struct value *tmp = value;
784 
785  /* Assume we are attempting an array access, and let the value code
786  throw an exception if the index has an invalid type.
787  Check the value's type is something that can be accessed via
788  a subscript. */
789  tmp = coerce_ref (tmp);
790  type = check_typedef (value_type (tmp));
791  if (TYPE_CODE (type) != TYPE_CODE_ARRAY
792  && TYPE_CODE (type) != TYPE_CODE_PTR)
793  error (_("Cannot subscript requested type"));
794 
795  res_val = value_subscript (tmp, value_as_long (index));
796  }
797  CATCH (except, RETURN_MASK_ALL)
798  {
800  }
801  END_CATCH
802 
803  gdb_assert (res_val != NULL);
804  result = vlscm_scm_from_value (res_val);
805 
806  do_cleanups (cleanups);
807 
808  if (gdbscm_is_exception (result))
809  gdbscm_throw (result);
810 
811  return result;
812 }
813 
814 /* (value-call <gdb:value> arg-list) -> <gdb:value>
815  Perform an inferior function call on the value. */
816 
817 static SCM
818 gdbscm_value_call (SCM self, SCM args)
819 {
820  value_smob *v_smob
821  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
822  struct value *function = v_smob->value;
823  struct value *mark = value_mark ();
824  struct type *ftype = NULL;
825  long args_count;
826  struct value **vargs = NULL;
827  SCM result = SCM_BOOL_F;
828 
829  TRY
830  {
831  ftype = check_typedef (value_type (function));
832  }
833  CATCH (except, RETURN_MASK_ALL)
834  {
836  }
837  END_CATCH
838 
839  SCM_ASSERT_TYPE (TYPE_CODE (ftype) == TYPE_CODE_FUNC, self,
840  SCM_ARG1, FUNC_NAME,
841  _("function (value of TYPE_CODE_FUNC)"));
842 
843  SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (args)), args,
844  SCM_ARG2, FUNC_NAME, _("list"));
845 
846  args_count = scm_ilength (args);
847  if (args_count > 0)
848  {
849  struct gdbarch *gdbarch = get_current_arch ();
850  const struct language_defn *language = current_language;
851  SCM except_scm;
852  long i;
853 
854  vargs = alloca (sizeof (struct value *) * args_count);
855  for (i = 0; i < args_count; i++)
856  {
857  SCM arg = scm_car (args);
858 
860  GDBSCM_ARG_NONE, arg,
861  &except_scm,
862  gdbarch, language);
863  if (vargs[i] == NULL)
864  gdbscm_throw (except_scm);
865 
866  args = scm_cdr (args);
867  }
868  gdb_assert (gdbscm_is_true (scm_null_p (args)));
869  }
870 
871  TRY
872  {
874  struct value *return_value;
875 
876  return_value = call_function_by_hand (function, args_count, vargs);
877  result = vlscm_scm_from_value (return_value);
878  do_cleanups (cleanup);
879  }
880  CATCH (except, RETURN_MASK_ALL)
881  {
883  }
884  END_CATCH
885 
886  if (gdbscm_is_exception (result))
887  gdbscm_throw (result);
888 
889  return result;
890 }
891 
892 /* (value->bytevector <gdb:value>) -> bytevector */
893 
894 static SCM
896 {
897  value_smob *v_smob
898  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
899  struct value *value = v_smob->value;
900  struct type *type;
901  size_t length = 0;
902  const gdb_byte *contents = NULL;
903  SCM bv;
904 
905  type = value_type (value);
906 
907  TRY
908  {
909  CHECK_TYPEDEF (type);
910  length = TYPE_LENGTH (type);
911  contents = value_contents (value);
912  }
913  CATCH (except, RETURN_MASK_ALL)
914  {
916  }
917  END_CATCH
918 
919  bv = scm_c_make_bytevector (length);
920  memcpy (SCM_BYTEVECTOR_CONTENTS (bv), contents, length);
921 
922  return bv;
923 }
924 
925 /* Helper function to determine if a type is "int-like". */
926 
927 static int
928 is_intlike (struct type *type, int ptr_ok)
929 {
930  return (TYPE_CODE (type) == TYPE_CODE_INT
931  || TYPE_CODE (type) == TYPE_CODE_ENUM
932  || TYPE_CODE (type) == TYPE_CODE_BOOL
933  || TYPE_CODE (type) == TYPE_CODE_CHAR
934  || (ptr_ok && TYPE_CODE (type) == TYPE_CODE_PTR));
935 }
936 
937 /* (value->bool <gdb:value>) -> boolean
938  Throws an error if the value is not integer-like. */
939 
940 static SCM
942 {
943  value_smob *v_smob
944  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
945  struct value *value = v_smob->value;
946  struct type *type;
947  LONGEST l = 0;
948 
949  type = value_type (value);
950 
951  TRY
952  {
953  CHECK_TYPEDEF (type);
954  }
955  CATCH (except, RETURN_MASK_ALL)
956  {
958  }
959  END_CATCH
960 
961  SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
962  _("integer-like gdb value"));
963 
964  TRY
965  {
966  if (TYPE_CODE (type) == TYPE_CODE_PTR)
967  l = value_as_address (value);
968  else
969  l = value_as_long (value);
970  }
971  CATCH (except, RETURN_MASK_ALL)
972  {
974  }
975  END_CATCH
976 
977  return scm_from_bool (l != 0);
978 }
979 
980 /* (value->integer <gdb:value>) -> integer
981  Throws an error if the value is not integer-like. */
982 
983 static SCM
985 {
986  value_smob *v_smob
987  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
988  struct value *value = v_smob->value;
989  struct type *type;
990  LONGEST l = 0;
991 
992  type = value_type (value);
993 
994  TRY
995  {
996  CHECK_TYPEDEF (type);
997  }
998  CATCH (except, RETURN_MASK_ALL)
999  {
1000  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1001  }
1002  END_CATCH
1003 
1004  SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
1005  _("integer-like gdb value"));
1006 
1007  TRY
1008  {
1009  if (TYPE_CODE (type) == TYPE_CODE_PTR)
1010  l = value_as_address (value);
1011  else
1012  l = value_as_long (value);
1013  }
1014  CATCH (except, RETURN_MASK_ALL)
1015  {
1016  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1017  }
1018  END_CATCH
1019 
1020  if (TYPE_UNSIGNED (type))
1021  return gdbscm_scm_from_ulongest (l);
1022  else
1023  return gdbscm_scm_from_longest (l);
1024 }
1025 
1026 /* (value->real <gdb:value>) -> real
1027  Throws an error if the value is not a number. */
1028 
1029 static SCM
1031 {
1032  value_smob *v_smob
1033  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1034  struct value *value = v_smob->value;
1035  struct type *type;
1036  DOUBLEST d = 0;
1037 
1038  type = value_type (value);
1039 
1040  TRY
1041  {
1042  CHECK_TYPEDEF (type);
1043  }
1044  CATCH (except, RETURN_MASK_ALL)
1045  {
1046  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1047  }
1048  END_CATCH
1049 
1050  SCM_ASSERT_TYPE (is_intlike (type, 0) || TYPE_CODE (type) == TYPE_CODE_FLT,
1051  self, SCM_ARG1, FUNC_NAME, _("number"));
1052 
1053  TRY
1054  {
1055  d = value_as_double (value);
1056  }
1057  CATCH (except, RETURN_MASK_ALL)
1058  {
1059  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1060  }
1061  END_CATCH
1062 
1063  /* TODO: Is there a better way to check if the value fits? */
1064  if (d != (double) d)
1065  gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
1066  _("number can't be converted to a double"));
1067 
1068  return scm_from_double (d);
1069 }
1070 
1071 /* (value->string <gdb:value>
1072  [#:encoding encoding]
1073  [#:errors #f | 'error | 'substitute]
1074  [#:length length])
1075  -> string
1076  Return Unicode string with value's contents, which must be a string.
1077 
1078  If ENCODING is not given, the string is assumed to be encoded in
1079  the target's charset.
1080 
1081  ERRORS is one of #f, 'error or 'substitute.
1082  An error setting of #f means use the default, which is Guile's
1083  %default-port-conversion-strategy when using Guile >= 2.0.6, or 'error if
1084  using an earlier version of Guile. Earlier versions do not properly
1085  support obtaining the default port conversion strategy.
1086  If the default is not one of 'error or 'substitute, 'substitute is used.
1087  An error setting of "error" causes an exception to be thrown if there's
1088  a decoding error. An error setting of "substitute" causes invalid
1089  characters to be replaced with "?".
1090 
1091  If LENGTH is provided, only fetch string to the length provided.
1092  LENGTH must be a Scheme integer, it can't be a <gdb:value> integer. */
1093 
1094 static SCM
1095 gdbscm_value_to_string (SCM self, SCM rest)
1096 {
1097  value_smob *v_smob
1098  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1099  struct value *value = v_smob->value;
1100  const SCM keywords[] = {
1102  };
1103  int encoding_arg_pos = -1, errors_arg_pos = -1, length_arg_pos = -1;
1104  char *encoding = NULL;
1105  SCM errors = SCM_BOOL_F;
1106  int length = -1;
1107  gdb_byte *buffer = NULL;
1108  const char *la_encoding = NULL;
1109  struct type *char_type = NULL;
1110  SCM result;
1111  struct cleanup *cleanups;
1112 
1113  /* The sequencing here, as everywhere else, is important.
1114  We can't have existing cleanups when a Scheme exception is thrown. */
1115 
1116  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#sOi", rest,
1117  &encoding_arg_pos, &encoding,
1118  &errors_arg_pos, &errors,
1119  &length_arg_pos, &length);
1120 
1121  cleanups = make_cleanup (xfree, encoding);
1122 
1123  if (errors_arg_pos > 0
1124  && errors != SCM_BOOL_F
1125  && !scm_is_eq (errors, error_symbol)
1126  && !scm_is_eq (errors, substitute_symbol))
1127  {
1128  SCM excp
1129  = gdbscm_make_out_of_range_error (FUNC_NAME, errors_arg_pos, errors,
1130  _("invalid error kind"));
1131 
1132  do_cleanups (cleanups);
1133  gdbscm_throw (excp);
1134  }
1135  if (errors == SCM_BOOL_F)
1136  {
1137  /* N.B. scm_port_conversion_strategy in Guile versions prior to 2.0.6
1138  will throw a Scheme error when passed #f. */
1139  if (gdbscm_guile_version_is_at_least (2, 0, 6))
1140  errors = scm_port_conversion_strategy (SCM_BOOL_F);
1141  else
1142  errors = error_symbol;
1143  }
1144  /* We don't assume anything about the result of scm_port_conversion_strategy.
1145  From this point on, if errors is not 'errors, use 'substitute. */
1146 
1147  TRY
1148  {
1149  LA_GET_STRING (value, &buffer, &length, &char_type, &la_encoding);
1150  }
1151  CATCH (except, RETURN_MASK_ALL)
1152  {
1153  GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
1154  }
1155  END_CATCH
1156 
1157  /* If errors is "error" scm_from_stringn may throw a Scheme exception.
1158  Make sure we don't leak. This is done via scm_dynwind_begin, et.al. */
1159  discard_cleanups (cleanups);
1160 
1161  scm_dynwind_begin (0);
1162 
1163  gdbscm_dynwind_xfree (encoding);
1164  gdbscm_dynwind_xfree (buffer);
1165 
1166  result = scm_from_stringn ((const char *) buffer,
1167  length * TYPE_LENGTH (char_type),
1168  (encoding != NULL && *encoding != '\0'
1169  ? encoding
1170  : la_encoding),
1171  scm_is_eq (errors, error_symbol)
1172  ? SCM_FAILED_CONVERSION_ERROR
1173  : SCM_FAILED_CONVERSION_QUESTION_MARK);
1174 
1175  scm_dynwind_end ();
1176 
1177  return result;
1178 }
1179 
1180 /* (value->lazy-string <gdb:value> [#:encoding encoding] [#:length length])
1181  -> <gdb:lazy-string>
1182  Return a Scheme object representing a lazy_string_object type.
1183  A lazy string is a pointer to a string with an optional encoding and length.
1184  If ENCODING is not given, the target's charset is used.
1185  If LENGTH is provided then the length parameter is set to LENGTH, otherwise
1186  length will be set to -1 (first null of appropriate with).
1187  LENGTH must be a Scheme integer, it can't be a <gdb:value> integer. */
1188 
1189 static SCM
1190 gdbscm_value_to_lazy_string (SCM self, SCM rest)
1191 {
1192  value_smob *v_smob
1193  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1194  struct value *value = v_smob->value;
1195  const SCM keywords[] = { encoding_keyword, length_keyword, SCM_BOOL_F };
1196  int encoding_arg_pos = -1, length_arg_pos = -1;
1197  char *encoding = NULL;
1198  int length = -1;
1199  SCM result = SCM_BOOL_F; /* -Wall */
1200  struct cleanup *cleanups;
1201  struct gdb_exception except = exception_none;
1202 
1203  /* The sequencing here, as everywhere else, is important.
1204  We can't have existing cleanups when a Scheme exception is thrown. */
1205 
1206  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#si", rest,
1207  &encoding_arg_pos, &encoding,
1208  &length_arg_pos, &length);
1209 
1210  cleanups = make_cleanup (xfree, encoding);
1211 
1212  TRY
1213  {
1214  struct cleanup *inner_cleanup
1216 
1217  if (TYPE_CODE (value_type (value)) == TYPE_CODE_PTR)
1218  value = value_ind (value);
1219 
1220  result = lsscm_make_lazy_string (value_address (value), length,
1221  encoding, value_type (value));
1222 
1223  do_cleanups (inner_cleanup);
1224  }
1225  CATCH (ex, RETURN_MASK_ALL)
1226  {
1227  except = ex;
1228  }
1229  END_CATCH
1230 
1231  do_cleanups (cleanups);
1232  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1233 
1234  if (gdbscm_is_exception (result))
1235  gdbscm_throw (result);
1236 
1237  return result;
1238 }
1239 
1240 /* (value-lazy? <gdb:value>) -> boolean */
1241 
1242 static SCM
1244 {
1245  value_smob *v_smob
1246  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1247  struct value *value = v_smob->value;
1248 
1249  return scm_from_bool (value_lazy (value));
1250 }
1251 
1252 /* (value-fetch-lazy! <gdb:value>) -> unspecified */
1253 
1254 static SCM
1256 {
1257  value_smob *v_smob
1258  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1259  struct value *value = v_smob->value;
1260 
1261  TRY
1262  {
1263  if (value_lazy (value))
1264  value_fetch_lazy (value);
1265  }
1266  CATCH (except, RETURN_MASK_ALL)
1267  {
1268  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1269  }
1270  END_CATCH
1271 
1272  return SCM_UNSPECIFIED;
1273 }
1274 
1275 /* (value-print <gdb:value>) -> string */
1276 
1277 static SCM
1279 {
1280  value_smob *v_smob
1281  = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1282  struct value *value = v_smob->value;
1283  struct value_print_options opts;
1284  char *s = NULL;
1285  SCM result;
1286 
1287  get_user_print_options (&opts);
1288  opts.deref_ref = 0;
1289 
1290  TRY
1291  {
1292  struct ui_file *stb = mem_fileopen ();
1293  struct cleanup *old_chain = make_cleanup_ui_file_delete (stb);
1294 
1295  common_val_print (value, stb, 0, &opts, current_language);
1296  s = ui_file_xstrdup (stb, NULL);
1297 
1298  do_cleanups (old_chain);
1299  }
1300  CATCH (except, RETURN_MASK_ALL)
1301  {
1302  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1303  }
1304  END_CATCH
1305 
1306  /* Use SCM_FAILED_CONVERSION_QUESTION_MARK to ensure this doesn't
1307  throw an error if the encoding fails.
1308  IWBN to use scm_take_locale_string here, but we'd have to temporarily
1309  override the default port conversion handler because contrary to
1310  documentation it doesn't necessarily free the input string. */
1311  result = scm_from_stringn (s, strlen (s), host_charset (),
1312  SCM_FAILED_CONVERSION_QUESTION_MARK);
1313  xfree (s);
1314 
1315  return result;
1316 }
1317 
1318 /* (parse-and-eval string) -> <gdb:value>
1319  Parse a string and evaluate the string as an expression. */
1320 
1321 static SCM
1323 {
1324  char *expr_str;
1325  struct value *res_val = NULL;
1326  SCM result;
1327  struct cleanup *cleanups;
1328 
1329  /* The sequencing here, as everywhere else, is important.
1330  We can't have existing cleanups when a Scheme exception is thrown. */
1331 
1332  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
1333  expr_scm, &expr_str);
1334 
1336  make_cleanup (xfree, expr_str);
1337 
1338  TRY
1339  {
1340  res_val = parse_and_eval (expr_str);
1341  }
1342  CATCH (except, RETURN_MASK_ALL)
1343  {
1344  GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
1345  }
1346  END_CATCH
1347 
1348  gdb_assert (res_val != NULL);
1349  result = vlscm_scm_from_value (res_val);
1350 
1351  do_cleanups (cleanups);
1352 
1353  if (gdbscm_is_exception (result))
1354  gdbscm_throw (result);
1355 
1356  return result;
1357 }
1358 
1359 /* (history-ref integer) -> <gdb:value>
1360  Return the specified value from GDB's value history. */
1361 
1362 static SCM
1364 {
1365  int i;
1366  struct value *res_val = NULL; /* Initialize to appease gcc warning. */
1367 
1368  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", index, &i);
1369 
1370  TRY
1371  {
1372  res_val = access_value_history (i);
1373  }
1374  CATCH (except, RETURN_MASK_ALL)
1375  {
1376  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1377  }
1378  END_CATCH
1379 
1380  return vlscm_scm_from_value (res_val);
1381 }
1382 
1383 /* (history-append! <gdb:value>) -> index
1384  Append VALUE to GDB's value history. Return its index in the history. */
1385 
1386 static SCM
1388 {
1389  int res_index = -1;
1390  struct value *v;
1391  value_smob *v_smob;
1392 
1393  v_smob = vlscm_get_value_smob_arg_unsafe (value, SCM_ARG1, FUNC_NAME);
1394  v = v_smob->value;
1395 
1396  TRY
1397  {
1398  res_index = record_latest_value (v);
1399  }
1400  CATCH (except, RETURN_MASK_ALL)
1401  {
1402  GDBSCM_HANDLE_GDB_EXCEPTION (except);
1403  }
1404  END_CATCH
1405 
1406  return scm_from_int (res_index);
1407 }
1408 
1409 /* Initialize the Scheme value code. */
1410 
1411 static const scheme_function value_functions[] =
1412 {
1413  { "value?", 1, 0, 0, gdbscm_value_p,
1414  "\
1415 Return #t if the object is a <gdb:value> object." },
1416 
1417  { "make-value", 1, 0, 1, gdbscm_make_value,
1418  "\
1419 Create a <gdb:value> representing object.\n\
1420 Typically this is used to convert numbers and strings to\n\
1421 <gdb:value> objects.\n\
1422 \n\
1423  Arguments: object [#:type <gdb:type>]" },
1424 
1425  { "value-optimized-out?", 1, 0, 0, gdbscm_value_optimized_out_p,
1426  "\
1427 Return #t if the value has been optimizd out." },
1428 
1429  { "value-address", 1, 0, 0, gdbscm_value_address,
1430  "\
1431 Return the address of the value." },
1432 
1433  { "value-type", 1, 0, 0, gdbscm_value_type,
1434  "\
1435 Return the type of the value." },
1436 
1437  { "value-dynamic-type", 1, 0, 0, gdbscm_value_dynamic_type,
1438  "\
1439 Return the dynamic type of the value." },
1440 
1441  { "value-cast", 2, 0, 0, gdbscm_value_cast,
1442  "\
1443 Cast the value to the supplied type.\n\
1444 \n\
1445  Arguments: <gdb:value> <gdb:type>" },
1446 
1447  { "value-dynamic-cast", 2, 0, 0, gdbscm_value_dynamic_cast,
1448  "\
1449 Cast the value to the supplied type, as if by the C++\n\
1450 dynamic_cast operator.\n\
1451 \n\
1452  Arguments: <gdb:value> <gdb:type>" },
1453 
1454  { "value-reinterpret-cast", 2, 0, 0, gdbscm_value_reinterpret_cast,
1455  "\
1456 Cast the value to the supplied type, as if by the C++\n\
1457 reinterpret_cast operator.\n\
1458 \n\
1459  Arguments: <gdb:value> <gdb:type>" },
1460 
1461  { "value-dereference", 1, 0, 0, gdbscm_value_dereference,
1462  "\
1463 Return the result of applying the C unary * operator to the value." },
1464 
1465  { "value-referenced-value", 1, 0, 0, gdbscm_value_referenced_value,
1466  "\
1467 Given a value of a reference type, return the value referenced.\n\
1468 The difference between this function and value-dereference is that\n\
1469 the latter applies * unary operator to a value, which need not always\n\
1470 result in the value referenced.\n\
1471 For example, for a value which is a reference to an 'int' pointer ('int *'),\n\
1472 value-dereference will result in a value of type 'int' while\n\
1473 value-referenced-value will result in a value of type 'int *'." },
1474 
1475  { "value-field", 2, 0, 0, gdbscm_value_field,
1476  "\
1477 Return the specified field of the value.\n\
1478 \n\
1479  Arguments: <gdb:value> string" },
1480 
1481  { "value-subscript", 2, 0, 0, gdbscm_value_subscript,
1482  "\
1483 Return the value of the array at the specified index.\n\
1484 \n\
1485  Arguments: <gdb:value> integer" },
1486 
1487  { "value-call", 2, 0, 0, gdbscm_value_call,
1488  "\
1489 Perform an inferior function call taking the value as a pointer to the\n\
1490 function to call.\n\
1491 Each element of the argument list must be a <gdb:value> object or an object\n\
1492 that can be converted to one.\n\
1493 The result is the value returned by the function.\n\
1494 \n\
1495  Arguments: <gdb:value> arg-list" },
1496 
1497  { "value->bool", 1, 0, 0, gdbscm_value_to_bool,
1498  "\
1499 Return the Scheme boolean representing the GDB value.\n\
1500 The value must be \"integer like\". Pointers are ok." },
1501 
1502  { "value->integer", 1, 0, 0, gdbscm_value_to_integer,
1503  "\
1504 Return the Scheme integer representing the GDB value.\n\
1505 The value must be \"integer like\". Pointers are ok." },
1506 
1507  { "value->real", 1, 0, 0, gdbscm_value_to_real,
1508  "\
1509 Return the Scheme real number representing the GDB value.\n\
1510 The value must be a number." },
1511 
1512  { "value->bytevector", 1, 0, 0, gdbscm_value_to_bytevector,
1513  "\
1514 Return a Scheme bytevector with the raw contents of the GDB value.\n\
1515 No transformation, endian or otherwise, is performed." },
1516 
1517  { "value->string", 1, 0, 1, gdbscm_value_to_string,
1518  "\
1519 Return the Unicode string of the value's contents.\n\
1520 If ENCODING is not given, the string is assumed to be encoded in\n\
1521 the target's charset.\n\
1522 An error setting \"error\" causes an exception to be thrown if there's\n\
1523 a decoding error. An error setting of \"substitute\" causes invalid\n\
1524 characters to be replaced with \"?\". The default is \"error\".\n\
1525 If LENGTH is provided, only fetch string to the length provided.\n\
1526 \n\
1527  Arguments: <gdb:value>\n\
1528  [#:encoding encoding] [#:errors \"error\"|\"substitute\"]\n\
1529  [#:length length]" },
1530 
1531  { "value->lazy-string", 1, 0, 1, gdbscm_value_to_lazy_string,
1532  "\
1533 Return a Scheme object representing a lazily fetched Unicode string\n\
1534 of the value's contents.\n\
1535 If ENCODING is not given, the string is assumed to be encoded in\n\
1536 the target's charset.\n\
1537 If LENGTH is provided, only fetch string to the length provided.\n\
1538 \n\
1539  Arguments: <gdb:value> [#:encoding encoding] [#:length length]" },
1540 
1541  { "value-lazy?", 1, 0, 0, gdbscm_value_lazy_p,
1542  "\
1543 Return #t if the value is lazy (not fetched yet from the inferior).\n\
1544 A lazy value is fetched when needed, or when the value-fetch-lazy! function\n\
1545 is called." },
1546 
1547  { "make-lazy-value", 2, 0, 0, gdbscm_make_lazy_value,
1548  "\
1549 Create a <gdb:value> that will be lazily fetched from the target.\n\
1550 \n\
1551  Arguments: <gdb:type> address" },
1552 
1553  { "value-fetch-lazy!", 1, 0, 0, gdbscm_value_fetch_lazy_x,
1554  "\
1555 Fetch the value from the inferior, if it was lazy.\n\
1556 The result is \"unspecified\"." },
1557 
1558  { "value-print", 1, 0, 0, gdbscm_value_print,
1559  "\
1560 Return the string representation (print form) of the value." },
1561 
1562  { "parse-and-eval", 1, 0, 0, gdbscm_parse_and_eval,
1563  "\
1564 Evaluates string in gdb and returns the result as a <gdb:value> object." },
1565 
1566  { "history-ref", 1, 0, 0, gdbscm_history_ref,
1567  "\
1568 Return the specified value from GDB's value history." },
1569 
1570  { "history-append!", 1, 0, 0, gdbscm_history_append_x,
1571  "\
1572 Append the specified value onto GDB's value history." },
1573 
1575 };
1576 
1577 void
1579 {
1581  sizeof (value_smob));
1582  scm_set_smob_free (value_smob_tag, vlscm_free_value_smob);
1583  scm_set_smob_print (value_smob_tag, vlscm_print_value_smob);
1584  scm_set_smob_equalp (value_smob_tag, vlscm_equal_p_value_smob);
1585 
1586  gdbscm_define_functions (value_functions, 1);
1587 
1588  type_keyword = scm_from_latin1_keyword ("type");
1589  encoding_keyword = scm_from_latin1_keyword ("encoding");
1590  errors_keyword = scm_from_latin1_keyword ("errors");
1591  length_keyword = scm_from_latin1_keyword ("length");
1592 
1593  error_symbol = scm_from_latin1_symbol ("error");
1594  escape_symbol = scm_from_latin1_symbol ("escape");
1595  substitute_symbol = scm_from_latin1_symbol ("substitute");
1596 }
struct value * value_mark(void)
Definition: value.c:1499
static void vlscm_remember_scheme_value(value_smob *v_smob)
Definition: scm-value.c:99
struct value * call_function_by_hand(struct value *function, int nargs, struct value **args)
Definition: infcall.c:488
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
struct value * value_addr(struct value *arg1)
Definition: valops.c:1472
static value_smob * values_in_scheme
Definition: scm-value.c:67
static SCM gdbscm_value_cast(SCM self, SCM new_type)
Definition: scm-value.c:681
struct value * value_subscript(struct value *array, LONGEST index)
Definition: valarith.c:146
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
static SCM vlscm_make_value_smob(void)
Definition: scm-value.c:215
struct value * value_from_contents_and_address(struct type *type, const gdb_byte *valaddr, CORE_ADDR address)
Definition: value.c:3529
static SCM errors_keyword
Definition: scm-value.c:72
SCM gdbscm_scm_from_ulongest(ULONGEST l)
Definition: scm-utils.c:552
void xfree(void *)
Definition: common-utils.c:97
struct _value_smob value_smob
struct value * value_reinterpret_cast(struct type *type, struct value *arg)
Definition: valops.c:579
static SCM gdbscm_value_type(SCM self)
Definition: scm-value.c:553
LONGEST value_as_long(struct value *val)
Definition: value.c:2654
SCM tyscm_scm_from_type(struct type *type)
Definition: scm-type.c:303
SCM dynamic_type
Definition: scm-value.c:56
struct value * vlscm_convert_value_from_scheme(const char *func_name, int obj_arg_pos, SCM obj, SCM *except_scmp, struct gdbarch *gdbarch, const struct language_defn *language)
Definition: scm-math.c:893
struct type * tyscm_type_smob_type(type_smob *t_smob)
Definition: scm-type.c:97
static SCM vlscm_get_value_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-value.c:276
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 scm_t_bits value_smob_tag
Definition: scm-value.c:62
static SCM gdbscm_value_call(SCM self, SCM args)
Definition: scm-value.c:818
void common_val_print(struct value *val, struct ui_file *stream, int recurse, const struct value_print_options *options, const struct language_defn *language)
Definition: valprint.c:846
static SCM substitute_symbol
Definition: scm-value.c:78
#define FUNC_NAME
const struct gdb_exception exception_none
struct value * coerce_ref(struct value *arg)
Definition: value.c:3688
void value_free(struct value *val)
Definition: value.c:1518
SCM gdbscm_scm_from_longest(LONGEST l)
Definition: scm-utils.c:533
struct value * value_ind(struct value *arg1)
Definition: valops.c:1533
SCM gdbscm_make_out_of_range_error(const char *subr, int arg_pos, SCM bad_value, const char *error)
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:102
struct _value_smob * next
Definition: scm-value.c:44
#define _(String)
Definition: gdb_locale.h:40
static SCM length_keyword
Definition: scm-value.c:73
#define END_CATCH
int gdbscm_is_exception(SCM scm)
#define gdbscm_is_true(scm)
static struct type * new_type(char *)
Definition: mdebugread.c:4864
#define GDBSCM_ARG_NONE
static SCM gdbscm_value_to_lazy_string(SCM self, SCM rest)
Definition: scm-value.c:1190
struct _value_smob * prev
Definition: scm-value.c:45
SCM lsscm_make_lazy_string(CORE_ADDR address, int length, const char *encoding, struct type *type)
static int is_intlike(struct type *type, int ptr_ok)
Definition: scm-value.c:928
#define TRY
int gdbscm_guile_version_is_at_least(int major, int minor, int micro)
Definition: scm-utils.c:629
void gdbscm_dynwind_xfree(void *ptr)
Definition: scm-utils.c:571
static SCM gdbscm_value_subscript(SCM self, SCM index_scm)
Definition: scm-value.c:752
static SCM gdbscm_value_to_bool(SCM self)
Definition: scm-value.c:941
struct value * value_struct_elt(struct value **argp, struct value **args, const char *name, int *static_memfuncp, const char *err)
Definition: valops.c:2128
int vlscm_is_value(SCM scm)
Definition: scm-value.c:240
void preserve_one_value(struct value *value, struct objfile *objfile, htab_t copied_types)
Definition: value.c:2495
struct type * check_typedef(struct type *type)
Definition: gdbtypes.c:2217
void gdbscm_init_gsmob(gdb_smob *base)
Definition: scm-gsmob.c:113
const gdb_byte * value_contents(struct value *value)
Definition: value.c:1329
#define CATCH(EXCEPTION, MASK)
static SCM gdbscm_value_address(SCM self)
Definition: scm-value.c:426
SCM address
Definition: scm-value.c:54
static SCM gdbscm_make_lazy_value(SCM type_scm, SCM address_scm)
Definition: scm-value.c:361
static struct parser_state * pstate
Definition: ada-exp.c:149
int value_lazy(struct value *value)
Definition: value.c:1305
static SCM gdbscm_value_to_string(SCM self, SCM rest)
Definition: scm-value.c:1095
SCM vlscm_scm_from_value(struct value *value)
Definition: scm-value.c:258
static SCM gdbscm_parse_and_eval(SCM expr_scm)
Definition: scm-value.c:1322
double DOUBLEST
Definition: doublest.h:24
struct cleanup * make_cleanup_value_free_to_mark(struct value *mark)
Definition: utils.c:388
struct cleanup * make_cleanup(make_cleanup_ftype *function, void *arg)
Definition: cleanups.c:117
static SCM gdbscm_value_to_bytevector(SCM self)
Definition: scm-value.c:895
Definition: gdbtypes.h:749
static SCM vlscm_equal_p_value_smob(SCM v1, SCM v2)
Definition: scm-value.c:193
void gdbscm_throw(SCM exception) ATTRIBUTE_NORETURN
struct gdbarch * get_type_arch(const struct type *type)
Definition: gdbtypes.c:232
struct gdbarch * get_current_arch(void)
Definition: arch-utils.c:781
static SCM gdbscm_value_print(SCM self)
Definition: scm-value.c:1278
static const char * type
Definition: language.c:103
#define gdb_assert(expr)
Definition: gdb_assert.h:33
static SCM gdbscm_value_dereference(SCM self)
Definition: scm-value.c:467
struct value * value_cast(struct type *type, struct value *arg2)
Definition: valops.c:351
static SCM gdbscm_value_lazy_p(SCM self)
Definition: scm-value.c:1243
static SCM escape_symbol
Definition: scm-value.c:77
struct value * value_dynamic_cast(struct type *type, struct value *arg)
Definition: valops.c:724
static value_smob * vlscm_get_value_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-value.c:288
static char encoding[]
Definition: remote-mips.c:2988
int value_equal(struct value *arg1, struct value *arg2)
Definition: valarith.c:1574
struct ui_file * mem_fileopen(void)
Definition: ui-file.c:427
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
static SCM encoding_keyword
Definition: scm-value.c:71
static SCM gdbscm_value_p(SCM scm)
Definition: scm-value.c:248
static SCM gdbscm_value_reinterpret_cast(SCM self, SCM new_type)
Definition: scm-value.c:697
#define TYPE_UNSIGNED(t)
Definition: gdbtypes.h:233
static SCM gdbscm_history_append_x(SCM value)
Definition: scm-value.c:1387
static SCM gdbscm_value_to_real(SCM self)
Definition: scm-value.c:1030
Definition: value.c:172
struct value * vlscm_scm_to_value(SCM v_scm)
Definition: scm-value.c:300
static SCM gdbscm_value_referenced_value(SCM self)
Definition: scm-value.c:508
static SCM gdbscm_value_to_integer(SCM self)
Definition: scm-value.c:984
void release_value_or_incref(struct value *val)
Definition: value.c:1633
bfd_byte gdb_byte
Definition: common-types.h:38
unsigned length
Definition: gdbtypes.h:807
#define END_FUNCTIONS
void discard_cleanups(struct cleanup *old_chain)
Definition: cleanups.c:213
const struct language_defn * current_language
Definition: language.c:85
int value_optimized_out(struct value *value)
Definition: value.c:1346
#define TYPE_TARGET_TYPE(thistype)
Definition: gdbtypes.h:1229
static SCM gdbscm_value_dynamic_type(SCM self)
Definition: scm-value.c:568
void value_fetch_lazy(struct value *val)
Definition: value.c:3793
struct cleanup * make_cleanup_ui_file_delete(struct ui_file *arg)
Definition: utils.c:237
static SCM gdbscm_value_fetch_lazy_x(SCM self)
Definition: scm-value.c:1255
#define TYPE_CODE(thistype)
Definition: gdbtypes.h:1240
static SCM gdbscm_value_optimized_out_p(SCM self)
Definition: scm-value.c:402
gdb_smob base
Definition: scm-value.c:39
void gdbscm_out_of_range_error(const char *subr, int arg_pos, SCM bad_value, const char *error) ATTRIBUTE_NORETURN
void get_user_print_options(struct value_print_options *opts)
Definition: valprint.c:129
Definition: buffer.h:23
static SCM error_symbol
Definition: scm-value.c:76
struct value * value
Definition: scm-value.c:47
type_smob * tyscm_get_type_smob_arg_unsafe(SCM type_scm, int arg_pos, const char *func_name)
Definition: scm-type.c:342
struct type * value_rtti_type(struct value *v, int *full, int *top, int *using_enc)
Definition: cp-abi.c:108
exp_opcode
Definition: expression.h:43
#define GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS(exception, cleanups)
#define CHECK_TYPEDEF(TYPE)
Definition: gdbtypes.h:1817
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_history_ref(SCM index)
Definition: scm-value.c:1363
static SCM vlscm_do_cast(SCM self, SCM type_scm, enum exp_opcode op, const char *func_name)
Definition: scm-value.c:634
int record_latest_value(struct value *val)
Definition: value.c:1788
struct value * parse_and_eval(const char *exp)
Definition: eval.c:124
unsigned long long ULONGEST
Definition: common-types.h:53
#define GDBSCM_HANDLE_GDB_EXCEPTION(exception)
language
Definition: defs.h:167
struct type * value_type(const struct value *value)
Definition: value.c:1021
static size_t vlscm_free_value_smob(SCM self)
Definition: scm-value.c:128
static int vlscm_print_value_smob(SCM self, SCM port, scm_print_state *pstate)
Definition: scm-value.c:141
struct type * lookup_reference_type(struct type *type)
Definition: gdbtypes.c:441
struct value * access_value_history(int num)
Definition: value.c:1834
CORE_ADDR value_as_address(struct value *val)
Definition: value.c:2679
const char * host_charset(void)
Definition: charset.c:399
#define TYPE_LENGTH(thistype)
Definition: gdbtypes.h:1237
static SCM gdbscm_value_field(SCM self, SCM field_scm)
Definition: scm-value.c:707
static SCM type_keyword
Definition: scm-value.c:70
void gdbscm_preserve_values(const struct extension_language_defn *extlang, struct objfile *objfile, htab_t copied_types)
Definition: scm-value.c:87
static void vlscm_forget_value_smob(value_smob *v_smob)
Definition: scm-value.c:111
static SCM gdbscm_value_dynamic_cast(SCM self, SCM new_type)
Definition: scm-value.c:689
static const char value_smob_name[]
Definition: scm-value.c:59
CORE_ADDR value_address(const struct value *value)
Definition: value.c:1440
void gdbscm_initialize_values(void)
Definition: scm-value.c:1578
void error(const char *fmt,...)
Definition: errors.c:38
DOUBLEST value_as_double(struct value *val)
Definition: value.c:2664
struct type * lookup_pointer_type(struct type *type)
Definition: gdbtypes.c:368
static SCM gdbscm_make_value(SCM x, SCM rest)
Definition: scm-value.c:314
long long LONGEST
Definition: common-types.h:52
void do_cleanups(struct cleanup *old_chain)
Definition: cleanups.c:175
#define LA_GET_STRING(value, buffer, length, chartype, encoding)
Definition: language.h:501
struct value * vlscm_convert_typed_value_from_scheme(const char *func_name, int obj_arg_pos, SCM obj, int type_arg_pos, SCM type_scm, struct type *type, SCM *except_scmp, struct gdbarch *gdbarch, const struct language_defn *language)
Definition: scm-math.c:747