Blame SOURCES/gdb-rhbz1964167-move-fortran-expr-handling.patch

0a406a
From FEDORA_PATCHES Mon Sep 17 00:00:00 2001
0a406a
From: Kevin Buettner <kevinb@redhat.com>
0a406a
Date: Mon, 24 May 2021 17:00:17 -0700
0a406a
Subject: gdb-rhbz1964167-move-fortran-expr-handling.patch
0a406a
0a406a
;; [fortran] Backport Andrew Burgess's commit which moves Fortran
0a406a
;; expression handling to f-lang.c.
0a406a
0a406a
gdb/fortran: Move Fortran expression handling into f-lang.c
0a406a
0a406a
The Fortran specific OP_F77_UNDETERMINED_ARGLIST is currently handled
0a406a
in the generic expression handling code.  There's no reason why this
0a406a
should be the case, so this commit moves handling of this into Fortran
0a406a
specific files.
0a406a
0a406a
There should be no user visible changes after this commit.
0a406a
0a406a
gdb/ChangeLog:
0a406a
0a406a
	* eval.c: Remove 'f-lang.h' include.
0a406a
	(value_f90_subarray): Moved to f-lang.c.
0a406a
	(eval_call): Renamed to...
0a406a
	(evaluate_subexp_do_call): ...this, is no longer static, header
0a406a
	comment moved into header file.
0a406a
	(evaluate_funcall): Update call to eval_call.
0a406a
	(skip_undetermined_arglist): Moved to f-lang.c.
0a406a
	(fortran_value_subarray): Likewise.
0a406a
	(evaluate_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
0a406a
	moved to evaluate_subexp_f.
0a406a
	(calc_f77_array_dims): Moved to f-lang.c
0a406a
	* expprint.c (print_subexp_funcall): New function.
0a406a
	(print_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
0a406a
	moved to print_subexp_f, OP_FUNCALL uses new function.
0a406a
	(dump_subexp_body_funcall): New function.
0a406a
	(dump_subexp_body_standard): OP_F77_UNDETERMINED_ARGLIST handling
0a406a
	moved to dump_subexp_f, OP_FUNCALL uses new function.
0a406a
	* expression.h (evaluate_subexp_do_call): Declare.
0a406a
	* f-lang.c (value_f90_subarray): Moved from eval.c.
0a406a
	(skip_undetermined_arglist): Likewise.
0a406a
	(calc_f77_array_dims): Likewise.
0a406a
	(fortran_value_subarray): Likewise.
0a406a
	(evaluate_subexp_f): Add OP_F77_UNDETERMINED_ARGLIST support.
0a406a
	(operator_length_f): Likewise.
0a406a
	(print_subexp_f): Likewise.
0a406a
	(dump_subexp_body_f): Likewise.
0a406a
	* fortran-operator.def (OP_F77_UNDETERMINED_ARGLIST): Move
0a406a
	declaration of this operation to here.
0a406a
	* parse.c (operator_length_standard): OP_F77_UNDETERMINED_ARGLIST
0a406a
	support moved to operator_length_f.
0a406a
	* parser-defs.h (dump_subexp_body_funcall): Declare.
0a406a
	(print_subexp_funcall): Declare.
0a406a
	* std-operator.def (OP_F77_UNDETERMINED_ARGLIST): Moved to
0a406a
	fortran-operator.def.
0a406a
0a406a
diff --git a/gdb/eval.c b/gdb/eval.c
0a406a
--- a/gdb/eval.c
0a406a
+++ b/gdb/eval.c
0a406a
@@ -26,7 +26,6 @@
0a406a
 #include "frame.h"
0a406a
 #include "gdbthread.h"
0a406a
 #include "language.h"		/* For CAST_IS_CONVERSION.  */
0a406a
-#include "f-lang.h"		/* For array bound stuff.  */
0a406a
 #include "cp-abi.h"
0a406a
 #include "infcall.h"
0a406a
 #include "objc-lang.h"
0a406a
@@ -371,32 +370,6 @@ init_array_element (struct value *array, struct value *element,
0a406a
   return index;
0a406a
 }
0a406a
 
0a406a
-static struct value *
0a406a
-value_f90_subarray (struct value *array,
0a406a
-		    struct expression *exp, int *pos, enum noside noside)
0a406a
-{
0a406a
-  int pc = (*pos) + 1;
0a406a
-  LONGEST low_bound, high_bound;
0a406a
-  struct type *range = check_typedef (value_type (array)->index_type ());
0a406a
-  enum range_type range_type
0a406a
-    = (enum range_type) longest_to_int (exp->elts[pc].longconst);
0a406a
- 
0a406a
-  *pos += 3;
0a406a
-
0a406a
-  if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
0a406a
-    low_bound = range->bounds ()->low.const_val ();
0a406a
-  else
0a406a
-    low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
0a406a
-
0a406a
-  if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
0a406a
-    high_bound = range->bounds ()->high.const_val ();
0a406a
-  else
0a406a
-    high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
0a406a
-
0a406a
-  return value_slice (array, low_bound, high_bound - low_bound + 1);
0a406a
-}
0a406a
-
0a406a
-
0a406a
 /* Promote value ARG1 as appropriate before performing a unary operation
0a406a
    on this argument.
0a406a
    If the result is not appropriate for any particular language then it
0a406a
@@ -749,17 +722,13 @@ eval_skip_value (expression *exp)
0a406a
   return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
0a406a
 }
0a406a
 
0a406a
-/* Evaluate a function call.  The function to be called is in
0a406a
-   ARGVEC[0] and the arguments passed to the function are in
0a406a
-   ARGVEC[1..NARGS].  FUNCTION_NAME is the name of the function, if
0a406a
-   known.  DEFAULT_RETURN_TYPE is used as the function's return type
0a406a
-   if the return type is unknown.  */
0a406a
+/* See expression.h.  */
0a406a
 
0a406a
-static value *
0a406a
-eval_call (expression *exp, enum noside noside,
0a406a
-	   int nargs, value **argvec,
0a406a
-	   const char *function_name,
0a406a
-	   type *default_return_type)
0a406a
+value *
0a406a
+evaluate_subexp_do_call (expression *exp, enum noside noside,
0a406a
+			 int nargs, value **argvec,
0a406a
+			 const char *function_name,
0a406a
+			 type *default_return_type)
0a406a
 {
0a406a
   if (argvec[0] == NULL)
0a406a
     error (_("Cannot evaluate function -- may be inlined"));
0a406a
@@ -1230,20 +1199,8 @@ evaluate_funcall (type *expect_type, expression *exp, int *pos,
0a406a
       /* Nothing to be done; argvec already correctly set up.  */
0a406a
     }
0a406a
 
0a406a
-  return eval_call (exp, noside, nargs, argvec, var_func_name, expect_type);
0a406a
-}
0a406a
-
0a406a
-/* Helper for skipping all the arguments in an undetermined argument list.
0a406a
-   This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
0a406a
-   case of evaluate_subexp_standard as multiple, but not all, code paths
0a406a
-   require a generic skip.  */
0a406a
-
0a406a
-static void
0a406a
-skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
0a406a
-			   enum noside noside)
0a406a
-{
0a406a
-  for (int i = 0; i < nargs; ++i)
0a406a
-    evaluate_subexp (nullptr, exp, pos, noside);
0a406a
+  return evaluate_subexp_do_call (exp, noside, nargs, argvec,
0a406a
+				  var_func_name, expect_type);
0a406a
 }
0a406a
 
0a406a
 /* Return true if type is integral or reference to integral */
0a406a
@@ -1260,67 +1217,6 @@ is_integral_or_integral_reference (struct type *type)
0a406a
 	  && is_integral_type (TYPE_TARGET_TYPE (type)));
