Re: [PATCHv2 06/10] gdb/fortran: Move Fortran expression handling into f-lang.c

Andrew Burgess
2020-09-19T08:54:00Z

* Andrew Burgess <andrew.burgess@embecosm.com> [2020-08-26 15:49:13 +0100]:

> The Fortran specific OP_F77_UNDETERMINED_ARGLIST is currently handled
> in the generic expression handling code. As I start to add array
> stride support in here the amount of Fortran only code that is forced
> into the generic expression evaluation file will grow.
>
> Now seems like a good time to move this Fortran specific operation
> into the 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.

I pushed this patch with a slightly modified commit message.

Thanks,
Andrew

> ---
> gdb/ChangeLog | 37 +++++++
> gdb/eval.c | 223 ++-------------------------------------
> gdb/expprint.c | 61 ++++++-----
> gdb/expression.h | 12 +++
> gdb/f-lang.c | 221 ++++++++++++++++++++++++++++++++++++++
> gdb/fortran-operator.def | 8 ++
> gdb/parse.c | 1 -
> gdb/parser-defs.h | 16 +++
> gdb/std-operator.def | 8 --
> 9 files changed, 339 insertions(+), 248 deletions(-)
>
> diff --git a/gdb/eval.c b/gdb/eval.c
> index 660edbe34af..3ccc4148e48 100644
> --- a/gdb/eval.c
> +++ b/gdb/eval.c
> @@ -26,7 +26,6 @@
> #include "frame.h"
> #include "gdbthread.h"
> #include "language.h" /* For CAST_IS_CONVERSION. */
> -#include "f-lang.h" /* For array bound stuff. */
> #include "cp-abi.h"
> #include "infcall.h"
> #include "objc-lang.h"
> @@ -371,32 +370,6 @@ init_array_element (struct value *array, struct value *element,
> return index;
> }
>
> -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 (NULL_TYPE, 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 (NULL_TYPE, exp, pos, noside));
> -
> - return value_slice (array, low_bound, high_bound - low_bound + 1);
> -}
> -
> -
> /* Promote value ARG1 as appropriate before performing a unary operation
> on this argument.
> If the result is not appropriate for any particular language then it
> @@ -749,17 +722,13 @@ eval_skip_value (expression *exp)
> return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
> }
>
> -/* Evaluate a function call. The function to be called is in
> - ARGVEC[0] and the arguments passed to the function are in
> - ARGVEC[1..NARGS]. FUNCTION_NAME is the name of the function, if
> - known. DEFAULT_RETURN_TYPE is used as the function's return type
> - if the return type is unknown. */
> +/* See expression.h. */
>
> -static value *
> -eval_call (expression *exp, enum noside noside,
> - int nargs, value **argvec,
> - const char *function_name,
> - type *default_return_type)
> +value *
> +evaluate_subexp_do_call (expression *exp, enum noside noside,
> + int nargs, value **argvec,
> + const char *function_name,
> + type *default_return_type)
> {
> if (argvec[0] == NULL)
> error (_("Cannot evaluate function -- may be inlined"));
> @@ -1230,20 +1199,8 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
> /* Nothing to be done; argvec already correctly set up. */
> }
>
> - return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
> -}
> -
> -/* 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 (NULL_TYPE, exp, pos, noside);
> + return evaluate_subexp_do_call (exp, noside, nargs, argvec,
> + var_func_name, expect_type);
> }
>
> /* Return true if type is integral or reference to integral */
> @@ -1260,67 +1217,6 @@ is_integral_or_integral_reference (struct type *type)
> && is_integral_type (TYPE_TARGET_TYPE (type)));
> }
>
> -/* 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;
> -}
> -
> struct value *
> evaluate_subexp_standard (struct type *expect_type,
> struct expression *exp, int *pos,
> @@ -1335,7 +1231,6 @@ evaluate_subexp_standard (struct type *expect_type,
> struct type *type;
> int nargs;
> struct value **argvec;
> - int code;
> int ix;
> long mem_offset;
> struct type **arg_types;
> @@ -1977,84 +1872,6 @@ evaluate_subexp_standard (struct type *expect_type,
> case OP_FUNCALL:
> return evaluate_funcall (expect_type, exp, pos, noside);
>
> - 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. */
> -
> - nargs = longest_to_int (exp->elts[pc + 1].longconst);
> - (*pos) += 2;
> -
> - /* First determine the type code we are dealing with. */
> - arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
> - type = check_typedef (value_type (arg1));
> - 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 terminating NULL. */
> - argvec = (struct value **)
> - alloca (sizeof (struct value *) * (nargs + 2));
> - argvec[0] = arg1;
> - 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 eval_call (exp, noside, nargs, argvec, NULL, expect_type);
> -
> - default:
> - error (_("Cannot perform substring on this type"));
> - }
> -
> case OP_COMPLEX:
> /* We have a complex number, There should be 2 floating
> point numbers that compose it. */
> @@ -3348,27 +3165,3 @@ parse_and_eval_type (char *p, int length)
> error (_("Internal error in eval_type."));
> return expr->elts[1].type;
> }
> -
> -/* 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;
> -}
> diff --git a/gdb/expprint.c b/gdb/expprint.c
> index 5427a56f6ae..350f291b75e 100644
> --- a/gdb/expprint.c
> +++ b/gdb/expprint.c
> @@ -53,6 +53,25 @@ print_subexp (struct expression *exp, int *pos,
> exp->language_defn->la_exp_desc->print_subexp (exp, pos, stream, prec);
> }
>
> +/* See parser-defs.h. */
> +
> +void
> +print_subexp_funcall (struct expression *exp, int *pos,
> + struct ui_file *stream)
> +{
> + (*pos) += 2;
> + unsigned nargs = longest_to_int (exp->elts[*pos].longconst);
> + print_subexp (exp, pos, stream, PREC_SUFFIX);
> + fputs_filtered (" (", stream);
> + for (unsigned tem = 0; tem < nargs; tem++)
> + {
> + if (tem != 0)
> + fputs_filtered (", ", stream);
> + print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
> + }
> + fputs_filtered (")", stream);
> +}
> +
> /* Standard implementation of print_subexp for use in language_defn
> vectors. */
> void
> @@ -187,18 +206,7 @@ print_subexp_standard (struct expression *exp, int *pos,
> return;
>
> case OP_FUNCALL:
> - case OP_F77_UNDETERMINED_ARGLIST:
> - (*pos) += 2;
> - nargs = longest_to_int (exp->elts[pc + 1].longconst);
> - print_subexp (exp, pos, stream, PREC_SUFFIX);
> - fputs_filtered (" (", stream);
> - for (tem = 0; tem < nargs; tem++)
> - {
> - if (tem != 0)
> - fputs_filtered (", ", stream);
> - print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
> - }
> - fputs_filtered (")", stream);
> + print_subexp_funcall (exp, pos, stream);
> return;
>
> case OP_NAME:
> @@ -796,6 +804,22 @@ dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
> return exp->language_defn->la_exp_desc->dump_subexp_body (exp, stream, elt);
> }
>
> +/* See parser-defs.h. */
> +
> +int
> +dump_subexp_body_funcall (struct expression *exp,
> + struct ui_file *stream, int elt)
> +{
> + int nargs = longest_to_int (exp->elts[elt].longconst);
> + fprintf_filtered (stream, "Number of args: %d", nargs);
> + elt += 2;
> +
> + for (int i = 1; i <= nargs + 1; i++)
> + elt = dump_subexp (exp, stream, elt);
> +
> + return elt;
> +}
> +
> /* Default value for subexp_body in exp_descriptor vector. */
>
> int
> @@ -931,18 +955,7 @@ dump_subexp_body_standard (struct expression *exp,
> elt += 2;
> break;
> case OP_FUNCALL:
> - case OP_F77_UNDETERMINED_ARGLIST:
> - {
> - int i, nargs;
> -
> - nargs = longest_to_int (exp->elts[elt].longconst);
> -
> - fprintf_filtered (stream, "Number of args: %d", nargs);
> - elt += 2;
> -
> - for (i = 1; i <= nargs + 1; i++)
> - elt = dump_subexp (exp, stream, elt);
> - }
> + elt = dump_subexp_body_funcall (exp, stream, elt);
> break;
> case OP_ARRAY:
> {
> diff --git a/gdb/expression.h b/gdb/expression.h
> index f1128c44248..5af10f05db1 100644
> --- a/gdb/expression.h
> +++ b/gdb/expression.h
> @@ -155,6 +155,18 @@ enum noside
> extern struct value *evaluate_subexp_standard
> (struct type *, struct expression *, int *, enum noside);
>
> +/* Evaluate a function call. The function to be called is in ARGVEC[0] and
> + the arguments passed to the function are in ARGVEC[1..NARGS].
> + FUNCTION_NAME is the name of the function, if known.
> + DEFAULT_RETURN_TYPE is used as the function's return type if the return
> + type is unknown. */
> +
> +extern struct value *evaluate_subexp_do_call (expression *exp,
> + enum noside noside,
> + int nargs, value **argvec,
> + const char *function_name,
> + type *default_return_type);
> +
> /* From expprint.c */
>
> extern void print_expression (struct expression *, struct ui_file *);
> diff --git a/gdb/f-lang.c b/gdb/f-lang.c
> index 58b41d11d11..6210522c182 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 (NULL_TYPE, 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 (NULL_TYPE, 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 (NULL_TYPE, 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 (NULL_TYPE, 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;
> diff --git a/gdb/fortran-operator.def b/gdb/fortran-operator.def
> index fd4051ebe59..bfdbc401711 100644
> --- a/gdb/fortran-operator.def
> +++ b/gdb/fortran-operator.def
> @@ -17,6 +17,14 @@
> You should have received a copy of the GNU General Public License
> along with this program. If not, see <http://www.gnu.org/licenses/>. */
>
> +/* This is EXACTLY like OP_FUNCALL but is semantically different.
> + In F77, array subscript expressions, substring expressions and
> + function calls are all exactly the same syntactically. They
> + may only be disambiguated at runtime. Thus this operator,
> + which indicates that we have found something of the form
> + <name> ( <stuff> ). */
> +OP (OP_F77_UNDETERMINED_ARGLIST)
> +
> /* Single operand builtins. */
> OP (UNOP_FORTRAN_KIND)
> OP (UNOP_FORTRAN_FLOOR)
> diff --git a/gdb/parse.c b/gdb/parse.c
> index 2fb474e27f1..435f87a06e4 100644
> --- a/gdb/parse.c
> +++ b/gdb/parse.c
> @@ -817,7 +817,6 @@ operator_length_standard (const struct expression *expr, int endpos,
> break;
>
> case OP_FUNCALL:
> - case OP_F77_UNDETERMINED_ARGLIST:
> oplen = 3;
> args = 1 + longest_to_int (expr->elts[endpos - 2].longconst);
> break;
> diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h
> index a9b8a12959b..bc6fc2f9ba3 100644
> --- a/gdb/parser-defs.h
> +++ b/gdb/parser-defs.h
> @@ -338,6 +338,13 @@ extern int dump_subexp (struct expression *, struct ui_file *, int);
> extern int dump_subexp_body_standard (struct expression *,
> struct ui_file *, int);
>
> +/* Dump (to STREAM) a function call like expression at position ELT in the
> + expression array EXP. Return a new value for ELT just after the
> + function call expression. */
> +
> +extern int dump_subexp_body_funcall (struct expression *exp,
> + struct ui_file *stream, int elt);
> +
> extern void operator_length (const struct expression *, int, int *, int *);
>
> extern void operator_length_standard (const struct expression *, int, int *,
> @@ -440,6 +447,15 @@ extern void print_subexp (struct expression *, int *, struct ui_file *,
> extern void print_subexp_standard (struct expression *, int *,
> struct ui_file *, enum precedence);
>
> +/* Print a function call like expression to STREAM. This is called as a
> + helper function by which point the expression node identifying this as a
> + function call has already been stripped off and POS should point to the
> + number of function call arguments. EXP is the object containing the
> + list of expression elements. */
> +
> +extern void print_subexp_funcall (struct expression *exp, int *pos,
> + struct ui_file *stream);
> +
> /* Function used to avoid direct calls to fprintf
> in the code generated by the bison parser. */
>
> diff --git a/gdb/std-operator.def b/gdb/std-operator.def
> index e969bdccaed..6f90875f477 100644
> --- a/gdb/std-operator.def
> +++ b/gdb/std-operator.def
> @@ -168,14 +168,6 @@ OP (OP_FUNCALL)
> pointer. This is an Objective C message. */
> OP (OP_OBJC_MSGCALL)
>
> -/* This is EXACTLY like OP_FUNCALL but is semantically different.
> - In F77, array subscript expressions, substring expressions and
> - function calls are all exactly the same syntactically. They
> - may only be disambiguated at runtime. Thus this operator,
> - which indicates that we have found something of the form
> - <name> ( <stuff> ). */
> -OP (OP_F77_UNDETERMINED_ARGLIST)
> -
> /* OP_COMPLEX takes a type in the following element, followed by another
> OP_COMPLEX, making three exp_elements. It is followed by two double
> args, and converts them into a complex number of the given type. */
> --
> 2.25.4
>