Implement function calls for Ada

This implements function calls for Ada.  This takes a different
approach than that used for other languages, primarily because Ada
requires special treatment generally.  The "ordinary" special case for
just the callee didn't really apply neatly here; there's only one case
in Ada needing special callee treatment.

gdb/ChangeLog
2021-03-08  Tom Tromey  <tom@tromey.com>

	* ada-lang.c (ada_funcall_operation::evaluate): New method.
	* ada-exp.h (class ada_var_msym_value_operation) <get_symbol>: New
	method.
	(class ada_funcall_operation): New.

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 781fa8bf70365909bc422f11af73bb50d68c9d23..47383501082f46e1e63d2ff3b96181994b46906b 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,10 @@
+2021-03-08  Tom Tromey  <tom@tromey.com>
+
+       * ada-lang.c (ada_funcall_operation::evaluate): New method.
+       * ada-exp.h (class ada_var_msym_value_operation) <get_symbol>: New
+       method.
+       (class ada_funcall_operation): New.
+
 2021-03-08  Tom Tromey  <tom@tromey.com>
 
        * ada-lang.c (ada_structop_operation::evaluate): New method.

diff --git a/gdb/ada-exp.h b/gdb/ada-exp.h
index 34b9c1d166da0fba7f37b14ae632555dd827bc74..287ed5cc62ce1994e41de07eb72383baf57c5ffe 100644 (file)
--- a/gdb/ada-exp.h
+++ b/gdb/ada-exp.h
@@ -320,6 +320,9 @@ public:
                            struct expression *exp,
                            enum noside noside) override;
 
+  symbol *get_symbol () const
+  { return std::get<0> (m_storage); }
+
 protected:
 
   using operation::do_generate_ax;
@@ -387,6 +390,22 @@ public:
   { return STRUCTOP_STRUCT; }
 };
 
+/* Function calls for Ada.  */
+class ada_funcall_operation
+  : public tuple_holding_operation<operation_up, std::vector<operation_up>>
+{
+public:
+
+  using tuple_holding_operation::tuple_holding_operation;
+
+  value *evaluate (struct type *expect_type,
+                  struct expression *exp,
+                  enum noside noside) override;
+
+  enum exp_opcode opcode () const override
+  { return OP_FUNCALL; }
+};
+
 } /* namespace expr */
 
 #endif /* ADA_EXP_H */

diff --git a/gdb/ada-lang.c b/gdb/ada-lang.c
index 915fbe36f8c3d6635123701acb90fdd190a4d7a8..2bee8abc94c04c244d633ee8a567c8bf875d7533 100644 (file)
--- a/gdb/ada-lang.c
+++ b/gdb/ada-lang.c
@@ -10830,6 +10830,148 @@ ada_structop_operation::evaluate (struct type *expect_type,
     }
 }
 
