\f
-/* Table of operators and their precedences for printing expressions. */
-
-const struct op_print f_language::op_print_tab[] =
-{
- {"+", BINOP_ADD, PREC_ADD, 0},
- {"+", UNOP_PLUS, PREC_PREFIX, 0},
- {"-", BINOP_SUB, PREC_ADD, 0},
- {"-", UNOP_NEG, PREC_PREFIX, 0},
- {"*", BINOP_MUL, PREC_MUL, 0},
- {"/", BINOP_DIV, PREC_MUL, 0},
- {"DIV", BINOP_INTDIV, PREC_MUL, 0},
- {"MOD", BINOP_REM, PREC_MUL, 0},
- {"=", BINOP_ASSIGN, PREC_ASSIGN, 1},
- {".OR.", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
- {".AND.", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
- {".NOT.", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
- {".EQ.", BINOP_EQUAL, PREC_EQUAL, 0},
- {".NE.", BINOP_NOTEQUAL, PREC_EQUAL, 0},
- {".LE.", BINOP_LEQ, PREC_ORDER, 0},
- {".GE.", BINOP_GEQ, PREC_ORDER, 0},
- {".GT.", BINOP_GTR, PREC_ORDER, 0},
- {".LT.", BINOP_LESS, PREC_ORDER, 0},
- {"**", UNOP_IND, PREC_PREFIX, 0},
- {"@", BINOP_REPEAT, PREC_REPEAT, 0},
- {NULL, OP_NULL, PREC_REPEAT, 0}
-};
-\f
-
/* A helper function for the "bound" intrinsics that checks that TYPE
is an array. LBOUND_P is true for lower bound; this is used for
the error message, if any. */
return fortran_associated (exp->gdbarch, exp->language_defn, arg1, arg2);
}
+/* Implement FORTRAN_ARRAY_SIZE expression, this corresponds to the 'SIZE'
+ keyword. Both GDBARCH and LANG are extracted from the expression being
+ evaluated. ARRAY is the value that should be an array, though this will
+ not have been checked before calling this function. DIM is optional, if
+ present then it should be an integer identifying a dimension of the
+ array to ask about. As with ARRAY the validity of DIM is not checked
+ before calling this function.
+
+ Return either the total number of elements in ARRAY (when DIM is
+ nullptr), or the number of elements in dimension DIM. */
+
+static struct value *
+fortran_array_size (struct gdbarch *gdbarch, const language_defn *lang,
+ struct value *array, struct value *dim_val = nullptr)
+{
+ /* Check that ARRAY is the correct type. */
+ struct type *array_type = check_typedef (value_type (array));
+ if (array_type->code () != TYPE_CODE_ARRAY)
+ error (_("SIZE can only be applied to arrays"));
+ if (type_not_allocated (array_type) || type_not_associated (array_type))
+ error (_("SIZE can only be used on allocated/associated arrays"));
+
+ int ndimensions = calc_f77_array_dims (array_type);
+ int dim = -1;
+ LONGEST result = 0;
+
+ if (dim_val != nullptr)
+ {
+ if (check_typedef (value_type (dim_val))->code () != TYPE_CODE_INT)
+ error (_("DIM argument to SIZE must be an integer"));
+ dim = (int) value_as_long (dim_val);
+
+ if (dim < 1 || dim > ndimensions)
+ error (_("DIM argument to SIZE must be between 1 and %d"),
+ ndimensions);
+ }
+
+ /* Now walk over all the dimensions of the array totalling up the
+ elements in each dimension. */
+ for (int i = ndimensions - 1; i >= 0; --i)
+ {
+ /* If this is the requested dimension then we're done. Grab the
+ bounds and return. */
+ if (i == dim - 1 || dim == -1)
+ {
+ LONGEST lbound, ubound;
+ struct type *range = array_type->index_type ();
+
+ if (!get_discrete_bounds (range, &lbound, &ubound))
+ error (_("failed to find array bounds"));
+
+ LONGEST dim_size = (ubound - lbound + 1);
+ if (result == 0)
+ result = dim_size;
+ else
+ result *= dim_size;
+
+ if (dim != -1)
+ break;
+ }
+
+ /* Peel off another dimension of the array. */
+ array_type = TYPE_TARGET_TYPE (array_type);
+ }
+
+ struct type *result_type
+ = builtin_f_type (gdbarch)->builtin_integer;
+ return value_from_longest (result_type, result);
+}
+
+/* See f-exp.h. */
+
+struct value *
+eval_op_f_array_size (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside,
+ enum exp_opcode opcode,
+ struct value *arg1)
+{
+ gdb_assert (opcode == FORTRAN_ARRAY_SIZE);
+ return fortran_array_size (exp->gdbarch, exp->language_defn, arg1);
+}
+
+/* See f-exp.h. */
+
+struct value *
+eval_op_f_array_size (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside,
+ enum exp_opcode opcode,
+ struct value *arg1,
+ struct value *arg2)
+{
+ gdb_assert (opcode == FORTRAN_ARRAY_SIZE);
+ return fortran_array_size (exp->gdbarch, exp->language_defn, arg1, arg2);
+}
+
/* A helper function for UNOP_ABS. */
struct value *
enum exp_opcode opcode,
struct value *arg1)
{
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
struct type *type = value_type (arg1);
switch (type->code ())
{
enum exp_opcode opcode,
struct value *arg1, struct value *arg2)
{
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
struct type *type = value_type (arg1);
if (type->code () != value_type (arg2)->code ())
error (_("non-matching types for parameters to MOD ()"));
enum exp_opcode opcode,
struct value *arg1)
{
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
struct type *type = value_type (arg1);
if (type->code () != TYPE_CODE_FLT)
error (_("argument to CEILING must be of type float"));
enum exp_opcode opcode,
struct value *arg1)
{
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
struct type *type = value_type (arg1);
if (type->code () != TYPE_CODE_FLT)
error (_("argument to FLOOR must be of type float"));
enum exp_opcode opcode,
struct value *arg1, struct value *arg2)
{
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
struct type *type = value_type (arg1);
if (type->code () != value_type (arg2)->code ())
error (_("non-matching types for parameters to MODULO ()"));
enum exp_opcode opcode,
struct value *arg1, struct value *arg2)
{
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
struct type *type = builtin_f_type(exp->gdbarch)->builtin_complex_s16;
return value_literal_complex (arg1, arg2, type);
}
return value_from_longest (result_type, result_value);
}
+/* See f-exp.h. */
+
+struct value *
+eval_op_f_rank (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside,
+ enum exp_opcode op,
+ struct value *arg1)
+{
+ gdb_assert (op == UNOP_FORTRAN_RANK);
+
+ struct type *result_type
+ = builtin_f_type (exp->gdbarch)->builtin_integer;
+ struct type *type = check_typedef (value_type (arg1));
+ if (type->code () != TYPE_CODE_ARRAY)
+ return value_from_longest (result_type, 0);
+ LONGEST ndim = calc_f77_array_dims (type);
+ return value_from_longest (result_type, ndim);
+}
+
namespace expr
{
projects / deliverable / binutils-gdb.git / blobdiff