0a406a
 }
0a406a
 
0a406a
-/* Called from evaluate_subexp_standard to perform array indexing, and
0a406a
-   sub-range extraction, for Fortran.  As well as arrays this function
0a406a
-   also handles strings as they can be treated like arrays of characters.
0a406a
-   ARRAY is the array or string being accessed.  EXP, POS, and NOSIDE are
0a406a
-   as for evaluate_subexp_standard, and NARGS is the number of arguments
0a406a
-   in this access (e.g. 'array (1,2,3)' would be NARGS 3).  */
0a406a
-
0a406a
-static struct value *
0a406a
-fortran_value_subarray (struct value *array, struct expression *exp,
0a406a
-			int *pos, int nargs, enum noside noside)
0a406a
-{
0a406a
-  if (exp->elts[*pos].opcode == OP_RANGE)
0a406a
-    return value_f90_subarray (array, exp, pos, noside);
0a406a
-
0a406a
-  if (noside == EVAL_SKIP)
0a406a
-    {
0a406a
-      skip_undetermined_arglist (nargs, exp, pos, noside);
0a406a
-      /* Return the dummy value with the correct type.  */
0a406a
-      return array;
0a406a
-    }
0a406a
-
0a406a
-  LONGEST subscript_array[MAX_FORTRAN_DIMS];
0a406a
-  int ndimensions = 1;
0a406a
-  struct type *type = check_typedef (value_type (array));
0a406a
-
0a406a
-  if (nargs > MAX_FORTRAN_DIMS)
0a406a
-    error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
0a406a
-
0a406a
-  ndimensions = calc_f77_array_dims (type);
0a406a
-
0a406a
-  if (nargs != ndimensions)
0a406a
-    error (_("Wrong number of subscripts"));
0a406a
-
0a406a
-  gdb_assert (nargs > 0);
0a406a
-
0a406a
-  /* Now that we know we have a legal array subscript expression let us
0a406a
-     actually find out where this element exists in the array.  */
0a406a
-
0a406a
-  /* Take array indices left to right.  */
0a406a
-  for (int i = 0; i < nargs; i++)
0a406a
-    {
0a406a
-      /* Evaluate each subscript; it must be a legal integer in F77.  */
0a406a
-      value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
0a406a
-
0a406a
-      /* Fill in the subscript array.  */
0a406a
-      subscript_array[i] = value_as_long (arg2);
0a406a
-    }
0a406a
-
0a406a
-  /* Internal type of array is arranged right to left.  */
0a406a
-  for (int i = nargs; i > 0; i--)
0a406a
-    {
0a406a
-      struct type *array_type = check_typedef (value_type (array));
0a406a
-      LONGEST index = subscript_array[i - 1];
0a406a
-
0a406a
-      array = value_subscripted_rvalue (array, index,
0a406a
-					f77_get_lowerbound (array_type));
0a406a
-    }
0a406a
-
0a406a
-  return array;
0a406a
-}
0a406a
-
0a406a
 struct value *
