gdb/fortran: Move Fortran expression handling into f-lang.c
authorAndrew Burgess <andrew.burgess@embecosm.com>
Thu, 7 May 2020 15:27:16 +0000 (16:27 +0100)
committerAndrew Burgess <andrew.burgess@embecosm.com>
Sat, 19 Sep 2020 08:44:58 +0000 (09:44 +0100)
The Fortran specific OP_F77_UNDETERMINED_ARGLIST is currently handled
in the generic expression handling code.  There's no reason why this
should be the case, so this commit moves handling of this into Fortran
specific files.

There should be no user visible changes after this commit.

gdb/ChangeLog:

* eval.c: Remove 'f-lang.h' include.
(value_f90_subarray): Moved to f-lang.c.
(eval_call): Renamed to...
(evaluate_subexp_do_call): ...this, is no longer static, header
comment moved into header file.
(evaluate_funcall): Update call to eval_call.
(skip_undetermined_arglist): Moved to f-lang.c.
(fortran_value_subarray): Likewise.
(evaluate_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to evaluate_subexp_f.
(calc_f77_array_dims): Moved to f-lang.c
* expprint.c (print_subexp_funcall): New function.
(print_subexp_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to print_subexp_f, OP_FUNCALL uses new function.
(dump_subexp_body_funcall): New function.
(dump_subexp_body_standard): OP_F77_UNDETERMINED_ARGLIST handling
moved to dump_subexp_f, OP_FUNCALL uses new function.
* expression.h (evaluate_subexp_do_call): Declare.
* f-lang.c (value_f90_subarray): Moved from eval.c.
(skip_undetermined_arglist): Likewise.
(calc_f77_array_dims): Likewise.
(fortran_value_subarray): Likewise.
(evaluate_subexp_f): Add OP_F77_UNDETERMINED_ARGLIST support.
(operator_length_f): Likewise.
(print_subexp_f): Likewise.
(dump_subexp_body_f): Likewise.
* fortran-operator.def (OP_F77_UNDETERMINED_ARGLIST): Move
declaration of this operation to here.
* parse.c (operator_length_standard): OP_F77_UNDETERMINED_ARGLIST
support moved to operator_length_f.
* parser-defs.h (dump_subexp_body_funcall): Declare.
(print_subexp_funcall): Declare.
* std-operator.def (OP_F77_UNDETERMINED_ARGLIST): Moved to
fortran-operator.def.

gdb/ChangeLog
gdb/eval.c
gdb/expprint.c
gdb/expression.h
gdb/f-lang.c
gdb/fortran-operator.def
gdb/parse.c
gdb/parser-defs.h
gdb/std-operator.def

index 6330a054c7e09b115a538b8bf4737cf2b91ab917..ce820507e3c011032f733c4014b5e295dcad20b9 100644 (file)
@@ -1,3 +1,40 @@
+2020-09-19  Andrew Burgess  <andrew.burgess@embecosm.com>
+
+       * 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.
+
 2020-09-19  Andrew Burgess  <andrew.burgess@embecosm.com>
 
        * eval.c (fortran_value_subarray): New function, content is taken
index da4bbb288ffd79eb24a9ade6501f3d9cff51cf3b..2a1fd98caed60ae4e2c34fbd142cff536b615309 100644 (file)
@@ -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 (nullptr, exp, pos, noside));
-
-  if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
-    high_bound = range->bounds ()->high.const_val ();
-  else
-    high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
-
-  return value_slice (array, low_bound, high_bound - low_bound + 1);
-}
-
-
 /* 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 (nullptr, 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;
@@ -1976,84 +1871,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 (nullptr, 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.  */
@@ -3346,27 +3163,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;
-}
index 5bd9553a4112c2fc78dd70c79d25ba746834ddc3..d7d7c871bddd022e248f7620550eb3dbd9ae3cb4 100644 (file)
@@ -54,6 +54,25 @@ print_subexp (struct expression *exp, int *pos,
                                                       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
@@ -188,18 +207,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:
@@ -798,6 +806,22 @@ dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
                                                                  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
@@ -933,18 +957,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:
       {
index f1128c442483a742c1fdcee6772e6018df75adee..5af10f05db186803daeca037efee204116220bc9 100644 (file)
@@ -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 *);
index 8bc708dfa738681831fced66e81e2fd8345f509c..e13097baee453be7d98a8444991ba65efe5a0a17 100644 (file)
@@ -114,6 +114,134 @@ enum f_primitive_types {
   nr_f_primitive_types
 };
 
+/* Called from fortran_value_subarray to take a slice of an array or a
+   string.  ARRAY is the array or string to be accessed.  EXP, POS, and
+   NOSIDE are as for evaluate_subexp_standard.  Return a value that is a
+   slice of the array.  */
+
+static struct value *
+value_f90_subarray (struct value *array,
+                   struct expression *exp, int *pos, enum noside noside)
+{
+  int pc = (*pos) + 1;
+  LONGEST low_bound, high_bound;
+  struct type *range = check_typedef (value_type (array)->index_type ());
+  enum range_type range_type
+    = (enum range_type) longest_to_int (exp->elts[pc].longconst);
+
+  *pos += 3;
+
+  if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+    low_bound = range->bounds ()->low.const_val ();
+  else
+    low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+
+  if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
+    high_bound = range->bounds ()->high.const_val ();
+  else
+    high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside));
+
+  return value_slice (array, low_bound, high_bound - low_bound + 1);
+}
+
+/* Helper for skipping all the arguments in an undetermined argument list.
+   This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST
+   case of evaluate_subexp_standard as multiple, but not all, code paths
+   require a generic skip.  */
+
+static void
+skip_undetermined_arglist (int nargs, struct expression *exp, int *pos,
+                          enum noside noside)
+{
+  for (int i = 0; i < nargs; ++i)
+    evaluate_subexp (nullptr, exp, pos, noside);
+}
+
+/* Return the number of dimensions for a Fortran array or string.  */
+
+int
+calc_f77_array_dims (struct type *array_type)
+{
+  int ndimen = 1;
+  struct type *tmp_type;
+
+  if ((array_type->code () == TYPE_CODE_STRING))
+    return 1;
+
+  if ((array_type->code () != TYPE_CODE_ARRAY))
+    error (_("Can't get dimensions for a non-array type"));
+
+  tmp_type = array_type;
+
+  while ((tmp_type = TYPE_TARGET_TYPE (tmp_type)))
+    {
+      if (tmp_type->code () == TYPE_CODE_ARRAY)
+       ++ndimen;
+    }
+  return ndimen;
+}
+
+/* Called from evaluate_subexp_standard to perform array indexing, and
+   sub-range extraction, for Fortran.  As well as arrays this function
+   also handles strings as they can be treated like arrays of characters.
+   ARRAY is the array or string being accessed.  EXP, POS, and NOSIDE are
+   as for evaluate_subexp_standard, and NARGS is the number of arguments
+   in this access (e.g. 'array (1,2,3)' would be NARGS 3).  */
+
+static struct value *
+fortran_value_subarray (struct value *array, struct expression *exp,
+                       int *pos, int nargs, enum noside noside)
+{
+  if (exp->elts[*pos].opcode == OP_RANGE)
+    return value_f90_subarray (array, exp, pos, noside);
+
+  if (noside == EVAL_SKIP)
+    {
+      skip_undetermined_arglist (nargs, exp, pos, noside);
+      /* Return the dummy value with the correct type.  */
+      return array;
+    }
+
+  LONGEST subscript_array[MAX_FORTRAN_DIMS];
+  int ndimensions = 1;
+  struct type *type = check_typedef (value_type (array));
+
+  if (nargs > MAX_FORTRAN_DIMS)
+    error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
+
+  ndimensions = calc_f77_array_dims (type);
+
+  if (nargs != ndimensions)
+    error (_("Wrong number of subscripts"));
+
+  gdb_assert (nargs > 0);
+
+  /* Now that we know we have a legal array subscript expression let us
+     actually find out where this element exists in the array.  */
+
+  /* Take array indices left to right.  */
+  for (int i = 0; i < nargs; i++)
+    {
+      /* Evaluate each subscript; it must be a legal integer in F77.  */
+      value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+
+      /* Fill in the subscript array.  */
+      subscript_array[i] = value_as_long (arg2);
+    }
+
+  /* Internal type of array is arranged right to left.  */
+  for (int i = nargs; i > 0; i--)
+    {
+      struct type *array_type = check_typedef (value_type (array));
+      LONGEST index = subscript_array[i - 1];
+
+      array = value_subscripted_rvalue (array, index,
+                                       f77_get_lowerbound (array_type));
+    }
+
+  return array;
+}
+
 /* Special expression evaluation cases for Fortran.  */
 
 static struct value *
