calls.c (expand_call): Try to do a tail call for thunks at -O0 too.

	* calls.c (expand_call): Try to do a tail call for thunks at -O0 too.
	* cgraph.h (struct cgraph_thunk_info): Add indirect_offset.
	(cgraph_node::create_thunk): Add indirect_offset parameter.
	(thunk_adjust): Likewise.
	* cgraph.c (cgraph_node::create_thunk): Add indirect_offset parameter
	and initialize the corresponding field with it.
	(cgraph_node::dump): Dump indirect_offset field.
	* cgraphclones.c (duplicate_thunk_for_node): Deal with indirect_offset.
	* cgraphunit.c (cgraph_node::analyze): Be prepared for external thunks.
	(thunk_adjust): Add indirect_offset parameter and deal with it.
	(cgraph_node::expand_thunk): Deal with the indirect_offset field and
	pass it to thunk_adjust.  Do not call the target hook if it's non-zero
	or if the thunk is external or local.  Fix formatting.  Do not chain
	the RESULT_DECL to BLOCK_VARS.  Pass the static chain to the target,
	if any, in the GIMPLE representation.
	* ipa-icf.c (sem_function::equals_wpa): Deal with indirect_offset.
	* lto-cgraph.c (lto_output_node): Write indirect_offset field.
	(input_node): Read indirect_offset field.
	* tree-inline.c (expand_call_inline): Pass indirect_offset field in the
	call to thunk_adjust.
	* tree-nested.c (struct nesting_info): Add thunk_p field.
	(create_nesting_tree): Set it.
	(convert_all_function_calls): Copy static chain from targets to thunks.
	(finalize_nesting_tree_1): Return early for thunks.
	(unnest_nesting_tree_1): Do not finalize thunks.
	(gimplify_all_functions): Do not gimplify thunks.
cp/
	* method.c (use_thunk): Adjust call to cgraph_node::create_thunk.
ada/
	* gcc-interface/decl.c (is_cplusplus_method): Do not require C++
	convention on Interfaces.
	* gcc-interface/trans.c (Subprogram_Body_to_gnu): Try to create a
	bona-fide thunk and hand it over to the middle-end.
	(get_controlling_type): New function.
	(use_alias_for_thunk_p): Likewise.
	(thunk_labelno): New static variable.
	(make_covariant_thunk): New function.
	(maybe_make_gnu_thunk): Likewise.
	* gcc-interface/utils.c (finish_subprog_decl): Set DECL_CONTEXT of the
	result DECL here instead of...
	(end_subprog_body): ...here.

Co-Authored-By: Pierre-Marie de Rodat <derodat@adacore.com>

From-SVN: r264701

3 files changed, 246 insertions, 6 deletions

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 8dd62f7..4a1845a 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -4851,15 +4851,15 @@ is_cplusplus_method (Entity_Id gnat_entity)
   if (Convention (gnat_entity) != Convention_CPP)
     return false;
 
-  /* And that the type of the first parameter (indirectly) has it too.  */
+  /* And that the type of the first parameter (indirectly) has it too, but
+     we make an exception for Interfaces because they need not be imported.  */
   Entity_Id gnat_first = First_Formal (gnat_entity);
   if (No (gnat_first))
     return false;
-
   Entity_Id gnat_type = Etype (gnat_first);
   if (Is_Access_Type (gnat_type))
     gnat_type = Directly_Designated_Type (gnat_type);
-  if (Convention (gnat_type) != Convention_CPP)
+  if (Convention (gnat_type) != Convention_CPP && !Is_Interface (gnat_type))
     return false;
 
   /* This is the main case: a C++ virtual method imported as a primitive
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 12f6a87..53513e5 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -247,6 +247,7 @@ static bool set_end_locus_from_node (tree, Node_Id);
 static int lvalue_required_p (Node_Id, tree, bool, bool);
 static tree build_raise_check (int, enum exception_info_kind);
 static tree create_init_temporary (const char *, tree, tree *, Node_Id);
+static bool maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk);
 
 /* Hooks for debug info back-ends, only supported and used in a restricted set
    of configurations.  */
@@ -3791,6 +3792,11 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
   if (Was_Expression_Function (gnat_node))
     DECL_DISREGARD_INLINE_LIMITS (gnu_subprog_decl) = 1;
 
