[PATCH 188/203] Remove now-unused Ada evaluator code
Tom Tromey
tom@tromey.com
Fri Jan 1 21:47:08 GMT 2021
Now that the Ada parser has switched to the new style, there is no
need for the old Ada evaluation code.
gdb/ChangeLog
2021-01-01 Tom Tromey <tom@tromey.com>
* ada-lang.c (resolve_subexp, replace_operator_with_call)
(evaluate_subexp_type, assign_aggregate)
(aggregate_assign_positional, aggregate_assign_from_choices)
(aggregate_assign_others, ada_evaluate_subexp_for_cast)
(ada_evaluate_subexp, ADA_OPERATORS, ada_operator_length)
(ada_operator_check, ada_forward_operator_length)
(ada_dump_subexp_body, ada_print_subexp, ada_exp_descriptor):
Remove.
(post_parser): Update.
(class ada_language) <expresssion_ops>: Remove.
---
gdb/ChangeLog | 13 +
gdb/ada-lang.c | 2060 ++++--------------------------------------------
2 files changed, 174 insertions(+), 1899 deletions(-)
diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 657ef37dca7..c7d9540798d 100644
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -119,13 +119,6 @@ static int num_defns_collected (struct obstack *);
static struct block_symbol *defns_collected (struct obstack *, int);
-static struct value *resolve_subexp (expression_up *, int *, int,
- struct type *, int,
- innermost_block_tracker *);
-
-static void replace_operator_with_call (expression_up *, int, int, int,
- struct symbol *, const struct block *);
-
static int possible_user_operator_p (enum exp_opcode, struct value **);
static const char *ada_decoded_op_name (enum exp_opcode);
@@ -141,8 +134,6 @@ static int discrete_type_p (struct type *);
static struct type *ada_lookup_struct_elt_type (struct type *, const char *,
int, int);
-static struct value *evaluate_subexp_type (struct expression *, int *);
-
static struct type *ada_find_parallel_type_with_name (struct type *,
const char *);
@@ -211,36 +202,9 @@ static int ada_is_direct_array_type (struct type *);
static struct value *ada_index_struct_field (int, struct value *, int,
struct type *);
-static struct value *assign_aggregate (struct value *, struct value *,
- struct expression *,
- int *, enum noside);
-
-static void aggregate_assign_from_choices (struct value *, struct value *,
- struct expression *,
- int *, std::vector<LONGEST> &,
- LONGEST, LONGEST);
-
-static void aggregate_assign_positional (struct value *, struct value *,
- struct expression *,
- int *, std::vector<LONGEST> &,
- LONGEST, LONGEST);
-
-
-static void aggregate_assign_others (struct value *, struct value *,
- struct expression *,
- int *, std::vector<LONGEST> &,
- LONGEST, LONGEST);
-
-
static void add_component_interval (LONGEST, LONGEST, std::vector<LONGEST> &);
-static struct value *ada_evaluate_subexp (struct type *, struct expression *,
- int *, enum noside);
-
-static void ada_forward_operator_length (struct expression *, int, int *,
- int *);
-
static struct type *ada_find_any_type (const char *name);
static symbol_name_matcher_ftype *ada_get_symbol_name_matcher
@@ -3576,277 +3540,6 @@ ada_resolve_variable (struct symbol *sym, const struct block *block,
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
- with their resolutions, replacing built-in operators with
- function calls to user-defined operators, where appropriate, and,
- when DEPROCEDURE_P is non-zero, converting function-valued variables
- into parameterless calls. May expand *EXPP. The CONTEXT_TYPE functions
- are as in ada_resolve, above. */
-
-static struct value *
-resolve_subexp (expression_up *expp, int *pos, int deprocedure_p,
- struct type *context_type, int parse_completion,
- innermost_block_tracker *tracker)
-{
- int pc = *pos;
- int i;
- struct expression *exp; /* Convenience: == *expp. */
- enum exp_opcode op = (*expp)->elts[pc].opcode;
- struct value **argvec; /* Vector of operand types (alloca'ed). */
- int nargs; /* Number of operands. */
- int oplen;
-
- argvec = NULL;
- nargs = 0;
- exp = expp->get ();
-
- /* Pass one: resolve operands, saving their types and updating *pos,
- if needed. */
- switch (op)
- {
- case OP_FUNCALL:
- if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
- && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
- *pos += 7;
- else
- {
- *pos += 3;
- resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
- }
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- break;
-
- case UNOP_ADDR:
- *pos += 1;
- resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
- break;
-
- case UNOP_QUAL:
- *pos += 3;
- resolve_subexp (expp, pos, 1, check_typedef (exp->elts[pc + 1].type),
- parse_completion, tracker);
- break;
-
- case OP_ATR_MODULUS:
- case OP_ATR_SIZE:
- case OP_ATR_TAG:
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- case OP_ATR_LENGTH:
- case OP_ATR_POS:
- case OP_ATR_VAL:
- case OP_ATR_MIN:
- case OP_ATR_MAX:
- case TERNOP_IN_RANGE:
- case BINOP_IN_BOUNDS:
- case UNOP_IN_RANGE:
- case OP_AGGREGATE:
- case OP_OTHERS:
- case OP_CHOICES:
- case OP_POSITIONAL:
- case OP_DISCRETE_RANGE:
- case OP_NAME:
- ada_forward_operator_length (exp, pc, &oplen, &nargs);
- *pos += oplen;
- break;
-
- case BINOP_ASSIGN:
- {
- struct value *arg1;
-
- *pos += 1;
- arg1 = resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
- if (arg1 == NULL)
- resolve_subexp (expp, pos, 1, NULL, parse_completion, tracker);
- else
- resolve_subexp (expp, pos, 1, value_type (arg1), parse_completion,
- tracker);
- break;
- }
-
- case UNOP_CAST:
- *pos += 3;
- nargs = 1;
- break;
-
- case BINOP_ADD:
- case BINOP_SUB:
- case BINOP_MUL:
- case BINOP_DIV:
- case BINOP_REM:
- case BINOP_MOD:
- case BINOP_EXP:
- case BINOP_CONCAT:
- case BINOP_LOGICAL_AND:
- case BINOP_LOGICAL_OR:
- case BINOP_BITWISE_AND:
- case BINOP_BITWISE_IOR:
- case BINOP_BITWISE_XOR:
-
- case BINOP_EQUAL:
- case BINOP_NOTEQUAL:
- case BINOP_LESS:
- case BINOP_GTR:
- case BINOP_LEQ:
- case BINOP_GEQ:
-
- case BINOP_REPEAT:
- case BINOP_SUBSCRIPT:
- case BINOP_COMMA:
- *pos += 1;
- nargs = 2;
- break;
-
- case UNOP_NEG:
- case UNOP_PLUS:
- case UNOP_LOGICAL_NOT:
- case UNOP_ABS:
- case UNOP_IND:
- *pos += 1;
- nargs = 1;
- break;
-
- case OP_LONG:
- case OP_FLOAT:
- case OP_VAR_VALUE:
- case OP_VAR_MSYM_VALUE:
- *pos += 4;
- break;
-
- case OP_TYPE:
- case OP_BOOL:
- case OP_LAST:
- case OP_INTERNALVAR:
- *pos += 3;
- break;
-
- case UNOP_MEMVAL:
- *pos += 3;
- nargs = 1;
- break;
-
- case OP_REGISTER:
- *pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
- break;
-
- case STRUCTOP_STRUCT:
- *pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
- nargs = 1;
- break;
-
- case TERNOP_SLICE:
- *pos += 1;
- nargs = 3;
- break;
-
- case OP_STRING:
- break;
-
- default:
- error (_("Unexpected operator during name resolution"));
- }
-
- argvec = XALLOCAVEC (struct value *, nargs + 1);
- for (i = 0; i < nargs; i += 1)
- argvec[i] = resolve_subexp (expp, pos, 1, NULL, parse_completion,
- tracker);
- argvec[i] = NULL;
- exp = expp->get ();
-
- /* Pass two: perform any resolution on principal operator. */
- switch (op)
- {
- default:
- break;
-
- case OP_VAR_VALUE:
- if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
- {
- 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
- && (SYMBOL_TYPE (exp->elts[pc + 2].symbol)->code ()
- == TYPE_CODE_FUNC))
- {
- replace_operator_with_call (expp, pc, 0, 4,
- exp->elts[pc + 2].symbol,
- exp->elts[pc + 1].block);
- exp = expp->get ();
- }
- break;
-
- case OP_FUNCALL:
- {
- if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
- && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
- {
- 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 BINOP_ADD:
- case BINOP_SUB:
- case BINOP_MUL:
- case BINOP_DIV:
- case BINOP_REM:
- case BINOP_MOD:
- case BINOP_CONCAT:
- case BINOP_BITWISE_AND:
- case BINOP_BITWISE_IOR:
- case BINOP_BITWISE_XOR:
- case BINOP_EQUAL:
- case BINOP_NOTEQUAL:
- case BINOP_LESS:
- case BINOP_GTR:
- case BINOP_LEQ:
- case BINOP_GEQ:
- case BINOP_EXP:
- case UNOP_NEG:
- case UNOP_PLUS:
- case UNOP_LOGICAL_NOT:
- case UNOP_ABS:
- {
- 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,
- found.symbol, found.block);
- exp = expp->get ();
- }
- break;
-
- case OP_TYPE:
- case OP_REGISTER:
- return NULL;
- }
-
- *pos = pc;
- if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
- return evaluate_var_msym_value (EVAL_AVOID_SIDE_EFFECTS,
- exp->elts[pc + 1].objfile,
- exp->elts[pc + 2].msymbol);
- else
- return evaluate_subexp_type (exp, pos);
-}
-
/* Return non-zero if formal type FTYPE matches actual type ATYPE. If
MAY_DEREF is non-zero, the formal may be a pointer and the actual
a non-pointer. */
@@ -4029,38 +3722,6 @@ ada_resolve_function (struct block_symbol syms[],
return 0;
}
-/* Replace the operator of length OPLEN at position PC in *EXPP with a call
- on the function identified by SYM and BLOCK, and taking NARGS
- arguments. Update *EXPP as needed to hold more space. */
-
-static void
-replace_operator_with_call (expression_up *expp, int pc, int nargs,
- int oplen, struct symbol *sym,
- const struct block *block)
-{
- /* We want to add 6 more elements (3 for funcall, 4 for function
- symbol, -OPLEN for operator being replaced) to the
- expression. */
- struct expression *exp = expp->get ();
- int save_nelts = exp->nelts;
- int extra_elts = 7 - oplen;
- exp->nelts += extra_elts;
-
- if (extra_elts > 0)
- exp->resize (exp->nelts);
- memmove (exp->elts + pc + 7, exp->elts + pc + oplen,
- EXP_ELEM_TO_BYTES (save_nelts - pc - oplen));
- if (extra_elts < 0)
- exp->resize (exp->nelts);
-
- exp->elts[pc].opcode = exp->elts[pc + 2].opcode = OP_FUNCALL;
- exp->elts[pc + 1].longconst = (LONGEST) nargs;
-
- exp->elts[pc + 3].opcode = exp->elts[pc + 6].opcode = OP_VAR_VALUE;
- exp->elts[pc + 4].block = block;
- exp->elts[pc + 5].symbol = sym;
-}
-
/* Type-class predicates */
/* True iff TYPE is numeric (i.e., an INT, RANGE (of numeric type),
@@ -9237,16 +8898,6 @@ ada_enum_name (const char *name)
}
}
-/* Evaluate the subexpression of EXP starting at *POS as for
- evaluate_type, updating *POS to point just past the evaluated
- expression. */
-
-static struct value *
-evaluate_subexp_type (struct expression *exp, int *pos)
-{
- return evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
-}
-
/* If VAL is wrapped in an aligner or subtype wrapper, return the
value it wraps. */
@@ -9525,17 +9176,27 @@ ada_value_equal (struct value *arg1, struct value *arg2)
return value_equal (arg1, arg2);
}
-/* Assign the result of evaluating EXP starting at *POS to the INDEXth
- component of LHS (a simple array or a record), updating *POS past
- the expression, assuming that LHS is contained in CONTAINER. Does
- not modify the inferior's memory, nor does it modify LHS (unless
- LHS == CONTAINER). */
+namespace expr
+{
+
+bool
+check_objfile (const std::unique_ptr<ada_component> &comp,
+ struct objfile *objfile)
+{
+ return comp->uses_objfile (objfile);
+}
+
+/* Assign the result of evaluating ARG starting at *POS to the INDEXth
+ component of LHS (a simple array or a record). Does not modify the
+ inferior's memory, nor does it modify LHS (unless LHS ==
+ CONTAINER). */
static void
assign_component (struct value *container, struct value *lhs, LONGEST index,
- struct expression *exp, int *pos)
+ struct expression *exp, operation_up &arg)
{
- struct value *mark = value_mark ();
+ scoped_value_mark mark;
+
struct value *elt;
struct type *lhs_type = check_typedef (value_type (lhs));
@@ -9552,41 +9213,56 @@ assign_component (struct value *container, struct value *lhs, LONGEST index,
elt = ada_to_fixed_value (elt);
}
- if (exp->elts[*pos].opcode == OP_AGGREGATE)
- assign_aggregate (container, elt, exp, pos, EVAL_NORMAL);
+ ada_aggregate_operation *ag_op
+ = dynamic_cast<ada_aggregate_operation *> (arg.get ());
+ if (ag_op != nullptr)
+ ag_op->assign_aggregate (container, elt, exp);
else
- value_assign_to_component (container, elt,
- ada_evaluate_subexp (NULL, exp, pos,
- EVAL_NORMAL));
+ value_assign_to_component (container, elt,
+ arg->evaluate (nullptr, exp,
+ EVAL_NORMAL));
+}
- value_free_to_mark (mark);
+bool
+ada_aggregate_component::uses_objfile (struct objfile *objfile)
+{
+ for (const auto &item : m_components)
+ if (item->uses_objfile (objfile))
+ return true;
+ return false;
+}
+
+void
+ada_aggregate_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sAggregate\n"), depth, "");
+ for (const auto &item : m_components)
+ item->dump (stream, depth + 1);
+}
+
+void
+ada_aggregate_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
+{
+ for (auto &item : m_components)
+ item->assign (container, lhs, exp, indices, low, high);
}
/* Assuming that LHS represents an lvalue having a record or array
- type, and EXP->ELTS[*POS] is an OP_AGGREGATE, evaluate an assignment
- of that aggregate's value to LHS, advancing *POS past the
- aggregate. NOSIDE is as for evaluate_subexp. CONTAINER is an
- lvalue containing LHS (possibly LHS itself). Does not modify
- the inferior's memory, nor does it modify the contents of
- LHS (unless == CONTAINER). Returns the modified CONTAINER. */
+ type, evaluate an assignment of this aggregate's value to LHS.
+ CONTAINER is an lvalue containing LHS (possibly LHS itself). Does
+ not modify the inferior's memory, nor does it modify the contents
+ of LHS (unless == CONTAINER). */
-static struct value *
-assign_aggregate (struct value *container,
- struct value *lhs, struct expression *exp,
- int *pos, enum noside noside)
+void
+ada_aggregate_operation::assign_aggregate (struct value *container,
+ struct value *lhs,
+ struct expression *exp)
{
struct type *lhs_type;
- int n = exp->elts[*pos+1].longconst;
LONGEST low_index, high_index;
- int i;
-
- *pos += 3;
- if (noside != EVAL_NORMAL)
- {
- for (i = 0; i < n; i += 1)
- ada_evaluate_subexp (NULL, exp, pos, noside);
- return container;
- }
container = ada_coerce_ref (container);
if (ada_is_direct_array_type (value_type (container)))
@@ -9615,317 +9291,47 @@ assign_aggregate (struct value *container,
indices[0] = indices[1] = low_index - 1;
indices[2] = indices[3] = high_index + 1;
- for (i = 0; i < n; i += 1)
- {
- switch (exp->elts[*pos].opcode)
- {
- case OP_CHOICES:
- aggregate_assign_from_choices (container, lhs, exp, pos, indices,
- low_index, high_index);
- break;
- case OP_POSITIONAL:
- aggregate_assign_positional (container, lhs, exp, pos, indices,
- low_index, high_index);
- break;
- case OP_OTHERS:
- if (i != n-1)
- error (_("Misplaced 'others' clause"));
- aggregate_assign_others (container, lhs, exp, pos, indices,
- low_index, high_index);
- break;
- default:
- error (_("Internal error: bad aggregate clause"));
- }
- }
+ std::get<0> (m_storage)->assign (container, lhs, exp, indices,
+ low_index, high_index);
+}
+
+bool
+ada_positional_component::uses_objfile (struct objfile *objfile)
+{
+ return m_op->uses_objfile (objfile);
+}
- return container;
+void
+ada_positional_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sPositional, index = %d\n"),
+ depth, "", m_index);
+ m_op->dump (stream, depth + 1);
}
-
+
/* Assign into the component of LHS indexed by the OP_POSITIONAL
- construct at *POS, updating *POS past the construct, given that
- the positions are relative to lower bound LOW, where HIGH is the
- upper bound. Record the position in INDICES. CONTAINER is as for
- assign_aggregate. */
-static void
-aggregate_assign_positional (struct value *container,
- struct value *lhs, struct expression *exp,
- int *pos, std::vector<LONGEST> &indices,
- LONGEST low, LONGEST high)
+ construct, given that the positions are relative to lower bound
+ LOW, where HIGH is the upper bound. Record the position in
+ INDICES. CONTAINER is as for assign_aggregate. */
+void
+ada_positional_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
{
- LONGEST ind = longest_to_int (exp->elts[*pos + 1].longconst) + low;
-
+ LONGEST ind = m_index + low;
+
if (ind - 1 == high)
warning (_("Extra components in aggregate ignored."));
if (ind <= high)
{
add_component_interval (ind, ind, indices);
- *pos += 3;
- assign_component (container, lhs, ind, exp, pos);
+ assign_component (container, lhs, ind, exp, m_op);
}
- else
- ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
}
-/* Assign into the components of LHS indexed by the OP_CHOICES
- construct at *POS, updating *POS past the construct, given that
- the allowable indices are LOW..HIGH. Record the indices assigned
- to in INDICES. CONTAINER is as for assign_aggregate. */
-static void
-aggregate_assign_from_choices (struct value *container,
- struct value *lhs, struct expression *exp,
- int *pos, std::vector<LONGEST> &indices,
- LONGEST low, LONGEST high)
-{
- int j;
- int n_choices = longest_to_int (exp->elts[*pos+1].longconst);
- int choice_pos, expr_pc;
- int is_array = ada_is_direct_array_type (value_type (lhs));
-
- choice_pos = *pos += 3;
-
- for (j = 0; j < n_choices; j += 1)
- ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
- expr_pc = *pos;
- ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
-
- for (j = 0; j < n_choices; j += 1)
- {
- LONGEST lower, upper;
- enum exp_opcode op = exp->elts[choice_pos].opcode;
-
- if (op == OP_DISCRETE_RANGE)
- {
- choice_pos += 1;
- lower = value_as_long (ada_evaluate_subexp (NULL, exp, pos,
- EVAL_NORMAL));
- upper = value_as_long (ada_evaluate_subexp (NULL, exp, pos,
- EVAL_NORMAL));
- }
- else if (is_array)
- {
- lower = value_as_long (ada_evaluate_subexp (NULL, exp, &choice_pos,
- EVAL_NORMAL));
- upper = lower;
- }
- else
- {
- int ind;
- const char *name;
-
- switch (op)
- {
- case OP_NAME:
- name = &exp->elts[choice_pos + 2].string;
- break;
- case OP_VAR_VALUE:
- name = exp->elts[choice_pos + 2].symbol->natural_name ();
- break;
- default:
- error (_("Invalid record component association."));
- }
- ada_evaluate_subexp (NULL, exp, &choice_pos, EVAL_SKIP);
- ind = 0;
- if (! find_struct_field (name, value_type (lhs), 0,
- NULL, NULL, NULL, NULL, &ind))
- error (_("Unknown component name: %s."), name);
- lower = upper = ind;
- }
-
- if (lower <= upper && (lower < low || upper > high))
- error (_("Index in component association out of bounds."));
-
- add_component_interval (lower, upper, indices);
- while (lower <= upper)
- {
- int pos1;
-
- pos1 = expr_pc;
- assign_component (container, lhs, lower, exp, &pos1);
- lower += 1;
- }
- }
-}
-
-/* Assign the value of the expression in the OP_OTHERS construct in
- EXP at *POS into the components of LHS indexed from LOW .. HIGH that
- have not been previously assigned. The index intervals already assigned
- are in INDICES. Updates *POS to after the OP_OTHERS clause.
- CONTAINER is as for assign_aggregate. */
-static void
-aggregate_assign_others (struct value *container,
- struct value *lhs, struct expression *exp,
- int *pos, std::vector<LONGEST> &indices,
- LONGEST low, LONGEST high)
-{
- int i;
- int expr_pc = *pos + 1;
-
- int num_indices = indices.size ();
- for (i = 0; i < num_indices - 2; i += 2)
- {
- LONGEST ind;
-
- for (ind = indices[i + 1] + 1; ind < indices[i + 2]; ind += 1)
- {
- int localpos;
-
- localpos = expr_pc;
- assign_component (container, lhs, ind, exp, &localpos);
- }
- }
- ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
-}
-
-namespace expr
-{
-
-bool
-check_objfile (const std::unique_ptr<ada_component> &comp,
- struct objfile *objfile)
-{
- return comp->uses_objfile (objfile);
-}
-
-/* Assign the result of evaluating ARG starting at *POS to the INDEXth
- component of LHS (a simple array or a record). Does not modify the
- inferior's memory, nor does it modify LHS (unless LHS ==
- CONTAINER). */
-
-static void
-assign_component (struct value *container, struct value *lhs, LONGEST index,
- struct expression *exp, operation_up &arg)
-{
- scoped_value_mark mark;
-
- struct value *elt;
- struct type *lhs_type = check_typedef (value_type (lhs));
-
- if (lhs_type->code () == TYPE_CODE_ARRAY)
- {
- struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
- struct value *index_val = value_from_longest (index_type, index);
-
- elt = unwrap_value (ada_value_subscript (lhs, 1, &index_val));
- }
- else
- {
- elt = ada_index_struct_field (index, lhs, 0, value_type (lhs));
- elt = ada_to_fixed_value (elt);
- }
-
- ada_aggregate_operation *ag_op
- = dynamic_cast<ada_aggregate_operation *> (arg.get ());
- if (ag_op != nullptr)
- ag_op->assign_aggregate (container, elt, exp);
- else
- value_assign_to_component (container, elt,
- arg->evaluate (nullptr, exp,
- EVAL_NORMAL));
-}
-
-bool
-ada_aggregate_component::uses_objfile (struct objfile *objfile)
-{
- for (const auto &item : m_components)
- if (item->uses_objfile (objfile))
- return true;
- return false;
-}
-
-void
-ada_aggregate_component::dump (ui_file *stream, int depth)
-{
- fprintf_filtered (stream, _("%*sAggregate\n"), depth, "");
- for (const auto &item : m_components)
- item->dump (stream, depth + 1);
-}
-
-void
-ada_aggregate_component::assign (struct value *container,
- struct value *lhs, struct expression *exp,
- std::vector<LONGEST> &indices,
- LONGEST low, LONGEST high)
-{
- for (auto &item : m_components)
- item->assign (container, lhs, exp, indices, low, high);
-}
-
-void
-ada_aggregate_operation::assign_aggregate (struct value *container,
- struct value *lhs,
- struct expression *exp)
-{
- struct type *lhs_type;
- LONGEST low_index, high_index;
-
- container = ada_coerce_ref (container);
- if (ada_is_direct_array_type (value_type (container)))
- container = ada_coerce_to_simple_array (container);
- lhs = ada_coerce_ref (lhs);
- if (!deprecated_value_modifiable (lhs))
- error (_("Left operand of assignment is not a modifiable lvalue."));
-
- lhs_type = check_typedef (value_type (lhs));
- if (ada_is_direct_array_type (lhs_type))
- {
- lhs = ada_coerce_to_simple_array (lhs);
- lhs_type = check_typedef (value_type (lhs));
- low_index = lhs_type->bounds ()->low.const_val ();
- high_index = lhs_type->bounds ()->high.const_val ();
- }
- else if (lhs_type->code () == TYPE_CODE_STRUCT)
- {
- low_index = 0;
- high_index = num_visible_fields (lhs_type) - 1;
- }
- else
- error (_("Left-hand side must be array or record."));
-
- std::vector<LONGEST> indices (4);
- indices[0] = indices[1] = low_index - 1;
- indices[2] = indices[3] = high_index + 1;
-
- std::get<0> (m_storage)->assign (container, lhs, exp, indices,
- low_index, high_index);
-}
-
-bool
-ada_positional_component::uses_objfile (struct objfile *objfile)
-{
- return m_op->uses_objfile (objfile);
-}
-
-void
-ada_positional_component::dump (ui_file *stream, int depth)
-{
- fprintf_filtered (stream, _("%*sPositional, index = %d\n"),
- depth, "", m_index);
- m_op->dump (stream, depth + 1);
-}
-
-/* Assign into the component of LHS indexed by the OP_POSITIONAL
- construct, given that the positions are relative to lower bound
- LOW, where HIGH is the upper bound. Record the position in
- INDICES. CONTAINER is as for assign_aggregate. */
-void
-ada_positional_component::assign (struct value *container,
- struct value *lhs, struct expression *exp,
- std::vector<LONGEST> &indices,
- LONGEST low, LONGEST high)
-{
- LONGEST ind = m_index + low;
-
- if (ind - 1 == high)
- warning (_("Extra components in aggregate ignored."));
- if (ind <= high)
- {
- add_component_interval (ind, ind, indices);
- assign_component (container, lhs, ind, exp, m_op);
- }
-}
-
-bool
-ada_discrete_range_association::uses_objfile (struct objfile *objfile)
+bool
+ada_discrete_range_association::uses_objfile (struct objfile *objfile)
{
return m_low->uses_objfile (objfile) || m_high->uses_objfile (objfile);
}
@@ -10430,58 +9836,6 @@ ada_value_cast (struct type *type, struct value *arg2)
entity. Results in this case are unpredictable, as we usually read
past the buffer containing the data =:-o. */
-/* Evaluate a subexpression of EXP, at index *POS, and return a value
- for that subexpression cast to TO_TYPE. Advance *POS over the
- subexpression. */
-
-static value *
-ada_evaluate_subexp_for_cast (expression *exp, int *pos,
- enum noside noside, struct type *to_type)
-{
- int pc = *pos;
-
- if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE
- || exp->elts[pc].opcode == OP_VAR_VALUE)
- {
- (*pos) += 4;
-
- value *val;
- if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
- {
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (to_type, not_lval);
-
- val = evaluate_var_msym_value (noside,
- exp->elts[pc + 1].objfile,
- exp->elts[pc + 2].msymbol);
- }
- else
- val = evaluate_var_value (noside,
- exp->elts[pc + 1].block,
- exp->elts[pc + 2].symbol);
-
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
-
- val = ada_value_cast (to_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 *val = evaluate_subexp (to_type, exp, pos, noside);
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
- return ada_value_cast (to_type, val);
-}
-
/* A helper function for TERNOP_IN_RANGE. */
static value *
@@ -11442,841 +10796,100 @@ ada_funcall_operation::evaluate (struct type *expect_type,
something. */
return value_zero (builtin_type (exp->gdbarch)->builtin_int,
not_lval);
- else
- return call_internal_function (exp->gdbarch, exp->language_defn,
- callee, nargs,
- argvec.data ());
-
- case TYPE_CODE_STRUCT:
- {
- int arity;
-
- arity = ada_array_arity (type);
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("cannot subscript or call a record"));
- if (arity != nargs)
- error (_("wrong number of subscripts; expecting %d"), arity);
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (ada_aligned_type (type), lval_memory);
- return
- unwrap_value (ada_value_subscript
- (callee, nargs, argvec.data ()));
- }
- case TYPE_CODE_ARRAY:
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("element type of array unknown"));
- else
- return value_zero (ada_aligned_type (type), lval_memory);
- }
- return
- unwrap_value (ada_value_subscript
- (ada_coerce_to_simple_array (callee),
- nargs, argvec.data ()));
- case TYPE_CODE_PTR: /* Pointer to array */
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("element type of array unknown"));
- else
- return value_zero (ada_aligned_type (type), lval_memory);
- }
- return
- unwrap_value (ada_value_ptr_subscript (callee, nargs,
- argvec.data ()));
-
- default:
- error (_("Attempt to index or call something other than an "
- "array or function"));
- }
-}
-
-bool
-ada_funcall_operation::resolve (struct expression *exp,
- bool deprocedure_p,
- bool parse_completion,
- innermost_block_tracker *tracker,
- struct type *context_type)
-{
- operation_up &callee_op = std::get<0> (m_storage);
-
- ada_var_value_operation *avv
- = dynamic_cast<ada_var_value_operation *> (callee_op.get ());
- if (avv == nullptr)
- return false;
-
- symbol *sym = avv->get_symbol ();
- if (SYMBOL_DOMAIN (sym) != UNDEF_DOMAIN)
- return false;
-
- const std::vector<operation_up> &args_up = std::get<1> (m_storage);
- int nargs = args_up.size ();
- std::vector<value *> argvec (nargs);
-
- for (int i = 0; i < args_up.size (); ++i)
- argvec[i] = args_up[i]->evaluate (nullptr, exp, EVAL_AVOID_SIDE_EFFECTS);
-
- const block *block = avv->get_block ();
- block_symbol resolved
- = ada_resolve_funcall (sym, block,
- context_type, parse_completion,
- nargs, argvec.data (),
- tracker);
-
- std::get<0> (m_storage)
- = make_operation<ada_var_value_operation> (resolved.symbol,
- resolved.block);
- return false;
-}
-
-}
-
-/* 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:
- {
- struct value *result;
-
- *pos -= 1;
- result = evaluate_subexp_standard (expect_type, exp, pos, 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;
- }
-
- case UNOP_CAST:
- (*pos) += 2;
- type = exp->elts[pc + 1].type;
- return ada_evaluate_subexp_for_cast (exp, pos, noside, type);
-
- case UNOP_QUAL:
- (*pos) += 2;
- type = exp->elts[pc + 1].type;
- return ada_evaluate_subexp (type, exp, pos, noside);
-
- case BINOP_ASSIGN:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (exp->elts[*pos].opcode == OP_AGGREGATE)
- {
- arg1 = assign_aggregate (arg1, arg1, exp, pos, noside);
- if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
- return arg1;
- return ada_value_assign (arg1, arg1);
- }
- /* Force the evaluation of the rhs ARG2 to the type of the lhs ARG1,
- except if the lhs of our assignment is a convenience variable.
- In the case of assigning to a convenience variable, the lhs
- should be exactly the result of the evaluation of the rhs. */
- type = value_type (arg1);
- if (VALUE_LVAL (arg1) == lval_internalvar)
- type = NULL;
- arg2 = evaluate_subexp (type, exp, pos, noside);
- if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
- return arg1;
- if (VALUE_LVAL (arg1) == lval_internalvar)
- {
- /* Nothing. */
- }
- else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg1)))
- arg2 = cast_to_gnat_encoded_fixed_point_type (value_type (arg1), arg2);
- else if (ada_is_gnat_encoded_fixed_point_type (value_type (arg2)))
- error
- (_("Fixed-point values must be assigned to fixed-point variables"));
- else
- arg2 = coerce_for_assign (value_type (arg1), arg2);
- return ada_value_assign (arg1, arg2);
-
- case BINOP_ADD:
- arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- if (value_type (arg1)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg1),
- value_as_long (arg1) + value_as_long (arg2)));
- if (value_type (arg2)->code () == TYPE_CODE_PTR)
- 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. */
- 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));
-
- case BINOP_SUB:
- arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- if (value_type (arg1)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg1),
- value_as_long (arg1) - value_as_long (arg2)));
- if (value_type (arg2)->code () == TYPE_CODE_PTR)
- 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. */
- 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));
-
- case BINOP_MUL:
- case BINOP_DIV:
- case BINOP_REM:
- case BINOP_MOD:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_mult_binop (expect_type, exp, noside, op,
- arg1, arg2);
-
- case BINOP_EQUAL:
- case BINOP_NOTEQUAL:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_equal_binop (expect_type, exp, noside, op, arg1, arg2);
-
- case UNOP_NEG:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- return ada_unop_neg (expect_type, exp, noside, op, arg1);
-
- case BINOP_LOGICAL_AND:
- case BINOP_LOGICAL_OR:
- case UNOP_LOGICAL_NOT:
- {
- struct value *val;
-
- *pos -= 1;
- val = evaluate_subexp_standard (expect_type, exp, pos, noside);
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_cast (type, val);
- }
-
- case BINOP_BITWISE_AND:
- case BINOP_BITWISE_IOR:
- case BINOP_BITWISE_XOR:
- {
- struct value *val;
-
- arg1 = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
- *pos = pc;
- val = evaluate_subexp_standard (expect_type, exp, pos, noside);
-
- return value_cast (value_type (arg1), val);
- }
-
- case OP_VAR_VALUE:
- *pos -= 1;
-
- if (noside == EVAL_SKIP)
- {
- *pos += 4;
- goto nosideret;
- }
-
- if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == 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"),
- exp->elts[pc + 2].symbol->print_name ());
-
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
- /* 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. */
- arg1 = evaluate_subexp (nullptr, exp, pos, 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))
- {
- *pos += 4;
- return value_zero (to_static_fixed_type (type), not_lval);
- }
- }
-
- arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
- return ada_to_fixed_value (arg1);
-
- case OP_FUNCALL:
- (*pos) += 2;
-
- /* Allocate arg vector, including space for the function to be
- called in argvec[0] and a terminating NULL. */
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- argvec = XALLOCAVEC (struct value *, nargs + 2);
-
- if (exp->elts[*pos].opcode == OP_VAR_VALUE
- && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
- error (_("Unexpected unresolved symbol, %s, during evaluation"),
- exp->elts[pc + 5].symbol->print_name ());
- else
- {
- for (tem = 0; tem <= nargs; tem += 1)
- argvec[tem] = evaluate_subexp (nullptr, exp, pos, noside);
- argvec[tem] = 0;
-
- if (noside == EVAL_SKIP)
- goto nosideret;
- }
-
- if (ada_is_constrained_packed_array_type
- (desc_base_type (value_type (argvec[0]))))
- argvec[0] = ada_coerce_to_simple_array (argvec[0]);
- else if (value_type (argvec[0])->code () == TYPE_CODE_ARRAY
- && TYPE_FIELD_BITSIZE (value_type (argvec[0]), 0) != 0)
- /* This is a packed array that has already been fixed, and
- therefore already coerced to a simple array. Nothing further
- to do. */
- ;
- else if (value_type (argvec[0])->code () == TYPE_CODE_REF)
- {
- /* Make sure we dereference references so that all the code below
- feels like it's really handling the referenced value. Wrapping
- types (for alignment) may be there, so make sure we strip them as
- well. */
- argvec[0] = ada_to_fixed_value (coerce_ref (argvec[0]));
- }
- else if (value_type (argvec[0])->code () == TYPE_CODE_ARRAY
- && VALUE_LVAL (argvec[0]) == lval_memory)
- argvec[0] = value_addr (argvec[0]);
-
- type = ada_check_typedef (value_type (argvec[0]));
-
- /* Ada allows us to implicitly dereference arrays when subscripting
- them. So, if this is an array typedef (encoding use for array
- access types encoded as fat pointers), strip it now. */
- if (type->code () == TYPE_CODE_TYPEDEF)
- type = ada_typedef_target_type (type);
-
- if (type->code () == TYPE_CODE_PTR)
- {
- switch (ada_check_typedef (TYPE_TARGET_TYPE (type))->code ())
- {
- case TYPE_CODE_FUNC:
- type = ada_check_typedef (TYPE_TARGET_TYPE (type));
- break;
- case TYPE_CODE_ARRAY:
- break;
- case TYPE_CODE_STRUCT:
- if (noside != EVAL_AVOID_SIDE_EFFECTS)
- argvec[0] = ada_value_ind (argvec[0]);
- type = ada_check_typedef (TYPE_TARGET_TYPE (type));
- break;
- default:
- error (_("cannot subscript or call something of type `%s'"),
- ada_type_name (value_type (argvec[0])));
- break;
- }
- }
-
- switch (type->code ())
- {
- case TYPE_CODE_FUNC:
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- if (TYPE_TARGET_TYPE (type) == NULL)
- error_call_unknown_return_type (NULL);
- return allocate_value (TYPE_TARGET_TYPE (type));
- }
- return call_function_by_hand (argvec[0], NULL,
- gdb::make_array_view (argvec + 1,
- nargs));
- case TYPE_CODE_INTERNAL_FUNCTION:
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- /* We don't know anything about what the internal
- function might return, but we have to return
- something. */
- return value_zero (builtin_type (exp->gdbarch)->builtin_int,
- not_lval);
- else
- return call_internal_function (exp->gdbarch, exp->language_defn,
- argvec[0], nargs, argvec + 1);
-
- case TYPE_CODE_STRUCT:
- {
- int arity;
-
- arity = ada_array_arity (type);
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("cannot subscript or call a record"));
- if (arity != nargs)
- error (_("wrong number of subscripts; expecting %d"), arity);
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (ada_aligned_type (type), lval_memory);
- return
- unwrap_value (ada_value_subscript
- (argvec[0], nargs, argvec + 1));
- }
- case TYPE_CODE_ARRAY:
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("element type of array unknown"));
- else
- return value_zero (ada_aligned_type (type), lval_memory);
- }
- return
- unwrap_value (ada_value_subscript
- (ada_coerce_to_simple_array (argvec[0]),
- nargs, argvec + 1));
- case TYPE_CODE_PTR: /* Pointer to array */
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("element type of array unknown"));
- else
- return value_zero (ada_aligned_type (type), lval_memory);
- }
- return
- unwrap_value (ada_value_ptr_subscript (argvec[0],
- nargs, argvec + 1));
-
- default:
- error (_("Attempt to index or call something other than an "
- "array or function"));
- }
-
- case TERNOP_SLICE:
- {
- struct value *array = evaluate_subexp (nullptr, exp, pos, noside);
- struct value *low_bound_val
- = evaluate_subexp (nullptr, exp, pos, noside);
- struct value *high_bound_val
- = evaluate_subexp (nullptr, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- 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);
- return ada_unop_in_range (expect_type, exp, noside, op, arg1, type);
-
- case BINOP_IN_BOUNDS:
- (*pos) += 2;
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (nullptr, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- tem = longest_to_int (exp->elts[pc + 1].longconst);
-
- return ada_binop_in_bounds (exp, noside, arg1, arg2, tem);
-
- case TERNOP_IN_RANGE:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (nullptr, exp, pos, noside);
- arg3 = evaluate_subexp (nullptr, exp, pos, noside);
-
- return eval_ternop_in_range (expect_type, exp, noside, arg1, arg2, arg3);
-
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- case OP_ATR_LENGTH:
- {
- struct type *type_arg;
-
- if (exp->elts[*pos].opcode == OP_TYPE)
- {
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- arg1 = NULL;
- type_arg = check_typedef (exp->elts[pc + 2].type);
- }
- else
- {
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- type_arg = NULL;
- }
-
- if (exp->elts[*pos].opcode != OP_LONG)
- error (_("Invalid operand to '%s"), ada_attribute_name (op));
- tem = longest_to_int (exp->elts[*pos + 2].longconst);
- *pos += 4;
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- return ada_unop_atr (exp, noside, op, arg1, type_arg, tem);
- }
+ else
+ return call_internal_function (exp->gdbarch, exp->language_defn,
+ callee, nargs,
+ argvec.data ());
- case OP_ATR_TAG:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_atr_tag (expect_type, exp, noside, op, arg1);
-
- case OP_ATR_MIN:
- case OP_ATR_MAX:
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_binop_minmax (expect_type, exp, noside, op, arg1, arg2);
-
- case OP_ATR_MODULUS:
+ case TYPE_CODE_STRUCT:
{
- struct type *type_arg = check_typedef (exp->elts[pc + 2].type);
-
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- if (!ada_is_modular_type (type_arg))
- error (_("'modulus must be applied to modular type"));
+ int arity;
- return value_from_longest (TYPE_TARGET_TYPE (type_arg),
- ada_modulus (type_arg));
+ arity = ada_array_arity (type);
+ type = ada_array_element_type (type, nargs);
+ if (type == NULL)
+ error (_("cannot subscript or call a record"));
+ if (arity != nargs)
+ error (_("wrong number of subscripts; expecting %d"), arity);
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (ada_aligned_type (type), lval_memory);
+ return
+ unwrap_value (ada_value_subscript
+ (callee, nargs, argvec.data ()));
}
-
-
- case OP_ATR_POS:
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_pos_atr (expect_type, exp, noside, op, arg1);
-
- case OP_ATR_SIZE:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- return ada_atr_size (expect_type, exp, noside, op, arg1);
-
- case OP_ATR_VAL:
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- type = exp->elts[pc + 2].type;
- if (noside == EVAL_SKIP)
- goto nosideret;
- 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;
- return ada_binop_exp (expect_type, exp, noside, op, arg1, arg2);
-
- case UNOP_PLUS:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- else
- return arg1;
-
- case UNOP_ABS:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_abs (expect_type, exp, noside, op, arg1);
-
- case UNOP_IND:
- preeval_pos = *pos;
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- type = ada_check_typedef (value_type (arg1));
+ case TYPE_CODE_ARRAY:
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
- if (ada_is_array_descriptor_type (type))
- /* GDB allows dereferencing GNAT array descriptors. */
- {
- struct type *arrType = ada_type_of_array (arg1, 0);
-
- if (arrType == NULL)
- error (_("Attempt to dereference null array pointer."));
- return value_at_lazy (arrType, 0);
- }
- else if (type->code () == TYPE_CODE_PTR
- || type->code () == TYPE_CODE_REF
- /* In C you can dereference an array to get the 1st elt. */
- || type->code () == TYPE_CODE_ARRAY)
- {
- /* As mentioned in the OP_VAR_VALUE case, tagged types can
- only be determined by inspecting the object's tag.
- This means that we need to evaluate completely the
- expression in order to get its type. */
-
- if ((type->code () == TYPE_CODE_REF
- || type->code () == TYPE_CODE_PTR)
- && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0))
- {
- arg1
- = evaluate_subexp (nullptr, exp, &preeval_pos, EVAL_NORMAL);
- type = value_type (ada_value_ind (arg1));
- }
- else
- {
- type = to_static_fixed_type
- (ada_aligned_type
- (ada_check_typedef (TYPE_TARGET_TYPE (type))));
- }
- ada_ensure_varsize_limit (type);
- return value_zero (type, lval_memory);
- }
- else if (type->code () == TYPE_CODE_INT)
- {
- /* GDB allows dereferencing an int. */
- if (expect_type == NULL)
- return value_zero (builtin_type (exp->gdbarch)->builtin_int,
- lval_memory);
- else
- {
- expect_type =
- to_static_fixed_type (ada_aligned_type (expect_type));
- return value_zero (expect_type, lval_memory);
- }
- }
+ type = ada_array_element_type (type, nargs);
+ if (type == NULL)
+ error (_("element type of array unknown"));
else
- error (_("Attempt to take contents of a non-pointer value."));
+ return value_zero (ada_aligned_type (type), lval_memory);
}
- arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
- type = ada_check_typedef (value_type (arg1));
-
- if (type->code () == TYPE_CODE_INT)
- /* GDB allows dereferencing an int. If we were given
- the expect_type, then use that as the target type.
- Otherwise, assume that the target type is an int. */
+ return
+ unwrap_value (ada_value_subscript
+ (ada_coerce_to_simple_array (callee),
+ nargs, argvec.data ()));
+ case TYPE_CODE_PTR: /* Pointer to array */
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
- if (expect_type != NULL)
- return ada_value_ind (value_cast (lookup_pointer_type (expect_type),
- arg1));
+ type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
+ type = ada_array_element_type (type, nargs);
+ if (type == NULL)
+ error (_("element type of array unknown"));
else
- return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
- (CORE_ADDR) value_as_address (arg1));
+ return value_zero (ada_aligned_type (type), lval_memory);
}
+ return
+ unwrap_value (ada_value_ptr_subscript (callee, nargs,
+ argvec.data ()));
- if (ada_is_array_descriptor_type (type))
- /* GDB allows dereferencing GNAT array descriptors. */
- return ada_coerce_to_simple_array (arg1);
- else
- return ada_value_ind (arg1);
-
- case STRUCTOP_STRUCT:
- tem = longest_to_int (exp->elts[pc + 1].longconst);
- (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
- preeval_pos = *pos;
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- struct type *type1 = value_type (arg1);
+ default:
+ error (_("Attempt to index or call something other than an "
+ "array or function"));
+ }
+}
- if (ada_is_tagged_type (type1, 1))
- {
- type = ada_lookup_struct_elt_type (type1,
- &exp->elts[pc + 2].string,
- 1, 1);
+bool
+ada_funcall_operation::resolve (struct expression *exp,
+ bool deprocedure_p,
+ bool parse_completion,
+ innermost_block_tracker *tracker,
+ struct type *context_type)
+{
+ operation_up &callee_op = std::get<0> (m_storage);
- /* If the field is not found, check if it exists in the
- extension of this object's type. This means that we
- need to evaluate completely the expression. */
+ ada_var_value_operation *avv
+ = dynamic_cast<ada_var_value_operation *> (callee_op.get ());
+ if (avv == nullptr)
+ return false;
- if (type == NULL)
- {
- arg1
- = evaluate_subexp (nullptr, exp, &preeval_pos, EVAL_NORMAL);
- arg1 = ada_value_struct_elt (arg1,
- &exp->elts[pc + 2].string,
- 0);
- arg1 = unwrap_value (arg1);
- type = value_type (ada_to_fixed_value (arg1));
- }
- }
- else
- type =
- ada_lookup_struct_elt_type (type1, &exp->elts[pc + 2].string, 1,
- 0);
+ symbol *sym = avv->get_symbol ();
+ if (SYMBOL_DOMAIN (sym) != UNDEF_DOMAIN)
+ return false;
- return value_zero (ada_aligned_type (type), lval_memory);
- }
- else
- {
- arg1 = ada_value_struct_elt (arg1, &exp->elts[pc + 2].string, 0);
- arg1 = unwrap_value (arg1);
- return ada_to_fixed_value (arg1);
- }
+ const std::vector<operation_up> &args_up = std::get<1> (m_storage);
+ int nargs = args_up.size ();
+ std::vector<value *> argvec (nargs);
- case OP_TYPE:
- /* The value is not supposed to be used. This is here to make it
- easier to accommodate expressions that contain types. */
- (*pos) += 2;
- if (noside == EVAL_SKIP)
- goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return allocate_value (exp->elts[pc + 1].type);
- else
- error (_("Attempt to use a type name as an expression"));
-
- case OP_AGGREGATE:
- case OP_CHOICES:
- case OP_OTHERS:
- case OP_DISCRETE_RANGE:
- case OP_POSITIONAL:
- case OP_NAME:
- if (noside == EVAL_NORMAL)
- switch (op)
- {
- case OP_NAME:
- error (_("Undefined name, ambiguous name, or renaming used in "
- "component association: %s."), &exp->elts[pc+2].string);
- case OP_AGGREGATE:
- error (_("Aggregates only allowed on the right of an assignment"));
- default:
- internal_error (__FILE__, __LINE__,
- _("aggregate apparently mangled"));
- }
+ for (int i = 0; i < args_up.size (); ++i)
+ argvec[i] = args_up[i]->evaluate (nullptr, exp, EVAL_AVOID_SIDE_EFFECTS);
- ada_forward_operator_length (exp, pc, &oplen, &nargs);
- *pos += oplen - 1;
- for (tem = 0; tem < nargs; tem += 1)
- ada_evaluate_subexp (NULL, exp, pos, noside);
- goto nosideret;
- }
+ const block *block = avv->get_block ();
+ block_symbol resolved
+ = ada_resolve_funcall (sym, block,
+ context_type, parse_completion,
+ nargs, argvec.data (),
+ tracker);
+
+ std::get<0> (m_storage)
+ = make_operation<ada_var_value_operation> (resolved.symbol,
+ resolved.block);
+ return false;
+}
-nosideret:
- return eval_skip_value (exp);
}
+
/* Fixed point */
@@ -14288,336 +12901,6 @@ info_exceptions_command (const char *regexp, int from_tty)
printf_filtered ("%s: %s\n", info.name, paddress (gdbarch, info.addr));
}
- /* Operators */
-/* Information about operators given special treatment in functions
- below. */
-/* Format: OP_DEFN (<operator>, <operator length>, <# args>, <binop>). */
-
-#define ADA_OPERATORS \
- OP_DEFN (OP_VAR_VALUE, 4, 0, 0) \
- OP_DEFN (BINOP_IN_BOUNDS, 3, 2, 0) \
- OP_DEFN (TERNOP_IN_RANGE, 1, 3, 0) \
- OP_DEFN (OP_ATR_FIRST, 1, 2, 0) \
- OP_DEFN (OP_ATR_LAST, 1, 2, 0) \
- OP_DEFN (OP_ATR_LENGTH, 1, 2, 0) \
- OP_DEFN (OP_ATR_IMAGE, 1, 2, 0) \
- OP_DEFN (OP_ATR_MAX, 1, 3, 0) \
- OP_DEFN (OP_ATR_MIN, 1, 3, 0) \
- OP_DEFN (OP_ATR_MODULUS, 1, 1, 0) \
- OP_DEFN (OP_ATR_POS, 1, 2, 0) \
- OP_DEFN (OP_ATR_SIZE, 1, 1, 0) \
- OP_DEFN (OP_ATR_TAG, 1, 1, 0) \
- OP_DEFN (OP_ATR_VAL, 1, 2, 0) \
- OP_DEFN (UNOP_QUAL, 3, 1, 0) \
- OP_DEFN (UNOP_IN_RANGE, 3, 1, 0) \
- OP_DEFN (OP_OTHERS, 1, 1, 0) \
- OP_DEFN (OP_POSITIONAL, 3, 1, 0) \
- OP_DEFN (OP_DISCRETE_RANGE, 1, 2, 0)
-
-static void
-ada_operator_length (const struct expression *exp, int pc, int *oplenp,
- int *argsp)
-{
- switch (exp->elts[pc - 1].opcode)
- {
- default:
- operator_length_standard (exp, pc, oplenp, argsp);
- break;
-
-#define OP_DEFN(op, len, args, binop) \
- case op: *oplenp = len; *argsp = args; break;
- ADA_OPERATORS;
-#undef OP_DEFN
-
- case OP_AGGREGATE:
- *oplenp = 3;
- *argsp = longest_to_int (exp->elts[pc - 2].longconst);
- break;
-
- case OP_CHOICES:
- *oplenp = 3;
- *argsp = longest_to_int (exp->elts[pc - 2].longconst) + 1;
- break;
- }
-}
-
-/* Implementation of the exp_descriptor method operator_check. */
-
-static int
-ada_operator_check (struct expression *exp, int pos,
- int (*objfile_func) (struct objfile *objfile, void *data),
- void *data)
-{
- const union exp_element *const elts = exp->elts;
- struct type *type = NULL;
-
- switch (elts[pos].opcode)
- {
- case UNOP_IN_RANGE:
- case UNOP_QUAL:
- type = elts[pos + 1].type;
- break;
-
- default:
- return operator_check_standard (exp, pos, objfile_func, data);
- }
-
- /* Invoke callbacks for TYPE and OBJFILE if they were set as non-NULL. */
-
- if (type && TYPE_OBJFILE (type)
- && (*objfile_func) (TYPE_OBJFILE (type), data))
- return 1;
-
- return 0;
-}
-
-/* As for operator_length, but assumes PC is pointing at the first
- element of the operator, and gives meaningful results only for the
- Ada-specific operators, returning 0 for *OPLENP and *ARGSP otherwise. */
-
-static void
-ada_forward_operator_length (struct expression *exp, int pc,
- int *oplenp, int *argsp)
-{
- switch (exp->elts[pc].opcode)
- {
- default:
- *oplenp = *argsp = 0;
- break;
-
-#define OP_DEFN(op, len, args, binop) \
- case op: *oplenp = len; *argsp = args; break;
- ADA_OPERATORS;
-#undef OP_DEFN
-
- case OP_AGGREGATE:
- *oplenp = 3;
- *argsp = longest_to_int (exp->elts[pc + 1].longconst);
- break;
-
- case OP_CHOICES:
- *oplenp = 3;
- *argsp = longest_to_int (exp->elts[pc + 1].longconst) + 1;
- break;
-
- case OP_STRING:
- case OP_NAME:
- {
- int len = longest_to_int (exp->elts[pc + 1].longconst);
-
- *oplenp = 4 + BYTES_TO_EXP_ELEM (len + 1);
- *argsp = 0;
- break;
- }
- }
-}
-
-static int
-ada_dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
-{
- enum exp_opcode op = exp->elts[elt].opcode;
- int oplen, nargs;
- int pc = elt;
- int i;
-
- ada_forward_operator_length (exp, elt, &oplen, &nargs);
-
- switch (op)
- {
- /* Ada attributes ('Foo). */
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- case OP_ATR_LENGTH:
- case OP_ATR_IMAGE:
- case OP_ATR_MAX:
- case OP_ATR_MIN:
- case OP_ATR_MODULUS:
- case OP_ATR_POS:
- case OP_ATR_SIZE:
- case OP_ATR_TAG:
- case OP_ATR_VAL:
- break;
-
- case UNOP_IN_RANGE:
- case UNOP_QUAL:
- /* XXX: gdb_sprint_host_address, type_sprint */
- fprintf_filtered (stream, _("Type @"));
- gdb_print_host_address (exp->elts[pc + 1].type, stream);
- fprintf_filtered (stream, " (");
- type_print (exp->elts[pc + 1].type, NULL, stream, 0);
- fprintf_filtered (stream, ")");
- break;
- case BINOP_IN_BOUNDS:
- fprintf_filtered (stream, " (%d)",
- longest_to_int (exp->elts[pc + 2].longconst));
- break;
- case TERNOP_IN_RANGE:
- break;
-
- case OP_AGGREGATE:
- case OP_OTHERS:
- case OP_DISCRETE_RANGE:
- case OP_POSITIONAL:
- case OP_CHOICES:
- break;
-
- case OP_NAME:
- case OP_STRING:
- {
- char *name = &exp->elts[elt + 2].string;
- int len = longest_to_int (exp->elts[elt + 1].longconst);
-
- fprintf_filtered (stream, "Text: `%.*s'", len, name);
- break;
- }
-
- default:
- return dump_subexp_body_standard (exp, stream, elt);
- }
-
- elt += oplen;
- for (i = 0; i < nargs; i += 1)
- elt = dump_subexp (exp, stream, elt);
-
- return elt;
-}
-
-/* The Ada extension of print_subexp (q.v.). */
-
-static void
-ada_print_subexp (struct expression *exp, int *pos,
- struct ui_file *stream, enum precedence prec)
-{
- int oplen, nargs, i;
- int pc = *pos;
- enum exp_opcode op = exp->elts[pc].opcode;
-
- ada_forward_operator_length (exp, pc, &oplen, &nargs);
-
- *pos += oplen;
- switch (op)
- {
- default:
- *pos -= oplen;
- print_subexp_standard (exp, pos, stream, prec);
- return;
-
- case OP_VAR_VALUE:
- fputs_filtered (exp->elts[pc + 2].symbol->natural_name (), stream);
- return;
-
- case BINOP_IN_BOUNDS:
- /* XXX: sprint_subexp */
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered (" in ", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered ("'range", stream);
- if (exp->elts[pc + 1].longconst > 1)
- fprintf_filtered (stream, "(%ld)",
- (long) exp->elts[pc + 1].longconst);
- return;
-
- case TERNOP_IN_RANGE:
- if (prec >= PREC_EQUAL)
- fputs_filtered ("(", stream);
- /* XXX: sprint_subexp */
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered (" in ", stream);
- print_subexp (exp, pos, stream, PREC_EQUAL);
- fputs_filtered (" .. ", stream);
- print_subexp (exp, pos, stream, PREC_EQUAL);
- if (prec >= PREC_EQUAL)
- fputs_filtered (")", stream);
- return;
-
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- case OP_ATR_LENGTH:
- case OP_ATR_IMAGE:
- case OP_ATR_MAX:
- case OP_ATR_MIN:
- case OP_ATR_MODULUS:
- case OP_ATR_POS:
- case OP_ATR_SIZE:
- case OP_ATR_TAG:
- case OP_ATR_VAL:
- if (exp->elts[*pos].opcode == OP_TYPE)
- {
- if (exp->elts[*pos + 1].type->code () != TYPE_CODE_VOID)
- LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0,
- &type_print_raw_options);
- *pos += 3;
- }
- else
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fprintf_filtered (stream, "'%s", ada_attribute_name (op));
- if (nargs > 1)
- {
- int tem;
-
- for (tem = 1; tem < nargs; tem += 1)
- {
- fputs_filtered ((tem == 1) ? " (" : ", ", stream);
- print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
- }
- fputs_filtered (")", stream);
- }
- return;
-
- case UNOP_QUAL:
- type_print (exp->elts[pc + 1].type, "", stream, 0);
- fputs_filtered ("'(", stream);
- print_subexp (exp, pos, stream, PREC_PREFIX);
- fputs_filtered (")", stream);
- return;
-
- case UNOP_IN_RANGE:
- /* XXX: sprint_subexp */
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered (" in ", stream);
- LA_PRINT_TYPE (exp->elts[pc + 1].type, "", stream, 1, 0,
- &type_print_raw_options);
- return;
-
- case OP_DISCRETE_RANGE:
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered ("..", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- return;
-
- case OP_OTHERS:
- fputs_filtered ("others => ", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- return;
-
- case OP_CHOICES:
- for (i = 0; i < nargs-1; i += 1)
- {
- if (i > 0)
- fputs_filtered ("|", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- }
- fputs_filtered (" => ", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- return;
-
- case OP_POSITIONAL:
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- return;
-
- case OP_AGGREGATE:
- fputs_filtered ("(", stream);
- for (i = 0; i < nargs; i += 1)
- {
- if (i > 0)
- fputs_filtered (", ", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- }
- fputs_filtered (")", stream);
- return;
- }
-}
-
/* Table mapping opcodes into strings for printing operators
and precedences of the operators. */
@@ -14658,14 +12941,6 @@ static const struct op_print ada_op_print_tab[] = {
/* Language vector */
-static const struct exp_descriptor ada_exp_descriptor = {
- ada_print_subexp,
- ada_operator_length,
- ada_operator_check,
- ada_dump_subexp_body,
- ada_evaluate_subexp
-};
-
/* symbol_name_matcher_ftype adapter for wild_match. */
static bool
@@ -15258,14 +13533,6 @@ class ada_language : public language_defn
void post_parser (expression_up *expp, struct parser_state *ps)
const override
{
- struct type *context_type = NULL;
- int pc = 0;
-
- if (ps->void_context_p)
- context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
-
- resolve_subexp (expp, &pc, 1, context_type, ps->parse_completion,
- ps->block_tracker);
}
/* See language.h. */
@@ -15332,11 +13599,6 @@ class ada_language : public language_defn
/* See language.h. */
- const struct exp_descriptor *expression_ops () const override
- { return &ada_exp_descriptor; }
-
- /* See language.h. */
-
const struct op_print *opcode_print_table () const override
{ return ada_op_print_tab; }
--
2.26.2
More information about the Gdb-patches
mailing list