@@ -285,6 +413,87 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
                                   TYPE_LENGTH (type));
       return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
                                 TYPE_LENGTH (TYPE_TARGET_TYPE (type)));
+
+
+    case OP_F77_UNDETERMINED_ARGLIST:
+      /* Remember that in F77, functions, substring ops and array subscript
+         operations cannot be disambiguated at parse time.  We have made
+         all array subscript operations, substring operations as well as
+         function calls come here and we now have to discover what the heck
+         this thing actually was.  If it is a function, we process just as
+         if we got an OP_FUNCALL.  */
+      int nargs = longest_to_int (exp->elts[pc + 1].longconst);
+      (*pos) += 2;
+
+      /* First determine the type code we are dealing with.  */
+      arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+      type = check_typedef (value_type (arg1));
+      enum type_code code = type->code ();
+
+      if (code == TYPE_CODE_PTR)
+       {
+         /* Fortran always passes variable to subroutines as pointer.
+            So we need to look into its target type to see if it is
+            array, string or function.  If it is, we need to switch
+            to the target value the original one points to.  */
+         struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
+
+         if (target_type->code () == TYPE_CODE_ARRAY
+             || target_type->code () == TYPE_CODE_STRING
+             || target_type->code () == TYPE_CODE_FUNC)
+           {
+             arg1 = value_ind (arg1);
+             type = check_typedef (value_type (arg1));
+             code = type->code ();
+           }
+       }
+
+      switch (code)
+       {
+       case TYPE_CODE_ARRAY:
+       case TYPE_CODE_STRING:
+         return fortran_value_subarray (arg1, exp, pos, nargs, noside);
+
+       case TYPE_CODE_PTR:
+       case TYPE_CODE_FUNC:
+       case TYPE_CODE_INTERNAL_FUNCTION:
+         {
+           /* It's a function call.  Allocate arg vector, including
+           space for the function to be called in argvec[0] and a
+           termination NULL.  */
+           struct value **argvec = (struct value **)
+             alloca (sizeof (struct value *) * (nargs + 2));
+           argvec[0] = arg1;
+           int tem = 1;
+           for (; tem <= nargs; tem++)
+             {
+               argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
+               /* Arguments in Fortran are passed by address.  Coerce the
+                  arguments here rather than in value_arg_coerce as
+                  otherwise the call to malloc to place the non-lvalue
+                  parameters in target memory is hit by this Fortran
+                  specific logic.  This results in malloc being called
+                  with a pointer to an integer followed by an attempt to
+                  malloc the arguments to malloc in target memory.
+                  Infinite recursion ensues.  */
+               if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC)
+                 {
+                   bool is_artificial
+                     = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1);
+                   argvec[tem] = fortran_argument_convert (argvec[tem],
+                                                           is_artificial);
+                 }
+             }
+           argvec[tem] = 0;    /* signal end of arglist */
+           if (noside == EVAL_SKIP)
+             return eval_skip_value (exp);
+           return evaluate_subexp_do_call (exp, noside, nargs, argvec, NULL,
+                                           expect_type);
+         }
+
+       default:
+         error (_("Cannot perform substring on this type"));
+       }
     }
 
   /* Should be unreachable.  */
