#include "gdbsupport/function-view.h"
#include "gdbsupport/byte-vector.h"
#include <algorithm>
+#include "ada-exp.h"
/* Define whether or not the C operator '/' truncates towards zero for
differently signed operands (truncation direction is undefined in C).
static struct value *val_atr (struct type *, LONGEST);
-static struct value *value_val_atr (struct type *, struct value *);
-
static struct symbol *standard_lookup (const char *, const struct block *,
domain_enum);
return n_chosen;
}
+/* See ada-lang.h. */
+
+block_symbol
+ada_find_operator_symbol (enum exp_opcode op, int parse_completion,
+ int nargs, value *argvec[])
+{
+ if (possible_user_operator_p (op, argvec))
+ {
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (ada_decoded_op_name (op),
+ NULL, VAR_DOMAIN);
+
+ int i = ada_resolve_function (candidates, argvec,
+ nargs, ada_decoded_op_name (op), NULL,
+ parse_completion);
+ if (i >= 0)
+ return candidates[i];
+ }
+ return {};
+}
+
+/* See ada-lang.h. */
+
+block_symbol
+ada_resolve_funcall (struct symbol *sym, const struct block *block,
+ struct type *context_type,
+ int parse_completion,
+ int nargs, value *argvec[],
+ innermost_block_tracker *tracker)
+{
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (sym->linkage_name (), block, VAR_DOMAIN);
+
+ int i;
+ if (candidates.size () == 1)
+ i = 0;
+ else
+ {
+ i = ada_resolve_function
+ (candidates,
+ argvec, nargs,
+ sym->linkage_name (),
+ context_type, parse_completion);
+ if (i < 0)
+ error (_("Could not find a match for %s"), sym->print_name ());
+ }
+
+ tracker->update (candidates[i]);
+ return candidates[i];
+}
+
+/* See ada-lang.h. */
+
+block_symbol
+ada_resolve_variable (struct symbol *sym, const struct block *block,
+ struct type *context_type,
+ int parse_completion,
+ int deprocedure_p,
+ innermost_block_tracker *tracker)
+{
+ std::vector<struct block_symbol> candidates
+ = ada_lookup_symbol_list (sym->linkage_name (), block, VAR_DOMAIN);
+
+ if (std::any_of (candidates.begin (),
+ candidates.end (),
+ [] (block_symbol &bsym)
+ {
+ switch (SYMBOL_CLASS (bsym.symbol))
+ {
+ case LOC_REGISTER:
+ case LOC_ARG:
+ case LOC_REF_ARG:
+ case LOC_REGPARM_ADDR:
+ case LOC_LOCAL:
+ case LOC_COMPUTED:
+ return true;
+ default:
+ return false;
+ }
+ }))
+ {
+ /* Types tend to get re-introduced locally, so if there
+ are any local symbols that are not types, first filter
+ out all types. */
+ candidates.erase
+ (std::remove_if
+ (candidates.begin (),
+ candidates.end (),
+ [] (block_symbol &bsym)
+ {
+ return SYMBOL_CLASS (bsym.symbol) == LOC_TYPEDEF;
+ }),
+ candidates.end ());
+ }
+
+ int i;
+ if (candidates.empty ())
+ error (_("No definition found for %s"), sym->print_name ());
+ else if (candidates.size () == 1)
+ i = 0;
+ else if (deprocedure_p && !is_nonfunction (candidates))
+ {
+ i = ada_resolve_function
+ (candidates, NULL, 0,
+ sym->linkage_name (),
+ context_type, parse_completion);
+ if (i < 0)
+ error (_("Could not find a match for %s"), sym->print_name ());
+ }
+ else
+ {
+ printf_filtered (_("Multiple matches for %s\n"), sym->print_name ());
+ user_select_syms (candidates.data (), candidates.size (), 1);
+ i = 0;
+ }
+
+ tracker->update (candidates[i]);
+ return candidates[i];
+}
+
/* Resolve the operator of the subexpression beginning at
position *POS of *EXPP. "Resolving" consists of replacing
the symbols that have undefined namespaces in OP_VAR_VALUE nodes
case OP_VAR_VALUE:
if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
{
- std::vector<struct block_symbol> candidates
- = ada_lookup_symbol_list (exp->elts[pc + 2].symbol->linkage_name (),
- exp->elts[pc + 1].block, VAR_DOMAIN);
-
- if (std::any_of (candidates.begin (),
- candidates.end (),
- [] (block_symbol &sym)
- {
- switch (SYMBOL_CLASS (sym.symbol))
- {
- case LOC_REGISTER:
- case LOC_ARG:
- case LOC_REF_ARG:
- case LOC_REGPARM_ADDR:
- case LOC_LOCAL:
- case LOC_COMPUTED:
- return true;
- default:
- return false;
- }
- }))
- {
- /* Types tend to get re-introduced locally, so if there
- are any local symbols that are not types, first filter
- out all types. */
- candidates.erase
- (std::remove_if
- (candidates.begin (),
- candidates.end (),
- [] (block_symbol &sym)
- {
- return SYMBOL_CLASS (sym.symbol) == LOC_TYPEDEF;
- }),
- candidates.end ());
- }
-
- if (candidates.empty ())
- error (_("No definition found for %s"),
- exp->elts[pc + 2].symbol->print_name ());
- else if (candidates.size () == 1)
- i = 0;
- else if (deprocedure_p && !is_nonfunction (candidates))
- {
- i = ada_resolve_function
- (candidates, NULL, 0,
- exp->elts[pc + 2].symbol->linkage_name (),
- context_type, parse_completion);
- if (i < 0)
- error (_("Could not find a match for %s"),
- exp->elts[pc + 2].symbol->print_name ());
- }
- else
- {
- printf_filtered (_("Multiple matches for %s\n"),
- exp->elts[pc + 2].symbol->print_name ());
- user_select_syms (candidates.data (), candidates.size (), 1);
- i = 0;
- }
-
- exp->elts[pc + 1].block = candidates[i].block;
- exp->elts[pc + 2].symbol = candidates[i].symbol;
- tracker->update (candidates[i]);
+ block_symbol resolved
+ = ada_resolve_variable (exp->elts[pc + 2].symbol,
+ exp->elts[pc + 1].block,
+ context_type, parse_completion,
+ deprocedure_p, tracker);
+ exp->elts[pc + 1].block = resolved.block;
+ exp->elts[pc + 2].symbol = resolved.symbol;
}
if (deprocedure_p
if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
&& SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
{
- std::vector<struct block_symbol> candidates
- = ada_lookup_symbol_list (exp->elts[pc + 5].symbol->linkage_name (),
- exp->elts[pc + 4].block, VAR_DOMAIN);
-
- if (candidates.size () == 1)
- i = 0;
- else
- {
- i = ada_resolve_function
- (candidates,
- argvec, nargs,
- exp->elts[pc + 5].symbol->linkage_name (),
- context_type, parse_completion);
- if (i < 0)
- error (_("Could not find a match for %s"),
- exp->elts[pc + 5].symbol->print_name ());
- }
-
- exp->elts[pc + 4].block = candidates[i].block;
- exp->elts[pc + 5].symbol = candidates[i].symbol;
- tracker->update (candidates[i]);
+ block_symbol resolved
+ = ada_resolve_funcall (exp->elts[pc + 5].symbol,
+ exp->elts[pc + 4].block,
+ context_type, parse_completion,
+ nargs, argvec,
+ tracker);
+ exp->elts[pc + 4].block = resolved.block;
+ exp->elts[pc + 5].symbol = resolved.symbol;
}
}
break;
case UNOP_PLUS:
case UNOP_LOGICAL_NOT:
case UNOP_ABS:
- if (possible_user_operator_p (op, argvec))
- {
- std::vector<struct block_symbol> candidates
- = ada_lookup_symbol_list (ada_decoded_op_name (op),
- NULL, VAR_DOMAIN);
-
- i = ada_resolve_function (candidates, argvec,
- nargs, ada_decoded_op_name (op), NULL,
- parse_completion);
- if (i < 0)
- break;
+ {
+ block_symbol found = ada_find_operator_symbol (op, parse_completion,
+ nargs, argvec);
+ if (found.symbol == nullptr)
+ break;
- replace_operator_with_call (expp, pc, nargs, 1,
- candidates[i].symbol,
- candidates[i].block);
- exp = expp->get ();
- }
+ replace_operator_with_call (expp, pc, nargs, 1,
+ found.symbol, found.block);
+ exp = expp->get ();
+ }
break;
case OP_TYPE:
}
static struct value *
-value_val_atr (struct type *type, struct value *arg)
+ada_val_atr (enum noside noside, struct type *type, struct value *arg)
{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (type, not_lval);
+
if (!discrete_type_p (type))
error (_("'VAL only defined on discrete types"));
if (!integer_type_p (value_type (arg)))
/* A helper function for UNOP_NEG. */
-static value *
+value *
ada_unop_neg (struct type *expect_type,
struct expression *exp,
enum noside noside, enum exp_opcode op,
return value_neg (arg1);
}
+/* A helper function for UNOP_IN_RANGE. */
+
+value *
+ada_unop_in_range (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1, struct type *type)
+{
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+
+ struct value *arg2, *arg3;
+ switch (type->code ())
+ {
+ default:
+ lim_warning (_("Membership test incompletely implemented; "
+ "always returns true"));
+ type = language_bool_type (exp->language_defn, exp->gdbarch);
+ return value_from_longest (type, (LONGEST) 1);
+
+ case TYPE_CODE_RANGE:
+ arg2 = value_from_longest (type,
+ type->bounds ()->low.const_val ());
+ arg3 = value_from_longest (type,
+ type->bounds ()->high.const_val ());
+ 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 OP_ATR_TAG. */
+
+value *
+ada_atr_tag (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg1)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (ada_tag_type (arg1), not_lval);
+
+ return ada_value_tag (arg1);
+}
+
+/* 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. */
+
+static 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. */
+
+static 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. */
+
+static 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. */
+
+static 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. */
+
+static 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);
+}
+
+}
+
/* Implement the evaluate_exp routine in the exp_descriptor structure
for the Ada language. */
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_zero (value_type (arg1), not_lval);
- }
- else
- {
- type = builtin_type (exp->gdbarch)->builtin_double;
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return ada_value_binop (arg1, arg2, op);
- }
+ return ada_mult_binop (expect_type, exp, noside, op,
+ arg1, arg2);
case BINOP_EQUAL:
case BINOP_NOTEQUAL:
arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- 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;
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_from_longest (type, (LONGEST) tem);
+ return ada_equal_binop (expect_type, exp, noside, op, arg1, arg2);
case UNOP_NEG:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
= evaluate_subexp (nullptr, exp, pos, noside);
struct value *high_bound_val
= evaluate_subexp (nullptr, exp, pos, noside);
- 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 (noside == EVAL_SKIP)
goto nosideret;
- /* 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));
+ return ada_ternop_slice (exp, noside, array, low_bound_val,
+ high_bound_val);
}
case UNOP_IN_RANGE:
(*pos) += 2;
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
type = check_typedef (exp->elts[pc + 1].type);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- switch (type->code ())
- {
- default:
- lim_warning (_("Membership test incompletely implemented; "
- "always returns true"));
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_from_longest (type, (LONGEST) 1);
-
- case TYPE_CODE_RANGE:
- arg2 = value_from_longest (type,
- type->bounds ()->low.const_val ());
- arg3 = value_from_longest (type,
- type->bounds ()->high.const_val ());
- 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)));
- }
+ return ada_unop_in_range (expect_type, exp, noside, op, arg1, type);
case BINOP_IN_BOUNDS:
(*pos) += 2;
if (noside == EVAL_SKIP)
goto nosideret;
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_zero (type, not_lval);
- }
-
tem = longest_to_int (exp->elts[pc + 1].longconst);
- type = ada_index_type (value_type (arg2), tem, "range");
- if (!type)
- type = value_type (arg1);
-
- arg3 = value_from_longest (type, ada_array_bound (arg2, tem, 1));
- arg2 = value_from_longest (type, ada_array_bound (arg2, tem, 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)));
+ return ada_binop_in_bounds (exp, noside, arg1, arg2, tem);
case TERNOP_IN_RANGE:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else 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);
-
- 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);
-
- 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);
- }
- }
+ return ada_unop_atr (exp, noside, op, arg1, type_arg, tem);
}
case OP_ATR_TAG:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
-
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (ada_tag_type (arg1), not_lval);
-
- return ada_value_tag (arg1);
+ return ada_atr_tag (expect_type, exp, noside, op, arg1);
case OP_ATR_MIN:
case OP_ATR_MAX:
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else 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);
- }
+ return ada_binop_minmax (expect_type, exp, noside, op, arg1, arg2);
case OP_ATR_MODULUS:
{
case OP_ATR_SIZE:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- 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)
- goto nosideret;
- 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));
+ return ada_atr_size (expect_type, exp, noside, op, arg1);
case OP_ATR_VAL:
evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
type = exp->elts[pc + 2].type;
if (noside == EVAL_SKIP)
goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (type, not_lval);
- else
- return value_val_atr (type, arg1);
+ return ada_val_atr (noside, type, arg1);
case BINOP_EXP:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg2 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- else 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);
- }
+ return ada_binop_exp (expect_type, exp, noside, op, arg1, arg2);
case UNOP_PLUS:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
- 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;
+ return ada_abs (expect_type, exp, noside, op, arg1);
case UNOP_IND:
preeval_pos = *pos;
projects / deliverable / binutils-gdb.git / blobdiff