1 /* GDB/Scheme support for math operations on values.
3 Copyright (C) 2008-2015 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 "doublest.h" /* Needed by dfp.h. */
28 #include "expression.h" /* Needed by dfp.h. */
30 #include "symtab.h" /* Needed by language.h. */
34 #include "guile-internal.h"
36 /* Note: Use target types here to remain consistent with the values system in
37 GDB (which uses target arithmetic). */
39 enum valscm_unary_opcode
45 /* Note: This is Scheme's "logical not", not GDB's.
46 GDB calls this UNOP_COMPLEMENT. */
50 enum valscm_binary_opcode
68 /* If TYPE is a reference, return the target; otherwise return TYPE. */
69 #define STRIP_REFERENCE(TYPE) \
70 ((TYPE_CODE (TYPE) == TYPE_CODE_REF) ? (TYPE_TARGET_TYPE (TYPE)) : (TYPE))
72 /* Returns a value object which is the result of applying the operation
73 specified by OPCODE to the given argument.
74 If there's an error a Scheme exception is thrown. */
77 vlscm_unop (enum valscm_unary_opcode opcode
, SCM x
, const char *func_name
)
79 struct gdbarch
*gdbarch
= get_current_arch ();
80 const struct language_defn
*language
= current_language
;
82 SCM result
= SCM_BOOL_F
;
83 struct value
*res_val
= NULL
;
85 struct cleanup
*cleanups
;
86 volatile struct gdb_exception except
;
88 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
90 arg1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
91 &except_scm
, gdbarch
, language
);
94 do_cleanups (cleanups
);
95 gdbscm_throw (except_scm
);
98 TRY_CATCH (except
, RETURN_MASK_ALL
)
103 /* Alas gdb and guile use the opposite meaning for "logical not". */
105 struct type
*type
= language_bool_type (language
, gdbarch
);
107 = value_from_longest (type
, (LONGEST
) value_logical_not (arg1
));
111 res_val
= value_neg (arg1
);
114 /* Seemingly a no-op, but if X was a Scheme value it is now
115 a <gdb:value> object. */
119 if (value_less (arg1
, value_zero (value_type (arg1
), not_lval
)))
120 res_val
= value_neg (arg1
);
125 res_val
= value_complement (arg1
);
128 gdb_assert_not_reached ("unsupported operation");
131 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
133 gdb_assert (res_val
!= NULL
);
134 result
= vlscm_scm_from_value (res_val
);
136 do_cleanups (cleanups
);
138 if (gdbscm_is_exception (result
))
139 gdbscm_throw (result
);
144 /* Returns a value object which is the result of applying the operation
145 specified by OPCODE to the given arguments.
146 If there's an error a Scheme exception is thrown. */
149 vlscm_binop (enum valscm_binary_opcode opcode
, SCM x
, SCM y
,
150 const char *func_name
)
152 struct gdbarch
*gdbarch
= get_current_arch ();
153 const struct language_defn
*language
= current_language
;
154 struct value
*arg1
, *arg2
;
155 SCM result
= SCM_BOOL_F
;
156 struct value
*res_val
= NULL
;
158 struct cleanup
*cleanups
;
159 volatile struct gdb_exception except
;
161 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
163 arg1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
164 &except_scm
, gdbarch
, language
);
167 do_cleanups (cleanups
);
168 gdbscm_throw (except_scm
);
170 arg2
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG2
, y
,
171 &except_scm
, gdbarch
, language
);
174 do_cleanups (cleanups
);
175 gdbscm_throw (except_scm
);
178 TRY_CATCH (except
, RETURN_MASK_ALL
)
184 struct type
*ltype
= value_type (arg1
);
185 struct type
*rtype
= value_type (arg2
);
187 CHECK_TYPEDEF (ltype
);
188 ltype
= STRIP_REFERENCE (ltype
);
189 CHECK_TYPEDEF (rtype
);
190 rtype
= STRIP_REFERENCE (rtype
);
192 if (TYPE_CODE (ltype
) == TYPE_CODE_PTR
193 && is_integral_type (rtype
))
194 res_val
= value_ptradd (arg1
, value_as_long (arg2
));
195 else if (TYPE_CODE (rtype
) == TYPE_CODE_PTR
196 && is_integral_type (ltype
))
197 res_val
= value_ptradd (arg2
, value_as_long (arg1
));
199 res_val
= value_binop (arg1
, arg2
, BINOP_ADD
);
204 struct type
*ltype
= value_type (arg1
);
205 struct type
*rtype
= value_type (arg2
);
207 CHECK_TYPEDEF (ltype
);
208 ltype
= STRIP_REFERENCE (ltype
);
209 CHECK_TYPEDEF (rtype
);
210 rtype
= STRIP_REFERENCE (rtype
);
212 if (TYPE_CODE (ltype
) == TYPE_CODE_PTR
213 && TYPE_CODE (rtype
) == TYPE_CODE_PTR
)
215 /* A ptrdiff_t for the target would be preferable here. */
217 = value_from_longest (builtin_type (gdbarch
)->builtin_long
,
218 value_ptrdiff (arg1
, arg2
));
220 else if (TYPE_CODE (ltype
) == TYPE_CODE_PTR
221 && is_integral_type (rtype
))
222 res_val
= value_ptradd (arg1
, - value_as_long (arg2
));
224 res_val
= value_binop (arg1
, arg2
, BINOP_SUB
);
228 res_val
= value_binop (arg1
, arg2
, BINOP_MUL
);
231 res_val
= value_binop (arg1
, arg2
, BINOP_DIV
);
234 res_val
= value_binop (arg1
, arg2
, BINOP_REM
);
237 res_val
= value_binop (arg1
, arg2
, BINOP_MOD
);
240 res_val
= value_binop (arg1
, arg2
, BINOP_EXP
);
243 res_val
= value_binop (arg1
, arg2
, BINOP_LSH
);
246 res_val
= value_binop (arg1
, arg2
, BINOP_RSH
);
249 res_val
= value_binop (arg1
, arg2
, BINOP_MIN
);
252 res_val
= value_binop (arg1
, arg2
, BINOP_MAX
);
255 res_val
= value_binop (arg1
, arg2
, BINOP_BITWISE_AND
);
258 res_val
= value_binop (arg1
, arg2
, BINOP_BITWISE_IOR
);
261 res_val
= value_binop (arg1
, arg2
, BINOP_BITWISE_XOR
);
264 gdb_assert_not_reached ("unsupported operation");
267 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
269 gdb_assert (res_val
!= NULL
);
270 result
= vlscm_scm_from_value (res_val
);
272 do_cleanups (cleanups
);
274 if (gdbscm_is_exception (result
))
275 gdbscm_throw (result
);
280 /* (value-add x y) -> <gdb:value> */
283 gdbscm_value_add (SCM x
, SCM y
)
285 return vlscm_binop (VALSCM_ADD
, x
, y
, FUNC_NAME
);
288 /* (value-sub x y) -> <gdb:value> */
291 gdbscm_value_sub (SCM x
, SCM y
)
293 return vlscm_binop (VALSCM_SUB
, x
, y
, FUNC_NAME
);
296 /* (value-mul x y) -> <gdb:value> */
299 gdbscm_value_mul (SCM x
, SCM y
)
301 return vlscm_binop (VALSCM_MUL
, x
, y
, FUNC_NAME
);
304 /* (value-div x y) -> <gdb:value> */
307 gdbscm_value_div (SCM x
, SCM y
)
309 return vlscm_binop (VALSCM_DIV
, x
, y
, FUNC_NAME
);
312 /* (value-rem x y) -> <gdb:value> */
315 gdbscm_value_rem (SCM x
, SCM y
)
317 return vlscm_binop (VALSCM_REM
, x
, y
, FUNC_NAME
);
320 /* (value-mod x y) -> <gdb:value> */
323 gdbscm_value_mod (SCM x
, SCM y
)
325 return vlscm_binop (VALSCM_MOD
, x
, y
, FUNC_NAME
);
328 /* (value-pow x y) -> <gdb:value> */
331 gdbscm_value_pow (SCM x
, SCM y
)
333 return vlscm_binop (VALSCM_POW
, x
, y
, FUNC_NAME
);
336 /* (value-neg x) -> <gdb:value> */
339 gdbscm_value_neg (SCM x
)
341 return vlscm_unop (VALSCM_NEG
, x
, FUNC_NAME
);
344 /* (value-pos x) -> <gdb:value> */
347 gdbscm_value_pos (SCM x
)
349 return vlscm_unop (VALSCM_NOP
, x
, FUNC_NAME
);
352 /* (value-abs x) -> <gdb:value> */
355 gdbscm_value_abs (SCM x
)
357 return vlscm_unop (VALSCM_ABS
, x
, FUNC_NAME
);
360 /* (value-lsh x y) -> <gdb:value> */
363 gdbscm_value_lsh (SCM x
, SCM y
)
365 return vlscm_binop (VALSCM_LSH
, x
, y
, FUNC_NAME
);
368 /* (value-rsh x y) -> <gdb:value> */
371 gdbscm_value_rsh (SCM x
, SCM y
)
373 return vlscm_binop (VALSCM_RSH
, x
, y
, FUNC_NAME
);
376 /* (value-min x y) -> <gdb:value> */
379 gdbscm_value_min (SCM x
, SCM y
)
381 return vlscm_binop (VALSCM_MIN
, x
, y
, FUNC_NAME
);
384 /* (value-max x y) -> <gdb:value> */
387 gdbscm_value_max (SCM x
, SCM y
)
389 return vlscm_binop (VALSCM_MAX
, x
, y
, FUNC_NAME
);
392 /* (value-not x) -> <gdb:value> */
395 gdbscm_value_not (SCM x
)
397 return vlscm_unop (VALSCM_NOT
, x
, FUNC_NAME
);
400 /* (value-lognot x) -> <gdb:value> */
403 gdbscm_value_lognot (SCM x
)
405 return vlscm_unop (VALSCM_LOGNOT
, x
, FUNC_NAME
);
408 /* (value-logand x y) -> <gdb:value> */
411 gdbscm_value_logand (SCM x
, SCM y
)
413 return vlscm_binop (VALSCM_BITAND
, x
, y
, FUNC_NAME
);
416 /* (value-logior x y) -> <gdb:value> */
419 gdbscm_value_logior (SCM x
, SCM y
)
421 return vlscm_binop (VALSCM_BITOR
, x
, y
, FUNC_NAME
);
424 /* (value-logxor x y) -> <gdb:value> */
427 gdbscm_value_logxor (SCM x
, SCM y
)
429 return vlscm_binop (VALSCM_BITXOR
, x
, y
, FUNC_NAME
);
432 /* Utility to perform all value comparisons.
433 If there's an error a Scheme exception is thrown. */
436 vlscm_rich_compare (int op
, SCM x
, SCM y
, const char *func_name
)
438 struct gdbarch
*gdbarch
= get_current_arch ();
439 const struct language_defn
*language
= current_language
;
440 struct value
*v1
, *v2
;
443 struct cleanup
*cleanups
;
444 volatile struct gdb_exception except
;
446 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
448 v1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
449 &except_scm
, gdbarch
, language
);
452 do_cleanups (cleanups
);
453 gdbscm_throw (except_scm
);
455 v2
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG2
, y
,
456 &except_scm
, gdbarch
, language
);
459 do_cleanups (cleanups
);
460 gdbscm_throw (except_scm
);
463 TRY_CATCH (except
, RETURN_MASK_ALL
)
468 result
= value_less (v1
, v2
);
471 result
= (value_less (v1
, v2
)
472 || value_equal (v1
, v2
));
475 result
= value_equal (v1
, v2
);
478 gdb_assert_not_reached ("not-equal not implemented");
480 result
= value_less (v2
, v1
);
483 result
= (value_less (v2
, v1
)
484 || value_equal (v1
, v2
));
487 gdb_assert_not_reached ("invalid <gdb:value> comparison");
490 do_cleanups (cleanups
);
491 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
493 return scm_from_bool (result
);
496 /* (value=? x y) -> boolean
497 There is no "not-equal?" function (value!= ?) on purpose.
498 We're following string=?, etc. as our Guide here. */
501 gdbscm_value_eq_p (SCM x
, SCM y
)
503 return vlscm_rich_compare (BINOP_EQUAL
, x
, y
, FUNC_NAME
);
506 /* (value<? x y) -> boolean */
509 gdbscm_value_lt_p (SCM x
, SCM y
)
511 return vlscm_rich_compare (BINOP_LESS
, x
, y
, FUNC_NAME
);
514 /* (value<=? x y) -> boolean */
517 gdbscm_value_le_p (SCM x
, SCM y
)
519 return vlscm_rich_compare (BINOP_LEQ
, x
, y
, FUNC_NAME
);
522 /* (value>? x y) -> boolean */
525 gdbscm_value_gt_p (SCM x
, SCM y
)
527 return vlscm_rich_compare (BINOP_GTR
, x
, y
, FUNC_NAME
);
530 /* (value>=? x y) -> boolean */
533 gdbscm_value_ge_p (SCM x
, SCM y
)
535 return vlscm_rich_compare (BINOP_GEQ
, x
, y
, FUNC_NAME
);
538 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
539 Convert OBJ, a Scheme number, to a <gdb:value> object.
540 OBJ_ARG_POS is its position in the argument list, used in exception text.
542 TYPE is the result type. TYPE_ARG_POS is its position in
543 the argument list, used in exception text.
544 TYPE_SCM is Scheme object wrapping TYPE, used in exception text.
546 If the number isn't representable, e.g. it's too big, a <gdb:exception>
547 object is stored in *EXCEPT_SCMP and NULL is returned.
548 The conversion may throw a gdb error, e.g., if TYPE is invalid. */
550 static struct value
*
551 vlscm_convert_typed_number (const char *func_name
, int obj_arg_pos
, SCM obj
,
552 int type_arg_pos
, SCM type_scm
, struct type
*type
,
553 struct gdbarch
*gdbarch
, SCM
*except_scmp
)
555 if (is_integral_type (type
)
556 || TYPE_CODE (type
) == TYPE_CODE_PTR
)
558 if (TYPE_UNSIGNED (type
))
562 get_unsigned_type_max (type
, &max
);
563 if (!scm_is_unsigned_integer (obj
, 0, max
))
566 = gdbscm_make_out_of_range_error (func_name
,
568 _("value out of range for type"));
571 return value_from_longest (type
, gdbscm_scm_to_ulongest (obj
));
577 get_signed_type_minmax (type
, &min
, &max
);
578 if (!scm_is_signed_integer (obj
, min
, max
))
581 = gdbscm_make_out_of_range_error (func_name
,
583 _("value out of range for type"));
586 return value_from_longest (type
, gdbscm_scm_to_longest (obj
));
589 else if (TYPE_CODE (type
) == TYPE_CODE_FLT
)
590 return value_from_double (type
, scm_to_double (obj
));
593 *except_scmp
= gdbscm_make_type_error (func_name
, obj_arg_pos
, obj
,
599 /* Return non-zero if OBJ, an integer, fits in TYPE. */
602 vlscm_integer_fits_p (SCM obj
, struct type
*type
)
604 if (TYPE_UNSIGNED (type
))
608 /* If scm_is_unsigned_integer can't work with this type, just punt. */
609 if (TYPE_LENGTH (type
) > sizeof (scm_t_uintmax
))
611 get_unsigned_type_max (type
, &max
);
612 return scm_is_unsigned_integer (obj
, 0, max
);
618 /* If scm_is_signed_integer can't work with this type, just punt. */
619 if (TYPE_LENGTH (type
) > sizeof (scm_t_intmax
))
621 get_signed_type_minmax (type
, &min
, &max
);
622 return scm_is_signed_integer (obj
, min
, max
);
626 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
627 Convert OBJ, a Scheme number, to a <gdb:value> object.
628 OBJ_ARG_POS is its position in the argument list, used in exception text.
630 If OBJ is an integer, then the smallest int that will hold the value in
631 the following progression is chosen:
632 int, unsigned int, long, unsigned long, long long, unsigned long long.
633 Otherwise, if OBJ is a real number, then it is converted to a double.
634 Otherwise an exception is thrown.
636 If the number isn't representable, e.g. it's too big, a <gdb:exception>
637 object is stored in *EXCEPT_SCMP and NULL is returned. */
639 static struct value
*
640 vlscm_convert_number (const char *func_name
, int obj_arg_pos
, SCM obj
,
641 struct gdbarch
*gdbarch
, SCM
*except_scmp
)
643 const struct builtin_type
*bt
= builtin_type (gdbarch
);
645 /* One thing to keep in mind here is that we are interested in the
646 target's representation of OBJ, not the host's. */
648 if (scm_is_exact (obj
) && scm_is_integer (obj
))
650 if (vlscm_integer_fits_p (obj
, bt
->builtin_int
))
651 return value_from_longest (bt
->builtin_int
,
652 gdbscm_scm_to_longest (obj
));
653 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_int
))
654 return value_from_longest (bt
->builtin_unsigned_int
,
655 gdbscm_scm_to_ulongest (obj
));
656 if (vlscm_integer_fits_p (obj
, bt
->builtin_long
))
657 return value_from_longest (bt
->builtin_long
,
658 gdbscm_scm_to_longest (obj
));
659 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_long
))
660 return value_from_longest (bt
->builtin_unsigned_long
,
661 gdbscm_scm_to_ulongest (obj
));
662 if (vlscm_integer_fits_p (obj
, bt
->builtin_long_long
))
663 return value_from_longest (bt
->builtin_long_long
,
664 gdbscm_scm_to_longest (obj
));
665 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_long_long
))
666 return value_from_longest (bt
->builtin_unsigned_long_long
,
667 gdbscm_scm_to_ulongest (obj
));
669 else if (scm_is_real (obj
))
670 return value_from_double (bt
->builtin_double
, scm_to_double (obj
));
672 *except_scmp
= gdbscm_make_out_of_range_error (func_name
, obj_arg_pos
, obj
,
673 _("value not a number representable on the target"));
677 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
678 Convert BV, a Scheme bytevector, to a <gdb:value> object.
680 TYPE, if non-NULL, is the result type. Otherwise, a vector of type
682 TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
683 or #f if TYPE is NULL.
685 If the bytevector isn't the same size as the type, then a <gdb:exception>
686 object is stored in *EXCEPT_SCMP, and NULL is returned. */
688 static struct value
*
689 vlscm_convert_bytevector (SCM bv
, struct type
*type
, SCM type_scm
,
690 int arg_pos
, const char *func_name
,
691 SCM
*except_scmp
, struct gdbarch
*gdbarch
)
693 LONGEST length
= SCM_BYTEVECTOR_LENGTH (bv
);
698 type
= builtin_type (gdbarch
)->builtin_uint8
;
699 type
= lookup_array_range_type (type
, 0, length
);
700 make_vector_type (type
);
702 type
= check_typedef (type
);
703 if (TYPE_LENGTH (type
) != length
)
705 *except_scmp
= gdbscm_make_out_of_range_error (func_name
, arg_pos
,
707 _("size of type does not match size of bytevector"));
711 value
= value_from_contents (type
,
712 (gdb_byte
*) SCM_BYTEVECTOR_CONTENTS (bv
));
716 /* Convert OBJ, a Scheme value, to a <gdb:value> object.
717 OBJ_ARG_POS is its position in the argument list, used in exception text.
719 TYPE, if non-NULL, is the result type which must be compatible with
720 the value being converted.
721 If TYPE is NULL then a suitable default type is chosen.
722 TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
723 or SCM_UNDEFINED if TYPE is NULL.
724 TYPE_ARG_POS is its position in the argument list, used in exception text,
725 or -1 if TYPE is NULL.
727 OBJ may also be a <gdb:value> object, in which case a copy is returned
728 and TYPE must be NULL.
730 If the value cannot be converted, NULL is returned and a gdb:exception
731 object is stored in *EXCEPT_SCMP.
732 Otherwise the new value is returned, added to the all_values chain. */
735 vlscm_convert_typed_value_from_scheme (const char *func_name
,
736 int obj_arg_pos
, SCM obj
,
737 int type_arg_pos
, SCM type_scm
,
740 struct gdbarch
*gdbarch
,
741 const struct language_defn
*language
)
743 struct value
*value
= NULL
;
744 SCM except_scm
= SCM_BOOL_F
;
745 volatile struct gdb_exception except
;
749 gdb_assert (type_arg_pos
== -1);
750 gdb_assert (SCM_UNBNDP (type_scm
));
753 *except_scmp
= SCM_BOOL_F
;
755 TRY_CATCH (except
, RETURN_MASK_ALL
)
757 if (vlscm_is_value (obj
))
761 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
763 _("No type allowed"));
767 value
= value_copy (vlscm_scm_to_value (obj
));
769 else if (gdbscm_is_true (scm_bytevector_p (obj
)))
771 value
= vlscm_convert_bytevector (obj
, type
, type_scm
,
772 obj_arg_pos
, func_name
,
773 &except_scm
, gdbarch
);
775 else if (gdbscm_is_bool (obj
))
778 && !is_integral_type (type
))
780 except_scm
= gdbscm_make_type_error (func_name
, type_arg_pos
,
785 value
= value_from_longest (type
787 : language_bool_type (language
,
789 gdbscm_is_true (obj
));
792 else if (scm_is_number (obj
))
796 value
= vlscm_convert_typed_number (func_name
, obj_arg_pos
, obj
,
797 type_arg_pos
, type_scm
, type
,
798 gdbarch
, &except_scm
);
802 value
= vlscm_convert_number (func_name
, obj_arg_pos
, obj
,
803 gdbarch
, &except_scm
);
806 else if (scm_is_string (obj
))
810 struct cleanup
*cleanup
;
814 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
816 _("No type allowed"));
821 /* TODO: Provide option to specify conversion strategy. */
822 s
= gdbscm_scm_to_string (obj
, &len
,
823 target_charset (gdbarch
),
828 cleanup
= make_cleanup (xfree
, s
);
830 = value_cstring (s
, len
,
831 language_string_char_type (language
,
833 do_cleanups (cleanup
);
839 else if (lsscm_is_lazy_string (obj
))
843 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
845 _("No type allowed"));
850 value
= lsscm_safe_lazy_string_to_value (obj
, obj_arg_pos
,
855 else /* OBJ isn't anything we support. */
857 except_scm
= gdbscm_make_type_error (func_name
, obj_arg_pos
, obj
,
862 if (except
.reason
< 0)
863 except_scm
= gdbscm_scm_from_gdb_exception (except
);
865 if (gdbscm_is_true (except_scm
))
867 gdb_assert (value
== NULL
);
868 *except_scmp
= except_scm
;
874 /* Wrapper around vlscm_convert_typed_value_from_scheme for cases where there
875 is no supplied type. See vlscm_convert_typed_value_from_scheme for
879 vlscm_convert_value_from_scheme (const char *func_name
,
880 int obj_arg_pos
, SCM obj
,
881 SCM
*except_scmp
, struct gdbarch
*gdbarch
,
882 const struct language_defn
*language
)
884 return vlscm_convert_typed_value_from_scheme (func_name
, obj_arg_pos
, obj
,
885 -1, SCM_UNDEFINED
, NULL
,
890 /* Initialize value math support. */
892 static const scheme_function math_functions
[] =
894 { "value-add", 2, 0, 0, gdbscm_value_add
,
898 { "value-sub", 2, 0, 0, gdbscm_value_sub
,
902 { "value-mul", 2, 0, 0, gdbscm_value_mul
,
906 { "value-div", 2, 0, 0, gdbscm_value_div
,
910 { "value-rem", 2, 0, 0, gdbscm_value_rem
,
914 { "value-mod", 2, 0, 0, gdbscm_value_mod
,
916 Return a mod b. See Knuth 1.2.4." },
918 { "value-pow", 2, 0, 0, gdbscm_value_pow
,
920 Return pow (x, y)." },
922 { "value-not", 1, 0, 0, gdbscm_value_not
,
926 { "value-neg", 1, 0, 0, gdbscm_value_neg
,
930 { "value-pos", 1, 0, 0, gdbscm_value_pos
,
934 { "value-abs", 1, 0, 0, gdbscm_value_abs
,
938 { "value-lsh", 2, 0, 0, gdbscm_value_lsh
,
942 { "value-rsh", 2, 0, 0, gdbscm_value_rsh
,
946 { "value-min", 2, 0, 0, gdbscm_value_min
,
948 Return min (a, b)." },
950 { "value-max", 2, 0, 0, gdbscm_value_max
,
952 Return max (a, b)." },
954 { "value-lognot", 1, 0, 0, gdbscm_value_lognot
,
958 { "value-logand", 2, 0, 0, gdbscm_value_logand
,
962 { "value-logior", 2, 0, 0, gdbscm_value_logior
,
966 { "value-logxor", 2, 0, 0, gdbscm_value_logxor
,
970 { "value=?", 2, 0, 0, gdbscm_value_eq_p
,
974 { "value<?", 2, 0, 0, gdbscm_value_lt_p
,
978 { "value<=?", 2, 0, 0, gdbscm_value_le_p
,
982 { "value>?", 2, 0, 0, gdbscm_value_gt_p
,
986 { "value>=?", 2, 0, 0, gdbscm_value_ge_p
,
994 gdbscm_initialize_math (void)
996 gdbscm_define_functions (math_functions
, 1);