re PR ada/37139 (DEP prevents using Ada tasking)

	PR ada/37139
	PR ada/67205
	* common.opt (-ftrampolines): New option.
	* doc/invoke.texi (Code Gen Options): Document it.
	* doc/tm.texi.in (Trampolines): Add TARGET_CUSTOM_FUNCTION_DESCRIPTORS.
	* doc/tm.texi: Regenerate.
	* builtins.def: Add init_descriptor and adjust_descriptor.
	* builtins.c (expand_builtin_init_trampoline): Do not issue a warning
	on platforms with descriptors.
	(expand_builtin_init_descriptor): New function.
	(expand_builtin_adjust_descriptor): Likewise.
	(expand_builtin) <BUILT_IN_INIT_DESCRIPTOR>: New case.
	<BUILT_IN_ADJUST_DESCRIPTOR>: Likewise.
	* calls.c (prepare_call_address): Remove SIBCALLP parameter and add
	FLAGS parameter.  Deal with indirect calls by descriptor and adjust.
	Set STATIC_CHAIN_REG_P on the static chain register, if any.
	(call_expr_flags): Set ECF_BY_DESCRIPTOR for calls by descriptor.
	(expand_call): Likewise.  Move around call to prepare_call_address
	and pass all flags to it.
	* cfgexpand.c (expand_call_stmt): Reinstate CALL_EXPR_BY_DESCRIPTOR.
	* gimple.h (enum gf_mask): New GF_CALL_BY_DESCRIPTOR value.
	(gimple_call_set_by_descriptor): New setter.
	(gimple_call_by_descriptor_p): New getter.
	* gimple.c (gimple_build_call_from_tree): SetCALL_EXPR_BY_DESCRIPTOR.
	(gimple_call_flags): Deal with GF_CALL_BY_DESCRIPTOR.
	* langhooks.h (struct lang_hooks): Add custom_function_descriptors.
	* langhooks-def.h (LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS): Define.
	(LANG_HOOKS_INITIALIZER): Add LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS.
	* rtl.h (STATIC_CHAIN_REG_P): New macro.
	* rtlanal.c (find_first_parameter_load): Skip static chain registers.
	* target.def (custom_function_descriptors): New POD hook.
	* tree.h (FUNC_ADDR_BY_DESCRIPTOR): New flag on ADDR_EXPR.
	(CALL_EXPR_BY_DESCRIPTOR): New flag on CALL_EXPR.
	* tree-core.h (ECF_BY_DESCRIPTOR): New mask.
	Document FUNC_ADDR_BY_DESCRIPTOR and CALL_EXPR_BY_DESCRIPTOR.
	* tree.c (make_node_stat) <tcc_declaration>: Use FUNCTION_ALIGNMENT.
	(build_common_builtin_nodes): Initialize init_descriptor and
	adjust_descriptor.
	* tree-nested.c: Include target.h.
	(struct nesting_info): Add 'any_descr_created' field.
	(get_descriptor_type): New function.
	(lookup_element_for_decl): New function extracted from...
	(create_field_for_decl): Likewise.
	(lookup_tramp_for_decl): ...here.  Adjust.
	(lookup_descr_for_decl): New function.
	(convert_tramp_reference_op): Deal with descriptors.
	(build_init_call_stmt): New function extracted from...
	(finalize_nesting_tree_1): ...here.  Adjust and deal withdescriptors.
	* defaults.h (FUNCTION_ALIGNMENT): Define.
	(TRAMPOLINE_ALIGNMENT): Set to above instead of FUNCTION_BOUNDARY.
	* config/i386/i386.h (TARGET_CUSTOM_FUNCTION_DESCRIPTORS): Define.
	* config/ia64/ia64.h (TARGET_CUSTOM_FUNCTION_DESCRIPTORS): Likewise.
	* config/rs6000/rs6000.h (TARGET_CUSTOM_FUNCTION_DESCRIPTORS):Likewise.
	* config/sparc/sparc.h (TARGET_CUSTOM_FUNCTION_DESCRIPTORS): Likewise.
ada/
	* gcc-interface/misc.c (LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS):Define.
	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Access>: Deal with
	a zero TARGET_CUSTOM_FUNCTION_DESCRIPTORS specially for Code_Address.
	Otherwise, if TARGET_CUSTOM_FUNCTION_DESCRIPTORS is positive, set
	FUNC_ADDR_BY_DESCRIPTOR for 'Access/'Unrestricted_Access of nested
	subprograms if the type can use an internal representation.
	(call_to_gnu): Likewise, but set CALL_EXPR_BY_DESCRIPTOR on indirect
	calls if the type can use an internal representation.

From-SVN: r241222

3 files changed, 48 insertions, 5 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1cd1d35..cd13389 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,16 @@
 2016-10-16  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/misc.c (LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS):Define.