0a406a
 evaluate_subexp_standard (struct type *expect_type,
0a406a
 			  struct expression *exp, int *pos,
0a406a
@@ -1335,7 +1231,6 @@ evaluate_subexp_standard (struct type *expect_type,
0a406a
   struct type *type;
0a406a
   int nargs;
0a406a
   struct value **argvec;
0a406a
-  int code;
0a406a
   int ix;
0a406a
   long mem_offset;
0a406a
   struct type **arg_types;
0a406a
@@ -1976,84 +1871,6 @@ evaluate_subexp_standard (struct type *expect_type,
0a406a
     case OP_FUNCALL:
0a406a
       return evaluate_funcall (expect_type, exp, pos, noside);
0a406a
 
0a406a
-    case OP_F77_UNDETERMINED_ARGLIST:
0a406a
-
0a406a
-      /* Remember that in F77, functions, substring ops and 
0a406a
-         array subscript operations cannot be disambiguated 
0a406a
-         at parse time.  We have made all array subscript operations, 
0a406a
-         substring operations as well as function calls  come here 
0a406a
-         and we now have to discover what the heck this thing actually was.
0a406a
-         If it is a function, we process just as if we got an OP_FUNCALL.  */
0a406a
-
0a406a
-      nargs = longest_to_int (exp->elts[pc + 1].longconst);
0a406a
-      (*pos) += 2;
0a406a
-
0a406a
-      /* First determine the type code we are dealing with.  */
0a406a
-      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
0a406a
-      type = check_typedef (value_type (arg1));
0a406a
-      code = type->code ();
0a406a
-
0a406a
-      if (code == TYPE_CODE_PTR)
0a406a
-	{
0a406a
-	  /* Fortran always passes variable to subroutines as pointer.
0a406a
-	     So we need to look into its target type to see if it is
0a406a
-	     array, string or function.  If it is, we need to switch
0a406a
-	     to the target value the original one points to.  */ 
0a406a
-	  struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
0a406a
-
0a406a
-	  if (target_type->code () == TYPE_CODE_ARRAY
0a406a
-	      || target_type->code () == TYPE_CODE_STRING
0a406a
-	      || target_type->code () == TYPE_CODE_FUNC)
0a406a
-	    {
0a406a
-	      arg1 = value_ind (arg1);
0a406a
-	      type = check_typedef (value_type (arg1));
0a406a
-	      code = type->code ();
0a406a
-	    }
0a406a
-	} 
0a406a
-
0a406a
-      switch (code)
0a406a
-	{
0a406a
-	case TYPE_CODE_ARRAY:
0a406a
-	case TYPE_CODE_STRING:
0a406a
-	  return fortran_value_subarray (arg1, exp, pos, nargs, noside);
0a406a
-
0a406a
-	case TYPE_CODE_PTR:
0a406a
-	case TYPE_CODE_FUNC:
0a406a
-	case TYPE_CODE_INTERNAL_FUNCTION:
0a406a
-	  /* It's a function call.  */
0a406a
-	  /* Allocate arg vector, including space for the function to be
0a406a
-	     called in argvec[0] and a terminating NULL.  */
0a406a
-	  argvec = (struct value **)
0a406a
-	    alloca (sizeof (struct value *) * (nargs + 2));
0a406a
-	  argvec[0] = arg1;
0a406a
-	  tem = 1;
0a406a
-	  for (; tem <= nargs; tem++)
0a406a
-	    {
0a406a
-	      argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
0a406a
-	      /* Arguments in Fortran are passed by address.  Coerce the
0a406a
-		 arguments here rather than in value_arg_coerce as otherwise
0a406a
-		 the call to malloc to place the non-lvalue parameters in
0a406a
-		 target memory is hit by this Fortran specific logic.  This
0a406a
-		 results in malloc being called with a pointer to an integer
0a406a
-		 followed by an attempt to malloc the arguments to malloc in
0a406a
-		 target memory.  Infinite recursion ensues.  */
0a406a
-	      if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
0a406a
-		{
0a406a
-		  bool is_artificial
0a406a
-		    = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
0a406a
-		  argvec[tem] = fortran_argument_convert (argvec[tem],
0a406a
-							  is_artificial);
0a406a
-		}
0a406a
-	    }
0a406a
-	  argvec[tem] = 0;	/* signal end of arglist */
0a406a
-	  if (noside == EVAL_SKIP)
0a406a
-	    return eval_skip_value (exp);
0a406a
-	  return eval_call (exp, noside, nargs, argvec, NULL, expect_type);
0a406a
-
0a406a
-	default:
0a406a
-	  error (_("Cannot perform substring on this type"));
0a406a
-	}
0a406a
-
0a406a
     case OP_COMPLEX:
0a406a
       /* We have a complex number, There should be 2 floating 
0a406a
          point numbers that compose it.  */
0a406a
@@ -3346,27 +3163,3 @@ parse_and_eval_type (char *p, int length)
0a406a
     error (_("Internal error in eval_type."));
0a406a
   return expr->elts[1].type;
0a406a
 }
0a406a
-
0a406a
-/* Return the number of dimensions for a Fortran array or string.  */
0a406a
-
0a406a
-int
0a406a
-calc_f77_array_dims (struct type *array_type)
0a406a
-{
0a406a
-  int ndimen = 1;
0a406a
-  struct type *tmp_type;
0a406a
-
0a406a
-  if ((array_type->code () == TYPE_CODE_STRING))
0a406a
-    return 1;
0a406a
-
0a406a
-  if ((array_type->code () != TYPE_CODE_ARRAY))
0a406a
-    error (_("Can't get dimensions for a non-array type"));
0a406a
-
0a406a
-  tmp_type = array_type;
0a406a
-
0a406a
-  while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
0a406a
-    {
0a406a
-      if (tmp_type->code () == TYPE_CODE_ARRAY)
0a406a
-	++ndimen;
0a406a
-    }
0a406a
-  return ndimen;
0a406a
-}
0a406a
diff --git a/gdb/expprint.c b/gdb/expprint.c
0a406a
--- a/gdb/expprint.c
0a406a
+++ b/gdb/expprint.c
0a406a
@@ -53,6 +53,25 @@ print_subexp (struct expression *exp, int *pos,
0a406a
   exp->language_defn->la_exp_desc->print_subexp (exp, pos, stream, prec);
0a406a
 }
0a406a
 
0a406a
+/* See parser-defs.h.  */
0a406a
+
0a406a
+void
0a406a
+print_subexp_funcall (struct expression *exp, int *pos,
0a406a
+		      struct ui_file *stream)
0a406a
+{
0a406a
+  (*pos) += 2;
0a406a
+  unsigned nargs = longest_to_int (exp->elts[*pos].longconst);
0a406a
+  print_subexp (exp, pos, stream, PREC_SUFFIX);
0a406a
+  fputs_filtered (" (", stream);
0a406a
+  for (unsigned tem = 0; tem < nargs; tem++)
0a406a
+    {
0a406a
+      if (tem != 0)
0a406a
+	fputs_filtered (", ", stream);
0a406a
+      print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
0a406a
+    }
0a406a
+  fputs_filtered (")", stream);
0a406a
+}
0a406a
+
0a406a
 /* Standard implementation of print_subexp for use in language_defn
0a406a
    vectors.  */
0a406a
 void
0a406a
@@ -187,18 +206,7 @@ print_subexp_standard (struct expression *exp, int *pos,
0a406a
       return;
0a406a
 
0a406a
     case OP_FUNCALL:
0a406a
-    case OP_F77_UNDETERMINED_ARGLIST:
0a406a
-      (*pos) += 2;
0a406a
-      nargs = longest_to_int (exp->elts[pc + 1].longconst);
0a406a
-      print_subexp (exp, pos, stream, PREC_SUFFIX);
0a406a
-      fputs_filtered (" (", stream);
0a406a
-      for (tem = 0; tem < nargs; tem++)
0a406a
-	{
0a406a
-	  if (tem != 0)
0a406a
-	    fputs_filtered (", ", stream);
0a406a
-	  print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
0a406a
-	}
0a406a
-      fputs_filtered (")", stream);
0a406a
+      print_subexp_funcall (exp, pos, stream);
0a406a
       return;
0a406a
 
0a406a
     case OP_NAME:
0a406a
@@ -796,6 +804,22 @@ dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
0a406a
   return exp->language_defn->la_exp_desc->dump_subexp_body (exp, stream, elt);
0a406a
 }
0a406a
 
0a406a
+/* See parser-defs.h.  */
0a406a
+
0a406a
+int
0a406a
+dump_subexp_body_funcall (struct expression *exp,
0a406a
+			  struct ui_file *stream, int elt)
0a406a
+{
0a406a
+  int nargs = longest_to_int (exp->elts[elt].longconst);
0a406a
+  fprintf_filtered (stream, "Number of args: %d", nargs);
0a406a
+  elt += 2;
0a406a
+
0a406a
+  for (int i = 1; i <= nargs + 1; i++)
0a406a
+    elt = dump_subexp (exp, stream, elt);
0a406a
+
0a406a
+  return elt;
0a406a
+}
0a406a
+
0a406a
 /* Default value for subexp_body in exp_descriptor vector.  */
0a406a
 
0a406a
 int
0a406a
@@ -931,18 +955,7 @@ dump_subexp_body_standard (struct expression *exp,
0a406a
       elt += 2;
0a406a
       break;
0a406a
     case OP_FUNCALL:
0a406a
-    case OP_F77_UNDETERMINED_ARGLIST:
0a406a
-      {
0a406a
-	int i, nargs;
0a406a
-
0a406a
-	nargs = longest_to_int (exp->elts[elt].longconst);
0a406a
-
0a406a
-	fprintf_filtered (stream, "Number of args: %d", nargs);
0a406a
-	elt += 2;
0a406a
-
0a406a
-	for (i = 1; i <= nargs + 1; i++)
0a406a
-	  elt = dump_subexp (exp, stream, elt);
0a406a
-      }
0a406a
+      elt = dump_subexp_body_funcall (exp, stream, elt);
0a406a
       break;
0a406a
     case OP_ARRAY:
0a406a
       {
0a406a
diff --git a/gdb/expression.h b/gdb/expression.h
0a406a
--- a/gdb/expression.h
0a406a
+++ b/gdb/expression.h
0a406a
@@ -155,6 +155,18 @@ enum noside
0a406a
 extern struct value *evaluate_subexp_standard
0a406a
   (struct type *, struct expression *, int *, enum noside);
0a406a
 
0a406a
+/* Evaluate a function call.  The function to be called is in ARGVEC[0] and
0a406a
+   the arguments passed to the function are in ARGVEC[1..NARGS].
0a406a
+   FUNCTION_NAME is the name of the function, if known.
0a406a
+   DEFAULT_RETURN_TYPE is used as the function's return type if the return
0a406a
+   type is unknown.  */
0a406a
+
0a406a
+extern struct value *evaluate_subexp_do_call (expression *exp,
0a406a
+					      enum noside noside,
0a406a
+					      int nargs, value **argvec,
0a406a
+					      const char *function_name,
0a406a
+					      type *default_return_type);
0a406a
+
0a406a
 /* From expprint.c */
0a406a
 
0a406a
 extern void print_expression (struct expression *, struct ui_file *);
0a406a
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
0a406a
--- a/gdb/f-lang.c
0a406a
+++ b/gdb/f-lang.c
0a406a
@@ -114,6 +114,134 @@ enum f_primitive_types {
0a406a
   nr_f_primitive_types
0a406a
 };
0a406a
 
0a406a
+/* Called from fortran_value_subarray to take a slice of an array or a
0a406a
+   string.  ARRAY is the array or string to be accessed.  EXP, POS, and
0a406a
+   NOSIDE are as for evaluate_subexp_standard.  Return a value that is a
0a406a
+   slice of the array.  */
0a406a
+
0a406a
+static struct value *
0a406a
+value_f90_subarray (struct value *array,
0a406a
+		    struct expression *exp, int *pos, enum noside noside)
0a406a
+{
0a406a
+  int pc = (*pos) + 1;
0a406a
+  LONGEST low_bound, high_bound;
0a406a
+  struct type *range = check_typedef (value_type (array)->index_type ());
0a406a
+  enum range_type range_type
0a406a
+    = (enum range_type) longest_to_int (exp->elts[pc].longconst);
0a406a
+
0a406a
+  *pos += 3;
0a406a
+
0a406a
+  if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
0a406a
+    low_bound = range->bounds ()->low.const_val ();
0a406a
+  else
0a406a
+    low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
0a406a
+
0a406a
+  if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
0a406a
+    high_bound = range->bounds ()->high.const_val ();
0a406a
+  else
0a406a
+    high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
0a406a
+
0a406a
+  return value_slice (array, low_bound, high_bound - low_bound + 1);
0a406a
+}
0a406a
+
0a406a
+/* Helper for skipping all the arguments in an undetermined argument list.
0a406a
+   This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
0a406a
+   case of evaluate_subexp_standard as multiple, but not all, code paths
0a406a
+   require a generic skip.  */
0a406a
+
0a406a
+static void
0a406a
+skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
0a406a
+			   enum noside noside)
0a406a
+{
0a406a
+  for (int i = 0; i < nargs; ++i)
0a406a
+    evaluate_subexp (nullptr, exp, pos, noside);
0a406a
+}
0a406a
+
0a406a
+/* Return the number of dimensions for a Fortran array or string.  */
0a406a
+
0a406a
+int
0a406a
+calc_f77_array_dims (struct type *array_type)
0a406a
+{
0a406a
+  int ndimen = 1;
0a406a
+  struct type *tmp_type;
0a406a
+
0a406a
+  if ((array_type->code () == TYPE_CODE_STRING))
0a406a
+    return 1;
0a406a
+
0a406a
+  if ((array_type->code () != TYPE_CODE_ARRAY))
0a406a
+    error (_("Can't get dimensions for a non-array type"));
0a406a
+
0a406a
+  tmp_type = array_type;
0a406a
+
0a406a
+  while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
0a406a
+    {
0a406a
+      if (tmp_type->code () == TYPE_CODE_ARRAY)
0a406a
+	++ndimen;
0a406a
+    }
0a406a
+  return ndimen;
0a406a
+}
0a406a
+
0a406a
+/* Called from evaluate_subexp_standard to perform array indexing, and
0a406a
+   sub-range extraction, for Fortran.  As well as arrays this function
0a406a
+   also handles strings as they can be treated like arrays of characters.
0a406a
+   ARRAY is the array or string being accessed.  EXP, POS, and NOSIDE are
0a406a
+   as for evaluate_subexp_standard, and NARGS is the number of arguments
0a406a
+   in this access (e.g. 'array (1,2,3)' would be NARGS 3).  */
0a406a
+
0a406a
+static struct value *
0a406a
+fortran_value_subarray (struct value *array, struct expression *exp,
0a406a
+			int *pos, int nargs, enum noside noside)
0a406a
+{
0a406a
+  if (exp->elts[*pos].opcode == OP_RANGE)
0a406a
+    return value_f90_subarray (array, exp, pos, noside);
0a406a
+
0a406a
+  if (noside == EVAL_SKIP)
0a406a
+    {
0a406a
+      skip_undetermined_arglist (nargs, exp, pos, noside);
0a406a
+      /* Return the dummy value with the correct type.  */
0a406a
+      return array;
0a406a
+    }
0a406a
+
0a406a
+  LONGEST subscript_array[MAX_FORTRAN_DIMS];
0a406a
+  int ndimensions = 1;
0a406a
+  struct type *type = check_typedef (value_type (array));
0a406a
+
0a406a
+  if (nargs > MAX_FORTRAN_DIMS)
0a406a
+    error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
0a406a
+
0a406a
+  ndimensions = calc_f77_array_dims (type);
0a406a
+
0a406a
+  if (nargs != ndimensions)
0a406a
+    error (_("Wrong number of subscripts"));
0a406a
+
0a406a
+  gdb_assert (nargs > 0);
0a406a
+
0a406a
+  /* Now that we know we have a legal array subscript expression let us
0a406a
+     actually find out where this element exists in the array.  */
0a406a
+
0a406a
+  /* Take array indices left to right.  */
0a406a
+  for (int i = 0; i < nargs; i++)
0a406a
+    {
0a406a
+      /* Evaluate each subscript; it must be a legal integer in F77.  */
0a406a
+      value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
0a406a
+
0a406a
+      /* Fill in the subscript array.  */
0a406a
+      subscript_array[i] = value_as_long (arg2);
0a406a
+    }
0a406a
+
0a406a
+  /* Internal type of array is arranged right to left.  */
0a406a
+  for (int i = nargs; i > 0; i--)
0a406a
+    {
0a406a
+      struct type *array_type = check_typedef (value_type (array));
0a406a
+      LONGEST index = subscript_array[i - 1];
0a406a
+
0a406a
+      array = value_subscripted_rvalue (array, index,
0a406a
+					f77_get_lowerbound (array_type));
0a406a
+    }
0a406a
+
0a406a
+  return array;
0a406a
+}
0a406a
+
0a406a
 /* Special expression evaluation cases for Fortran.  */
0a406a
 
0a406a
 static struct value *
0a406a
@@ -285,6 +413,87 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
0a406a
 				   TYPE_LENGTH (type));
0a406a
       return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
0a406a
 				 TYPE_LENGTH (TYPE_TARGET_TYPE (type)));
0a406a
+
0a406a
+
0a406a
+    case OP_F77_UNDETERMINED_ARGLIST:
0a406a
+      /* Remember that in F77, functions, substring ops and array subscript
0a406a
+         operations cannot be disambiguated at parse time.  We have made
0a406a
+         all array subscript operations, substring operations as well as
0a406a
+         function calls come here and we now have to discover what the heck
0a406a
+         this thing actually was.  If it is a function, we process just as
0a406a
+         if we got an OP_FUNCALL.  */
0a406a
+      int nargs = longest_to_int (exp->elts[pc + 1].longconst);
0a406a
+      (*pos) += 2;
0a406a
+
0a406a
+      /* First determine the type code we are dealing with.  */
0a406a
+      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
0a406a
+      type = check_typedef (value_type (arg1));
0a406a
+      enum type_code code = type->code ();
0a406a
+
0a406a
+      if (code == TYPE_CODE_PTR)
0a406a
+	{
0a406a
+	  /* Fortran always passes variable to subroutines as pointer.
0a406a
+	     So we need to look into its target type to see if it is
0a406a
+	     array, string or function.  If it is, we need to switch
0a406a
+	     to the target value the original one points to.  */
0a406a
+	  struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
0a406a
+
0a406a
+	  if (target_type->code () == TYPE_CODE_ARRAY
0a406a
+	      || target_type->code () == TYPE_CODE_STRING
0a406a
+	      || target_type->code () == TYPE_CODE_FUNC)
0a406a
+	    {
0a406a
+	      arg1 = value_ind (arg1);
0a406a
+	      type = check_typedef (value_type (arg1));
0a406a
+	      code = type->code ();
0a406a
+	    }
0a406a
+	}
0a406a
+
0a406a
+      switch (code)
0a406a
+	{
0a406a
+	case TYPE_CODE_ARRAY:
0a406a
+	case TYPE_CODE_STRING:
0a406a
+	  return fortran_value_subarray (arg1, exp, pos, nargs, noside);
0a406a
+
0a406a
+	case TYPE_CODE_PTR:
0a406a
+	case TYPE_CODE_FUNC:
0a406a
+	case TYPE_CODE_INTERNAL_FUNCTION:
0a406a
+	  {
0a406a
+	    /* It's a function call.  Allocate arg vector, including
0a406a
+	    space for the function to be called in argvec[0] and a
0a406a
+	    termination NULL.  */
0a406a
+	    struct value **argvec = (struct value **)
0a406a
+	      alloca (sizeof (struct value *) * (nargs + 2));
0a406a
+	    argvec[0] = arg1;
0a406a
+	    int tem = 1;
0a406a
+	    for (; tem <= nargs; tem++)
0a406a
+	      {
0a406a
+		argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
0a406a
+		/* Arguments in Fortran are passed by address.  Coerce the
0a406a
+		   arguments here rather than in value_arg_coerce as
0a406a
+		   otherwise the call to malloc to place the non-lvalue
0a406a
+		   parameters in target memory is hit by this Fortran
0a406a
+		   specific logic.  This results in malloc being called
0a406a
+		   with a pointer to an integer followed by an attempt to
0a406a
+		   malloc the arguments to malloc in target memory.
0a406a
+		   Infinite recursion ensues.  */
0a406a
+		if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
0a406a
+		  {
0a406a
+		    bool is_artificial
0a406a
+		      = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
0a406a
+		    argvec[tem] = fortran_argument_convert (argvec[tem],
0a406a
+							    is_artificial);
0a406a
+		  }
0a406a
+	      }
0a406a
+	    argvec[tem] = 0;	/* signal end of arglist */
0a406a
+	    if (noside == EVAL_SKIP)
0a406a
+	      return eval_skip_value (exp);
0a406a
+	    return evaluate_subexp_do_call (exp, noside, nargs, argvec, NULL,
0a406a
+					    expect_type);
0a406a
+	  }
0a406a
+
0a406a
+	default:
0a406a
+	  error (_("Cannot perform substring on this type"));
0a406a
+	}
0a406a
     }
