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

Andrew Burgess andrew.burgess@embecosm.com
Sat Sep 19 08:53:57 GMT 2020


* 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
> 


More information about the Gdb-patches mailing list