+/* A helper function for OP_ATR_SIZE. */
+
+value *
+ada_atr_size (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ struct type *type = value_type (arg1);
+
+ /* If the argument is a reference, then dereference its type, since
+ the user is really asking for the size of the actual object,
+ not the size of the pointer. */
+ if (type->code () == TYPE_CODE_REF)
+ type = TYPE_TARGET_TYPE (type);
+
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (builtin_type (exp->gdbarch)->builtin_int, not_lval);
+ else
+ return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
+ TARGET_CHAR_BIT * TYPE_LENGTH (type));
+}
+
+/* A helper function for UNOP_ABS. */
+
+value *
+ada_abs (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
+ return value_neg (arg1);
+ else
+ return arg1;
+}
+
+/* A helper function for BINOP_MUL. */
+
+value *
+ada_mult_binop (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_zero (value_type (arg1), not_lval);
+ }
+ else
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return ada_value_binop (arg1, arg2, op);
+ }
+}
+
+/* A helper function for BINOP_EQUAL and BINOP_NOTEQUAL. */
+
+value *
+ada_equal_binop (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ int tem;
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ tem = 0;
+ else
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ tem = ada_value_equal (arg1, arg2);
+ }
+ if (op == BINOP_NOTEQUAL)
+ tem = !tem;
+ struct type *type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_from_longest (type, (LONGEST) tem);
+}
+
+/* A helper function for TERNOP_SLICE. */
+
+value *
+ada_ternop_slice (struct expression *exp,
+ enum noside noside,
+ struct value *array, struct value *low_bound_val,
+ struct value *high_bound_val)
+{
+ LONGEST low_bound;
+ LONGEST high_bound;
+
+ low_bound_val = coerce_ref (low_bound_val);
+ high_bound_val = coerce_ref (high_bound_val);
+ low_bound = value_as_long (low_bound_val);
+ high_bound = value_as_long (high_bound_val);
+
+ /* If this is a reference to an aligner type, then remove all
+ the aligners. */
+ if (value_type (array)->code () == TYPE_CODE_REF
+ && ada_is_aligner_type (TYPE_TARGET_TYPE (value_type (array))))
+ TYPE_TARGET_TYPE (value_type (array)) =
+ ada_aligned_type (TYPE_TARGET_TYPE (value_type (array)));
+
+ if (ada_is_any_packed_array_type (value_type (array)))
+ error (_("cannot slice a packed array"));
+
+ /* If this is a reference to an array or an array lvalue,
+ convert to a pointer. */
+ if (value_type (array)->code () == TYPE_CODE_REF
+ || (value_type (array)->code () == TYPE_CODE_ARRAY
+ && VALUE_LVAL (array) == lval_memory))
+ array = value_addr (array);
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS
+ && ada_is_array_descriptor_type (ada_check_typedef
+ (value_type (array))))
+ return empty_array (ada_type_of_array (array, 0), low_bound,
+ high_bound);
+
+ array = ada_coerce_to_simple_array_ptr (array);
+
+ /* If we have more than one level of pointer indirection,
+ dereference the value until we get only one level. */
+ while (value_type (array)->code () == TYPE_CODE_PTR
+ && (TYPE_TARGET_TYPE (value_type (array))->code ()
+ == TYPE_CODE_PTR))
+ array = value_ind (array);
+
+ /* Make sure we really do have an array type before going further,
+ to avoid a SEGV when trying to get the index type or the target
+ type later down the road if the debug info generated by
+ the compiler is incorrect or incomplete. */
+ if (!ada_is_simple_array_type (value_type (array)))
+ error (_("cannot take slice of non-array"));
+
+ if (ada_check_typedef (value_type (array))->code ()
+ == TYPE_CODE_PTR)
+ {
+ struct type *type0 = ada_check_typedef (value_type (array));
+
+ if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
+ return empty_array (TYPE_TARGET_TYPE (type0), low_bound, high_bound);
+ else
+ {
+ struct type *arr_type0 =
+ to_fixed_array_type (TYPE_TARGET_TYPE (type0), NULL, 1);
+
+ return ada_value_slice_from_ptr (array, arr_type0,
+ longest_to_int (low_bound),
+ longest_to_int (high_bound));
+ }
+ }
+ else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return array;
+ else if (high_bound < low_bound)
+ return empty_array (value_type (array), low_bound, high_bound);
+ else
+ return ada_value_slice (array, longest_to_int (low_bound),
+ longest_to_int (high_bound));
+}
+
+/* A helper function for BINOP_IN_BOUNDS. */
+
+value *
+ada_binop_in_bounds (struct expression *exp, enum noside noside,
+ struct value *arg1, struct value *arg2, int n)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ struct type *type = language_bool_type (exp->language_defn,
+ exp->gdbarch);
+ return value_zero (type, not_lval);
+ }
+
+ struct type *type = ada_index_type (value_type (arg2), n, "range");
+ if (!type)
+ type = value_type (arg1);
+
+ value *arg3 = value_from_longest (type, ada_array_bound (arg2, n, 1));
+ arg2 = value_from_longest (type, ada_array_bound (arg2, n, 0));
+
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_from_longest (type,
+ (value_less (arg1, arg3)
+ || value_equal (arg1, arg3))
+ && (value_less (arg2, arg1)
+ || value_equal (arg2, arg1)));
+}
+
+/* A helper function for some attribute operations. */
+
+static value *
+ada_unop_atr (struct expression *exp, enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct type *type_arg, int tem)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ if (type_arg == NULL)
+ type_arg = value_type (arg1);
+
+ if (ada_is_constrained_packed_array_type (type_arg))
+ type_arg = decode_constrained_packed_array_type (type_arg);
+
+ if (!discrete_type_p (type_arg))
+ {
+ switch (op)
+ {
+ default: /* Should never happen. */
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ case OP_ATR_LAST:
+ type_arg = ada_index_type (type_arg, tem,
+ ada_attribute_name (op));
+ break;
+ case OP_ATR_LENGTH:
+ type_arg = builtin_type (exp->gdbarch)->builtin_int;
+ break;
+ }
+ }
+
+ return value_zero (type_arg, not_lval);
+ }
+ else if (type_arg == NULL)
+ {
+ arg1 = ada_coerce_ref (arg1);
+
+ if (ada_is_constrained_packed_array_type (value_type (arg1)))
+ arg1 = ada_coerce_to_simple_array (arg1);
+
+ struct type *type;
+ if (op == OP_ATR_LENGTH)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ else
+ {
+ type = ada_index_type (value_type (arg1), tem,
+ ada_attribute_name (op));
+ if (type == NULL)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ }
+
+ switch (op)
+ {
+ default: /* Should never happen. */
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ return value_from_longest
+ (type, ada_array_bound (arg1, tem, 0));
+ case OP_ATR_LAST:
+ return value_from_longest
+ (type, ada_array_bound (arg1, tem, 1));
+ case OP_ATR_LENGTH:
+ return value_from_longest
+ (type, ada_array_length (arg1, tem));
+ }
+ }
+ else if (discrete_type_p (type_arg))
+ {
+ struct type *range_type;
+ const char *name = ada_type_name (type_arg);
+
+ range_type = NULL;
+ if (name != NULL && type_arg->code () != TYPE_CODE_ENUM)
+ range_type = to_fixed_range_type (type_arg, NULL);
+ if (range_type == NULL)
+ range_type = type_arg;
+ switch (op)
+ {
+ default:
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ return value_from_longest
+ (range_type, ada_discrete_type_low_bound (range_type));
+ case OP_ATR_LAST:
+ return value_from_longest
+ (range_type, ada_discrete_type_high_bound (range_type));
+ case OP_ATR_LENGTH:
+ error (_("the 'length attribute applies only to array types"));
+ }
+ }
+ else if (type_arg->code () == TYPE_CODE_FLT)
+ error (_("unimplemented type attribute"));
+ else
+ {
+ LONGEST low, high;
+
+ if (ada_is_constrained_packed_array_type (type_arg))
+ type_arg = decode_constrained_packed_array_type (type_arg);
+
+ struct type *type;
+ if (op == OP_ATR_LENGTH)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ else
+ {
+ type = ada_index_type (type_arg, tem, ada_attribute_name (op));
+ if (type == NULL)
+ type = builtin_type (exp->gdbarch)->builtin_int;
+ }
+
+ switch (op)
+ {
+ default:
+ error (_("unexpected attribute encountered"));
+ case OP_ATR_FIRST:
+ low = ada_array_bound_from_type (type_arg, tem, 0);
+ return value_from_longest (type, low);
+ case OP_ATR_LAST:
+ high = ada_array_bound_from_type (type_arg, tem, 1);
+ return value_from_longest (type, high);
+ case OP_ATR_LENGTH:
+ low = ada_array_bound_from_type (type_arg, tem, 0);
+ high = ada_array_bound_from_type (type_arg, tem, 1);
+ return value_from_longest (type, high - low + 1);
+ }
+ }
+}
+
+/* A helper function for OP_ATR_MIN and OP_ATR_MAX. */
+
+struct value *
+ada_binop_minmax (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (value_type (arg1), not_lval);
+ else
+ {
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+ return value_binop (arg1, arg2,
+ op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
+ }
+}
+
+/* A helper function for BINOP_EXP. */
+
+static struct value *
+ada_binop_exp (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct value *arg2)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (value_type (arg1), not_lval);
+ else
+ {
+ /* For integer exponentiation operations,
+ only promote the first argument. */
+ if (is_integral_type (value_type (arg2)))
+ unop_promote (exp->language_defn, exp->gdbarch, &arg1);
+ else
+ binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
+
+ return value_binop (arg1, arg2, op);
+ }
+}
+
+namespace expr
+{
+
+value *
+ada_wrapped_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *result = std::get<0> (m_storage)->evaluate (expect_type, exp, noside);
+ if (noside == EVAL_NORMAL)
+ result = unwrap_value (result);
+
+ /* If evaluating an OP_FLOAT and an EXPECT_TYPE was provided,
+ then we need to perform the conversion manually, because
+ evaluate_subexp_standard doesn't do it. This conversion is
+ necessary in Ada because the different kinds of float/fixed
+ types in Ada have different representations.
+
+ Similarly, we need to perform the conversion from OP_LONG
+ ourselves. */
+ if ((opcode () == OP_FLOAT || opcode () == OP_LONG) && expect_type != NULL)
+ result = ada_value_cast (expect_type, result);
+
+ return result;
+}
+
+value *
+ada_string_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *result = string_operation::evaluate (expect_type, exp, noside);
+ /* The result type will have code OP_STRING, bashed there from
+ OP_ARRAY. Bash it back. */
+ if (value_type (result)->code () == TYPE_CODE_STRING)
+ value_type (result)->set_code (TYPE_CODE_ARRAY);
+ return result;
+}
+
+value *
+ada_qual_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ struct type *type = std::get<1> (m_storage);
+ return std::get<0> (m_storage)->evaluate (type, exp, noside);
+}
+
+value *
+ada_ternop_range_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg0 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
+ value *arg1 = std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
+ value *arg2 = std::get<2> (m_storage)->evaluate (nullptr, exp, noside);
+ return eval_ternop_in_range (expect_type, exp, noside, arg0, arg1, arg2);
+}
+
+value *
+ada_binop_addsub_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg1 = std::get<1> (m_storage)->evaluate_with_coercion (exp, noside);
+ value *arg2 = std::get<2> (m_storage)->evaluate_with_coercion (exp, noside);
+
+ auto do_op = [=] (LONGEST x, LONGEST y)
+ {
+ if (std::get<0> (m_storage) == BINOP_ADD)
+ return x + y;
+ return x - y;
+ };
+
+ if (value_type (arg1)->code () == TYPE_CODE_PTR)
+ return (value_from_longest
+ (value_type (arg1),
+ do_op (value_as_long (arg1), value_as_long (arg2))));
+ if (value_type (arg2)->code () == TYPE_CODE_PTR)
+ return (value_from_longest
+ (value_type (arg2),
+ do_op (value_as_long (arg1), value_as_long (arg2))));
+ /* 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. */
+ struct 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);
+ arg1 = value_binop (arg1, arg2, std::get<0> (m_storage));
+ /* We need to special-case the result with 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;
+}
+
+value *
+ada_unop_atr_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ struct type *type_arg = nullptr;
+ value *val = nullptr;
+
+ if (std::get<0> (m_storage)->opcode () == OP_TYPE)
+ {
+ value *tem = std::get<0> (m_storage)->evaluate (nullptr, exp,
+ EVAL_AVOID_SIDE_EFFECTS);
+ type_arg = value_type (tem);
+ }
+ else
+ val = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
+
+ return ada_unop_atr (exp, noside, std::get<1> (m_storage),
+ val, type_arg, std::get<2> (m_storage));
+}
+
+value *
+ada_var_msym_value_operation::evaluate_for_cast (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (expect_type, not_lval);
+
+ value *val = evaluate_var_msym_value (noside,
+ std::get<1> (m_storage),
+ std::get<0> (m_storage));
+
+ val = ada_value_cast (expect_type, val);
+
+ /* Follow the Ada language semantics that do not allow taking
+ an address of the result of a cast (view conversion in Ada). */
+ if (VALUE_LVAL (val) == lval_memory)
+ {
+ if (value_lazy (val))
+ value_fetch_lazy (val);
+ VALUE_LVAL (val) = not_lval;
+ }
+ return val;
+}
+
+value *
+ada_var_value_operation::evaluate_for_cast (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *val = evaluate_var_value (noside,
+ std::get<1> (m_storage),
+ std::get<0> (m_storage));
+
+ val = ada_value_cast (expect_type, val);
+
+ /* Follow the Ada language semantics that do not allow taking
+ an address of the result of a cast (view conversion in Ada). */
+ if (VALUE_LVAL (val) == lval_memory)
+ {
+ if (value_lazy (val))
+ value_fetch_lazy (val);
+ VALUE_LVAL (val) = not_lval;
+ }
+ return val;
+}
+
+value *
+ada_var_value_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ symbol *sym = std::get<0> (m_storage);
+
+ if (SYMBOL_DOMAIN (sym) == UNDEF_DOMAIN)
+ /* Only encountered when an unresolved symbol occurs in a
+ context other than a function call, in which case, it is
+ invalid. */
+ error (_("Unexpected unresolved symbol, %s, during evaluation"),
+ sym->print_name ());
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ struct type *type = static_unwrap_type (SYMBOL_TYPE (sym));
+ /* Check to see if this is a tagged type. We also need to handle
+ the case where the type is a reference to a tagged type, but
+ we have to be careful to exclude pointers to tagged types.
+ The latter should be shown as usual (as a pointer), whereas
+ a reference should mostly be transparent to the user. */
+ if (ada_is_tagged_type (type, 0)
+ || (type->code () == TYPE_CODE_REF
+ && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
+ {
+ /* Tagged types are a little special in the fact that the real
+ type is dynamic and can only be determined by inspecting the
+ object's tag. This means that we need to get the object's
+ value first (EVAL_NORMAL) and then extract the actual object
+ type from its tag.
+
+ Note that we cannot skip the final step where we extract
+ the object type from its tag, because the EVAL_NORMAL phase
+ results in dynamic components being resolved into fixed ones.
+ This can cause problems when trying to print the type
+ description of tagged types whose parent has a dynamic size:
+ We use the type name of the "_parent" component in order
+ to print the name of the ancestor type in the type description.
+ If that component had a dynamic size, the resolution into
+ a fixed type would result in the loss of that type name,
+ thus preventing us from printing the name of the ancestor
+ type in the type description. */
+ value *arg1 = var_value_operation::evaluate (nullptr, exp,
+ EVAL_NORMAL);
+
+ if (type->code () != TYPE_CODE_REF)
+ {
+ struct type *actual_type;
+
+ actual_type = type_from_tag (ada_value_tag (arg1));
+ if (actual_type == NULL)
+ /* If, for some reason, we were unable to determine
+ the actual type from the tag, then use the static
+ approximation that we just computed as a fallback.
+ This can happen if the debugging information is
+ incomplete, for instance. */
+ actual_type = type;
+ return value_zero (actual_type, not_lval);
+ }
+ else
+ {
+ /* In the case of a ref, ada_coerce_ref takes care
+ of determining the actual type. But the evaluation
+ should return a ref as it should be valid to ask
+ for its address; so rebuild a ref after coerce. */
+ arg1 = ada_coerce_ref (arg1);
+ return value_ref (arg1, TYPE_CODE_REF);
+ }
+ }
+
+ /* Records and unions for which GNAT encodings have been
+ generated need to be statically fixed as well.
+ Otherwise, non-static fixing produces a type where
+ all dynamic properties are removed, which prevents "ptype"
+ from being able to completely describe the type.
+ For instance, a case statement in a variant record would be
+ replaced by the relevant components based on the actual
+ value of the discriminants. */
+ if ((type->code () == TYPE_CODE_STRUCT
+ && dynamic_template_type (type) != NULL)
+ || (type->code () == TYPE_CODE_UNION
+ && ada_find_parallel_type (type, "___XVU") != NULL))
+ return value_zero (to_static_fixed_type (type), not_lval);
+ }
+
+ value *arg1 = var_value_operation::evaluate (expect_type, exp, noside);
+ return ada_to_fixed_value (arg1);
+}
+
+}
+
+/* Implement the evaluate_exp routine in the exp_descriptor structure
+ for the Ada language. */
+
+static struct value *
+ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
+ int *pos, enum noside noside)
+{
+ enum exp_opcode op;
+ int tem;
+ int pc;
+ int preeval_pos;
+ struct value *arg1 = NULL, *arg2 = NULL, *arg3;
+ struct type *type;
+ int nargs, oplen;
+ struct value **argvec;
+
+ pc = *pos;
+ *pos += 1;
+ op = exp->elts[pc].opcode;
+
+ switch (op)
+ {
+ default:
+ *pos -= 1;
+ arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
+
+ if (noside == EVAL_NORMAL)
+ arg1 = unwrap_value (arg1);
+
+ /* If evaluating an OP_FLOAT and an EXPECT_TYPE was provided,
+ then we need to perform the conversion manually, because
+ evaluate_subexp_standard doesn't do it. This conversion is
+ necessary in Ada because the different kinds of float/fixed
+ types in Ada have different representations.
+
+ Similarly, we need to perform the conversion from OP_LONG
+ ourselves. */
+ if ((op == OP_FLOAT || op == OP_LONG) && expect_type != NULL)
+ arg1 = ada_value_cast (expect_type, arg1);
+
+ return arg1;
+
+ case OP_STRING:
+ {
projects / deliverable / binutils-gdb.git / blobdiff