+2021-01-06 Tom Tromey <tromey@adacore.com>
+
+ * ada-lang.c (ada_evaluate_subexp) <BINOP_ADD, BINOP_SUB>:
+ Do not cast result.
+ * valarith.c (fixed_point_binop): Handle multiplication
+ and division specially.
+ * valops.c (value_to_gdb_mpq): New function.
+ (value_cast_to_fixed_point): Use it.
+
2021-01-05 Hannes Domani <ssbssa@yahoo.de>
* tui/tui-winsource.c (tui_source_window_base::refresh_window):
return (value_from_longest
(value_type (arg2),
value_as_long (arg1) + value_as_long (arg2)));
- if ((ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
- || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- && value_type (arg1) != value_type (arg2))
- error (_("Operands of fixed-point addition must have the same type"));
- /* Do the addition, and cast the result to the type of the first
- argument. We cannot cast the result to a reference type, so if
- ARG1 is a reference type, find its underlying type. */
+ /* Preserve the original type for use by the range case below.
+ We cannot cast the result to a reference type, so if ARG1 is
+ a reference type, find its underlying type. */
type = value_type (arg1);
while (type->code () == TYPE_CODE_REF)
type = TYPE_TARGET_TYPE (type);
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_cast (type, value_binop (arg1, arg2, BINOP_ADD));
+ if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
+ || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
+ {
+ if (value_type (arg1) != value_type (arg2))
+ error (_("Operands of fixed-point addition must have the same type"));
+ }
+ else
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ arg1 = value_binop (arg1, arg2, BINOP_ADD);
+ /* We need to special-case the result of adding to a range.
+ This is done for the benefit of "ptype". gdb's Ada support
+ historically used the LHS to set the result type here, so
+ preserve this behavior. */
+ if (type->code () == TYPE_CODE_RANGE)
+ arg1 = value_cast (type, arg1);
+ return arg1;
case BINOP_SUB:
arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
return (value_from_longest
(value_type (arg2),
value_as_long (arg1) - value_as_long (arg2)));
- if ((ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
- || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- && value_type (arg1) != value_type (arg2))
- error (_("Operands of fixed-point subtraction "
- "must have the same type"));
- /* Do the substraction, and cast the result to the type of the first
- argument. We cannot cast the result to a reference type, so if
- ARG1 is a reference type, find its underlying type. */
+ /* Preserve the original type for use by the range case below.
+ We cannot cast the result to a reference type, so if ARG1 is
+ a reference type, find its underlying type. */
type = value_type (arg1);
while (type->code () == TYPE_CODE_REF)
type = TYPE_TARGET_TYPE (type);
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_cast (type, value_binop (arg1, arg2, BINOP_SUB));
+ if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1))
+ || ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
+ {
+ if (value_type (arg1) != value_type (arg2))
+ error (_("Operands of fixed-point subtraction "
+ "must have the same type"));
+ }
+ else
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ arg1 = value_binop (arg1, arg2, BINOP_SUB);
+ /* We need to special-case the result of adding to a range.
+ This is done for the benefit of "ptype". gdb's Ada support
+ historically used the LHS to set the result type here, so
+ preserve this behavior. */
+ if (type->code () == TYPE_CODE_RANGE)
+ arg1 = value_cast (type, arg1);
+ return arg1;
case BINOP_MUL:
case BINOP_DIV:
+2021-01-06 Tom Tromey <tromey@adacore.com>
+
+ * gdb.ada/fixed_points/pck.ads (Delta4): New constant.
+ (FP4_Type): New type.
+ (FP4_Var): New variable.
+ * gdb.ada/fixed_points/fixed_points.adb: Update.
+ * gdb.ada/fixed_points.exp: Add tests for binary operators.
+
2021-01-06 Simon Marchi <simon.marchi@polymtl.ca>
* lib/gdb.exp (gdb_test_sequence): Accept -prompt switch.
pass $gdb_test_name
}
}
+
+ # One of the benefits of minimal encoding is that operations work
+ # a bit better.
+ if {$scenario == "minimal"} {
+ gdb_test "print fp2_var + 0" \
+ " = -0.01"
+ gdb_test "print 0 + fp2_var" \
+ " = -0.01"
+ gdb_test "print fp2_var - 0" \
+ " = -0.01"
+
+ set fp4 "= 2e-07"
+ gdb_test "print fp4_var" $fp4
+ gdb_test "print fp4_var * 1" $fp4
+ gdb_test "print 1 * fp4_var" $fp4
+ gdb_test "print fp4_var / 1" $fp4
+ }
}
Do_Nothing (FP1_Var'Address);
Do_Nothing (FP2_Var'Address);
Do_Nothing (FP3_Var'Address);
+ Do_Nothing (FP4_Var'Address);
end Fixed_Points;
type FP3_Type is delta 0.1 range 0.0 .. 1.0 with Small => 0.1/3.0;
FP3_Var : FP3_Type := 0.1;
+ Delta4 : constant := 0.000_000_1;
+ type FP4_Type is delta Delta4 range 0.0 .. Delta4 * 10
+ with Small => Delta4 / 3.0;
+ FP4_Var : FP4_Type := 2 * Delta4;
+
procedure Do_Nothing (A : System.Address);
end pck;
struct gdbarch *gdbarch = get_type_arch (type1);
struct value *val;
+ gdb_mpq v1, v2, res;
+
gdb_assert (is_fixed_point_type (type1) || is_fixed_point_type (type2));
- if (!is_fixed_point_type (type1))
+ if (op == BINOP_MUL || op == BINOP_DIV)
{
- arg1 = value_cast (type2, arg1);
- type1 = type2;
+ v1 = value_to_gdb_mpq (arg1);
+ v2 = value_to_gdb_mpq (arg2);
+
+ /* The code below uses TYPE1 for the result type, so make sure
+ it is set properly. */
+ if (!is_fixed_point_type (type1))
+ type1 = type2;
}
- if (!is_fixed_point_type (type2))
+ else
{
- arg2 = value_cast (type1, arg2);
- type2 = type1;
- }
+ if (!is_fixed_point_type (type1))
+ {
+ arg1 = value_cast (type2, arg1);
+ type1 = type2;
+ }
+ if (!is_fixed_point_type (type2))
+ {
+ arg2 = value_cast (type1, arg2);
+ type2 = type1;
+ }
- gdb_mpq v1, v2, res;
- v1.read_fixed_point (gdb::make_array_view (value_contents (arg1),
- TYPE_LENGTH (type1)),
- type_byte_order (type1), type1->is_unsigned (),
- type1->fixed_point_scaling_factor ());
- v2.read_fixed_point (gdb::make_array_view (value_contents (arg2),
- TYPE_LENGTH (type2)),
- type_byte_order (type2), type2->is_unsigned (),
- type2->fixed_point_scaling_factor ());
+ v1.read_fixed_point (gdb::make_array_view (value_contents (arg1),
+ TYPE_LENGTH (type1)),
+ type_byte_order (type1), type1->is_unsigned (),
+ type1->fixed_point_scaling_factor ());
+ v2.read_fixed_point (gdb::make_array_view (value_contents (arg2),
+ TYPE_LENGTH (type2)),
+ type_byte_order (type2), type2->is_unsigned (),
+ type2->fixed_point_scaling_factor ());
+ }
auto fixed_point_to_value = [type1] (const gdb_mpq &fp)
{
return arg2;
}
+/* See value.h. */
+
+gdb_mpq
+value_to_gdb_mpq (struct value *value)
+{
+ struct type *type = check_typedef (value_type (value));
+
+ gdb_mpq result;
+ if (is_floating_type (type))
+ {
+ double d = target_float_to_host_double (value_contents (value),
+ type);
+ mpq_set_d (result.val, d);
+ }
+ else
+ {
+ gdb_assert (is_integral_type (type)
+ || is_fixed_point_type (type));
+
+ gdb_mpz vz;
+ vz.read (gdb::make_array_view (value_contents (value),
+ TYPE_LENGTH (type)),
+ type_byte_order (type), type->is_unsigned ());
+ mpq_set_z (result.val, vz.val);
+
+ if (is_fixed_point_type (type))
+ mpq_mul (result.val, result.val,
+ type->fixed_point_scaling_factor ().val);
+ }
+
+ return result;
+}
+
/* Assuming that TO_TYPE is a fixed point type, return a value
corresponding to the cast of FROM_VAL to that type. */
if (from_type == to_type)
return from_val;
- gdb_mpq vq;
-
- /* Extract the value as a rational number. */
-
- if (is_floating_type (from_type))
- {
- double d = target_float_to_host_double (value_contents (from_val),
- from_type);
- mpq_set_d (vq.val, d);
- }
-
- else if (is_integral_type (from_type) || is_fixed_point_type (from_type))
- {
- gdb_mpz vz;
-
- vz.read (gdb::make_array_view (value_contents (from_val),
- TYPE_LENGTH (from_type)),
- type_byte_order (from_type), from_type->is_unsigned ());
- mpq_set_z (vq.val, vz.val);
-
- if (is_fixed_point_type (from_type))
- mpq_mul (vq.val, vq.val, from_type->fixed_point_scaling_factor ().val);
- }
-
- else
+ if (!is_floating_type (from_type)
+ && !is_integral_type (from_type)
+ && !is_fixed_point_type (from_type))
error (_("Invalid conversion from type %s to fixed point type %s"),
from_type->name (), to_type->name ());
+ gdb_mpq vq = value_to_gdb_mpq (from_val);
+
/* Divide that value by the scaling factor to obtain the unscaled
value, first in rational form, and then in integer form. */
#include "frame.h" /* For struct frame_id. */
#include "extension.h"
#include "gdbsupport/gdb_ref_ptr.h"
+#include "gmp-utils.h"
struct block;
struct expression;
exiting (e.g., on quit_force). */
extern void finalize_values ();
+/* Convert VALUE to a gdb_mpq. The caller must ensure that VALUE is
+ of floating-point, fixed-point, or integer type. */
+extern gdb_mpq value_to_gdb_mpq (struct value *value);
+
#endif /* !defined (VALUE_H) */
projects / thirdparty / binutils-gdb.git / commitdiff
