+/* Total number of component associations in the aggregate starting at
+ index PC in EXP. Assumes that index PC is the start of an
+ OP_AGGREGATE. */
+
+static int
+num_component_specs (struct expression *exp, int pc)
+{
+ int n, m, i;
+ m = exp->elts[pc + 1].longconst;
+ pc += 3;
+ n = 0;
+ for (i = 0; i < m; i += 1)
+ {
+ switch (exp->elts[pc].opcode)
+ {
+ default:
+ n += 1;
+ break;
+ case OP_CHOICES:
+ n += exp->elts[pc + 1].longconst;
+ break;
+ }
+ ada_evaluate_subexp (NULL, exp, &pc, EVAL_SKIP);
+ }
+ return n;
+}
+
+/* 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). */
+
+static void
+assign_component (struct value *container, struct value *lhs, LONGEST index,
+ struct expression *exp, int *pos)
+{
+ struct value *mark = value_mark ();
+ struct value *elt;
+ if (TYPE_CODE (value_type (lhs)) == TYPE_CODE_ARRAY)
+ {
+ struct value *index_val = value_from_longest (builtin_type_int, 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 (unwrap_value (elt));
+ }
+
+ if (exp->elts[*pos].opcode == OP_AGGREGATE)
+ assign_aggregate (container, elt, exp, pos, EVAL_NORMAL);
+ else
+ value_assign_to_component (container, elt,
+ ada_evaluate_subexp (NULL, exp, pos,
+ EVAL_NORMAL));
+
+ value_free_to_mark (mark);
+}
+
+/* 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. */
+
+static struct value *
+assign_aggregate (struct value *container,
+ struct value *lhs, struct expression *exp,
+ int *pos, enum noside noside)
+{
+ struct type *lhs_type;
+ int n = exp->elts[*pos+1].longconst;
+ LONGEST low_index, high_index;
+ int num_specs;
+ LONGEST *indices;
+ int max_indices, num_indices;
+ int is_array_aggregate;
+ int i;
+ struct value *mark = value_mark ();
+
+ *pos += 3;
+ if (noside != EVAL_NORMAL)
+ {
+ int i;
+ 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)))
+ 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 = value_type (lhs);
+ if (ada_is_direct_array_type (lhs_type))
+ {
+ lhs = ada_coerce_to_simple_array (lhs);
+ lhs_type = value_type (lhs);
+ low_index = TYPE_ARRAY_LOWER_BOUND_VALUE (lhs_type);
+ high_index = TYPE_ARRAY_UPPER_BOUND_VALUE (lhs_type);
+ is_array_aggregate = 1;
+ }
+ else if (TYPE_CODE (lhs_type) == TYPE_CODE_STRUCT)
+ {
+ low_index = 0;
+ high_index = num_visible_fields (lhs_type) - 1;
+ is_array_aggregate = 0;
+ }
+ else
+ error (_("Left-hand side must be array or record."));
+
+ num_specs = num_component_specs (exp, *pos - 3);
+ max_indices = 4 * num_specs + 4;
+ indices = alloca (max_indices * sizeof (indices[0]));
+ indices[0] = indices[1] = low_index - 1;
+ indices[2] = indices[3] = high_index + 1;
+ num_indices = 4;
+
+ for (i = 0; i < n; i += 1)
+ {
+ switch (exp->elts[*pos].opcode)
+ {
+ case OP_CHOICES:
+ aggregate_assign_from_choices (container, lhs, exp, pos, indices,
+ &num_indices, max_indices,
+ low_index, high_index);
+ break;
+ case OP_POSITIONAL:
+ aggregate_assign_positional (container, lhs, exp, pos, indices,
+ &num_indices, max_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,
+ num_indices, low_index, high_index);
+ break;
+ default:
+ error (_("Internal error: bad aggregate clause"));
+ }
+ }
+
+ return container;
+}
+
+/* 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[0 .. MAX_INDICES-1]
+ updating *NUM_INDICES as needed. CONTAINER is as for
+ assign_aggregate. */
+static void
+aggregate_assign_positional (struct value *container,
+ struct value *lhs, struct expression *exp,
+ int *pos, LONGEST *indices, int *num_indices,
+ int max_indices, LONGEST low, LONGEST high)
+{
+ LONGEST ind = longest_to_int (exp->elts[*pos + 1].longconst) + low;
+
+ if (ind - 1 == high)
+ warning (_("Extra components in aggregate ignored."));
+ if (ind <= high)
+ {
+ add_component_interval (ind, ind, indices, num_indices, max_indices);
+ *pos += 3;
+ assign_component (container, lhs, ind, exp, pos);
+ }
+ 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[0 .. MAX_INDICES-1], updating *NUM_INDICES as
+ needed. CONTAINER is as for assign_aggregate. */
+static void
+aggregate_assign_from_choices (struct value *container,
+ struct value *lhs, struct expression *exp,
+ int *pos, LONGEST *indices, int *num_indices,
+ int max_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;
+ char *name;
+ switch (op)
+ {
+ case OP_NAME:
+ name = &exp->elts[choice_pos + 2].string;
+ break;
+ case OP_VAR_VALUE:
+ name = SYMBOL_NATURAL_NAME (exp->elts[choice_pos + 2].symbol);
+ 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, num_indices,
+ max_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[0 .. NUM_INDICES-1]. 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, LONGEST *indices, int num_indices,
+ LONGEST low, LONGEST high)
+{
+ int i;
+ int expr_pc = *pos+1;
+
+ for (i = 0; i < num_indices - 2; i += 2)
+ {
+ LONGEST ind;
+ for (ind = indices[i + 1] + 1; ind < indices[i + 2]; ind += 1)
+ {
+ int pos;
+ pos = expr_pc;
+ assign_component (container, lhs, ind, exp, &pos);
+ }
+ }
+ ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
+}
+
+/* Add the interval [LOW .. HIGH] to the sorted set of intervals
+ [ INDICES[0] .. INDICES[1] ],..., [ INDICES[*SIZE-2] .. INDICES[*SIZE-1] ],
+ modifying *SIZE as needed. It is an error if *SIZE exceeds
+ MAX_SIZE. The resulting intervals do not overlap. */
+static void
+add_component_interval (LONGEST low, LONGEST high,
+ LONGEST* indices, int *size, int max_size)
+{
+ int i, j;
+ for (i = 0; i < *size; i += 2) {
+ if (high >= indices[i] && low <= indices[i + 1])
+ {
+ int kh;
+ for (kh = i + 2; kh < *size; kh += 2)
+ if (high < indices[kh])
+ break;
+ if (low < indices[i])
+ indices[i] = low;
+ indices[i + 1] = indices[kh - 1];
+ if (high > indices[i + 1])
+ indices[i + 1] = high;
+ memcpy (indices + i + 2, indices + kh, *size - kh);
+ *size -= kh - i - 2;
+ return;
+ }
+ else if (high < indices[i])
+ break;
+ }
+
+ if (*size == max_size)
+ error (_("Internal error: miscounted aggregate components."));
+ *size += 2;
+ for (j = *size-1; j >= i+2; j -= 1)
+ indices[j] = indices[j - 2];
+ indices[i] = low;
+ indices[i + 1] = high;
+}
+
+static struct value *