+	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Access>: Deal with
+	a zero TARGET_CUSTOM_FUNCTION_DESCRIPTORS specially for Code_Address.
+	Otherwise, if TARGET_CUSTOM_FUNCTION_DESCRIPTORS is positive, set
+	FUNC_ADDR_BY_DESCRIPTOR for 'Access/'Unrestricted_Access of nested
+	subprograms if the type can use an internal representation.
+	(call_to_gnu): Likewise, but set CALL_EXPR_BY_DESCRIPTOR on indirect
+	calls if the type can use an internal representation.
+
+2016-10-16  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* system-aix.ads (Always_Compatible_Rep): Change to False.
 	* system-aix64.ads (Always_Compatible_Rep): Likewise.
 	* system-hpux-ia64.ads (Always_Compatible_Rep): Likewise.
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index cf29210..76ad06c 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -1415,6 +1415,8 @@ get_lang_specific (tree node)
 #define LANG_HOOKS_EH_PERSONALITY	gnat_eh_personality
 #undef  LANG_HOOKS_DEEP_UNSHARING
 #define LANG_HOOKS_DEEP_UNSHARING	true
+#undef  LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS
+#define LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS true
 
 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 7b319d4..e5047f0 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -1702,6 +1702,17 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 
 	  if (TREE_CODE (gnu_expr) == ADDR_EXPR)
 	    TREE_NO_TRAMPOLINE (gnu_expr) = TREE_CONSTANT (gnu_expr) = 1;
+
+	  /* On targets for which function symbols denote a descriptor, the
+	     code address is stored within the first slot of the descriptor
+	     so we do an additional dereference:
+	       result = *((result_type *) result)
+	     where we expect result to be of some pointer type already.  */
+	  if (targetm.calls.custom_function_descriptors == 0)
+	    gnu_result
+	      = build_unary_op (INDIRECT_REF, NULL_TREE,
+				convert (build_pointer_type (gnu_result_type),
+					 gnu_result));
 	}
 
       /* For 'Access, issue an error message if the prefix is a C++ method
@@ -1728,10 +1739,19 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 	      /* Also check the inlining status.  */
 	      check_inlining_for_nested_subprog (TREE_OPERAND (gnu_expr, 0));
 
-	      /* Check that we're not violating the No_Implicit_Dynamic_Code
-		 restriction.  Be conservative if we don't know anything
-		 about the trampoline strategy for the target.  */
-	      Check_Implicit_Dynamic_Code_Allowed (gnat_node);
+	      /* Moreover, for 'Access or 'Unrestricted_Access with non-
+		 foreign-compatible representation, mark the ADDR_EXPR so
+		 that we can build a descriptor instead of a trampoline.  */
+	      if ((attribute == Attr_Access
+		   || attribute == Attr_Unrestricted_Access)
+		  && targetm.calls.custom_function_descriptors > 0
+		  && Can_Use_Internal_Rep (Etype (gnat_node)))
+		FUNC_ADDR_BY_DESCRIPTOR (gnu_expr) = 1;
+
+	      /* Otherwise, we need to check that we are not violating the
+		 No_Implicit_Dynamic_Code restriction.  */
+	      else if (targetm.calls.custom_function_descriptors != 0)
+	        Check_Implicit_Dynamic_Code_Allowed (gnat_node);
 	    }
 	}
       break;
@@ -4228,6 +4248,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
   tree gnu_after_list = NULL_TREE;
   tree gnu_retval = NULL_TREE;
   tree gnu_call, gnu_result;
+  bool by_descriptor = false;
   bool went_into_elab_proc = false;
   bool pushed_binding_level = false;
   Entity_Id gnat_formal;
@@ -4267,7 +4288,15 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
      type the access type is pointing to.  Otherwise, get the formals from the
      entity being called.  */
   if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
-    gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node)));
+    {
+      gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node)));
+
+      /* If the access type doesn't require foreign-compatible representation,
+	 be prepared for descriptors.  */
+      if (targetm.calls.custom_function_descriptors > 0
+	  && Can_Use_Internal_Rep (Etype (Prefix (Name (gnat_node)))))
+	by_descriptor = true;
+    }
   else if (Nkind (Name (gnat_node)) == N_Attribute_Reference)
     /* Assume here that this must be 'Elab_Body or 'Elab_Spec.  */
     gnat_formal = Empty;
@@ -4670,6 +4699,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 
   gnu_call
     = build_call_vec (gnu_result_type, gnu_subprog_addr, gnu_actual_vec);
+  CALL_EXPR_BY_DESCRIPTOR (gnu_call) = by_descriptor;
   set_expr_location_from_node (gnu_call, gnat_node);
 
   /* If we have created a temporary for the return value, initialize it.  */