@@ -318,6 +527,11 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp,
       oplen = 1;
       args = 2;
       break;
+
+    case OP_F77_UNDETERMINED_ARGLIST:
+      oplen = 3;
+      args = 1 + longest_to_int (exp->elts[pc - 2].longconst);
+      break;
     }
 
   *oplenp = oplen;
@@ -390,6 +604,10 @@ print_subexp_f (struct expression *exp, int *pos,
     case BINOP_FORTRAN_MODULO:
       print_binop_subexp_f (exp, pos, stream, prec, "MODULO");
       return;
+
+    case OP_F77_UNDETERMINED_ARGLIST:
+      print_subexp_funcall (exp, pos, stream);
+      return;
     }
 }
 
@@ -432,6 +650,9 @@ dump_subexp_body_f (struct expression *exp,
     case BINOP_FORTRAN_MODULO:
       operator_length_f (exp, (elt + 1), &oplen, &nargs);
       break;
+
+    case OP_F77_UNDETERMINED_ARGLIST:
+      return dump_subexp_body_funcall (exp, stream, elt);
     }
 
   elt += oplen;
index fd4051ebe59ffe326d2dfcc9d4fcff282c64d826..bfdbc40171186b6d52e794325555f7933f6489da 100644 (file)
    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)
index 37bafe4cf2d3b453d63c53e561093efb074eb6e6..6b9541bfdc2cf8441889dfd5fc5cc62263132e48 100644 (file)
@@ -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;
index a9b8a12959b29e258d6ed73bbe949e762634f724..bc6fc2f9ba37e891bfedcc4fe585bf18eb5cdd89 100644 (file)
@@ -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.  */
 
index e969bdccaed8fd6855458e669fca7290046ad40d..6f90875f477654ad5016802fd02f0d44cf528218 100644 (file)
@@ -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.  */