+  /* Try to create a bona-fide thunk and hand it over to the middle-end.  */
+  if (Is_Thunk (gnat_subprog_id)
+      && maybe_make_gnu_thunk (gnat_subprog_id, gnu_subprog_decl))
+    return;
+
   /* Initialize the information structure for the function.  */
   allocate_struct_function (gnu_subprog_decl, false);
   gnu_subprog_language = ggc_cleared_alloc<language_function> ();
@@ -10333,6 +10339,242 @@ get_elaboration_procedure (void)
   return gnu_elab_proc_stack->last ();
 }
 
+/* Return the controlling type of a dispatching subprogram.  */
+
+static Entity_Id
+get_controlling_type (Entity_Id subprog)
+{
+  /* This is modelled on Expand_Interface_Thunk.  */
+  Entity_Id controlling_type = Etype (First_Formal (subprog));
+  if (Is_Access_Type (controlling_type))
+    controlling_type = Directly_Designated_Type (controlling_type);
+  controlling_type = Underlying_Type (controlling_type);
+  if (Is_Concurrent_Type (controlling_type))
+    controlling_type = Corresponding_Record_Type (controlling_type);
+  controlling_type = Base_Type (controlling_type);
+  return controlling_type;
+}
+
+/* Return whether we should use an alias for the TARGET of a thunk
+   in order to make the call generated in the thunk local.  */
+
+static bool
+use_alias_for_thunk_p (tree target)
+{
+  /* We cannot generate a local call in this case.  */
+  if (DECL_EXTERNAL (target))
+    return false;
+
+  /* The call is already local in this case.  */
+  if (TREE_CODE (DECL_CONTEXT (target)) == FUNCTION_DECL)
+    return false;
+
+  return TARGET_USE_LOCAL_THUNK_ALIAS_P (target);
+}
+
+static GTY(()) unsigned long thunk_labelno = 0;
+
+/* Create an alias for TARGET to be used as the target of a thunk.  */
+
+static tree
+make_alias_for_thunk (tree target)
+{
+  char buf[64];
+  targetm.asm_out.generate_internal_label (buf, "LTHUNK", thunk_labelno++);
+
+  tree alias = build_decl (DECL_SOURCE_LOCATION (target), TREE_CODE (target),
+			   get_identifier (buf), TREE_TYPE (target));
+
+  DECL_LANG_SPECIFIC (alias) = DECL_LANG_SPECIFIC (target);
+  DECL_CONTEXT (alias) = DECL_CONTEXT (target);
+  TREE_READONLY (alias) = TREE_READONLY (target);
+  TREE_THIS_VOLATILE (alias) = TREE_THIS_VOLATILE (target);
+  DECL_ARTIFICIAL (alias) = 1;
+  DECL_INITIAL (alias) = error_mark_node;
+  DECL_ARGUMENTS (alias) = copy_list (DECL_ARGUMENTS (target));
+  TREE_ADDRESSABLE (alias) = 1;
+  SET_DECL_ASSEMBLER_NAME (alias, DECL_NAME (alias));
+
+  cgraph_node *n = cgraph_node::create_same_body_alias (alias, target);
+  gcc_assert (n);
+
+  return alias;
+}
+
+/* Create the covariant part of the {GNAT,GNU}_THUNK.  */
+
+static tree
+make_covariant_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
+{
+  tree gnu_name = create_concat_name (gnat_thunk, "CV");
+  tree gnu_cv_thunk
+    = build_decl (DECL_SOURCE_LOCATION (gnu_thunk), TREE_CODE (gnu_thunk),
+		  gnu_name, TREE_TYPE (gnu_thunk));
+
+  DECL_ARGUMENTS (gnu_cv_thunk) = copy_list (DECL_ARGUMENTS (gnu_thunk));
+  DECL_RESULT (gnu_cv_thunk) = copy_node (DECL_RESULT (gnu_thunk));
+  DECL_CONTEXT (DECL_RESULT (gnu_cv_thunk)) = gnu_cv_thunk;
+
+  DECL_LANG_SPECIFIC (gnu_cv_thunk) = DECL_LANG_SPECIFIC (gnu_thunk);
+  DECL_CONTEXT (gnu_cv_thunk) = DECL_CONTEXT (gnu_thunk);
+  TREE_READONLY (gnu_cv_thunk) = TREE_READONLY (gnu_thunk);
+  TREE_THIS_VOLATILE (gnu_cv_thunk) = TREE_THIS_VOLATILE (gnu_thunk);
+  TREE_PUBLIC (gnu_cv_thunk) = TREE_PUBLIC (gnu_thunk);
+  DECL_ARTIFICIAL (gnu_cv_thunk) = 1;
+
+  return gnu_cv_thunk;
+}
+
+/* Try to create a GNU thunk for {GNAT,GNU}_THUNK and return true on success.
+
+   GNU thunks are more efficient than GNAT thunks because they don't call into
+   the runtime to retrieve the offset used in the displacement operation, but
+   they are tailored to C++ and thus too limited to support the full range of
+   thunks generated in Ada.  Here's the complete list of limitations:
+
+     1. Multi-controlling thunks, i.e thunks with more than one controlling
+	parameter, are simply not supported.
+
+     2. Covariant thunks, i.e. thunks for which the result is also controlling,
+	are split into a pair of (this, covariant-only) thunks.
+
+     3. Variable-offset thunks, i.e. thunks for which the offset depends on the
+	object and not only on its type, are supported as 2nd class citizens.
+
+     4. External thunks, i.e. thunks for which the target is not declared in
+	the same unit as the thunk, are supported as 2nd class citizens.
+
+     5. Local thunks, i.e. thunks generated for a local type, are supported as
+	2nd class citizens.  */
+
+static bool
+maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
+{
+  const Entity_Id gnat_target = Thunk_Entity (gnat_thunk);
+
+  /* Check that the first formal of the target is the only controlling one.  */
+  Entity_Id gnat_formal = First_Formal (gnat_target);
+  if (!Is_Controlling_Formal (gnat_formal))
+    return false;
+  for (gnat_formal = Next_Formal (gnat_formal);
+       Present (gnat_formal);
+       gnat_formal = Next_Formal (gnat_formal))
+    if (Is_Controlling_Formal (gnat_formal))
+      return false;
+
+  /* Look for the types that control the target and the thunk.  */
+  const Entity_Id gnat_controlling_type = get_controlling_type (gnat_target);
+  const Entity_Id gnat_interface_type = get_controlling_type (gnat_thunk);
+
+  /* Now compute whether the former covers the latter.  */
+  const Entity_Id gnat_interface_tag
+    = Is_Interface (gnat_interface_type)
+      ? Find_Interface_Tag (gnat_controlling_type, gnat_interface_type)
+      : Empty;
+  tree gnu_interface_tag
+    = Present (gnat_interface_tag)
+      ? gnat_to_gnu_field_decl (gnat_interface_tag)
+      : NULL_TREE;
+  tree gnu_interface_offset
+    = gnu_interface_tag ? byte_position (gnu_interface_tag) : NULL_TREE;
+
+  /* There are three ways to retrieve the offset between the interface view
+     and the base object.  Either the controlling type covers the interface
+     type and the offset of the corresponding tag is fixed, in which case it
+     can be statically encoded in the thunk (see FIXED_OFFSET below).  Or the
+     controlling type doesn't cover the interface type but is of fixed size,
+     in which case the offset is stored in the dispatch table, two pointers
+     above the dispatch table address (see VIRTUAL_VALUE below).  Otherwise,
+     the offset is variable and is stored right after the tag in every object
+     (see INDIRECT_OFFSET below).  See also a-tags.ads for more details.  */
+  HOST_WIDE_INT fixed_offset, virtual_value, indirect_offset;
+  tree virtual_offset;
+
+  if (gnu_interface_offset && TREE_CODE (gnu_interface_offset) == INTEGER_CST)
+    {
+      fixed_offset = - tree_to_shwi (gnu_interface_offset);
+      virtual_value = 0;
+      virtual_offset = NULL_TREE;
+      indirect_offset = 0;
+    }
+  else if (!gnu_interface_offset
+	   && !Is_Variable_Size_Record (gnat_controlling_type))
+    {
+      fixed_offset = 0;
+      virtual_value = - 2 * (HOST_WIDE_INT) (POINTER_SIZE / BITS_PER_UNIT);
+      virtual_offset = build_int_cst (integer_type_node, virtual_value);
+      indirect_offset = 0;
+    }
+  else
+    {
+      /* Covariant thunks with variable offset are not supported.  */
+      if (Has_Controlling_Result (gnat_target))
+	return false;
+
+      fixed_offset = 0;
+      virtual_value = 0;
+      virtual_offset = NULL_TREE;
+      indirect_offset = (HOST_WIDE_INT) (POINTER_SIZE / BITS_PER_UNIT);
+    }
+
+  tree gnu_target = gnat_to_gnu_entity (gnat_target, NULL_TREE, false);
+
+  /* Thunk and target must have the same nesting level, if any.  */
+  gcc_assert (DECL_CONTEXT (gnu_thunk) == DECL_CONTEXT (gnu_target));
+
+  /* If the target returns by invisible reference and is external, apply the
+     same transformation as Subprogram_Body_to_gnu here.  */
+  if (TREE_ADDRESSABLE (TREE_TYPE (gnu_target))
+      && DECL_EXTERNAL (gnu_target)
+      && !POINTER_TYPE_P (TREE_TYPE (DECL_RESULT (gnu_target))))
+    {
+      TREE_TYPE (DECL_RESULT (gnu_target))
+	= build_reference_type (TREE_TYPE (DECL_RESULT (gnu_target)));
+      relayout_decl (DECL_RESULT (gnu_target));
+    }
+
+  /* The thunk expander requires the return types of thunk and target to be
+     compatible, which is not fully the case with the CICO mechanism.  */
+  if (TYPE_CI_CO_LIST (TREE_TYPE (gnu_thunk)))
+    {
+      tree gnu_target_type = TREE_TYPE (gnu_target);
+      gcc_assert (TYPE_CI_CO_LIST (gnu_target_type));
+      TYPE_CANONICAL (TREE_TYPE (TREE_TYPE (gnu_thunk)))
+	= TYPE_CANONICAL (TREE_TYPE (gnu_target_type));
+    }
+
+  cgraph_node *target_node = cgraph_node::get_create (gnu_target);
+
+  /* If the return type of the target is a controlling type, then we need
+     both an usual this thunk and a covariant thunk in this order:
+
+       this thunk  -->  covariant thunk  -->  target
+
+     For covariant thunks, we can only handle a fixed offset.  */
+  if (Has_Controlling_Result (gnat_target))
+    {
+      gcc_assert (fixed_offset < 0);
+      tree gnu_cv_thunk = make_covariant_thunk (gnat_thunk, gnu_thunk);
+      target_node->create_thunk (gnu_cv_thunk, gnu_target, false,
+				 - fixed_offset, 0, 0,
+				 NULL_TREE, gnu_target);
+
+      gnu_target = gnu_cv_thunk;
+    }
+
+  /* We may also need to create an alias for the target in order to make
+     the call local, depending on the linkage of the target.  */
+  tree gnu_alias = use_alias_for_thunk_p (gnu_target)
+		  ? make_alias_for_thunk (gnu_target)
+		  : gnu_target;
+
+  target_node->create_thunk (gnu_thunk, gnu_target, true,
+			     fixed_offset, virtual_value, indirect_offset,
+			     virtual_offset, gnu_alias);
+
+  return true;
+}
+
 /* Initialize the table that maps GNAT codes to GCC codes for simple
    binary and unary operations.  */
 
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 9530165..1ce2f72 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -3294,6 +3294,7 @@ finish_subprog_decl (tree decl, tree asm_name, tree type)
 
   DECL_ARTIFICIAL (result_decl) = 1;
   DECL_IGNORED_P (result_decl) = 1;
+  DECL_CONTEXT (result_decl) = decl;
   DECL_BY_REFERENCE (result_decl) = TREE_ADDRESSABLE (type);
   DECL_RESULT (decl) = result_decl;
 
@@ -3369,9 +3370,6 @@ end_subprog_body (tree body)
   DECL_INITIAL (fndecl) = current_binding_level->block;
   gnat_poplevel ();
 
-  /* Mark the RESULT_DECL as being in this subprogram. */
-  DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
-
   /* The body should be a BIND_EXPR whose BLOCK is the top-level one.  */
   if (TREE_CODE (body) == BIND_EXPR)
     {