1 /* GDB/Scheme support for math operations on values.
3 Copyright (C) 2008-2014 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 "gdb_assert.h"
31 #include "symtab.h" /* Needed by language.h. */
35 #include "guile-internal.h"
37 /* Note: Use target types here to remain consistent with the values system in
38 GDB (which uses target arithmetic). */
40 enum valscm_unary_opcode
46 /* Note: This is Scheme's "logical not", not GDB's.
47 GDB calls this UNOP_COMPLEMENT. */
51 enum valscm_binary_opcode
69 /* If TYPE is a reference, return the target; otherwise return TYPE. */
70 #define STRIP_REFERENCE(TYPE) \
71 ((TYPE_CODE (TYPE) == TYPE_CODE_REF) ? (TYPE_TARGET_TYPE (TYPE)) : (TYPE))
73 /* Returns a value object which is the result of applying the operation
74 specified by OPCODE to the given argument.
75 If there's an error a Scheme exception is thrown. */
78 vlscm_unop (enum valscm_unary_opcode opcode
, SCM x
, const char *func_name
)
80 struct gdbarch
*gdbarch
= get_current_arch ();
81 const struct language_defn
*language
= current_language
;
83 SCM result
= SCM_BOOL_F
;
84 struct value
*res_val
= NULL
;
86 struct cleanup
*cleanups
;
87 volatile struct gdb_exception except
;
89 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
91 arg1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
92 &except_scm
, gdbarch
, language
);
95 do_cleanups (cleanups
);
96 gdbscm_throw (except_scm
);
99 TRY_CATCH (except
, RETURN_MASK_ALL
)
104 /* Alas gdb and guile use the opposite meaning for "logical not". */
106 struct type
*type
= language_bool_type (language
, gdbarch
);
108 = value_from_longest (type
, (LONGEST
) value_logical_not (arg1
));
112 res_val
= value_neg (arg1
);
115 /* Seemingly a no-op, but if X was a Scheme value it is now
116 a <gdb:value> object. */
120 if (value_less (arg1
, value_zero (value_type (arg1
), not_lval
)))
121 res_val
= value_neg (arg1
);
126 res_val
= value_complement (arg1
);
129 gdb_assert_not_reached ("unsupported operation");
132 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
;
160 volatile struct gdb_exception except
;
162 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
164 arg1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
165 &except_scm
, gdbarch
, language
);
168 do_cleanups (cleanups
);
169 gdbscm_throw (except_scm
);
171 arg2
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG2
, y
,
172 &except_scm
, gdbarch
, language
);
175 do_cleanups (cleanups
);
176 gdbscm_throw (except_scm
);
179 TRY_CATCH (except
, RETURN_MASK_ALL
)
185 struct type
*ltype
= value_type (arg1
);
186 struct type
*rtype
= value_type (arg2
);
188 CHECK_TYPEDEF (ltype
);
189 ltype
= STRIP_REFERENCE (ltype
);
190 CHECK_TYPEDEF (rtype
);
191 rtype
= STRIP_REFERENCE (rtype
);
193 if (TYPE_CODE (ltype
) == TYPE_CODE_PTR
194 && is_integral_type (rtype
))
195 res_val
= value_ptradd (arg1
, value_as_long (arg2
));
196 else if (TYPE_CODE (rtype
) == TYPE_CODE_PTR
197 && is_integral_type (ltype
))
198 res_val
= value_ptradd (arg2
, value_as_long (arg1
));
200 res_val
= value_binop (arg1
, arg2
, BINOP_ADD
);
205 struct type
*ltype
= value_type (arg1
);
206 struct type
*rtype
= value_type (arg2
);
208 CHECK_TYPEDEF (ltype
);
209 ltype
= STRIP_REFERENCE (ltype
);
210 CHECK_TYPEDEF (rtype
);
211 rtype
= STRIP_REFERENCE (rtype
);
213 if (TYPE_CODE (ltype
) == TYPE_CODE_PTR
214 && TYPE_CODE (rtype
) == TYPE_CODE_PTR
)
216 /* A ptrdiff_t for the target would be preferable here. */
218 = value_from_longest (builtin_type (gdbarch
)->builtin_long
,
219 value_ptrdiff (arg1
, arg2
));
221 else if (TYPE_CODE (ltype
) == TYPE_CODE_PTR
222 && is_integral_type (rtype
))
223 res_val
= value_ptradd (arg1
, - value_as_long (arg2
));
225 res_val
= value_binop (arg1
, arg2
, BINOP_SUB
);
229 res_val
= value_binop (arg1
, arg2
, BINOP_MUL
);
232 res_val
= value_binop (arg1
, arg2
, BINOP_DIV
);
235 res_val
= value_binop (arg1
, arg2
, BINOP_REM
);
238 res_val
= value_binop (arg1
, arg2
, BINOP_MOD
);
241 res_val
= value_binop (arg1
, arg2
, BINOP_EXP
);
244 res_val
= value_binop (arg1
, arg2
, BINOP_LSH
);
247 res_val
= value_binop (arg1
, arg2
, BINOP_RSH
);
250 res_val
= value_binop (arg1
, arg2
, BINOP_MIN
);
253 res_val
= value_binop (arg1
, arg2
, BINOP_MAX
);
256 res_val
= value_binop (arg1
, arg2
, BINOP_BITWISE_AND
);
259 res_val
= value_binop (arg1
, arg2
, BINOP_BITWISE_IOR
);
262 res_val
= value_binop (arg1
, arg2
, BINOP_BITWISE_XOR
);
265 gdb_assert_not_reached ("unsupported operation");
268 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
270 gdb_assert (res_val
!= NULL
);
271 result
= vlscm_scm_from_value (res_val
);
273 do_cleanups (cleanups
);
275 if (gdbscm_is_exception (result
))
276 gdbscm_throw (result
);
281 /* (value-add x y) -> <gdb:value> */
284 gdbscm_value_add (SCM x
, SCM y
)
286 return vlscm_binop (VALSCM_ADD
, x
, y
, FUNC_NAME
);
289 /* (value-sub x y) -> <gdb:value> */
292 gdbscm_value_sub (SCM x
, SCM y
)
294 return vlscm_binop (VALSCM_SUB
, x
, y
, FUNC_NAME
);
297 /* (value-mul x y) -> <gdb:value> */
300 gdbscm_value_mul (SCM x
, SCM y
)
302 return vlscm_binop (VALSCM_MUL
, x
, y
, FUNC_NAME
);
305 /* (value-div x y) -> <gdb:value> */
308 gdbscm_value_div (SCM x
, SCM y
)
310 return vlscm_binop (VALSCM_DIV
, x
, y
, FUNC_NAME
);
313 /* (value-rem x y) -> <gdb:value> */
316 gdbscm_value_rem (SCM x
, SCM y
)
318 return vlscm_binop (VALSCM_REM
, x
, y
, FUNC_NAME
);
321 /* (value-mod x y) -> <gdb:value> */
324 gdbscm_value_mod (SCM x
, SCM y
)
326 return vlscm_binop (VALSCM_MOD
, x
, y
, FUNC_NAME
);
329 /* (value-pow x y) -> <gdb:value> */
332 gdbscm_value_pow (SCM x
, SCM y
)
334 return vlscm_binop (VALSCM_POW
, x
, y
, FUNC_NAME
);
337 /* (value-neg x) -> <gdb:value> */
340 gdbscm_value_neg (SCM x
)
342 return vlscm_unop (VALSCM_NEG
, x
, FUNC_NAME
);
345 /* (value-pos x) -> <gdb:value> */
348 gdbscm_value_pos (SCM x
)
350 return vlscm_unop (VALSCM_NOP
, x
, FUNC_NAME
);
353 /* (value-abs x) -> <gdb:value> */
356 gdbscm_value_abs (SCM x
)
358 return vlscm_unop (VALSCM_ABS
, x
, FUNC_NAME
);
361 /* (value-lsh x y) -> <gdb:value> */
364 gdbscm_value_lsh (SCM x
, SCM y
)
366 return vlscm_binop (VALSCM_LSH
, x
, y
, FUNC_NAME
);
369 /* (value-rsh x y) -> <gdb:value> */
372 gdbscm_value_rsh (SCM x
, SCM y
)
374 return vlscm_binop (VALSCM_RSH
, x
, y
, FUNC_NAME
);
377 /* (value-min x y) -> <gdb:value> */
380 gdbscm_value_min (SCM x
, SCM y
)
382 return vlscm_binop (VALSCM_MIN
, x
, y
, FUNC_NAME
);
385 /* (value-max x y) -> <gdb:value> */
388 gdbscm_value_max (SCM x
, SCM y
)
390 return vlscm_binop (VALSCM_MAX
, x
, y
, FUNC_NAME
);
393 /* (value-not x) -> <gdb:value> */
396 gdbscm_value_not (SCM x
)
398 return vlscm_unop (VALSCM_NOT
, x
, FUNC_NAME
);
401 /* (value-lognot x) -> <gdb:value> */
404 gdbscm_value_lognot (SCM x
)
406 return vlscm_unop (VALSCM_LOGNOT
, x
, FUNC_NAME
);
409 /* (value-logand x y) -> <gdb:value> */
412 gdbscm_value_logand (SCM x
, SCM y
)
414 return vlscm_binop (VALSCM_BITAND
, x
, y
, FUNC_NAME
);
417 /* (value-logior x y) -> <gdb:value> */
420 gdbscm_value_logior (SCM x
, SCM y
)
422 return vlscm_binop (VALSCM_BITOR
, x
, y
, FUNC_NAME
);
425 /* (value-logxor x y) -> <gdb:value> */
428 gdbscm_value_logxor (SCM x
, SCM y
)
430 return vlscm_binop (VALSCM_BITXOR
, x
, y
, FUNC_NAME
);
433 /* Utility to perform all value comparisons.
434 If there's an error a Scheme exception is thrown. */
437 vlscm_rich_compare (int op
, SCM x
, SCM y
, const char *func_name
)
439 struct gdbarch
*gdbarch
= get_current_arch ();
440 const struct language_defn
*language
= current_language
;
441 struct value
*v1
, *v2
;
444 struct cleanup
*cleanups
;
445 volatile struct gdb_exception except
;
447 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
449 v1
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG1
, x
,
450 &except_scm
, gdbarch
, language
);
453 do_cleanups (cleanups
);
454 gdbscm_throw (except_scm
);
456 v2
= vlscm_convert_value_from_scheme (func_name
, SCM_ARG2
, y
,
457 &except_scm
, gdbarch
, language
);
460 do_cleanups (cleanups
);
461 gdbscm_throw (except_scm
);
464 TRY_CATCH (except
, RETURN_MASK_ALL
)
469 result
= value_less (v1
, v2
);
472 result
= (value_less (v1
, v2
)
473 || value_equal (v1
, v2
));
476 result
= value_equal (v1
, v2
);
479 gdb_assert_not_reached ("not-equal not implemented");
481 result
= value_less (v2
, v1
);
484 result
= (value_less (v2
, v1
)
485 || value_equal (v1
, v2
));
488 gdb_assert_not_reached ("invalid <gdb:value> comparison");
491 do_cleanups (cleanups
);
492 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
494 return scm_from_bool (result
);
497 /* (value=? x y) -> boolean
498 There is no "not-equal?" function (value!= ?) on purpose.
499 We're following string=?, etc. as our Guide here. */
502 gdbscm_value_eq_p (SCM x
, SCM y
)
504 return vlscm_rich_compare (BINOP_EQUAL
, x
, y
, FUNC_NAME
);
507 /* (value<? x y) -> boolean */
510 gdbscm_value_lt_p (SCM x
, SCM y
)
512 return vlscm_rich_compare (BINOP_LESS
, x
, y
, FUNC_NAME
);
515 /* (value<=? x y) -> boolean */
518 gdbscm_value_le_p (SCM x
, SCM y
)
520 return vlscm_rich_compare (BINOP_LEQ
, x
, y
, FUNC_NAME
);
523 /* (value>? x y) -> boolean */
526 gdbscm_value_gt_p (SCM x
, SCM y
)
528 return vlscm_rich_compare (BINOP_GTR
, x
, y
, FUNC_NAME
);
531 /* (value>=? x y) -> boolean */
534 gdbscm_value_ge_p (SCM x
, SCM y
)
536 return vlscm_rich_compare (BINOP_GEQ
, x
, y
, FUNC_NAME
);
539 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
540 Convert OBJ, a Scheme number, to a <gdb:value> object.
541 OBJ_ARG_POS is its position in the argument list, used in exception text.
543 TYPE is the result type. TYPE_ARG_POS is its position in
544 the argument list, used in exception text.
545 TYPE_SCM is Scheme object wrapping TYPE, used in exception text.
547 If the number isn't representable, e.g. it's too big, a <gdb:exception>
548 object is stored in *EXCEPT_SCMP and NULL is returned.
549 The conversion may throw a gdb error, e.g., if TYPE is invalid. */
551 static struct value
*
552 vlscm_convert_typed_number (const char *func_name
, int obj_arg_pos
, SCM obj
,
553 int type_arg_pos
, SCM type_scm
, struct type
*type
,
554 struct gdbarch
*gdbarch
, SCM
*except_scmp
)
556 if (is_integral_type (type
)
557 || TYPE_CODE (type
) == TYPE_CODE_PTR
)
559 if (TYPE_UNSIGNED (type
))
563 get_unsigned_type_max (type
, &max
);
564 if (!scm_is_unsigned_integer (obj
, 0, max
))
567 = gdbscm_make_out_of_range_error (func_name
,
569 _("value out of range for type"));
572 return value_from_longest (type
, gdbscm_scm_to_ulongest (obj
));
578 get_signed_type_minmax (type
, &min
, &max
);
579 if (!scm_is_signed_integer (obj
, min
, max
))
582 = gdbscm_make_out_of_range_error (func_name
,
584 _("value out of range for type"));
587 return value_from_longest (type
, gdbscm_scm_to_longest (obj
));
590 else if (TYPE_CODE (type
) == TYPE_CODE_FLT
)
591 return value_from_double (type
, scm_to_double (obj
));
594 *except_scmp
= gdbscm_make_type_error (func_name
, obj_arg_pos
, obj
,
600 /* Return non-zero if OBJ, an integer, fits in TYPE. */
603 vlscm_integer_fits_p (SCM obj
, struct type
*type
)
605 if (TYPE_UNSIGNED (type
))
609 /* If scm_is_unsigned_integer can't work with this type, just punt. */
610 if (TYPE_LENGTH (type
) > sizeof (scm_t_uintmax
))
612 get_unsigned_type_max (type
, &max
);
613 return scm_is_unsigned_integer (obj
, 0, max
);
619 /* If scm_is_signed_integer can't work with this type, just punt. */
620 if (TYPE_LENGTH (type
) > sizeof (scm_t_intmax
))
622 get_signed_type_minmax (type
, &min
, &max
);
623 return scm_is_signed_integer (obj
, min
, max
);
627 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
628 Convert OBJ, a Scheme number, to a <gdb:value> object.
629 OBJ_ARG_POS is its position in the argument list, used in exception text.
631 If OBJ is an integer, then the smallest int that will hold the value in
632 the following progression is chosen:
633 int, unsigned int, long, unsigned long, long long, unsigned long long.
634 Otherwise, if OBJ is a real number, then it is converted to a double.
635 Otherwise an exception is thrown.
637 If the number isn't representable, e.g. it's too big, a <gdb:exception>
638 object is stored in *EXCEPT_SCMP and NULL is returned. */
640 static struct value
*
641 vlscm_convert_number (const char *func_name
, int obj_arg_pos
, SCM obj
,
642 struct gdbarch
*gdbarch
, SCM
*except_scmp
)
644 const struct builtin_type
*bt
= builtin_type (gdbarch
);
646 /* One thing to keep in mind here is that we are interested in the
647 target's representation of OBJ, not the host's. */
649 if (scm_is_exact (obj
) && scm_is_integer (obj
))
651 if (vlscm_integer_fits_p (obj
, bt
->builtin_int
))
652 return value_from_longest (bt
->builtin_int
,
653 gdbscm_scm_to_longest (obj
));
654 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_int
))
655 return value_from_longest (bt
->builtin_unsigned_int
,
656 gdbscm_scm_to_ulongest (obj
));
657 if (vlscm_integer_fits_p (obj
, bt
->builtin_long
))
658 return value_from_longest (bt
->builtin_long
,
659 gdbscm_scm_to_longest (obj
));
660 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_long
))
661 return value_from_longest (bt
->builtin_unsigned_long
,
662 gdbscm_scm_to_ulongest (obj
));
663 if (vlscm_integer_fits_p (obj
, bt
->builtin_long_long
))
664 return value_from_longest (bt
->builtin_long_long
,
665 gdbscm_scm_to_longest (obj
));
666 if (vlscm_integer_fits_p (obj
, bt
->builtin_unsigned_long_long
))
667 return value_from_longest (bt
->builtin_unsigned_long_long
,
668 gdbscm_scm_to_ulongest (obj
));
670 else if (scm_is_real (obj
))
671 return value_from_double (bt
->builtin_double
, scm_to_double (obj
));
673 *except_scmp
= gdbscm_make_out_of_range_error (func_name
, obj_arg_pos
, obj
,
674 _("value not a number representable on the target"));
678 /* Subroutine of vlscm_convert_typed_value_from_scheme to simplify it.
679 Convert BV, a Scheme bytevector, to a <gdb:value> object.
681 TYPE, if non-NULL, is the result type. Otherwise, a vector of type
683 TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
684 or #f if TYPE is NULL.
686 If the bytevector isn't the same size as the type, then a <gdb:exception>
687 object is stored in *EXCEPT_SCMP, and NULL is returned. */
689 static struct value
*
690 vlscm_convert_bytevector (SCM bv
, struct type
*type
, SCM type_scm
,
691 int arg_pos
, const char *func_name
,
692 SCM
*except_scmp
, struct gdbarch
*gdbarch
)
694 LONGEST length
= SCM_BYTEVECTOR_LENGTH (bv
);
699 type
= builtin_type (gdbarch
)->builtin_uint8
;
700 type
= lookup_array_range_type (type
, 0, length
);
701 make_vector_type (type
);
703 type
= check_typedef (type
);
704 if (TYPE_LENGTH (type
) != length
)
706 *except_scmp
= gdbscm_make_out_of_range_error (func_name
, arg_pos
,
708 _("size of type does not match size of bytevector"));
712 value
= value_from_contents (type
,
713 (gdb_byte
*) SCM_BYTEVECTOR_CONTENTS (bv
));
717 /* Convert OBJ, a Scheme value, to a <gdb:value> object.
718 OBJ_ARG_POS is its position in the argument list, used in exception text.
720 TYPE, if non-NULL, is the result type which must be compatible with
721 the value being converted.
722 If TYPE is NULL then a suitable default type is chosen.
723 TYPE_SCM is Scheme object wrapping TYPE, used in exception text,
724 or SCM_UNDEFINED if TYPE is NULL.
725 TYPE_ARG_POS is its position in the argument list, used in exception text,
726 or -1 if TYPE is NULL.
728 OBJ may also be a <gdb:value> object, in which case a copy is returned
729 and TYPE must be NULL.
731 If the value cannot be converted, NULL is returned and a gdb:exception
732 object is stored in *EXCEPT_SCMP.
733 Otherwise the new value is returned, added to the all_values chain. */
736 vlscm_convert_typed_value_from_scheme (const char *func_name
,
737 int obj_arg_pos
, SCM obj
,
738 int type_arg_pos
, SCM type_scm
,
741 struct gdbarch
*gdbarch
,
742 const struct language_defn
*language
)
744 struct value
*value
= NULL
;
745 SCM except_scm
= SCM_BOOL_F
;
746 volatile struct gdb_exception except
;
750 gdb_assert (type_arg_pos
== -1);
751 gdb_assert (SCM_UNBNDP (type_scm
));
754 *except_scmp
= SCM_BOOL_F
;
756 TRY_CATCH (except
, RETURN_MASK_ALL
)
758 if (vlscm_is_value (obj
))
762 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
764 _("No type allowed"));
768 value
= value_copy (vlscm_scm_to_value (obj
));
770 else if (gdbscm_is_true (scm_bytevector_p (obj
)))
772 value
= vlscm_convert_bytevector (obj
, type
, type_scm
,
773 obj_arg_pos
, func_name
,
774 &except_scm
, gdbarch
);
776 else if (gdbscm_is_bool (obj
))
779 && !is_integral_type (type
))
781 except_scm
= gdbscm_make_type_error (func_name
, type_arg_pos
,
786 value
= value_from_longest (type
788 : language_bool_type (language
,
790 gdbscm_is_true (obj
));
793 else if (scm_is_number (obj
))
797 value
= vlscm_convert_typed_number (func_name
, obj_arg_pos
, obj
,
798 type_arg_pos
, type_scm
, type
,
799 gdbarch
, &except_scm
);
803 value
= vlscm_convert_number (func_name
, obj_arg_pos
, obj
,
804 gdbarch
, &except_scm
);
807 else if (scm_is_string (obj
))
811 struct cleanup
*cleanup
;
815 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
817 _("No type allowed"));
822 /* TODO: Provide option to specify conversion strategy. */
823 s
= gdbscm_scm_to_string (obj
, &len
,
824 target_charset (gdbarch
),
829 cleanup
= make_cleanup (xfree
, s
);
831 = value_cstring (s
, len
,
832 language_string_char_type (language
,
834 do_cleanups (cleanup
);
840 else if (lsscm_is_lazy_string (obj
))
844 except_scm
= gdbscm_make_misc_error (func_name
, type_arg_pos
,
846 _("No type allowed"));
851 value
= lsscm_safe_lazy_string_to_value (obj
, obj_arg_pos
,
856 else /* OBJ isn't anything we support. */
858 except_scm
= gdbscm_make_type_error (func_name
, obj_arg_pos
, obj
,
863 if (except
.reason
< 0)
864 except_scm
= gdbscm_scm_from_gdb_exception (except
);
866 if (gdbscm_is_true (except_scm
))
868 gdb_assert (value
== NULL
);
869 *except_scmp
= except_scm
;
875 /* Wrapper around vlscm_convert_typed_value_from_scheme for cases where there
876 is no supplied type. See vlscm_convert_typed_value_from_scheme for
880 vlscm_convert_value_from_scheme (const char *func_name
,
881 int obj_arg_pos
, SCM obj
,
882 SCM
*except_scmp
, struct gdbarch
*gdbarch
,
883 const struct language_defn
*language
)
885 return vlscm_convert_typed_value_from_scheme (func_name
, obj_arg_pos
, obj
,
886 -1, SCM_UNDEFINED
, NULL
,
891 /* Initialize value math support. */
893 static const scheme_function math_functions
[] =
895 { "value-add", 2, 0, 0, gdbscm_value_add
,
899 { "value-sub", 2, 0, 0, gdbscm_value_sub
,
903 { "value-mul", 2, 0, 0, gdbscm_value_mul
,
907 { "value-div", 2, 0, 0, gdbscm_value_div
,
911 { "value-rem", 2, 0, 0, gdbscm_value_rem
,
915 { "value-mod", 2, 0, 0, gdbscm_value_mod
,
917 Return a mod b. See Knuth 1.2.4." },
919 { "value-pow", 2, 0, 0, gdbscm_value_pow
,
921 Return pow (x, y)." },
923 { "value-not", 1, 0, 0, gdbscm_value_not
,
927 { "value-neg", 1, 0, 0, gdbscm_value_neg
,
931 { "value-pos", 1, 0, 0, gdbscm_value_pos
,
935 { "value-abs", 1, 0, 0, gdbscm_value_abs
,
939 { "value-lsh", 2, 0, 0, gdbscm_value_lsh
,
943 { "value-rsh", 2, 0, 0, gdbscm_value_rsh
,
947 { "value-min", 2, 0, 0, gdbscm_value_min
,
949 Return min (a, b)." },
951 { "value-max", 2, 0, 0, gdbscm_value_max
,
953 Return max (a, b)." },
955 { "value-lognot", 1, 0, 0, gdbscm_value_lognot
,
959 { "value-logand", 2, 0, 0, gdbscm_value_logand
,
963 { "value-logior", 2, 0, 0, gdbscm_value_logior
,
967 { "value-logxor", 2, 0, 0, gdbscm_value_logxor
,
971 { "value=?", 2, 0, 0, gdbscm_value_eq_p
,
975 { "value<?", 2, 0, 0, gdbscm_value_lt_p
,
979 { "value<=?", 2, 0, 0, gdbscm_value_le_p
,
983 { "value>?", 2, 0, 0, gdbscm_value_gt_p
,
987 { "value>=?", 2, 0, 0, gdbscm_value_ge_p
,
995 gdbscm_initialize_math (void)
997 gdbscm_define_functions (math_functions
, 1);