0a406a
 
0a406a
   /* Should be unreachable.  */
0a406a
@@ -318,6 +527,11 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp,
0a406a
       oplen = 1;
0a406a
       args = 2;
0a406a
       break;
0a406a
+
0a406a
+    case OP_F77_UNDETERMINED_ARGLIST:
0a406a
+      oplen = 3;
0a406a
+      args = 1 + longest_to_int (exp->elts[pc - 2].longconst);
0a406a
+      break;
0a406a
     }
0a406a
 
0a406a
   *oplenp = oplen;
0a406a
@@ -390,6 +604,10 @@ print_subexp_f (struct expression *exp, int *pos,
0a406a
     case BINOP_FORTRAN_MODULO:
0a406a
       print_binop_subexp_f (exp, pos, stream, prec, "MODULO");
0a406a
       return;
0a406a
+
0a406a
+    case OP_F77_UNDETERMINED_ARGLIST:
0a406a
+      print_subexp_funcall (exp, pos, stream);
0a406a
+      return;
0a406a
     }
0a406a
 }
0a406a
 
0a406a
@@ -432,6 +650,9 @@ dump_subexp_body_f (struct expression *exp,
0a406a
     case BINOP_FORTRAN_MODULO:
0a406a
       operator_length_f (exp, (elt + 1), &oplen, &nargs);
0a406a
       break;
0a406a
+
0a406a
+    case OP_F77_UNDETERMINED_ARGLIST:
0a406a
+      return dump_subexp_body_funcall (exp, stream, elt);
0a406a
     }
