1 /* Scheme interface to values.
3 Copyright (C) 2008-2018 Free Software Foundation, Inc.
5 This file is part of GDB.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
24 #include "arch-utils.h"
27 #include "target-float.h"
29 #include "symtab.h" /* Needed by language.h. */
33 #include "guile-internal.h"
35 /* The <gdb:value> smob. */
37 typedef struct _value_smob
39 /* This always appears first. */
42 /* Doubly linked list of values in values_in_scheme.
43 IWBN to use a chained_gdb_smob instead, which is doable, it just requires
44 a bit more casting than normal. */
45 struct _value_smob
*next
;
46 struct _value_smob
*prev
;
50 /* These are cached here to avoid making multiple copies of them.
51 Plus computing the dynamic_type can be a bit expensive.
52 We use #f to indicate that the value doesn't exist (e.g. value doesn't
53 have an address), so we need another value to indicate that we haven't
54 computed the value yet. For this we use SCM_UNDEFINED. */
60 static const char value_smob_name
[] = "gdb:value";
62 /* The tag Guile knows the value smob by. */
63 static scm_t_bits value_smob_tag
;
65 /* List of all values which are currently exposed to Scheme. It is
66 maintained so that when an objfile is discarded, preserve_values
67 can copy the values' types if needed. */
68 static value_smob
*values_in_scheme
;
70 /* Keywords used by Scheme procedures in this file. */
71 static SCM type_keyword
;
72 static SCM encoding_keyword
;
73 static SCM errors_keyword
;
74 static SCM length_keyword
;
76 /* Possible #:errors values. */
77 static SCM error_symbol
;
78 static SCM escape_symbol
;
79 static SCM substitute_symbol
;
81 /* Administrivia for value smobs. */
83 /* Iterate over all the <gdb:value> objects, calling preserve_one_value on
85 This is the extension_language_ops.preserve_values "method". */
88 gdbscm_preserve_values (const struct extension_language_defn
*extlang
,
89 struct objfile
*objfile
, htab_t copied_types
)
93 for (iter
= values_in_scheme
; iter
; iter
= iter
->next
)
94 preserve_one_value (iter
->value
, objfile
, copied_types
);
97 /* Helper to add a value_smob to the global list. */
100 vlscm_remember_scheme_value (value_smob
*v_smob
)
102 v_smob
->next
= values_in_scheme
;
104 v_smob
->next
->prev
= v_smob
;
106 values_in_scheme
= v_smob
;
109 /* Helper to remove a value_smob from the global list. */
112 vlscm_forget_value_smob (value_smob
*v_smob
)
114 /* Remove SELF from the global list. */
116 v_smob
->prev
->next
= v_smob
->next
;
119 gdb_assert (values_in_scheme
== v_smob
);
120 values_in_scheme
= v_smob
->next
;
123 v_smob
->next
->prev
= v_smob
->prev
;
126 /* The smob "free" function for <gdb:value>. */
129 vlscm_free_value_smob (SCM self
)
131 value_smob
*v_smob
= (value_smob
*) SCM_SMOB_DATA (self
);
133 vlscm_forget_value_smob (v_smob
);
134 value_decref (v_smob
->value
);
139 /* The smob "print" function for <gdb:value>. */
142 vlscm_print_value_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
144 value_smob
*v_smob
= (value_smob
*) SCM_SMOB_DATA (self
);
145 struct value_print_options opts
;
147 if (pstate
->writingp
)
148 gdbscm_printf (port
, "#<%s ", value_smob_name
);
150 get_user_print_options (&opts
);
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
;
163 common_val_print (v_smob
->value
, &stb
, 0, &opts
, current_language
);
164 scm_puts (stb
.c_str (), port
);
166 CATCH (except
, RETURN_MASK_ALL
)
168 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
172 if (pstate
->writingp
)
173 scm_puts (">", port
);
175 scm_remember_upto_here_1 (self
);
177 /* Non-zero means success. */
181 /* The smob "equalp" function for <gdb:value>. */
184 vlscm_equal_p_value_smob (SCM v1
, SCM v2
)
186 const value_smob
*v1_smob
= (value_smob
*) SCM_SMOB_DATA (v1
);
187 const value_smob
*v2_smob
= (value_smob
*) SCM_SMOB_DATA (v2
);
192 result
= value_equal (v1_smob
->value
, v2_smob
->value
);
194 CATCH (except
, RETURN_MASK_ALL
)
196 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
200 return scm_from_bool (result
);
203 /* Low level routine to create a <gdb:value> object. */
206 vlscm_make_value_smob (void)
208 value_smob
*v_smob
= (value_smob
*)
209 scm_gc_malloc (sizeof (value_smob
), value_smob_name
);
212 /* These must be filled in by the caller. */
213 v_smob
->value
= NULL
;
217 /* These are lazily computed. */
218 v_smob
->address
= SCM_UNDEFINED
;
219 v_smob
->type
= SCM_UNDEFINED
;
220 v_smob
->dynamic_type
= SCM_UNDEFINED
;
222 v_scm
= scm_new_smob (value_smob_tag
, (scm_t_bits
) v_smob
);
223 gdbscm_init_gsmob (&v_smob
->base
);
228 /* Return non-zero if SCM is a <gdb:value> object. */
231 vlscm_is_value (SCM scm
)
233 return SCM_SMOB_PREDICATE (value_smob_tag
, scm
);
236 /* (value? object) -> boolean */
239 gdbscm_value_p (SCM scm
)
241 return scm_from_bool (vlscm_is_value (scm
));
244 /* Create a new <gdb:value> object that encapsulates VALUE.
245 The value is released from the all_values chain so its lifetime is not
246 bound to the execution of a command. */
249 vlscm_scm_from_value (struct value
*value
)
251 /* N.B. It's important to not cause any side-effects until we know the
252 conversion worked. */
253 SCM v_scm
= vlscm_make_value_smob ();
254 value_smob
*v_smob
= (value_smob
*) SCM_SMOB_DATA (v_scm
);
256 v_smob
->value
= release_value (value
).release ();
257 vlscm_remember_scheme_value (v_smob
);
262 /* Returns the <gdb:value> object in SELF.
263 Throws an exception if SELF is not a <gdb:value> object. */
266 vlscm_get_value_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
268 SCM_ASSERT_TYPE (vlscm_is_value (self
), self
, arg_pos
, func_name
,
274 /* Returns a pointer to the value smob of SELF.
275 Throws an exception if SELF is not a <gdb:value> object. */
278 vlscm_get_value_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
280 SCM v_scm
= vlscm_get_value_arg_unsafe (self
, arg_pos
, func_name
);
281 value_smob
*v_smob
= (value_smob
*) SCM_SMOB_DATA (v_scm
);
286 /* Return the value field of V_SCM, an object of type <gdb:value>.
287 This exists so that we don't have to export the struct's contents. */
290 vlscm_scm_to_value (SCM v_scm
)
294 gdb_assert (vlscm_is_value (v_scm
));
295 v_smob
= (value_smob
*) SCM_SMOB_DATA (v_scm
);
296 return v_smob
->value
;
301 /* (make-value x [#:type type]) -> <gdb:value> */
304 gdbscm_make_value (SCM x
, SCM rest
)
306 const SCM keywords
[] = { type_keyword
, SCM_BOOL_F
};
308 int type_arg_pos
= -1;
309 SCM type_scm
= SCM_UNDEFINED
;
310 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, keywords
, "#O", rest
,
311 &type_arg_pos
, &type_scm
);
313 struct type
*type
= NULL
;
314 if (type_arg_pos
> 0)
316 type_smob
*t_smob
= tyscm_get_type_smob_arg_unsafe (type_scm
,
319 type
= tyscm_type_smob_type (t_smob
);
322 return gdbscm_wrap ([=]
324 scoped_value_mark free_values
;
328 = vlscm_convert_typed_value_from_scheme (FUNC_NAME
, SCM_ARG1
, x
,
329 type_arg_pos
, type_scm
, type
,
336 return vlscm_scm_from_value (value
);
340 /* (make-lazy-value <gdb:type> address) -> <gdb:value> */
343 gdbscm_make_lazy_value (SCM type_scm
, SCM address_scm
)
345 type_smob
*t_smob
= tyscm_get_type_smob_arg_unsafe (type_scm
,
346 SCM_ARG1
, FUNC_NAME
);
347 struct type
*type
= tyscm_type_smob_type (t_smob
);
350 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, NULL
, "U",
351 address_scm
, &address
);
353 return gdbscm_wrap ([=]
355 scoped_value_mark free_values
;
357 struct value
*value
= value_from_contents_and_address (type
, NULL
,
359 return vlscm_scm_from_value (value
);
363 /* (value-optimized-out? <gdb:value>) -> boolean */
366 gdbscm_value_optimized_out_p (SCM self
)
369 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
371 return gdbscm_wrap ([=]
373 return scm_from_bool (value_optimized_out (v_smob
->value
));
377 /* (value-address <gdb:value>) -> integer
378 Returns #f if the value doesn't have one. */
381 gdbscm_value_address (SCM self
)
384 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
385 struct value
*value
= v_smob
->value
;
387 return gdbscm_wrap ([=]
389 if (SCM_UNBNDP (v_smob
->address
))
391 scoped_value_mark free_values
;
393 SCM address
= SCM_BOOL_F
;
397 address
= vlscm_scm_from_value (value_addr (value
));
399 CATCH (except
, RETURN_MASK_ALL
)
404 if (gdbscm_is_exception (address
))
407 v_smob
->address
= address
;
410 return v_smob
->address
;
414 /* (value-dereference <gdb:value>) -> <gdb:value>
415 Given a value of a pointer type, apply the C unary * operator to it. */
418 gdbscm_value_dereference (SCM self
)
421 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
423 return gdbscm_wrap ([=]
425 scoped_value_mark free_values
;
427 struct value
*res_val
= value_ind (v_smob
->value
);
428 return vlscm_scm_from_value (res_val
);
432 /* (value-referenced-value <gdb:value>) -> <gdb:value>
433 Given a value of a reference type, return the value referenced.
434 The difference between this function and gdbscm_value_dereference is that
435 the latter applies * unary operator to a value, which need not always
436 result in the value referenced.
437 For example, for a value which is a reference to an 'int' pointer ('int *'),
438 gdbscm_value_dereference will result in a value of type 'int' while
439 gdbscm_value_referenced_value will result in a value of type 'int *'. */
442 gdbscm_value_referenced_value (SCM self
)
445 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
446 struct value
*value
= v_smob
->value
;
448 return gdbscm_wrap ([=]
450 scoped_value_mark free_values
;
452 struct value
*res_val
;
454 switch (TYPE_CODE (check_typedef (value_type (value
))))
457 res_val
= value_ind (value
);
460 res_val
= coerce_ref (value
);
463 error (_("Trying to get the referenced value from a value which is"
464 " neither a pointer nor a reference"));
467 return vlscm_scm_from_value (res_val
);
471 /* (value-type <gdb:value>) -> <gdb:type> */
474 gdbscm_value_type (SCM self
)
477 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
478 struct value
*value
= v_smob
->value
;
480 if (SCM_UNBNDP (v_smob
->type
))
481 v_smob
->type
= tyscm_scm_from_type (value_type (value
));
486 /* (value-dynamic-type <gdb:value>) -> <gdb:type> */
489 gdbscm_value_dynamic_type (SCM self
)
492 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
493 struct value
*value
= v_smob
->value
;
494 struct type
*type
= NULL
;
496 if (! SCM_UNBNDP (v_smob
->dynamic_type
))
497 return v_smob
->dynamic_type
;
501 scoped_value_mark free_values
;
503 type
= value_type (value
);
504 type
= check_typedef (type
);
506 if (((TYPE_CODE (type
) == TYPE_CODE_PTR
)
507 || (TYPE_CODE (type
) == TYPE_CODE_REF
))
508 && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_STRUCT
))
510 struct value
*target
;
511 int was_pointer
= TYPE_CODE (type
) == TYPE_CODE_PTR
;
514 target
= value_ind (value
);
516 target
= coerce_ref (value
);
517 type
= value_rtti_type (target
, NULL
, NULL
, NULL
);
522 type
= lookup_pointer_type (type
);
524 type
= lookup_lvalue_reference_type (type
);
527 else if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
528 type
= value_rtti_type (value
, NULL
, NULL
, NULL
);
531 /* Re-use object's static type. */
535 CATCH (except
, RETURN_MASK_ALL
)
537 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
542 v_smob
->dynamic_type
= gdbscm_value_type (self
);
544 v_smob
->dynamic_type
= tyscm_scm_from_type (type
);
546 return v_smob
->dynamic_type
;
549 /* A helper function that implements the various cast operators. */
552 vlscm_do_cast (SCM self
, SCM type_scm
, enum exp_opcode op
,
553 const char *func_name
)
556 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
557 struct value
*value
= v_smob
->value
;
559 = tyscm_get_type_smob_arg_unsafe (type_scm
, SCM_ARG2
, FUNC_NAME
);
560 struct type
*type
= tyscm_type_smob_type (t_smob
);
562 return gdbscm_wrap ([=]
564 scoped_value_mark free_values
;
566 struct value
*res_val
;
567 if (op
== UNOP_DYNAMIC_CAST
)
568 res_val
= value_dynamic_cast (type
, value
);
569 else if (op
== UNOP_REINTERPRET_CAST
)
570 res_val
= value_reinterpret_cast (type
, value
);
573 gdb_assert (op
== UNOP_CAST
);
574 res_val
= value_cast (type
, value
);
577 return vlscm_scm_from_value (res_val
);
581 /* (value-cast <gdb:value> <gdb:type>) -> <gdb:value> */
584 gdbscm_value_cast (SCM self
, SCM new_type
)
586 return vlscm_do_cast (self
, new_type
, UNOP_CAST
, FUNC_NAME
);
589 /* (value-dynamic-cast <gdb:value> <gdb:type>) -> <gdb:value> */
592 gdbscm_value_dynamic_cast (SCM self
, SCM new_type
)
594 return vlscm_do_cast (self
, new_type
, UNOP_DYNAMIC_CAST
, FUNC_NAME
);
597 /* (value-reinterpret-cast <gdb:value> <gdb:type>) -> <gdb:value> */
600 gdbscm_value_reinterpret_cast (SCM self
, SCM new_type
)
602 return vlscm_do_cast (self
, new_type
, UNOP_REINTERPRET_CAST
, FUNC_NAME
);
605 /* (value-field <gdb:value> string) -> <gdb:value>
606 Given string name of an element inside structure, return its <gdb:value>
610 gdbscm_value_field (SCM self
, SCM field_scm
)
613 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
615 SCM_ASSERT_TYPE (scm_is_string (field_scm
), field_scm
, SCM_ARG2
, FUNC_NAME
,
618 return gdbscm_wrap ([=]
620 scoped_value_mark free_values
;
622 gdb::unique_xmalloc_ptr
<char> field
= gdbscm_scm_to_c_string (field_scm
);
624 struct value
*tmp
= v_smob
->value
;
626 struct value
*res_val
= value_struct_elt (&tmp
, NULL
, field
.get (), NULL
,
627 "struct/class/union");
629 return vlscm_scm_from_value (res_val
);
633 /* (value-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
634 Return the specified value in an array. */
637 gdbscm_value_subscript (SCM self
, SCM index_scm
)
640 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
641 struct value
*value
= v_smob
->value
;
642 struct type
*type
= value_type (value
);
644 SCM_ASSERT (type
!= NULL
, self
, SCM_ARG2
, FUNC_NAME
);
646 return gdbscm_wrap ([=]
648 scoped_value_mark free_values
;
652 = vlscm_convert_value_from_scheme (FUNC_NAME
, SCM_ARG2
, index_scm
,
654 get_type_arch (type
),
659 /* Assume we are attempting an array access, and let the value code
660 throw an exception if the index has an invalid type.
661 Check the value's type is something that can be accessed via
663 struct value
*tmp
= coerce_ref (value
);
664 struct type
*tmp_type
= check_typedef (value_type (tmp
));
665 if (TYPE_CODE (tmp_type
) != TYPE_CODE_ARRAY
666 && TYPE_CODE (tmp_type
) != TYPE_CODE_PTR
)
667 error (_("Cannot subscript requested type"));
669 struct value
*res_val
= value_subscript (tmp
, value_as_long (index
));
670 return vlscm_scm_from_value (res_val
);
674 /* (value-call <gdb:value> arg-list) -> <gdb:value>
675 Perform an inferior function call on the value. */
678 gdbscm_value_call (SCM self
, SCM args
)
681 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
682 struct value
*function
= v_smob
->value
;
683 struct value
*mark
= value_mark ();
684 struct type
*ftype
= NULL
;
686 struct value
**vargs
= NULL
;
687 SCM result
= SCM_BOOL_F
;
691 ftype
= check_typedef (value_type (function
));
693 CATCH (except
, RETURN_MASK_ALL
)
695 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
699 SCM_ASSERT_TYPE (TYPE_CODE (ftype
) == TYPE_CODE_FUNC
, self
,
701 _("function (value of TYPE_CODE_FUNC)"));
703 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (args
)), args
,
704 SCM_ARG2
, FUNC_NAME
, _("list"));
706 args_count
= scm_ilength (args
);
709 struct gdbarch
*gdbarch
= get_current_arch ();
710 const struct language_defn
*language
= current_language
;
714 vargs
= XALLOCAVEC (struct value
*, args_count
);
715 for (i
= 0; i
< args_count
; i
++)
717 SCM arg
= scm_car (args
);
719 vargs
[i
] = vlscm_convert_value_from_scheme (FUNC_NAME
,
720 GDBSCM_ARG_NONE
, arg
,
723 if (vargs
[i
] == NULL
)
724 gdbscm_throw (except_scm
);
726 args
= scm_cdr (args
);
728 gdb_assert (gdbscm_is_true (scm_null_p (args
)));
731 return gdbscm_wrap ([=]
733 scoped_value_mark free_values
;
735 value
*return_value
= call_function_by_hand (function
, NULL
,
737 return vlscm_scm_from_value (return_value
);
741 /* (value->bytevector <gdb:value>) -> bytevector */
744 gdbscm_value_to_bytevector (SCM self
)
747 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
748 struct value
*value
= v_smob
->value
;
751 const gdb_byte
*contents
= NULL
;
754 type
= value_type (value
);
758 type
= check_typedef (type
);
759 length
= TYPE_LENGTH (type
);
760 contents
= value_contents (value
);
762 CATCH (except
, RETURN_MASK_ALL
)
764 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
768 bv
= scm_c_make_bytevector (length
);
769 memcpy (SCM_BYTEVECTOR_CONTENTS (bv
), contents
, length
);
774 /* Helper function to determine if a type is "int-like". */
777 is_intlike (struct type
*type
, int ptr_ok
)
779 return (TYPE_CODE (type
) == TYPE_CODE_INT
780 || TYPE_CODE (type
) == TYPE_CODE_ENUM
781 || TYPE_CODE (type
) == TYPE_CODE_BOOL
782 || TYPE_CODE (type
) == TYPE_CODE_CHAR
783 || (ptr_ok
&& TYPE_CODE (type
) == TYPE_CODE_PTR
));
786 /* (value->bool <gdb:value>) -> boolean
787 Throws an error if the value is not integer-like. */
790 gdbscm_value_to_bool (SCM self
)
793 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
794 struct value
*value
= v_smob
->value
;
798 type
= value_type (value
);
802 type
= check_typedef (type
);
804 CATCH (except
, RETURN_MASK_ALL
)
806 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
810 SCM_ASSERT_TYPE (is_intlike (type
, 1), self
, SCM_ARG1
, FUNC_NAME
,
811 _("integer-like gdb value"));
815 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
816 l
= value_as_address (value
);
818 l
= value_as_long (value
);
820 CATCH (except
, RETURN_MASK_ALL
)
822 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
826 return scm_from_bool (l
!= 0);
829 /* (value->integer <gdb:value>) -> integer
830 Throws an error if the value is not integer-like. */
833 gdbscm_value_to_integer (SCM self
)
836 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
837 struct value
*value
= v_smob
->value
;
841 type
= value_type (value
);
845 type
= check_typedef (type
);
847 CATCH (except
, RETURN_MASK_ALL
)
849 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
853 SCM_ASSERT_TYPE (is_intlike (type
, 1), self
, SCM_ARG1
, FUNC_NAME
,
854 _("integer-like gdb value"));
858 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
859 l
= value_as_address (value
);
861 l
= value_as_long (value
);
863 CATCH (except
, RETURN_MASK_ALL
)
865 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
869 if (TYPE_UNSIGNED (type
))
870 return gdbscm_scm_from_ulongest (l
);
872 return gdbscm_scm_from_longest (l
);
875 /* (value->real <gdb:value>) -> real
876 Throws an error if the value is not a number. */
879 gdbscm_value_to_real (SCM self
)
882 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
883 struct value
*value
= v_smob
->value
;
886 struct value
*check
= nullptr;
888 type
= value_type (value
);
892 type
= check_typedef (type
);
894 CATCH (except
, RETURN_MASK_ALL
)
896 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
900 SCM_ASSERT_TYPE (is_intlike (type
, 0) || TYPE_CODE (type
) == TYPE_CODE_FLT
,
901 self
, SCM_ARG1
, FUNC_NAME
, _("number"));
905 if (is_floating_value (value
))
907 d
= target_float_to_host_double (value_contents (value
), type
);
908 check
= allocate_value (type
);
909 target_float_from_host_double (value_contents_raw (check
), type
, d
);
911 else if (TYPE_UNSIGNED (type
))
913 d
= (ULONGEST
) value_as_long (value
);
914 check
= value_from_ulongest (type
, (ULONGEST
) d
);
918 d
= value_as_long (value
);
919 check
= value_from_longest (type
, (LONGEST
) d
);
922 CATCH (except
, RETURN_MASK_ALL
)
924 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
928 /* TODO: Is there a better way to check if the value fits? */
929 if (!value_equal (value
, check
))
930 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
931 _("number can't be converted to a double"));
933 return scm_from_double (d
);
936 /* (value->string <gdb:value>
937 [#:encoding encoding]
938 [#:errors #f | 'error | 'substitute]
941 Return Unicode string with value's contents, which must be a string.
943 If ENCODING is not given, the string is assumed to be encoded in
944 the target's charset.
946 ERRORS is one of #f, 'error or 'substitute.
947 An error setting of #f means use the default, which is Guile's
948 %default-port-conversion-strategy when using Guile >= 2.0.6, or 'error if
949 using an earlier version of Guile. Earlier versions do not properly
950 support obtaining the default port conversion strategy.
951 If the default is not one of 'error or 'substitute, 'substitute is used.
952 An error setting of "error" causes an exception to be thrown if there's
953 a decoding error. An error setting of "substitute" causes invalid
954 characters to be replaced with "?".
956 If LENGTH is provided, only fetch string to the length provided.
957 LENGTH must be a Scheme integer, it can't be a <gdb:value> integer. */
960 gdbscm_value_to_string (SCM self
, SCM rest
)
963 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
964 struct value
*value
= v_smob
->value
;
965 const SCM keywords
[] = {
966 encoding_keyword
, errors_keyword
, length_keyword
, SCM_BOOL_F
968 int encoding_arg_pos
= -1, errors_arg_pos
= -1, length_arg_pos
= -1;
969 char *encoding
= NULL
;
970 SCM errors
= SCM_BOOL_F
;
971 gdb_byte
*buffer_contents
;
973 const char *la_encoding
= NULL
;
974 struct type
*char_type
= NULL
;
977 /* The sequencing here, as everywhere else, is important.
978 We can't have existing cleanups when a Scheme exception is thrown. */
980 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, keywords
, "#sOi", rest
,
981 &encoding_arg_pos
, &encoding
,
982 &errors_arg_pos
, &errors
,
983 &length_arg_pos
, &length
);
985 if (errors_arg_pos
> 0
986 && errors
!= SCM_BOOL_F
987 && !scm_is_eq (errors
, error_symbol
)
988 && !scm_is_eq (errors
, substitute_symbol
))
991 = gdbscm_make_out_of_range_error (FUNC_NAME
, errors_arg_pos
, errors
,
992 _("invalid error kind"));
997 if (errors
== SCM_BOOL_F
)
999 /* N.B. scm_port_conversion_strategy in Guile versions prior to 2.0.6
1000 will throw a Scheme error when passed #f. */
1001 if (gdbscm_guile_version_is_at_least (2, 0, 6))
1002 errors
= scm_port_conversion_strategy (SCM_BOOL_F
);
1004 errors
= error_symbol
;
1006 /* We don't assume anything about the result of scm_port_conversion_strategy.
1007 From this point on, if errors is not 'errors, use 'substitute. */
1011 gdb::unique_xmalloc_ptr
<gdb_byte
> buffer
;
1012 LA_GET_STRING (value
, &buffer
, &length
, &char_type
, &la_encoding
);
1013 buffer_contents
= buffer
.release ();
1015 CATCH (except
, RETURN_MASK_ALL
)
1018 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1022 /* If errors is "error", scm_from_stringn may throw a Scheme exception.
1023 Make sure we don't leak. This is done via scm_dynwind_begin, et.al. */
1025 scm_dynwind_begin ((scm_t_dynwind_flags
) 0);
1027 gdbscm_dynwind_xfree (encoding
);
1028 gdbscm_dynwind_xfree (buffer_contents
);
1030 result
= scm_from_stringn ((const char *) buffer_contents
,
1031 length
* TYPE_LENGTH (char_type
),
1032 (encoding
!= NULL
&& *encoding
!= '\0'
1035 scm_is_eq (errors
, error_symbol
)
1036 ? SCM_FAILED_CONVERSION_ERROR
1037 : SCM_FAILED_CONVERSION_QUESTION_MARK
);
1044 /* (value->lazy-string <gdb:value> [#:encoding encoding] [#:length length])
1045 -> <gdb:lazy-string>
1046 Return a Scheme object representing a lazy_string_object type.
1047 A lazy string is a pointer to a string with an optional encoding and length.
1048 If ENCODING is not given, the target's charset is used.
1049 If LENGTH is provided then the length parameter is set to LENGTH.
1050 Otherwise if the value is an array of known length then the array's length
1051 is used. Otherwise the length will be set to -1 (meaning first null of
1053 LENGTH must be a Scheme integer, it can't be a <gdb:value> integer. */
1056 gdbscm_value_to_lazy_string (SCM self
, SCM rest
)
1059 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1060 struct value
*value
= v_smob
->value
;
1061 const SCM keywords
[] = { encoding_keyword
, length_keyword
, SCM_BOOL_F
};
1062 int encoding_arg_pos
= -1, length_arg_pos
= -1;
1063 char *encoding
= NULL
;
1065 SCM result
= SCM_BOOL_F
; /* -Wall */
1066 struct gdb_exception except
= exception_none
;
1068 /* The sequencing here, as everywhere else, is important.
1069 We can't have existing cleanups when a Scheme exception is thrown. */
1071 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, keywords
, "#si", rest
,
1072 &encoding_arg_pos
, &encoding
,
1073 &length_arg_pos
, &length
);
1077 gdbscm_out_of_range_error (FUNC_NAME
, length_arg_pos
,
1078 scm_from_int (length
),
1079 _("invalid length"));
1084 scoped_value_mark free_values
;
1086 struct type
*type
, *realtype
;
1089 type
= value_type (value
);
1090 realtype
= check_typedef (type
);
1092 switch (TYPE_CODE (realtype
))
1094 case TYPE_CODE_ARRAY
:
1096 LONGEST array_length
= -1;
1097 LONGEST low_bound
, high_bound
;
1099 /* PR 20786: There's no way to specify an array of length zero.
1100 Record a length of [0,-1] which is how Ada does it. Anything
1101 we do is broken, but this one possible solution. */
1102 if (get_array_bounds (realtype
, &low_bound
, &high_bound
))
1103 array_length
= high_bound
- low_bound
+ 1;
1105 length
= array_length
;
1106 else if (array_length
== -1)
1108 type
= lookup_array_range_type (TYPE_TARGET_TYPE (realtype
),
1111 else if (length
!= array_length
)
1113 /* We need to create a new array type with the
1114 specified length. */
1115 if (length
> array_length
)
1116 error (_("length is larger than array size"));
1117 type
= lookup_array_range_type (TYPE_TARGET_TYPE (type
),
1119 low_bound
+ length
- 1);
1121 addr
= value_address (value
);
1125 /* If a length is specified we defer creating an array of the
1126 specified width until we need to. */
1127 addr
= value_as_address (value
);
1130 /* Should flag an error here. PR 20769. */
1131 addr
= value_address (value
);
1135 result
= lsscm_make_lazy_string (addr
, length
, encoding
, type
);
1137 CATCH (ex
, RETURN_MASK_ALL
)
1144 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1146 if (gdbscm_is_exception (result
))
1147 gdbscm_throw (result
);
1152 /* (value-lazy? <gdb:value>) -> boolean */
1155 gdbscm_value_lazy_p (SCM self
)
1158 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1159 struct value
*value
= v_smob
->value
;
1161 return scm_from_bool (value_lazy (value
));
1164 /* (value-fetch-lazy! <gdb:value>) -> unspecified */
1167 gdbscm_value_fetch_lazy_x (SCM self
)
1170 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1171 struct value
*value
= v_smob
->value
;
1173 return gdbscm_wrap ([=]
1175 if (value_lazy (value
))
1176 value_fetch_lazy (value
);
1177 return SCM_UNSPECIFIED
;
1181 /* (value-print <gdb:value>) -> string */
1184 gdbscm_value_print (SCM self
)
1187 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1188 struct value
*value
= v_smob
->value
;
1189 struct value_print_options opts
;
1191 get_user_print_options (&opts
);
1198 common_val_print (value
, &stb
, 0, &opts
, current_language
);
1200 CATCH (except
, RETURN_MASK_ALL
)
1202 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1206 /* Use SCM_FAILED_CONVERSION_QUESTION_MARK to ensure this doesn't
1207 throw an error if the encoding fails.
1208 IWBN to use scm_take_locale_string here, but we'd have to temporarily
1209 override the default port conversion handler because contrary to
1210 documentation it doesn't necessarily free the input string. */
1211 return scm_from_stringn (stb
.c_str (), stb
.size (), host_charset (),
1212 SCM_FAILED_CONVERSION_QUESTION_MARK
);
1215 /* (parse-and-eval string) -> <gdb:value>
1216 Parse a string and evaluate the string as an expression. */
1219 gdbscm_parse_and_eval (SCM expr_scm
)
1222 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, NULL
, "s",
1223 expr_scm
, &expr_str
);
1225 return gdbscm_wrap ([=]
1227 scoped_value_mark free_values
;
1228 return vlscm_scm_from_value (parse_and_eval (expr_str
));
1232 /* (history-ref integer) -> <gdb:value>
1233 Return the specified value from GDB's value history. */
1236 gdbscm_history_ref (SCM index
)
1239 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, NULL
, "i", index
, &i
);
1241 return gdbscm_wrap ([=]
1243 return vlscm_scm_from_value (access_value_history (i
));
1247 /* (history-append! <gdb:value>) -> index
1248 Append VALUE to GDB's value history. Return its index in the history. */
1251 gdbscm_history_append_x (SCM value
)
1254 = vlscm_get_value_smob_arg_unsafe (value
, SCM_ARG1
, FUNC_NAME
);
1255 return gdbscm_wrap ([=]
1257 return scm_from_int (record_latest_value (v_smob
->value
));
1261 /* Initialize the Scheme value code. */
1263 static const scheme_function value_functions
[] =
1265 { "value?", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_p
),
1267 Return #t if the object is a <gdb:value> object." },
1269 { "make-value", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_value
),
1271 Create a <gdb:value> representing object.\n\
1272 Typically this is used to convert numbers and strings to\n\
1273 <gdb:value> objects.\n\
1275 Arguments: object [#:type <gdb:type>]" },
1277 { "value-optimized-out?", 1, 0, 0,
1278 as_a_scm_t_subr (gdbscm_value_optimized_out_p
),
1280 Return #t if the value has been optimizd out." },
1282 { "value-address", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_address
),
1284 Return the address of the value." },
1286 { "value-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_type
),
1288 Return the type of the value." },
1290 { "value-dynamic-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_dynamic_type
),
1292 Return the dynamic type of the value." },
1294 { "value-cast", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_cast
),
1296 Cast the value to the supplied type.\n\
1298 Arguments: <gdb:value> <gdb:type>" },
1300 { "value-dynamic-cast", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_dynamic_cast
),
1302 Cast the value to the supplied type, as if by the C++\n\
1303 dynamic_cast operator.\n\
1305 Arguments: <gdb:value> <gdb:type>" },
1307 { "value-reinterpret-cast", 2, 0, 0,
1308 as_a_scm_t_subr (gdbscm_value_reinterpret_cast
),
1310 Cast the value to the supplied type, as if by the C++\n\
1311 reinterpret_cast operator.\n\
1313 Arguments: <gdb:value> <gdb:type>" },
1315 { "value-dereference", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_dereference
),
1317 Return the result of applying the C unary * operator to the value." },
1319 { "value-referenced-value", 1, 0, 0,
1320 as_a_scm_t_subr (gdbscm_value_referenced_value
),
1322 Given a value of a reference type, return the value referenced.\n\
1323 The difference between this function and value-dereference is that\n\
1324 the latter applies * unary operator to a value, which need not always\n\
1325 result in the value referenced.\n\
1326 For example, for a value which is a reference to an 'int' pointer ('int *'),\n\
1327 value-dereference will result in a value of type 'int' while\n\
1328 value-referenced-value will result in a value of type 'int *'." },
1330 { "value-field", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_field
),
1332 Return the specified field of the value.\n\
1334 Arguments: <gdb:value> string" },
1336 { "value-subscript", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_subscript
),
1338 Return the value of the array at the specified index.\n\
1340 Arguments: <gdb:value> integer" },
1342 { "value-call", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_call
),
1344 Perform an inferior function call taking the value as a pointer to the\n\
1345 function to call.\n\
1346 Each element of the argument list must be a <gdb:value> object or an object\n\
1347 that can be converted to one.\n\
1348 The result is the value returned by the function.\n\
1350 Arguments: <gdb:value> arg-list" },
1352 { "value->bool", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_bool
),
1354 Return the Scheme boolean representing the GDB value.\n\
1355 The value must be \"integer like\". Pointers are ok." },
1357 { "value->integer", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_integer
),
1359 Return the Scheme integer representing the GDB value.\n\
1360 The value must be \"integer like\". Pointers are ok." },
1362 { "value->real", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_real
),
1364 Return the Scheme real number representing the GDB value.\n\
1365 The value must be a number." },
1367 { "value->bytevector", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_bytevector
),
1369 Return a Scheme bytevector with the raw contents of the GDB value.\n\
1370 No transformation, endian or otherwise, is performed." },
1372 { "value->string", 1, 0, 1, as_a_scm_t_subr (gdbscm_value_to_string
),
1374 Return the Unicode string of the value's contents.\n\
1375 If ENCODING is not given, the string is assumed to be encoded in\n\
1376 the target's charset.\n\
1377 An error setting \"error\" causes an exception to be thrown if there's\n\
1378 a decoding error. An error setting of \"substitute\" causes invalid\n\
1379 characters to be replaced with \"?\". The default is \"error\".\n\
1380 If LENGTH is provided, only fetch string to the length provided.\n\
1382 Arguments: <gdb:value>\n\
1383 [#:encoding encoding] [#:errors \"error\"|\"substitute\"]\n\
1384 [#:length length]" },
1386 { "value->lazy-string", 1, 0, 1,
1387 as_a_scm_t_subr (gdbscm_value_to_lazy_string
),
1389 Return a Scheme object representing a lazily fetched Unicode string\n\
1390 of the value's contents.\n\
1391 If ENCODING is not given, the string is assumed to be encoded in\n\
1392 the target's charset.\n\
1393 If LENGTH is provided, only fetch string to the length provided.\n\
1395 Arguments: <gdb:value> [#:encoding encoding] [#:length length]" },
1397 { "value-lazy?", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_lazy_p
),
1399 Return #t if the value is lazy (not fetched yet from the inferior).\n\
1400 A lazy value is fetched when needed, or when the value-fetch-lazy! function\n\
1403 { "make-lazy-value", 2, 0, 0, as_a_scm_t_subr (gdbscm_make_lazy_value
),
1405 Create a <gdb:value> that will be lazily fetched from the target.\n\
1407 Arguments: <gdb:type> address" },
1409 { "value-fetch-lazy!", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_fetch_lazy_x
),
1411 Fetch the value from the inferior, if it was lazy.\n\
1412 The result is \"unspecified\"." },
1414 { "value-print", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_print
),
1416 Return the string representation (print form) of the value." },
1418 { "parse-and-eval", 1, 0, 0, as_a_scm_t_subr (gdbscm_parse_and_eval
),
1420 Evaluates string in gdb and returns the result as a <gdb:value> object." },
1422 { "history-ref", 1, 0, 0, as_a_scm_t_subr (gdbscm_history_ref
),
1424 Return the specified value from GDB's value history." },
1426 { "history-append!", 1, 0, 0, as_a_scm_t_subr (gdbscm_history_append_x
),
1428 Append the specified value onto GDB's value history." },
1434 gdbscm_initialize_values (void)
1436 value_smob_tag
= gdbscm_make_smob_type (value_smob_name
,
1437 sizeof (value_smob
));
1438 scm_set_smob_free (value_smob_tag
, vlscm_free_value_smob
);
1439 scm_set_smob_print (value_smob_tag
, vlscm_print_value_smob
);
1440 scm_set_smob_equalp (value_smob_tag
, vlscm_equal_p_value_smob
);
1442 gdbscm_define_functions (value_functions
, 1);
1444 type_keyword
= scm_from_latin1_keyword ("type");
1445 encoding_keyword
= scm_from_latin1_keyword ("encoding");
1446 errors_keyword
= scm_from_latin1_keyword ("errors");
1447 length_keyword
= scm_from_latin1_keyword ("length");
1449 error_symbol
= scm_from_latin1_symbol ("error");
1450 escape_symbol
= scm_from_latin1_symbol ("escape");
1451 substitute_symbol
= scm_from_latin1_symbol ("substitute");