diff options
| author | Andrew Burgess <andrew.burgess@embecosm.com> | 2020-05-07 16:27:16 +0100 |
|---|---|---|
| committer | Andrew Burgess <andrew.burgess@embecosm.com> | 2020-09-19 09:44:58 +0100 |
| commit | 6d81691950f8c4be4a49a85a672255c140e82468 (patch) | |
| tree | 66e445599cf0dbd55335407b53133901c35fefbe /gdb/f-lang.c | |
| parent | 8c37706a511209f6a92d887812c14e860c3bd0a0 (diff) | |
| download | fsf-binutils-gdb-6d81691950f8c4be4a49a85a672255c140e82468.zip fsf-binutils-gdb-6d81691950f8c4be4a49a85a672255c140e82468.tar.gz fsf-binutils-gdb-6d81691950f8c4be4a49a85a672255c140e82468.tar.bz2 | |
gdb/fortran: Move Fortran expression handling into f-lang.c
The Fortran specific OP_F77_UNDETERMINED_ARGLIST is currently handled
in the generic expression handling code. There's no reason why this
should be the case, so this commit moves handling of this into Fortran
specific files.
There should be no user visible changes after this commit.
gdb/ChangeLog:
* eval.c: Remove 'f-lang.h' include.
(value_f90_subarray): Moved to f-lang.c.
(eval_call): Renamed to...
(evaluate_subexp_do_call): ...this, is no longer static, header
comment moved into header file.
(evaluate_funcall): Update call to eval_call.
(skip_undetermined_arglist): Moved to f-lang.c.
(fortran_value_subarray): Likewise.
(evaluate_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to evaluate_subexp_f.
(calc_f77_array_dims): Moved to f-lang.c
* expprint.c (print_subexp_funcall): New function.
(print_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to print_subexp_f, OP_FUNCALL uses new function.
(dump_subexp_body_funcall): New function.
(dump_subexp_body_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to dump_subexp_f, OP_FUNCALL uses new function.
* expression.h (evaluate_subexp_do_call): Declare.
* f-lang.c (value_f90_subarray): Moved from eval.c.
(skip_undetermined_arglist): Likewise.
(calc_f77_array_dims): Likewise.
(fortran_value_subarray): Likewise.
(evaluate_subexp_f): Add OP_F77_UNDETERMINED_ARGLIST support.
(operator_length_f): Likewise.
(print_subexp_f): Likewise.
(dump_subexp_body_f): Likewise.
* fortran-operator.def (OP_F77_UNDETERMINED_ARGLIST): Move
declaration of this operation to here.
* parse.c (operator_length_standard): OP_F77_UNDETERMINED_ARGLIST
support moved to operator_length_f.
* parser-defs.h (dump_subexp_body_funcall): Declare.
(print_subexp_funcall): Declare.
* std-operator.def (OP_F77_UNDETERMINED_ARGLIST): Moved to
fortran-operator.def.
Diffstat (limited to 'gdb/f-lang.c')
| -rw-r--r-- | gdb/f-lang.c | 221 |
1 files changed, 221 insertions, 0 deletions
diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 8bc708d..e13097b 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -114,6 +114,134 @@ enum f_primitive_types { nr_f_primitive_types }; +/* Called from fortran_value_subarray to take a slice of an array or a + string. ARRAY is the array or string to be accessed. EXP, POS, and + NOSIDE are as for evaluate_subexp_standard. Return a value that is a + slice of the array. */ + +static struct value * +value_f90_subarray (struct value *array, + struct expression *exp, int *pos, enum noside noside) +{ + int pc = (*pos) + 1; + LONGEST low_bound, high_bound; + struct type *range = check_typedef (value_type (array)->index_type ()); + enum range_type range_type + = (enum range_type) longest_to_int (exp->elts[pc].longconst); + + *pos += 3; + + if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) + low_bound = range->bounds ()->low.const_val (); + else + low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); + + if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) + high_bound = range->bounds ()->high.const_val (); + else + high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); + + return value_slice (array, low_bound, high_bound - low_bound + 1); +} + +/* Helper for skipping all the arguments in an undetermined argument list. + This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST + case of evaluate_subexp_standard as multiple, but not all, code paths + require a generic skip. */ + +static void +skip_undetermined_arglist (int nargs, struct expression *exp, int *pos, + enum noside noside) +{ + for (int i = 0; i < nargs; ++i) + evaluate_subexp (nullptr, exp, pos, noside); +} + +/* Return the number of dimensions for a Fortran array or string. */ + +int +calc_f77_array_dims (struct type *array_type) +{ + int ndimen = 1; + struct type *tmp_type; + + if ((array_type->code () == TYPE_CODE_STRING)) + return 1; + + if ((array_type->code () != TYPE_CODE_ARRAY)) + error (_("Can't get dimensions for a non-array type")); + + tmp_type = array_type; + + while ((tmp_type = TYPE_TARGET_TYPE (tmp_type))) + { + if (tmp_type->code () == TYPE_CODE_ARRAY) + ++ndimen; + } + return ndimen; +} + +/* Called from evaluate_subexp_standard to perform array indexing, and + sub-range extraction, for Fortran. As well as arrays this function + also handles strings as they can be treated like arrays of characters. + ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are + as for evaluate_subexp_standard, and NARGS is the number of arguments + in this access (e.g. 'array (1,2,3)' would be NARGS 3). */ + +static struct value * +fortran_value_subarray (struct value *array, struct expression *exp, + int *pos, int nargs, enum noside noside) +{ + if (exp->elts[*pos].opcode == OP_RANGE) + return value_f90_subarray (array, exp, pos, noside); + + if (noside == EVAL_SKIP) + { + skip_undetermined_arglist (nargs, exp, pos, noside); + /* Return the dummy value with the correct type. */ + return array; + } + + LONGEST subscript_array[MAX_FORTRAN_DIMS]; + int ndimensions = 1; + struct type *type = check_typedef (value_type (array)); + + if (nargs > MAX_FORTRAN_DIMS) + error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); + + ndimensions = calc_f77_array_dims (type); + + if (nargs != ndimensions) + error (_("Wrong number of subscripts")); + + gdb_assert (nargs > 0); + + /* Now that we know we have a legal array subscript expression let us + actually find out where this element exists in the array. */ + + /* Take array indices left to right. */ + for (int i = 0; i < nargs; i++) + { + /* Evaluate each subscript; it must be a legal integer in F77. */ + value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); + + /* Fill in the subscript array. */ + subscript_array[i] = value_as_long (arg2); + } + + /* Internal type of array is arranged right to left. */ + for (int i = nargs; i > 0; i--) + { + struct type *array_type = check_typedef (value_type (array)); + LONGEST index = subscript_array[i - 1]; + + array = value_subscripted_rvalue (array, index, + f77_get_lowerbound (array_type)); + } + + return array; +} + /* Special expression evaluation cases for Fortran. */ static struct value * @@ -285,6 +413,87 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp, TYPE_LENGTH (type)); return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, TYPE_LENGTH (TYPE_TARGET_TYPE (type))); + + + case OP_F77_UNDETERMINED_ARGLIST: + /* Remember that in F77, functions, substring ops and array subscript + operations cannot be disambiguated at parse time. We have made + all array subscript operations, substring operations as well as + function calls come here and we now have to discover what the heck + this thing actually was. If it is a function, we process just as + if we got an OP_FUNCALL. */ + int nargs = longest_to_int (exp->elts[pc + 1].longconst); + (*pos) += 2; + + /* First determine the type code we are dealing with. */ + arg1 = evaluate_subexp (nullptr, exp, pos, noside); + type = check_typedef (value_type (arg1)); + enum type_code code = type->code (); + + if (code == TYPE_CODE_PTR) + { + /* Fortran always passes variable to subroutines as pointer. + So we need to look into its target type to see if it is + array, string or function. If it is, we need to switch + to the target value the original one points to. */ + struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type)); + + if (target_type->code () == TYPE_CODE_ARRAY + || target_type->code () == TYPE_CODE_STRING + || target_type->code () == TYPE_CODE_FUNC) + { + arg1 = value_ind (arg1); + type = check_typedef (value_type (arg1)); + code = type->code (); + } + } + + switch (code) + { + case TYPE_CODE_ARRAY: + case TYPE_CODE_STRING: + return fortran_value_subarray (arg1, exp, pos, nargs, noside); + + case TYPE_CODE_PTR: + case TYPE_CODE_FUNC: + case TYPE_CODE_INTERNAL_FUNCTION: + { + /* It's a function call. Allocate arg vector, including + space for the function to be called in argvec[0] and a + termination NULL. */ + struct value **argvec = (struct value **) + alloca (sizeof (struct value *) * (nargs + 2)); + argvec[0] = arg1; + int tem = 1; + for (; tem <= nargs; tem++) + { + argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside); + /* Arguments in Fortran are passed by address. Coerce the + arguments here rather than in value_arg_coerce as + otherwise the call to malloc to place the non-lvalue + parameters in target memory is hit by this Fortran + specific logic. This results in malloc being called + with a pointer to an integer followed by an attempt to + malloc the arguments to malloc in target memory. + Infinite recursion ensues. */ + if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC) + { + bool is_artificial + = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1); + argvec[tem] = fortran_argument_convert (argvec[tem], + is_artificial); + } + } + argvec[tem] = 0; /* signal end of arglist */ + if (noside == EVAL_SKIP) + return eval_skip_value (exp); + return evaluate_subexp_do_call (exp, noside, nargs, argvec, NULL, + expect_type); + } + + default: + error (_("Cannot perform substring on this type")); + } } /* Should be unreachable. */ @@ -318,6 +527,11 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp, oplen = 1; args = 2; break; + + case OP_F77_UNDETERMINED_ARGLIST: + oplen = 3; + args = 1 + longest_to_int (exp->elts[pc - 2].longconst); + break; } *oplenp = oplen; @@ -390,6 +604,10 @@ print_subexp_f (struct expression *exp, int *pos, case BINOP_FORTRAN_MODULO: print_binop_subexp_f (exp, pos, stream, prec, "MODULO"); return; + + case OP_F77_UNDETERMINED_ARGLIST: + print_subexp_funcall (exp, pos, stream); + return; } } @@ -432,6 +650,9 @@ dump_subexp_body_f (struct expression *exp, case BINOP_FORTRAN_MODULO: operator_length_f (exp, (elt + 1), &oplen, &nargs); break; + + case OP_F77_UNDETERMINED_ARGLIST: + return dump_subexp_body_funcall (exp, stream, elt); } elt += oplen; |