0a406a
 
0a406a
   elt += oplen;
0a406a
diff --git a/gdb/fortran-operator.def b/gdb/fortran-operator.def
0a406a
--- a/gdb/fortran-operator.def
0a406a
+++ b/gdb/fortran-operator.def
0a406a
@@ -17,6 +17,14 @@
0a406a
    You should have received a copy of the GNU General Public License
0a406a
    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
0a406a
 
0a406a
+/* This is EXACTLY like OP_FUNCALL but is semantically different.
0a406a
+   In F77, array subscript expressions, substring expressions and
0a406a
+   function calls are all exactly the same syntactically.  They
0a406a
+   may only be disambiguated at runtime.  Thus this operator,
0a406a
+   which indicates that we have found something of the form
0a406a
+   <name> ( <stuff> ).  */
0a406a
+OP (OP_F77_UNDETERMINED_ARGLIST)
0a406a
+
0a406a
 /* Single operand builtins.  */
0a406a
 OP (UNOP_FORTRAN_KIND)
0a406a
 OP (UNOP_FORTRAN_FLOOR)
0a406a
diff --git a/gdb/parse.c b/gdb/parse.c
0a406a
--- a/gdb/parse.c
0a406a
+++ b/gdb/parse.c
0a406a
@@ -817,7 +817,6 @@ operator_length_standard (const struct expression *expr, int endpos,
0a406a
       break;
0a406a
 
0a406a
     case OP_FUNCALL:
0a406a
-    case OP_F77_UNDETERMINED_ARGLIST:
0a406a
       oplen = 3;
0a406a
       args = 1 + longest_to_int (expr->elts[endpos - 2].longconst);
0a406a
       break;
0a406a
diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h
0a406a
--- a/gdb/parser-defs.h
0a406a
+++ b/gdb/parser-defs.h
0a406a
@@ -338,6 +338,13 @@ extern int dump_subexp (struct expression *, struct ui_file *, int);
0a406a
 extern int dump_subexp_body_standard (struct expression *, 
0a406a
 				      struct ui_file *, int);
0a406a
 
0a406a
+/* Dump (to STREAM) a function call like expression at position ELT in the
0a406a
+   expression array EXP.  Return a new value for ELT just after the
0a406a
+   function call expression.  */
0a406a
+
0a406a
+extern int dump_subexp_body_funcall (struct expression *exp,
0a406a
+				     struct ui_file *stream, int elt);
0a406a
+
0a406a
 extern void operator_length (const struct expression *, int, int *, int *);
0a406a
 
0a406a
 extern void operator_length_standard (const struct expression *, int, int *,
0a406a
@@ -440,6 +447,15 @@ extern void print_subexp (struct expression *, int *, struct ui_file *,
0a406a
 extern void print_subexp_standard (struct expression *, int *, 
0a406a
 				   struct ui_file *, enum precedence);
0a406a
 
0a406a
+/* Print a function call like expression to STREAM.  This is called as a
0a406a
+   helper function by which point the expression node identifying this as a
0a406a
+   function call has already been stripped off and POS should point to the
0a406a
+   number of function call arguments.  EXP is the object containing the
0a406a
+   list of expression elements.  */
0a406a
+
0a406a
+extern void print_subexp_funcall (struct expression *exp, int *pos,
0a406a
+				  struct ui_file *stream);
0a406a
+
0a406a
 /* Function used to avoid direct calls to fprintf
0a406a
    in the code generated by the bison parser.  */
0a406a
 
0a406a
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
0a406a
--- a/gdb/std-operator.def
0a406a
+++ b/gdb/std-operator.def
0a406a
@@ -168,14 +168,6 @@ OP (OP_FUNCALL)
0a406a
    pointer.  This is an Objective C message.  */
0a406a
 OP (OP_OBJC_MSGCALL)
0a406a
 
0a406a
-/* This is EXACTLY like OP_FUNCALL but is semantically different.
0a406a
-   In F77, array subscript expressions, substring expressions and
0a406a
-   function calls are all exactly the same syntactically.  They
0a406a
-   may only be disambiguated at runtime.  Thus this operator,
0a406a
-   which indicates that we have found something of the form
0a406a
-   <name> ( <stuff> ).  */
0a406a
-OP (OP_F77_UNDETERMINED_ARGLIST)
0a406a
-
0a406a
 /* OP_COMPLEX takes a type in the following element, followed by another
0a406a
    OP_COMPLEX, making three exp_elements.  It is followed by two double
0a406a
    args, and converts them into a complex number of the given type.  */