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

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