@@ -410,10 +410,6 @@ do { \
/* Flags added to decl nodes. */
-/* Nonzero in a FUNCTION_DECL that represents a stubbed function
- discriminant. */
-#define DECL_STUBBED_P(NODE) DECL_LANG_FLAG_0 (FUNCTION_DECL_CHECK (NODE))
-
/* Nonzero in a VAR_DECL if it is guaranteed to be constant after having
been elaborated and TREE_READONLY is not set on it. */
#define DECL_READONLY_ONCE_ELAB(NODE) DECL_LANG_FLAG_0 (VAR_DECL_CHECK (NODE))
@@ -4095,19 +4095,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
else if (extern_flag && gnu_ext_name == DECL_NAME (realloc_decl))
gnu_decl = realloc_decl;
else
- {
- gnu_decl
- = create_subprog_decl (gnu_entity_name, gnu_ext_name,
- gnu_type, gnu_param_list,
- inline_status, public_flag,
- extern_flag, artificial_p,
- debug_info_p,
- definition && imported_p, attr_list,
- gnat_entity);
-
- DECL_STUBBED_P (gnu_decl)
- = (Convention (gnat_entity) == Convention_Stubbed);
- }
+ gnu_decl
+ = create_subprog_decl (gnu_entity_name, gnu_ext_name,
+ gnu_type, gnu_param_list,
+ inline_status, public_flag,
+ extern_flag, artificial_p,
+ debug_info_p,
+ definition && imported_p, attr_list,
+ gnat_entity);
}
}
break;
@@ -4453,13 +4453,14 @@ static tree
Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
atomic_acces_t atomic_access, bool atomic_sync)
{
+ const Node_Id gnat_name = Name (gnat_node);
const bool function_call = (Nkind (gnat_node) == N_Function_Call);
const bool returning_value = (function_call && !gnu_target);
/* The GCC node corresponding to the GNAT subprogram name. This can either
be a FUNCTION_DECL node if we are dealing with a standard subprogram call,
or an indirect reference expression (an INDIRECT_REF node) pointing to a
subprogram. */
- tree gnu_subprog = gnat_to_gnu (Name (gnat_node));
+ tree gnu_subprog = gnat_to_gnu (gnat_name);
/* The FUNCTION_TYPE node giving the GCC type of the subprogram. */
tree gnu_subprog_type = TREE_TYPE (gnu_subprog);
/* The return type of the FUNCTION_TYPE. */
@@ -4482,50 +4483,16 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
atomic_acces_t aa_type;
bool aa_sync;
- gcc_assert (FUNC_OR_METHOD_TYPE_P (gnu_subprog_type));
-
- /* If we are calling a stubbed function, raise Program_Error, but Elaborate
- all our args first. */
- if (TREE_CODE (gnu_subprog) == FUNCTION_DECL && DECL_STUBBED_P (gnu_subprog))
- {
- tree call_expr = build_call_raise (PE_Stubbed_Subprogram_Called,
- gnat_node, N_Raise_Program_Error);
-
- for (gnat_actual = First_Actual (gnat_node);
- Present (gnat_actual);
- gnat_actual = Next_Actual (gnat_actual))
- add_stmt (gnat_to_gnu (gnat_actual));
-
- if (returning_value)
- {
- *gnu_result_type_p = gnu_result_type;
- return build1 (NULL_EXPR, gnu_result_type, call_expr);
- }
-
- return call_expr;
- }
-
- if (TREE_CODE (gnu_subprog) == FUNCTION_DECL)
- {
- /* For a call to a nested function, check the inlining status. */
- if (decl_function_context (gnu_subprog))
- check_inlining_for_nested_subprog (gnu_subprog);
-
- /* For a recursive call, avoid explosion due to recursive inlining. */
- if (gnu_subprog == current_function_decl)
- DECL_DISREGARD_INLINE_LIMITS (gnu_subprog) = 0;
- }
-
- /* The only way we can be making a call via an access type is if Name is an
+ /* The only way we can make a call via an access type is if GNAT_NAME is an
explicit dereference. In that case, get the list of formal args from the
type the access type is pointing to. Otherwise, get the formals from the
entity being called. */
- if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
+ if (Nkind (gnat_name) == N_Explicit_Dereference)
{
const Entity_Id gnat_prefix_type
- = Underlying_Type (Etype (Prefix (Name (gnat_node))));
+ = Underlying_Type (Etype (Prefix (gnat_name)));
- gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node)));
+ gnat_formal = First_Formal_With_Extras (Etype (gnat_name));
variadic = IN (Convention (gnat_prefix_type), Convention_C_Variadic);
/* If the access type doesn't require foreign-compatible representation,
@@ -4534,19 +4501,56 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
= targetm.calls.custom_function_descriptors > 0
&& Can_Use_Internal_Rep (gnat_prefix_type);
}
- else if (Nkind (Name (gnat_node)) == N_Attribute_Reference)
+
+ else if (Nkind (gnat_name) == N_Attribute_Reference)
{
/* Assume here that this must be 'Elab_Body or 'Elab_Spec. */
gnat_formal = Empty;
variadic = false;
by_descriptor = false;
}
+
else
{
- gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node)));
- variadic
- = IN (Convention (Entity (Name (gnat_node))), Convention_C_Variadic);
+ gcc_checking_assert (Is_Entity_Name (gnat_name));
+
+ gnat_formal = First_Formal_With_Extras (Entity (gnat_name));
+ variadic = IN (Convention (Entity (gnat_name)), Convention_C_Variadic);
by_descriptor = false;
+
+ /* If we are calling a stubbed function, then raise Program_Error, but
+ elaborate all our args first. */
+ if (Convention (Entity (gnat_name)) == Convention_Stubbed)
+ {
+ tree call_expr = build_call_raise (PE_Stubbed_Subprogram_Called,
+ gnat_node, N_Raise_Program_Error);
+
+ for (gnat_actual = First_Actual (gnat_node);
+ Present (gnat_actual);
+ gnat_actual = Next_Actual (gnat_actual))
+ add_stmt (gnat_to_gnu (gnat_actual));
+
+ if (returning_value)
+ {
+ *gnu_result_type_p = gnu_result_type;
+ return build1 (NULL_EXPR, gnu_result_type, call_expr);
+ }
+
+ return call_expr;
+ }
+ }
+
+ gcc_assert (FUNC_OR_METHOD_TYPE_P (gnu_subprog_type));
+
+ if (TREE_CODE (gnu_subprog) == FUNCTION_DECL)
+ {
+ /* For a call to a nested function, check the inlining status. */
+ if (decl_function_context (gnu_subprog))
+ check_inlining_for_nested_subprog (gnu_subprog);
+
+ /* For a recursive call, avoid explosion due to recursive inlining. */
+ if (gnu_subprog == current_function_decl)
+ DECL_DISREGARD_INLINE_LIMITS (gnu_subprog) = 0;
}
/* The lifetime of the temporaries created for the call ends right after the
@@ -4765,8 +4769,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
/* Do not initialize it for the _Init parameter of an initialization
procedure since no data is meant to be passed in. */
if (Ekind (gnat_formal) == E_Out_Parameter
- && Is_Entity_Name (Name (gnat_node))
- && Is_Init_Proc (Entity (Name (gnat_node))))
+ && Is_Entity_Name (gnat_name)
+ && Is_Init_Proc (Entity (gnat_name)))
gnu_name = gnu_temp = create_temporary ("A", TREE_TYPE (gnu_name));
/* Initialize it on the fly like for an implicit temporary in the
@@ -5097,10 +5101,10 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
if (function_call)
gnu_cico_list = TREE_CHAIN (gnu_cico_list);
- if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
- gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node)));
+ if (Nkind (gnat_name) == N_Explicit_Dereference)
+ gnat_formal = First_Formal_With_Extras (Etype (gnat_name));
else
- gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node)));
+ gnat_formal = First_Formal_With_Extras (Entity (gnat_name));
for (gnat_actual = First_Actual (gnat_node);
Present (gnat_actual);