1 /* GDB/Scheme support for math operations on 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"
28 #include "symtab.h" /* Needed by language.h. */
32 #include "guile-internal.h"
34 /* Note: Use target types here to remain consistent with the values system in
35 GDB (which uses target arithmetic). */
37 enum valscm_unary_opcode
43 /* Note: This is Scheme's "logical not", not GDB's.
44 GDB calls this UNOP_COMPLEMENT. */
48 enum valscm_binary_opcode
66 /* If TYPE is a reference, return the target; otherwise return TYPE. */
67 #define STRIP_REFERENCE(TYPE) \
68 ((TYPE_CODE (TYPE) == TYPE_CODE_REF) ? (TYPE_TARGET_TYPE (TYPE)) : (TYPE))
70 /* Returns a value object which is the result of applying the operation
71 specified by OPCODE to the given argument.
72 If there's an error a Scheme exception is thrown. */
75 vlscm_unop (enum valscm_unary_opcode opcode
, SCM x
, const char *func_name
)
77 struct gdbarch
*gdbarch
= get_current_arch ();
78 const struct language_defn
*language
= current_language
;
80 SCM result
= SCM_BOOL_F
;
81 struct value
*res_val
= NULL
;
83 struct cleanup
*cleanups
;
85 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
87 arg1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
88 &except_scm
, gdbarch
, language
);
91 do_cleanups (cleanups
);
92 gdbscm_throw (except_scm
);
100 /* Alas gdb and guile use the opposite meaning for "logical not". */
102 struct type
*type
= language_bool_type (language
, gdbarch
);
104 = value_from_longest (type
, (LONGEST
) value_logical_not (arg1
));
108 res_val
= value_neg (arg1
);
111 /* Seemingly a no-op, but if X was a Scheme value it is now
112 a <gdb:value> object. */
116 if (value_less (arg1
, value_zero (value_type (arg1
), not_lval
)))
117 res_val
= value_neg (arg1
);
122 res_val
= value_complement (arg1
);
125 gdb_assert_not_reached ("unsupported operation");
128 CATCH (except
, RETURN_MASK_ALL
)
130 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
134 gdb_assert (res_val
!= NULL
);
135 result
= vlscm_scm_from_value (res_val
);
137 do_cleanups (cleanups
);
139 if (gdbscm_is_exception (result
))
140 gdbscm_throw (result
);
145 /* Returns a value object which is the result of applying the operation
146 specified by OPCODE to the given arguments.
147 If there's an error a Scheme exception is thrown. */
150 vlscm_binop (enum valscm_binary_opcode opcode
, SCM x
, SCM y
,
151 const char *func_name
)
153 struct gdbarch
*gdbarch
= get_current_arch ();
154 const struct language_defn
*language
= current_language
;
155 struct value
*arg1
, *arg2
;
156 SCM result
= SCM_BOOL_F
;
157 struct value
*res_val
= NULL
;
159 struct cleanup
*cleanups
;
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
);
184 struct type
*ltype
= value_type (arg1
);
185 struct type
*rtype
= value_type (arg2
);
187 ltype
= check_typedef (ltype
);
188 ltype
= STRIP_REFERENCE (ltype
);
189 rtype
= 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 ltype
= check_typedef (ltype
);
208 ltype
= STRIP_REFERENCE (ltype
);
209 rtype
= 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 CATCH (except
, RETURN_MASK_ALL
)
269 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
273 gdb_assert (res_val
!= NULL
);
274 result
= vlscm_scm_from_value (res_val
);
276 do_cleanups (cleanups
);
278 if (gdbscm_is_exception (result
))
279 gdbscm_throw (result
);
284 /* (value-add x y) -> <gdb:value> */
287 gdbscm_value_add (SCM x
, SCM y
)
289 return vlscm_binop (VALSCM_ADD
, x
, y
, FUNC_NAME
);
292 /* (value-sub x y) -> <gdb:value> */
295 gdbscm_value_sub (SCM x
, SCM y
)
297 return vlscm_binop (VALSCM_SUB
, x
, y
, FUNC_NAME
);
300 /* (value-mul x y) -> <gdb:value> */
303 gdbscm_value_mul (SCM x
, SCM y
)
305 return vlscm_binop (VALSCM_MUL
, x
, y
, FUNC_NAME
);
308 /* (value-div x y) -> <gdb:value> */
311 gdbscm_value_div (SCM x
, SCM y
)
313 return vlscm_binop (VALSCM_DIV
, x
, y
, FUNC_NAME
);
316 /* (value-rem x y) -> <gdb:value> */
319 gdbscm_value_rem (SCM x
, SCM y
)
321 return vlscm_binop (VALSCM_REM
, x
, y
, FUNC_NAME
);
324 /* (value-mod x y) -> <gdb:value> */
327 gdbscm_value_mod (SCM x
, SCM y
)
329 return vlscm_binop (VALSCM_MOD
, x
, y
, FUNC_NAME
);
332 /* (value-pow x y) -> <gdb:value> */
335 gdbscm_value_pow (SCM x
, SCM y
)
337 return vlscm_binop (VALSCM_POW
, x
, y
, FUNC_NAME
);
340 /* (value-neg x) -> <gdb:value> */
343 gdbscm_value_neg (SCM x
)
345 return vlscm_unop (VALSCM_NEG
, x
, FUNC_NAME
);
348 /* (value-pos x) -> <gdb:value> */
351 gdbscm_value_pos (SCM x
)
353 return vlscm_unop (VALSCM_NOP
, x
, FUNC_NAME
);
356 /* (value-abs x) -> <gdb:value> */
359 gdbscm_value_abs (SCM x
)
361 return vlscm_unop (VALSCM_ABS
, x
, FUNC_NAME
);
364 /* (value-lsh x y) -> <gdb:value> */
367 gdbscm_value_lsh (SCM x
, SCM y
)
369 return vlscm_binop (VALSCM_LSH
, x
, y
, FUNC_NAME
);
372 /* (value-rsh x y) -> <gdb:value> */
375 gdbscm_value_rsh (SCM x
, SCM y
)
377 return vlscm_binop (VALSCM_RSH
, x
, y
, FUNC_NAME
);
380 /* (value-min x y) -> <gdb:value> */
383 gdbscm_value_min (SCM x
, SCM y
)
385 return vlscm_binop (VALSCM_MIN
, x
, y
, FUNC_NAME
);
388 /* (value-max x y) -> <gdb:value> */
391 gdbscm_value_max (SCM x
, SCM y
)
393 return vlscm_binop (VALSCM_MAX
, x
, y
, FUNC_NAME
);
396 /* (value-not x) -> <gdb:value> */
399 gdbscm_value_not (SCM x
)
401 return vlscm_unop (VALSCM_NOT
, x
, FUNC_NAME
);
404 /* (value-lognot x) -> <gdb:value> */
407 gdbscm_value_lognot (SCM x
)
409 return vlscm_unop (VALSCM_LOGNOT
, x
, FUNC_NAME
);
412 /* (value-logand x y) -> <gdb:value> */
415 gdbscm_value_logand (SCM x
, SCM y
)
417 return vlscm_binop (VALSCM_BITAND
, x
, y
, FUNC_NAME
);
420 /* (value-logior x y) -> <gdb:value> */
423 gdbscm_value_logior (SCM x
, SCM y
)
425 return vlscm_binop (VALSCM_BITOR
, x
, y
, FUNC_NAME
);
428 /* (value-logxor x y) -> <gdb:value> */
431 gdbscm_value_logxor (SCM x
, SCM y
)
433 return vlscm_binop (VALSCM_BITXOR
, x
, y
, FUNC_NAME
);
436 /* Utility to perform all value comparisons.
437 If there's an error a Scheme exception is thrown. */
440 vlscm_rich_compare (int op
, SCM x
, SCM y
, const char *func_name
)
442 struct gdbarch
*gdbarch
= get_current_arch ();
443 const struct language_defn
*language
= current_language
;
444 struct value
*v1
, *v2
;
447 struct cleanup
*cleanups
;
448 struct gdb_exception except
= exception_none
;
450 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
452 v1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
453 &except_scm
, gdbarch
, language
);
456 do_cleanups (cleanups
);
457 gdbscm_throw (except_scm
);
459 v2
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG2
, y
,
460 &except_scm
, gdbarch
, language
);
463 do_cleanups (cleanups
);
464 gdbscm_throw (except_scm
);
472 result
= value_less (v1
, v2
);
475 result
= (value_less (v1
, v2
)
476 || value_equal (v1
, v2
));
479 result
= value_equal (v1
, v2
);
482 gdb_assert_not_reached ("not-equal not implemented");
484 result
= value_less (v2
, v1
);
487 result
= (value_less (v2
, v1
)
488 || value_equal (v1
, v2
));
491 gdb_assert_not_reached ("invalid <gdb:value> comparison");
494 CATCH (ex
, RETURN_MASK_ALL
)
500 do_cleanups (cleanups
);
501 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
503 return scm_from_bool (result
);
506 /* (value=? x y) -> boolean
507 There is no "not-equal?" function (value!= ?) on purpose.
508 We're following string=?, etc. as our Guide here. */
511 gdbscm_value_eq_p (SCM x
, SCM y
)
513 return vlscm_rich_compare (BINOP_EQUAL
, x
, y
, FUNC_NAME
);
516 /* (value<? x y) -> boolean */
519 gdbscm_value_lt_p (SCM x
, SCM y
)
521 return vlscm_rich_compare (BINOP_LESS
, x
, y
, FUNC_NAME
);
524 /* (value<=? x y) -> boolean */
527 gdbscm_value_le_p (SCM x
, SCM y
)
529 return vlscm_rich_compare (BINOP_LEQ
, x
, y
, FUNC_NAME
);
532 /* (value>? x y) -> boolean */
535 gdbscm_value_gt_p (SCM x
, SCM y
)
537 return vlscm_rich_compare (BINOP_GTR
, x
, y
, FUNC_NAME
);
540 /* (value>=? x y) -> boolean */
543 gdbscm_value_ge_p (SCM x
, SCM y
)
545 return vlscm_rich_compare (BINOP_GEQ
, x
, y
, FUNC_NAME
);
548 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
549 Convert OBJ, a Scheme number, to a <gdb:value> object.
550 OBJ_ARG_POS is its position in the argument list, used in exception text.
552 TYPE is the result type. TYPE_ARG_POS is its position in
553 the argument list, used in exception text.
554 TYPE_SCM is Scheme object wrapping TYPE, used in exception text.
556 If the number isn't representable, e.g. it's too big, a <gdb:exception>
557 object is stored in *EXCEPT_SCMP and NULL is returned.
558 The conversion may throw a gdb error, e.g., if TYPE is invalid. */
560 static struct value
*
561 vlscm_convert_typed_number (const char *func_name
, int obj_arg_pos
, SCM obj
,
562 int type_arg_pos
, SCM type_scm
, struct type
*type
,
563 struct gdbarch
*gdbarch
, SCM
*except_scmp
)
565 if (is_integral_type (type
)
566 || TYPE_CODE (type
) == TYPE_CODE_PTR
)
568 if (TYPE_UNSIGNED (type
))
572 get_unsigned_type_max (type
, &max
);
573 if (!scm_is_unsigned_integer (obj
, 0, max
))
576 = gdbscm_make_out_of_range_error (func_name
,
578 _("value out of range for type"));
581 return value_from_longest (type
, gdbscm_scm_to_ulongest (obj
));
587 get_signed_type_minmax (type
, &min
, &max
);
588 if (!scm_is_signed_integer (obj
, min
, max
))
591 = gdbscm_make_out_of_range_error (func_name
,
593 _("value out of range for type"));
596 return value_from_longest (type
, gdbscm_scm_to_longest (obj
));
599 else if (TYPE_CODE (type
) == TYPE_CODE_FLT
)
601 struct value
*value
= allocate_value (type
);
602 target_float_from_host_double (value_contents_raw (value
),
604 scm_to_double (obj
));
609 *except_scmp
= gdbscm_make_type_error (func_name
, obj_arg_pos
, obj
,
615 /* Return non-zero if OBJ, an integer, fits in TYPE. */
618 vlscm_integer_fits_p (SCM obj
, struct type
*type
)
620 if (TYPE_UNSIGNED (type
))
624 /* If scm_is_unsigned_integer can't work with this type, just punt. */
625 if (TYPE_LENGTH (type
) > sizeof (scm_t_uintmax
))
627 get_unsigned_type_max (type
, &max
);
628 return scm_is_unsigned_integer (obj
, 0, max
);
634 /* If scm_is_signed_integer can't work with this type, just punt. */
635 if (TYPE_LENGTH (type
) > sizeof (scm_t_intmax
))
637 get_signed_type_minmax (type
, &min
, &max
);
638 return scm_is_signed_integer (obj
, min
, max
);
642 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
643 Convert OBJ, a Scheme number, to a <gdb:value> object.
644 OBJ_ARG_POS is its position in the argument list, used in exception text.
646 If OBJ is an integer, then the smallest int that will hold the value in
647 the following progression is chosen:
648 int, unsigned int, long, unsigned long, long long, unsigned long long.
649 Otherwise, if OBJ is a real number, then it is converted to a double.
650 Otherwise an exception is thrown.
652 If the number isn't representable, e.g. it's too big, a <gdb:exception>
653 object is stored in *EXCEPT_SCMP and NULL is returned. */
655 static struct value
*
656 vlscm_convert_number (const char *func_name
, int obj_arg_pos
, SCM obj
,
657 struct gdbarch
*gdbarch
, SCM
*except_scmp
)
659 const struct builtin_type
*bt
= builtin_type (gdbarch
);
661 /* One thing to keep in mind here is that we are interested in the
662 target's representation of OBJ, not the host's. */
664 if (scm_is_exact (obj
) && scm_is_integer (obj
))
666 if (vlscm_integer_fits_p (obj
, bt
->builtin_int
))
667 return value_from_longest (bt
->builtin_int
,
668 gdbscm_scm_to_longest (obj
));
669 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_int
))
670 return value_from_longest (bt
->builtin_unsigned_int
,
671 gdbscm_scm_to_ulongest (obj
));
672 if (vlscm_integer_fits_p (obj
, bt
->builtin_long
))
673 return value_from_longest (bt
->builtin_long
,
674 gdbscm_scm_to_longest (obj
));
675 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_long
))
676 return value_from_longest (bt
->builtin_unsigned_long
,
677 gdbscm_scm_to_ulongest (obj
));
678 if (vlscm_integer_fits_p (obj
, bt
->builtin_long_long
))
679 return value_from_longest (bt
->builtin_long_long
,
680 gdbscm_scm_to_longest (obj
));
681 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_long_long
))
682 return value_from_longest (bt
->builtin_unsigned_long_long
,
683 gdbscm_scm_to_ulongest (obj
));
685 else if (scm_is_real (obj
))
687 struct value
*value
= allocate_value (bt
->builtin_double
);
688 target_float_from_host_double (value_contents_raw (value
),
690 scm_to_double (obj
));
694 *except_scmp
= gdbscm_make_out_of_range_error (func_name
, obj_arg_pos
, obj
,
695 _("value not a number representable on the target"));
699 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
700 Convert BV, a Scheme bytevector, to a <gdb:value> object.
702 TYPE, if non-NULL, is the result type. Otherwise, a vector of type
704 TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
705 or #f if TYPE is NULL.
707 If the bytevector isn't the same size as the type, then a <gdb:exception>
708 object is stored in *EXCEPT_SCMP, and NULL is returned. */
710 static struct value
*
711 vlscm_convert_bytevector (SCM bv
, struct type
*type
, SCM type_scm
,
712 int arg_pos
, const char *func_name
,
713 SCM
*except_scmp
, struct gdbarch
*gdbarch
)
715 LONGEST length
= SCM_BYTEVECTOR_LENGTH (bv
);
720 type
= builtin_type (gdbarch
)->builtin_uint8
;
721 type
= lookup_array_range_type (type
, 0, length
);
722 make_vector_type (type
);
724 type
= check_typedef (type
);
725 if (TYPE_LENGTH (type
) != length
)
727 *except_scmp
= gdbscm_make_out_of_range_error (func_name
, arg_pos
,
729 _("size of type does not match size of bytevector"));
733 value
= value_from_contents (type
,
734 (gdb_byte
*) SCM_BYTEVECTOR_CONTENTS (bv
));
738 /* Convert OBJ, a Scheme value, to a <gdb:value> object.
739 OBJ_ARG_POS is its position in the argument list, used in exception text.
741 TYPE, if non-NULL, is the result type which must be compatible with
742 the value being converted.
743 If TYPE is NULL then a suitable default type is chosen.
744 TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
745 or SCM_UNDEFINED if TYPE is NULL.
746 TYPE_ARG_POS is its position in the argument list, used in exception text,
747 or -1 if TYPE is NULL.
749 OBJ may also be a <gdb:value> object, in which case a copy is returned
750 and TYPE must be NULL.
752 If the value cannot be converted, NULL is returned and a gdb:exception
753 object is stored in *EXCEPT_SCMP.
754 Otherwise the new value is returned, added to the all_values chain. */
757 vlscm_convert_typed_value_from_scheme (const char *func_name
,
758 int obj_arg_pos
, SCM obj
,
759 int type_arg_pos
, SCM type_scm
,
762 struct gdbarch
*gdbarch
,
763 const struct language_defn
*language
)
765 struct value
*value
= NULL
;
766 SCM except_scm
= SCM_BOOL_F
;
770 gdb_assert (type_arg_pos
== -1);
771 gdb_assert (SCM_UNBNDP (type_scm
));
774 *except_scmp
= SCM_BOOL_F
;
778 if (vlscm_is_value (obj
))
782 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
784 _("No type allowed"));
788 value
= value_copy (vlscm_scm_to_value (obj
));
790 else if (gdbscm_is_true (scm_bytevector_p (obj
)))
792 value
= vlscm_convert_bytevector (obj
, type
, type_scm
,
793 obj_arg_pos
, func_name
,
794 &except_scm
, gdbarch
);
796 else if (gdbscm_is_bool (obj
))
799 && !is_integral_type (type
))
801 except_scm
= gdbscm_make_type_error (func_name
, type_arg_pos
,
806 value
= value_from_longest (type
808 : language_bool_type (language
,
810 gdbscm_is_true (obj
));
813 else if (scm_is_number (obj
))
817 value
= vlscm_convert_typed_number (func_name
, obj_arg_pos
, obj
,
818 type_arg_pos
, type_scm
, type
,
819 gdbarch
, &except_scm
);
823 value
= vlscm_convert_number (func_name
, obj_arg_pos
, obj
,
824 gdbarch
, &except_scm
);
827 else if (scm_is_string (obj
))
831 struct cleanup
*cleanup
;
835 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
837 _("No type allowed"));
842 /* TODO: Provide option to specify conversion strategy. */
843 s
= gdbscm_scm_to_string (obj
, &len
,
844 target_charset (gdbarch
),
849 cleanup
= make_cleanup (xfree
, s
);
851 = value_cstring (s
, len
,
852 language_string_char_type (language
,
854 do_cleanups (cleanup
);
860 else if (lsscm_is_lazy_string (obj
))
864 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
866 _("No type allowed"));
871 value
= lsscm_safe_lazy_string_to_value (obj
, obj_arg_pos
,
876 else /* OBJ isn't anything we support. */
878 except_scm
= gdbscm_make_type_error (func_name
, obj_arg_pos
, obj
,
883 CATCH (except
, RETURN_MASK_ALL
)
885 except_scm
= gdbscm_scm_from_gdb_exception (except
);
889 if (gdbscm_is_true (except_scm
))
891 gdb_assert (value
== NULL
);
892 *except_scmp
= except_scm
;
898 /* Wrapper around vlscm_convert_typed_value_from_scheme for cases where there
899 is no supplied type. See vlscm_convert_typed_value_from_scheme for
903 vlscm_convert_value_from_scheme (const char *func_name
,
904 int obj_arg_pos
, SCM obj
,
905 SCM
*except_scmp
, struct gdbarch
*gdbarch
,
906 const struct language_defn
*language
)
908 return vlscm_convert_typed_value_from_scheme (func_name
, obj_arg_pos
, obj
,
909 -1, SCM_UNDEFINED
, NULL
,
914 /* Initialize value math support. */
916 static const scheme_function math_functions
[] =
918 { "value-add", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_add
),
922 { "value-sub", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_sub
),
926 { "value-mul", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_mul
),
930 { "value-div", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_div
),
934 { "value-rem", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_rem
),
938 { "value-mod", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_mod
),
940 Return a mod b. See Knuth 1.2.4." },
942 { "value-pow", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_pow
),
944 Return pow (x, y)." },
946 { "value-not", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_not
),
950 { "value-neg", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_neg
),
954 { "value-pos", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_pos
),
958 { "value-abs", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_abs
),
962 { "value-lsh", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_lsh
),
966 { "value-rsh", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_rsh
),
970 { "value-min", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_min
),
972 Return min (a, b)." },
974 { "value-max", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_max
),
976 Return max (a, b)." },
978 { "value-lognot", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_lognot
),
982 { "value-logand", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_logand
),
986 { "value-logior", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_logior
),
990 { "value-logxor", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_logxor
),
994 { "value=?", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_eq_p
),
998 { "value<?", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_lt_p
),
1002 { "value<=?", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_le_p
),
1006 { "value>?", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_gt_p
),
1010 { "value>=?", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_ge_p
),
1018 gdbscm_initialize_math (void)
1020 gdbscm_define_functions (math_functions
, 1);