+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ /* If the user attempts to subscript something that has no target
+ type (like a plain int variable for example), then report this
+ as an error. */
+
+ type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
+ if (type)
+ return value_zero (type, VALUE_LVAL (arg1));
+ else
+ error ("cannot subscript something of type `%s'",
+ TYPE_NAME (VALUE_TYPE (arg1)));
+ }
+
+ if (binop_user_defined_p (op, arg1, arg2))
+ return value_x_binop (arg1, arg2, op, OP_NULL);
+ else
+ return value_subscript (arg1, arg2);
+
+ case BINOP_IN:
+ arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
+ arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+ return value_in (arg1, arg2);
+
+ case MULTI_SUBSCRIPT:
+ (*pos) += 2;
+ nargs = longest_to_int (exp->elts[pc + 1].longconst);
+ arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
+ while (nargs-- > 0)
+ {
+ arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+ /* FIXME: EVAL_SKIP handling may not be correct. */
+ if (noside == EVAL_SKIP)
+ {
+ if (nargs > 0)
+ {
+ continue;
+ }
+ else
+ {
+ goto nosideret;
+ }
+ }
+ /* FIXME: EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ /* If the user attempts to subscript something that has no target
+ type (like a plain int variable for example), then report this
+ as an error. */
+
+ type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
+ if (type != NULL)
+ {
+ arg1 = value_zero (type, VALUE_LVAL (arg1));
+ noside = EVAL_SKIP;
+ continue;
+ }
+ else
+ {
+ error ("cannot subscript something of type `%s'",
+ TYPE_NAME (VALUE_TYPE (arg1)));
+ }
+ }
+
+ if (binop_user_defined_p (op, arg1, arg2))
+ {
+ arg1 = value_x_binop (arg1, arg2, op, OP_NULL);
+ }
+ else
+ {
+ arg1 = value_subscript (arg1, arg2);
+ }
+ }
+ return (arg1);
+
+ multi_f77_subscript:
+ {
+ int subscript_array[MAX_FORTRAN_DIMS+1]; /* 1-based array of
+ subscripts, max == 7 */
+ int array_size_array[MAX_FORTRAN_DIMS+1];
+ int ndimensions=1,i;
+ struct type *tmp_type;
+ int offset_item; /* The array offset where the item lives */
+
+ if (nargs > MAX_FORTRAN_DIMS)
+ error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
+
+ ndimensions = calc_f77_array_dims (VALUE_TYPE (arg1));
+
+ if (nargs != ndimensions)
+ error ("Wrong number of subscripts");
+
+ /* Now that we know we have a legal array subscript expression
+ let us actually find out where this element exists in the array. */
+
+ tmp_type = VALUE_TYPE (arg1);
+ offset_item = 0;
+ for (i = 1; i <= nargs; i++)
+ {
+ /* Evaluate each subscript, It must be a legal integer in F77 */
+ arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+
+ if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
+ error ("Array subscripts must be of type integer");
+
+ /* Fill in the subscript and array size arrays */
+
+ subscript_array[i] = (* (unsigned int *) VALUE_CONTENTS(arg2));
+
+ retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
+ if (retcode == BOUND_FETCH_ERROR)
+ error ("Cannot obtain dynamic upper bound");
+
+ retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
+ if (retcode == BOUND_FETCH_ERROR)
+ error("Cannot obtain dynamic lower bound");
+
+ array_size_array[i] = upper - lower + 1;
+
+ /* Zero-normalize subscripts so that offsetting will work. */
+
+ subscript_array[i] -= lower;
+
+ /* If we are at the bottom of a multidimensional
+ array type then keep a ptr to the last ARRAY
+ type around for use when calling value_subscript()
+ below. This is done because we pretend to value_subscript
+ that we actually have a one-dimensional array
+ of base element type that we apply a simple
+ offset to. */
+
+ if (i < nargs)
+ tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ }
+
+ /* Now let us calculate the offset for this item */
+
+ offset_item = subscript_array[ndimensions];
+
+ for (i = ndimensions - 1; i >= 1; i--)
+ offset_item =
+ array_size_array[i] * offset_item + subscript_array[i];
+
+ /* Construct a value node with the value of the offset */
+
+ arg2 = value_from_longest (builtin_type_f_integer, offset_item);
+
+ /* Let us now play a dirty trick: we will take arg1
+ which is a value node pointing to the topmost level
+ of the multidimensional array-set and pretend
+ that it is actually a array of the final element
+ type, this will ensure that value_subscript()
+ returns the correct type value */
+
+ VALUE_TYPE (arg1) = tmp_type;
+ return value_ind (value_add (value_coerce_array (arg1), arg2));
+ }
+
+ case BINOP_LOGICAL_AND:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ {
+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ goto nosideret;
+ }
projects / binutils.git / blobdiff