+value *
+ada_funcall_operation::evaluate (struct type *expect_type,
+                                struct expression *exp,
+                                enum noside noside)
+{
+  const std::vector<operation_up> &args_up = std::get<1> (m_storage);
+  int nargs = args_up.size ();
+  std::vector<value *> argvec (nargs);
+  operation_up &callee_op = std::get<0> (m_storage);
+
+  ada_var_value_operation *avv
+    = dynamic_cast<ada_var_value_operation *> (callee_op.get ());
+  if (avv != nullptr
+      && SYMBOL_DOMAIN (avv->get_symbol ()) == UNDEF_DOMAIN)
+    error (_("Unexpected unresolved symbol, %s, during evaluation"),
+          avv->get_symbol ()->print_name ());
+
+  value *callee = callee_op->evaluate (nullptr, exp, noside);
+  for (int i = 0; i < args_up.size (); ++i)
+    argvec[i] = args_up[i]->evaluate (nullptr, exp, noside);
+
+  if (ada_is_constrained_packed_array_type
+      (desc_base_type (value_type (callee))))
+    callee = ada_coerce_to_simple_array (callee);
+  else if (value_type (callee)->code () == TYPE_CODE_ARRAY
+          && TYPE_FIELD_BITSIZE (value_type (callee), 0) != 0)
+    /* This is a packed array that has already been fixed, and
+       therefore already coerced to a simple array.  Nothing further
+       to do.  */
+    ;
+  else if (value_type (callee)->code () == TYPE_CODE_REF)
+    {
+      /* Make sure we dereference references so that all the code below
+        feels like it's really handling the referenced value.  Wrapping
+        types (for alignment) may be there, so make sure we strip them as
+        well.  */
+      callee = ada_to_fixed_value (coerce_ref (callee));
+    }
+  else if (value_type (callee)->code () == TYPE_CODE_ARRAY
+          && VALUE_LVAL (callee) == lval_memory)
+    callee = value_addr (callee);
+
+  struct type *type = ada_check_typedef (value_type (callee));
+
+  /* Ada allows us to implicitly dereference arrays when subscripting
+     them.  So, if this is an array typedef (encoding use for array
+     access types encoded as fat pointers), strip it now.  */
+  if (type->code () == TYPE_CODE_TYPEDEF)
+    type = ada_typedef_target_type (type);
+
+  if (type->code () == TYPE_CODE_PTR)
+    {
+      switch (ada_check_typedef (TYPE_TARGET_TYPE (type))->code ())
+       {
+       case TYPE_CODE_FUNC:
+         type = ada_check_typedef (TYPE_TARGET_TYPE (type));
+         break;
+       case TYPE_CODE_ARRAY:
+         break;
+       case TYPE_CODE_STRUCT:
+         if (noside != EVAL_AVOID_SIDE_EFFECTS)
+           callee = ada_value_ind (callee);
+         type = ada_check_typedef (TYPE_TARGET_TYPE (type));
+         break;
+       default:
+         error (_("cannot subscript or call something of type `%s'"),
+                ada_type_name (value_type (callee)));
+         break;
+       }
+    }
+
+  switch (type->code ())
+    {
+    case TYPE_CODE_FUNC:
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
+       {
+         if (TYPE_TARGET_TYPE (type) == NULL)
+           error_call_unknown_return_type (NULL);
+         return allocate_value (TYPE_TARGET_TYPE (type));
+       }
+      return call_function_by_hand (callee, NULL, argvec);
+    case TYPE_CODE_INTERNAL_FUNCTION:
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
+       /* We don't know anything about what the internal
+          function might return, but we have to return
+          something.  */
+       return value_zero (builtin_type (exp->gdbarch)->builtin_int,
+                          not_lval);
+      else
+       return call_internal_function (exp->gdbarch, exp->language_defn,
+                                      callee, nargs,
+                                      argvec.data ());
+
+    case TYPE_CODE_STRUCT:
+      {
+       int arity;
+
+       arity = ada_array_arity (type);
+       type = ada_array_element_type (type, nargs);
+       if (type == NULL)
+         error (_("cannot subscript or call a record"));
+       if (arity != nargs)
+         error (_("wrong number of subscripts; expecting %d"), arity);
+       if (noside == EVAL_AVOID_SIDE_EFFECTS)
+         return value_zero (ada_aligned_type (type), lval_memory);
+       return
+         unwrap_value (ada_value_subscript
+                       (callee, nargs, argvec.data ()));
+      }
+    case TYPE_CODE_ARRAY:
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
+       {
+         type = ada_array_element_type (type, nargs);
+         if (type == NULL)
+           error (_("element type of array unknown"));
+         else
+           return value_zero (ada_aligned_type (type), lval_memory);
+       }
+      return
+       unwrap_value (ada_value_subscript
+                     (ada_coerce_to_simple_array (callee),
+                      nargs, argvec.data ()));
+    case TYPE_CODE_PTR:     /* Pointer to array */
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
+       {
+         type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
+         type = ada_array_element_type (type, nargs);
+         if (type == NULL)
+           error (_("element type of array unknown"));
+         else
+           return value_zero (ada_aligned_type (type), lval_memory);
+       }
+      return
+       unwrap_value (ada_value_ptr_subscript (callee, nargs,
+                                              argvec.data ()));
+
+    default:
+      error (_("Attempt to index or call something other than an "
+              "array or function"));
+    }
+}
+
 }
 
 /* Implement the evaluate_exp routine in the exp_descriptor structure