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
;
87 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
89 arg1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
90 &except_scm
, gdbarch
, language
);
93 do_cleanups (cleanups
);
94 gdbscm_throw (except_scm
);
102 /* Alas gdb and guile use the opposite meaning for "logical not". */
104 struct type
*type
= language_bool_type (language
, gdbarch
);
106 = value_from_longest (type
, (LONGEST
) value_logical_not (arg1
));
110 res_val
= value_neg (arg1
);
113 /* Seemingly a no-op, but if X was a Scheme value it is now
114 a <gdb:value> object. */
118 if (value_less (arg1
, value_zero (value_type (arg1
), not_lval
)))
119 res_val
= value_neg (arg1
);
124 res_val
= value_complement (arg1
);
127 gdb_assert_not_reached ("unsupported operation");
130 CATCH (except
, RETURN_MASK_ALL
)
132 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
136 gdb_assert (res_val
!= NULL
);
137 result
= vlscm_scm_from_value (res_val
);
139 do_cleanups (cleanups
);
141 if (gdbscm_is_exception (result
))
142 gdbscm_throw (result
);
147 /* Returns a value object which is the result of applying the operation
148 specified by OPCODE to the given arguments.
149 If there's an error a Scheme exception is thrown. */
152 vlscm_binop (enum valscm_binary_opcode opcode
, SCM x
, SCM y
,
153 const char *func_name
)
155 struct gdbarch
*gdbarch
= get_current_arch ();
156 const struct language_defn
*language
= current_language
;
157 struct value
*arg1
, *arg2
;
158 SCM result
= SCM_BOOL_F
;
159 struct value
*res_val
= NULL
;
161 struct cleanup
*cleanups
;
163 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
165 arg1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
166 &except_scm
, gdbarch
, language
);
169 do_cleanups (cleanups
);
170 gdbscm_throw (except_scm
);
172 arg2
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG2
, y
,
173 &except_scm
, gdbarch
, language
);
176 do_cleanups (cleanups
);
177 gdbscm_throw (except_scm
);
186 struct type
*ltype
= value_type (arg1
);
187 struct type
*rtype
= value_type (arg2
);
189 ltype
= check_typedef (ltype
);
190 ltype
= STRIP_REFERENCE (ltype
);
191 rtype
= check_typedef (rtype
);
192 rtype
= STRIP_REFERENCE (rtype
);
194 if (TYPE_CODE (ltype
) == TYPE_CODE_PTR
195 && is_integral_type (rtype
))
196 res_val
= value_ptradd (arg1
, value_as_long (arg2
));
197 else if (TYPE_CODE (rtype
) == TYPE_CODE_PTR
198 && is_integral_type (ltype
))
199 res_val
= value_ptradd (arg2
, value_as_long (arg1
));
201 res_val
= value_binop (arg1
, arg2
, BINOP_ADD
);
206 struct type
*ltype
= value_type (arg1
);
207 struct type
*rtype
= value_type (arg2
);
209 ltype
= check_typedef (ltype
);
210 ltype
= STRIP_REFERENCE (ltype
);
211 rtype
= check_typedef (rtype
);
212 rtype
= STRIP_REFERENCE (rtype
);
214 if (TYPE_CODE (ltype
) == TYPE_CODE_PTR
215 && TYPE_CODE (rtype
) == TYPE_CODE_PTR
)
217 /* A ptrdiff_t for the target would be preferable here. */
219 = value_from_longest (builtin_type (gdbarch
)->builtin_long
,
220 value_ptrdiff (arg1
, arg2
));
222 else if (TYPE_CODE (ltype
) == TYPE_CODE_PTR
223 && is_integral_type (rtype
))
224 res_val
= value_ptradd (arg1
, - value_as_long (arg2
));
226 res_val
= value_binop (arg1
, arg2
, BINOP_SUB
);
230 res_val
= value_binop (arg1
, arg2
, BINOP_MUL
);
233 res_val
= value_binop (arg1
, arg2
, BINOP_DIV
);
236 res_val
= value_binop (arg1
, arg2
, BINOP_REM
);
239 res_val
= value_binop (arg1
, arg2
, BINOP_MOD
);
242 res_val
= value_binop (arg1
, arg2
, BINOP_EXP
);
245 res_val
= value_binop (arg1
, arg2
, BINOP_LSH
);
248 res_val
= value_binop (arg1
, arg2
, BINOP_RSH
);
251 res_val
= value_binop (arg1
, arg2
, BINOP_MIN
);
254 res_val
= value_binop (arg1
, arg2
, BINOP_MAX
);
257 res_val
= value_binop (arg1
, arg2
, BINOP_BITWISE_AND
);
260 res_val
= value_binop (arg1
, arg2
, BINOP_BITWISE_IOR
);
263 res_val
= value_binop (arg1
, arg2
, BINOP_BITWISE_XOR
);
266 gdb_assert_not_reached ("unsupported operation");
269 CATCH (except
, RETURN_MASK_ALL
)
271 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
275 gdb_assert (res_val
!= NULL
);
276 result
= vlscm_scm_from_value (res_val
);
278 do_cleanups (cleanups
);
280 if (gdbscm_is_exception (result
))
281 gdbscm_throw (result
);
286 /* (value-add x y) -> <gdb:value> */
289 gdbscm_value_add (SCM x
, SCM y
)
291 return vlscm_binop (VALSCM_ADD
, x
, y
, FUNC_NAME
);
294 /* (value-sub x y) -> <gdb:value> */
297 gdbscm_value_sub (SCM x
, SCM y
)
299 return vlscm_binop (VALSCM_SUB
, x
, y
, FUNC_NAME
);
302 /* (value-mul x y) -> <gdb:value> */
305 gdbscm_value_mul (SCM x
, SCM y
)
307 return vlscm_binop (VALSCM_MUL
, x
, y
, FUNC_NAME
);
310 /* (value-div x y) -> <gdb:value> */
313 gdbscm_value_div (SCM x
, SCM y
)
315 return vlscm_binop (VALSCM_DIV
, x
, y
, FUNC_NAME
);
318 /* (value-rem x y) -> <gdb:value> */
321 gdbscm_value_rem (SCM x
, SCM y
)
323 return vlscm_binop (VALSCM_REM
, x
, y
, FUNC_NAME
);
326 /* (value-mod x y) -> <gdb:value> */
329 gdbscm_value_mod (SCM x
, SCM y
)
331 return vlscm_binop (VALSCM_MOD
, x
, y
, FUNC_NAME
);
334 /* (value-pow x y) -> <gdb:value> */
337 gdbscm_value_pow (SCM x
, SCM y
)
339 return vlscm_binop (VALSCM_POW
, x
, y
, FUNC_NAME
);
342 /* (value-neg x) -> <gdb:value> */
345 gdbscm_value_neg (SCM x
)
347 return vlscm_unop (VALSCM_NEG
, x
, FUNC_NAME
);
350 /* (value-pos x) -> <gdb:value> */
353 gdbscm_value_pos (SCM x
)
355 return vlscm_unop (VALSCM_NOP
, x
, FUNC_NAME
);
358 /* (value-abs x) -> <gdb:value> */
361 gdbscm_value_abs (SCM x
)
363 return vlscm_unop (VALSCM_ABS
, x
, FUNC_NAME
);
366 /* (value-lsh x y) -> <gdb:value> */
369 gdbscm_value_lsh (SCM x
, SCM y
)
371 return vlscm_binop (VALSCM_LSH
, x
, y
, FUNC_NAME
);
374 /* (value-rsh x y) -> <gdb:value> */
377 gdbscm_value_rsh (SCM x
, SCM y
)
379 return vlscm_binop (VALSCM_RSH
, x
, y
, FUNC_NAME
);
382 /* (value-min x y) -> <gdb:value> */
385 gdbscm_value_min (SCM x
, SCM y
)
387 return vlscm_binop (VALSCM_MIN
, x
, y
, FUNC_NAME
);
390 /* (value-max x y) -> <gdb:value> */
393 gdbscm_value_max (SCM x
, SCM y
)
395 return vlscm_binop (VALSCM_MAX
, x
, y
, FUNC_NAME
);
398 /* (value-not x) -> <gdb:value> */
401 gdbscm_value_not (SCM x
)
403 return vlscm_unop (VALSCM_NOT
, x
, FUNC_NAME
);
406 /* (value-lognot x) -> <gdb:value> */
409 gdbscm_value_lognot (SCM x
)
411 return vlscm_unop (VALSCM_LOGNOT
, x
, FUNC_NAME
);
414 /* (value-logand x y) -> <gdb:value> */
417 gdbscm_value_logand (SCM x
, SCM y
)
419 return vlscm_binop (VALSCM_BITAND
, x
, y
, FUNC_NAME
);
422 /* (value-logior x y) -> <gdb:value> */
425 gdbscm_value_logior (SCM x
, SCM y
)
427 return vlscm_binop (VALSCM_BITOR
, x
, y
, FUNC_NAME
);
430 /* (value-logxor x y) -> <gdb:value> */
433 gdbscm_value_logxor (SCM x
, SCM y
)
435 return vlscm_binop (VALSCM_BITXOR
, x
, y
, FUNC_NAME
);
438 /* Utility to perform all value comparisons.
439 If there's an error a Scheme exception is thrown. */
442 vlscm_rich_compare (int op
, SCM x
, SCM y
, const char *func_name
)
444 struct gdbarch
*gdbarch
= get_current_arch ();
445 const struct language_defn
*language
= current_language
;
446 struct value
*v1
, *v2
;
449 struct cleanup
*cleanups
;
450 struct gdb_exception except
= exception_none
;
452 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
454 v1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
455 &except_scm
, gdbarch
, language
);
458 do_cleanups (cleanups
);
459 gdbscm_throw (except_scm
);
461 v2
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG2
, y
,
462 &except_scm
, gdbarch
, language
);
465 do_cleanups (cleanups
);
466 gdbscm_throw (except_scm
);
474 result
= value_less (v1
, v2
);
477 result
= (value_less (v1
, v2
)
478 || value_equal (v1
, v2
));
481 result
= value_equal (v1
, v2
);
484 gdb_assert_not_reached ("not-equal not implemented");
486 result
= value_less (v2
, v1
);
489 result
= (value_less (v2
, v1
)
490 || value_equal (v1
, v2
));
493 gdb_assert_not_reached ("invalid <gdb:value> comparison");
496 CATCH (ex
, RETURN_MASK_ALL
)
502 do_cleanups (cleanups
);
503 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
505 return scm_from_bool (result
);
508 /* (value=? x y) -> boolean
509 There is no "not-equal?" function (value!= ?) on purpose.
510 We're following string=?, etc. as our Guide here. */
513 gdbscm_value_eq_p (SCM x
, SCM y
)
515 return vlscm_rich_compare (BINOP_EQUAL
, x
, y
, FUNC_NAME
);
518 /* (value<? x y) -> boolean */
521 gdbscm_value_lt_p (SCM x
, SCM y
)
523 return vlscm_rich_compare (BINOP_LESS
, x
, y
, FUNC_NAME
);
526 /* (value<=? x y) -> boolean */
529 gdbscm_value_le_p (SCM x
, SCM y
)
531 return vlscm_rich_compare (BINOP_LEQ
, x
, y
, FUNC_NAME
);
534 /* (value>? x y) -> boolean */
537 gdbscm_value_gt_p (SCM x
, SCM y
)
539 return vlscm_rich_compare (BINOP_GTR
, x
, y
, FUNC_NAME
);
542 /* (value>=? x y) -> boolean */
545 gdbscm_value_ge_p (SCM x
, SCM y
)
547 return vlscm_rich_compare (BINOP_GEQ
, x
, y
, FUNC_NAME
);
550 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
551 Convert OBJ, a Scheme number, to a <gdb:value> object.
552 OBJ_ARG_POS is its position in the argument list, used in exception text.
554 TYPE is the result type. TYPE_ARG_POS is its position in
555 the argument list, used in exception text.
556 TYPE_SCM is Scheme object wrapping TYPE, used in exception text.
558 If the number isn't representable, e.g. it's too big, a <gdb:exception>
559 object is stored in *EXCEPT_SCMP and NULL is returned.
560 The conversion may throw a gdb error, e.g., if TYPE is invalid. */
562 static struct value
*
563 vlscm_convert_typed_number (const char *func_name
, int obj_arg_pos
, SCM obj
,
564 int type_arg_pos
, SCM type_scm
, struct type
*type
,
565 struct gdbarch
*gdbarch
, SCM
*except_scmp
)
567 if (is_integral_type (type
)
568 || TYPE_CODE (type
) == TYPE_CODE_PTR
)
570 if (TYPE_UNSIGNED (type
))
574 get_unsigned_type_max (type
, &max
);
575 if (!scm_is_unsigned_integer (obj
, 0, max
))
578 = gdbscm_make_out_of_range_error (func_name
,
580 _("value out of range for type"));
583 return value_from_longest (type
, gdbscm_scm_to_ulongest (obj
));
589 get_signed_type_minmax (type
, &min
, &max
);
590 if (!scm_is_signed_integer (obj
, min
, max
))
593 = gdbscm_make_out_of_range_error (func_name
,
595 _("value out of range for type"));
598 return value_from_longest (type
, gdbscm_scm_to_longest (obj
));
601 else if (TYPE_CODE (type
) == TYPE_CODE_FLT
)
602 return value_from_double (type
, scm_to_double (obj
));
605 *except_scmp
= gdbscm_make_type_error (func_name
, obj_arg_pos
, obj
,
611 /* Return non-zero if OBJ, an integer, fits in TYPE. */
614 vlscm_integer_fits_p (SCM obj
, struct type
*type
)
616 if (TYPE_UNSIGNED (type
))
620 /* If scm_is_unsigned_integer can't work with this type, just punt. */
621 if (TYPE_LENGTH (type
) > sizeof (scm_t_uintmax
))
623 get_unsigned_type_max (type
, &max
);
624 return scm_is_unsigned_integer (obj
, 0, max
);
630 /* If scm_is_signed_integer can't work with this type, just punt. */
631 if (TYPE_LENGTH (type
) > sizeof (scm_t_intmax
))
633 get_signed_type_minmax (type
, &min
, &max
);
634 return scm_is_signed_integer (obj
, min
, max
);
638 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
639 Convert OBJ, a Scheme number, to a <gdb:value> object.
640 OBJ_ARG_POS is its position in the argument list, used in exception text.
642 If OBJ is an integer, then the smallest int that will hold the value in
643 the following progression is chosen:
644 int, unsigned int, long, unsigned long, long long, unsigned long long.
645 Otherwise, if OBJ is a real number, then it is converted to a double.
646 Otherwise an exception is thrown.
648 If the number isn't representable, e.g. it's too big, a <gdb:exception>
649 object is stored in *EXCEPT_SCMP and NULL is returned. */
651 static struct value
*
652 vlscm_convert_number (const char *func_name
, int obj_arg_pos
, SCM obj
,
653 struct gdbarch
*gdbarch
, SCM
*except_scmp
)
655 const struct builtin_type
*bt
= builtin_type (gdbarch
);
657 /* One thing to keep in mind here is that we are interested in the
658 target's representation of OBJ, not the host's. */
660 if (scm_is_exact (obj
) && scm_is_integer (obj
))
662 if (vlscm_integer_fits_p (obj
, bt
->builtin_int
))
663 return value_from_longest (bt
->builtin_int
,
664 gdbscm_scm_to_longest (obj
));
665 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_int
))
666 return value_from_longest (bt
->builtin_unsigned_int
,
667 gdbscm_scm_to_ulongest (obj
));
668 if (vlscm_integer_fits_p (obj
, bt
->builtin_long
))
669 return value_from_longest (bt
->builtin_long
,
670 gdbscm_scm_to_longest (obj
));
671 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_long
))
672 return value_from_longest (bt
->builtin_unsigned_long
,
673 gdbscm_scm_to_ulongest (obj
));
674 if (vlscm_integer_fits_p (obj
, bt
->builtin_long_long
))
675 return value_from_longest (bt
->builtin_long_long
,
676 gdbscm_scm_to_longest (obj
));
677 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_long_long
))
678 return value_from_longest (bt
->builtin_unsigned_long_long
,
679 gdbscm_scm_to_ulongest (obj
));
681 else if (scm_is_real (obj
))
682 return value_from_double (bt
->builtin_double
, scm_to_double (obj
));
684 *except_scmp
= gdbscm_make_out_of_range_error (func_name
, obj_arg_pos
, obj
,
685 _("value not a number representable on the target"));
689 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
690 Convert BV, a Scheme bytevector, to a <gdb:value> object.
692 TYPE, if non-NULL, is the result type. Otherwise, a vector of type
694 TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
695 or #f if TYPE is NULL.
697 If the bytevector isn't the same size as the type, then a <gdb:exception>
698 object is stored in *EXCEPT_SCMP, and NULL is returned. */
700 static struct value
*
701 vlscm_convert_bytevector (SCM bv
, struct type
*type
, SCM type_scm
,
702 int arg_pos
, const char *func_name
,
703 SCM
*except_scmp
, struct gdbarch
*gdbarch
)
705 LONGEST length
= SCM_BYTEVECTOR_LENGTH (bv
);
710 type
= builtin_type (gdbarch
)->builtin_uint8
;
711 type
= lookup_array_range_type (type
, 0, length
);
712 make_vector_type (type
);
714 type
= check_typedef (type
);
715 if (TYPE_LENGTH (type
) != length
)
717 *except_scmp
= gdbscm_make_out_of_range_error (func_name
, arg_pos
,
719 _("size of type does not match size of bytevector"));
723 value
= value_from_contents (type
,
724 (gdb_byte
*) SCM_BYTEVECTOR_CONTENTS (bv
));
728 /* Convert OBJ, a Scheme value, to a <gdb:value> object.
729 OBJ_ARG_POS is its position in the argument list, used in exception text.
731 TYPE, if non-NULL, is the result type which must be compatible with
732 the value being converted.
733 If TYPE is NULL then a suitable default type is chosen.
734 TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
735 or SCM_UNDEFINED if TYPE is NULL.
736 TYPE_ARG_POS is its position in the argument list, used in exception text,
737 or -1 if TYPE is NULL.
739 OBJ may also be a <gdb:value> object, in which case a copy is returned
740 and TYPE must be NULL.
742 If the value cannot be converted, NULL is returned and a gdb:exception
743 object is stored in *EXCEPT_SCMP.
744 Otherwise the new value is returned, added to the all_values chain. */
747 vlscm_convert_typed_value_from_scheme (const char *func_name
,
748 int obj_arg_pos
, SCM obj
,
749 int type_arg_pos
, SCM type_scm
,
752 struct gdbarch
*gdbarch
,
753 const struct language_defn
*language
)
755 struct value
*value
= NULL
;
756 SCM except_scm
= SCM_BOOL_F
;
760 gdb_assert (type_arg_pos
== -1);
761 gdb_assert (SCM_UNBNDP (type_scm
));
764 *except_scmp
= SCM_BOOL_F
;
768 if (vlscm_is_value (obj
))
772 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
774 _("No type allowed"));
778 value
= value_copy (vlscm_scm_to_value (obj
));
780 else if (gdbscm_is_true (scm_bytevector_p (obj
)))
782 value
= vlscm_convert_bytevector (obj
, type
, type_scm
,
783 obj_arg_pos
, func_name
,
784 &except_scm
, gdbarch
);
786 else if (gdbscm_is_bool (obj
))
789 && !is_integral_type (type
))
791 except_scm
= gdbscm_make_type_error (func_name
, type_arg_pos
,
796 value
= value_from_longest (type
798 : language_bool_type (language
,
800 gdbscm_is_true (obj
));
803 else if (scm_is_number (obj
))
807 value
= vlscm_convert_typed_number (func_name
, obj_arg_pos
, obj
,
808 type_arg_pos
, type_scm
, type
,
809 gdbarch
, &except_scm
);
813 value
= vlscm_convert_number (func_name
, obj_arg_pos
, obj
,
814 gdbarch
, &except_scm
);
817 else if (scm_is_string (obj
))
821 struct cleanup
*cleanup
;
825 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
827 _("No type allowed"));
832 /* TODO: Provide option to specify conversion strategy. */
833 s
= gdbscm_scm_to_string (obj
, &len
,
834 target_charset (gdbarch
),
839 cleanup
= make_cleanup (xfree
, s
);
841 = value_cstring (s
, len
,
842 language_string_char_type (language
,
844 do_cleanups (cleanup
);
850 else if (lsscm_is_lazy_string (obj
))
854 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
856 _("No type allowed"));
861 value
= lsscm_safe_lazy_string_to_value (obj
, obj_arg_pos
,
866 else /* OBJ isn't anything we support. */
868 except_scm
= gdbscm_make_type_error (func_name
, obj_arg_pos
, obj
,
873 CATCH (except
, RETURN_MASK_ALL
)
875 except_scm
= gdbscm_scm_from_gdb_exception (except
);
879 if (gdbscm_is_true (except_scm
))
881 gdb_assert (value
== NULL
);
882 *except_scmp
= except_scm
;
888 /* Wrapper around vlscm_convert_typed_value_from_scheme for cases where there
889 is no supplied type. See vlscm_convert_typed_value_from_scheme for
893 vlscm_convert_value_from_scheme (const char *func_name
,
894 int obj_arg_pos
, SCM obj
,
895 SCM
*except_scmp
, struct gdbarch
*gdbarch
,
896 const struct language_defn
*language
)
898 return vlscm_convert_typed_value_from_scheme (func_name
, obj_arg_pos
, obj
,
899 -1, SCM_UNDEFINED
, NULL
,
904 /* Initialize value math support. */
906 static const scheme_function math_functions
[] =
908 { "value-add", 2, 0, 0, gdbscm_value_add
,
912 { "value-sub", 2, 0, 0, gdbscm_value_sub
,
916 { "value-mul", 2, 0, 0, gdbscm_value_mul
,
920 { "value-div", 2, 0, 0, gdbscm_value_div
,
924 { "value-rem", 2, 0, 0, gdbscm_value_rem
,
928 { "value-mod", 2, 0, 0, gdbscm_value_mod
,
930 Return a mod b. See Knuth 1.2.4." },
932 { "value-pow", 2, 0, 0, gdbscm_value_pow
,
934 Return pow (x, y)." },
936 { "value-not", 1, 0, 0, gdbscm_value_not
,
940 { "value-neg", 1, 0, 0, gdbscm_value_neg
,
944 { "value-pos", 1, 0, 0, gdbscm_value_pos
,
948 { "value-abs", 1, 0, 0, gdbscm_value_abs
,
952 { "value-lsh", 2, 0, 0, gdbscm_value_lsh
,
956 { "value-rsh", 2, 0, 0, gdbscm_value_rsh
,
960 { "value-min", 2, 0, 0, gdbscm_value_min
,
962 Return min (a, b)." },
964 { "value-max", 2, 0, 0, gdbscm_value_max
,
966 Return max (a, b)." },
968 { "value-lognot", 1, 0, 0, gdbscm_value_lognot
,
972 { "value-logand", 2, 0, 0, gdbscm_value_logand
,
976 { "value-logior", 2, 0, 0, gdbscm_value_logior
,
980 { "value-logxor", 2, 0, 0, gdbscm_value_logxor
,
984 { "value=?", 2, 0, 0, gdbscm_value_eq_p
,
988 { "value<?", 2, 0, 0, gdbscm_value_lt_p
,
992 { "value<=?", 2, 0, 0, gdbscm_value_le_p
,
996 { "value>?", 2, 0, 0, gdbscm_value_gt_p
,
1000 { "value>=?", 2, 0, 0, gdbscm_value_ge_p
,
1008 gdbscm_initialize_math (void)
1010 gdbscm_define_functions (math_functions
, 1);