Commit 9182f718 by Eric Botcazou Committed by Eric Botcazou

re PR ada/48835 (porting GNAT to m68k-linux)

	PR ada/48835
	PR ada/61954
	* gcc-interface/gigi.h (enum standard_datatypes): Add ADT_realloc_decl
	(realloc_decl): New macro.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Use local
	variable for the entity type and translate it as void pointer if the
	entity has convention C.
	(gnat_to_gnu_entity) <E_Function>: If this is not a definition and the
	external name matches that of malloc_decl or realloc_decl, return the
	correspoding node directly.
	(gnat_to_gnu_subprog_type): Likewise for parameter and return types.
	* gcc-interface/trans.c (gigi): Initialize void_list_node here, not...
	Initialize realloc_decl.
	* gcc-interface/utils.c (install_builtin_elementary_types): ...here.
	(build_void_list_node): Delete.
	* gcc-interface/utils2.c (known_alignment) <CALL_EXPR>: Return the
	alignment of the system allocator for malloc_decl and realloc_decl.
	Do not take alignment from void pointer types either.

From-SVN: r237850
parent 1af21224
2016-06-29 Eric Botcazou <ebotcazou@adacore.com> 2016-06-29 Eric Botcazou <ebotcazou@adacore.com>
PR ada/48835
PR ada/61954
* gcc-interface/gigi.h (enum standard_datatypes): Add ADT_realloc_decl
(realloc_decl): New macro.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Use local
variable for the entity type and translate it as void pointer if the
entity has convention C.
(gnat_to_gnu_entity) <E_Function>: If this is not a definition and the
external name matches that of malloc_decl or realloc_decl, return the
correspoding node directly.
(gnat_to_gnu_subprog_type): Likewise for parameter and return types.
* gcc-interface/trans.c (gigi): Initialize void_list_node here, not...
Initialize realloc_decl.
* gcc-interface/utils.c (install_builtin_elementary_types): ...here.
(build_void_list_node): Delete.
* gcc-interface/utils2.c (known_alignment) <CALL_EXPR>: Return the
alignment of the system allocator for malloc_decl and realloc_decl.
Do not take alignment from void pointer types either.
2016-06-29 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/misc.c (LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL): Reorder. * gcc-interface/misc.c (LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL): Reorder.
(LANG_HOOKS_INIT_TS): Likewise. (LANG_HOOKS_INIT_TS): Likewise.
......
...@@ -603,6 +603,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -603,6 +603,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
case E_Out_Parameter: case E_Out_Parameter:
case E_Variable: case E_Variable:
{ {
const Entity_Id gnat_type = Etype (gnat_entity);
/* Always create a variable for volatile objects and variables seen /* Always create a variable for volatile objects and variables seen
constant but with a Linker_Section pragma. */ constant but with a Linker_Section pragma. */
bool const_flag bool const_flag
...@@ -643,14 +644,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -643,14 +644,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
} }
/* Get the type after elaborating the renamed object. */ /* Get the type after elaborating the renamed object. */
gnu_type = gnat_to_gnu_type (Etype (gnat_entity)); if (Convention (gnat_entity) == Convention_C
&& Is_Descendant_Of_Address (gnat_type))
gnu_type = ptr_type_node;
else
{
gnu_type = gnat_to_gnu_type (gnat_type);
/* If this is a standard exception definition, then use the standard /* If this is a standard exception definition, use the standard
exception type. This is necessary to make sure that imported and exception type. This is necessary to make sure that imported
exported views of exceptions are properly merged in LTO mode. */ and exported views of exceptions are merged in LTO mode. */
if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL
&& DECL_NAME (TYPE_NAME (gnu_type)) == exception_data_name_id) && DECL_NAME (TYPE_NAME (gnu_type)) == exception_data_name_id)
gnu_type = except_type_node; gnu_type = except_type_node;
}
/* For a debug renaming declaration, build a debug-only entity. */ /* For a debug renaming declaration, build a debug-only entity. */
if (Present (Debug_Renaming_Link (gnat_entity))) if (Present (Debug_Renaming_Link (gnat_entity)))
...@@ -812,7 +819,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -812,7 +819,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|| (TYPE_SIZE (gnu_type) || (TYPE_SIZE (gnu_type)
&& integer_zerop (TYPE_SIZE (gnu_type)) && integer_zerop (TYPE_SIZE (gnu_type))
&& !TREE_OVERFLOW (TYPE_SIZE (gnu_type)))) && !TREE_OVERFLOW (TYPE_SIZE (gnu_type))))
&& !Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) && !Is_Constr_Subt_For_UN_Aliased (gnat_type)
&& No (Renamed_Object (gnat_entity)) && No (Renamed_Object (gnat_entity))
&& No (Address_Clause (gnat_entity))) && No (Address_Clause (gnat_entity)))
gnu_size = bitsize_unit_node; gnu_size = bitsize_unit_node;
...@@ -828,8 +835,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -828,8 +835,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|| (!Optimize_Alignment_Space (gnat_entity) || (!Optimize_Alignment_Space (gnat_entity)
&& kind != E_Exception && kind != E_Exception
&& kind != E_Out_Parameter && kind != E_Out_Parameter
&& Is_Composite_Type (Etype (gnat_entity)) && Is_Composite_Type (gnat_type)
&& !Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) && !Is_Constr_Subt_For_UN_Aliased (gnat_type)
&& !Is_Exported (gnat_entity) && !Is_Exported (gnat_entity)
&& !imported_p && !imported_p
&& No (Renamed_Object (gnat_entity)) && No (Renamed_Object (gnat_entity))
...@@ -895,12 +902,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -895,12 +902,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* If this is an aliased object with an unconstrained array nominal /* If this is an aliased object with an unconstrained array nominal
subtype, make a type that includes the template. We will either subtype, make a type that includes the template. We will either
allocate or create a variable of that type, see below. */ allocate or create a variable of that type, see below. */
if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
&& Is_Array_Type (Underlying_Type (Etype (gnat_entity))) && Is_Array_Type (Underlying_Type (gnat_type))
&& !type_annotate_only) && !type_annotate_only)
{ {
tree gnu_array tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_type));
= gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));
gnu_type gnu_type
= build_unc_object_type_from_ptr (TREE_TYPE (gnu_array), = build_unc_object_type_from_ptr (TREE_TYPE (gnu_array),
gnu_type, gnu_type,
...@@ -914,7 +920,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -914,7 +920,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
without pessimizing the allocation. This is a kludge necessary without pessimizing the allocation. This is a kludge necessary
because we don't support dynamic alignment. */ because we don't support dynamic alignment. */
if (align == 0 if (align == 0
&& Ekind (Etype (gnat_entity)) == E_Class_Wide_Subtype && Ekind (gnat_type) == E_Class_Wide_Subtype
&& No (Renamed_Object (gnat_entity)) && No (Renamed_Object (gnat_entity))
&& No (Address_Clause (gnat_entity))) && No (Address_Clause (gnat_entity)))
align = get_target_system_allocator_alignment () * BITS_PER_UNIT; align = get_target_system_allocator_alignment () * BITS_PER_UNIT;
...@@ -1194,8 +1200,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -1194,8 +1200,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* If this is an aliased object with an unconstrained array nominal /* If this is an aliased object with an unconstrained array nominal
subtype, then it can overlay only another aliased object with an subtype, then it can overlay only another aliased object with an
unconstrained array nominal subtype and compatible template. */ unconstrained array nominal subtype and compatible template. */
if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
&& Is_Array_Type (Underlying_Type (Etype (gnat_entity))) && Is_Array_Type (Underlying_Type (gnat_type))
&& !type_annotate_only) && !type_annotate_only)
{ {
tree rec_type = TREE_TYPE (gnu_type); tree rec_type = TREE_TYPE (gnu_type);
...@@ -1408,8 +1414,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -1408,8 +1414,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
This is aimed to make it easier for the debugger to decode the This is aimed to make it easier for the debugger to decode the
object. Note that we have to do it this late because of the object. Note that we have to do it this late because of the
couple of allocation adjustments that might be made above. */ couple of allocation adjustments that might be made above. */
if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
&& Is_Array_Type (Underlying_Type (Etype (gnat_entity))) && Is_Array_Type (Underlying_Type (gnat_type))
&& !type_annotate_only) && !type_annotate_only)
{ {
/* In case the object with the template has already been allocated /* In case the object with the template has already been allocated
...@@ -1436,8 +1442,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -1436,8 +1442,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
gnu_size = NULL_TREE; gnu_size = NULL_TREE;
} }
tree gnu_array tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_type));
= gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));
gnu_type gnu_type
= build_reference_type (TYPE_OBJECT_RECORD_TYPE (gnu_array)); = build_reference_type (TYPE_OBJECT_RECORD_TYPE (gnu_array));
} }
...@@ -1523,7 +1528,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -1523,7 +1528,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
&& No (Address_Clause (gnat_entity))) && No (Address_Clause (gnat_entity)))
|| Address_Taken (gnat_entity) || Address_Taken (gnat_entity)
|| Is_Aliased (gnat_entity) || Is_Aliased (gnat_entity)
|| Is_Aliased (Etype (gnat_entity)))) || Is_Aliased (gnat_type)))
{ {
tree gnu_corr_var tree gnu_corr_var
= create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
...@@ -4269,6 +4274,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -4269,6 +4274,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
DECL_BY_REF_P (gnu_decl) = 1; DECL_BY_REF_P (gnu_decl) = 1;
} }
/* If this is a mere subprogram type, just create the declaration. */
else if (kind == E_Subprogram_Type) else if (kind == E_Subprogram_Type)
{ {
process_attributes (&gnu_type, &attr_list, false, gnat_entity); process_attributes (&gnu_type, &attr_list, false, gnat_entity);
...@@ -4278,19 +4284,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -4278,19 +4284,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
debug_info_p, gnat_entity); debug_info_p, gnat_entity);
} }
/* Otherwise create the subprogram declaration with the external name,
the type and the parameter list. However, if this a reference to
the allocation routines, reuse the canonical declaration nodes as
they come with special properties. */
else
{
if (extern_flag && gnu_ext_name == DECL_NAME (malloc_decl))
gnu_decl = malloc_decl;
else if (extern_flag && gnu_ext_name == DECL_NAME (realloc_decl))
gnu_decl = realloc_decl;
else else
{ {
gnu_decl gnu_decl
= create_subprog_decl (gnu_entity_name, gnu_ext_name, gnu_type, = create_subprog_decl (gnu_entity_name, gnu_ext_name,
gnu_param_list, inline_status, gnu_type, gnu_param_list,
public_flag, extern_flag, inline_status, public_flag,
artificial_p, debug_info_p, extern_flag, artificial_p,
attr_list, gnat_entity); debug_info_p, attr_list, gnat_entity);
DECL_STUBBED_P (gnu_decl) DECL_STUBBED_P (gnu_decl)
= (Convention (gnat_entity) == Convention_Stubbed); = (Convention (gnat_entity) == Convention_Stubbed);
} }
} }
}
break; break;
case E_Incomplete_Type: case E_Incomplete_Type:
...@@ -5754,6 +5771,10 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, ...@@ -5754,6 +5771,10 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
else else
{ {
if (Convention (gnat_subprog) == Convention_C
&& Is_Descendant_Of_Address (gnat_return_type))
gnu_return_type = ptr_type_node;
else
gnu_return_type = gnat_to_gnu_profile_type (gnat_return_type); gnu_return_type = gnat_to_gnu_profile_type (gnat_return_type);
/* If this function returns by reference, make the actual return type /* If this function returns by reference, make the actual return type
...@@ -5914,6 +5935,11 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, ...@@ -5914,6 +5935,11 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
else else
{ {
Entity_Id gnat_param_type = Etype (gnat_param); Entity_Id gnat_param_type = Etype (gnat_param);
if (Convention (gnat_subprog) == Convention_C
&& Is_Descendant_Of_Address (gnat_param_type))
gnu_param_type = ptr_type_node;
else
gnu_param_type = gnat_to_gnu_profile_type (gnat_param_type); gnu_param_type = gnat_to_gnu_profile_type (gnat_param_type);
/* If the parameter type is incomplete, there are 2 cases: if it is /* If the parameter type is incomplete, there are 2 cases: if it is
......
...@@ -394,13 +394,15 @@ enum standard_datatypes ...@@ -394,13 +394,15 @@ enum standard_datatypes
/* Value BITS_PER_UNIT in signed bitsizetype. */ /* Value BITS_PER_UNIT in signed bitsizetype. */
ADT_sbitsize_unit_node, ADT_sbitsize_unit_node,
/* Function declaration nodes for run-time functions for allocating memory. /* Function declaration node for run-time allocation function. */
Ada allocators cause calls to this function to be generated. */
ADT_malloc_decl, ADT_malloc_decl,
/* Likewise for freeing memory. */ /* Function declaration node for run-time freeing function. */
ADT_free_decl, ADT_free_decl,
/* Function declaration node for run-time reallocation function. */
ADT_realloc_decl,
/* Function decl node for 64-bit multiplication with overflow checking. */ /* Function decl node for 64-bit multiplication with overflow checking. */
ADT_mulv64_decl, ADT_mulv64_decl,
...@@ -471,6 +473,7 @@ extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1]; ...@@ -471,6 +473,7 @@ extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1];
#define sbitsize_unit_node gnat_std_decls[(int) ADT_sbitsize_unit_node] #define sbitsize_unit_node gnat_std_decls[(int) ADT_sbitsize_unit_node]
#define malloc_decl gnat_std_decls[(int) ADT_malloc_decl] #define malloc_decl gnat_std_decls[(int) ADT_malloc_decl]
#define free_decl gnat_std_decls[(int) ADT_free_decl] #define free_decl gnat_std_decls[(int) ADT_free_decl]
#define realloc_decl gnat_std_decls[(int) ADT_realloc_decl]
#define mulv64_decl gnat_std_decls[(int) ADT_mulv64_decl] #define mulv64_decl gnat_std_decls[(int) ADT_mulv64_decl]
#define parent_name_id gnat_std_decls[(int) ADT_parent_name_id] #define parent_name_id gnat_std_decls[(int) ADT_parent_name_id]
#define exception_data_name_id gnat_std_decls[(int) ADT_exception_data_name_id] #define exception_data_name_id gnat_std_decls[(int) ADT_exception_data_name_id]
......
...@@ -387,14 +387,13 @@ gigi (Node_Id gnat_root, ...@@ -387,14 +387,13 @@ gigi (Node_Id gnat_root,
true, false, NULL, gnat_literal); true, false, NULL, gnat_literal);
save_gnu_tree (gnat_literal, t, false); save_gnu_tree (gnat_literal, t, false);
/* Declare the building blocks of function nodes. */
void_list_node = build_tree_list (NULL_TREE, void_type_node);
void_ftype = build_function_type_list (void_type_node, NULL_TREE); void_ftype = build_function_type_list (void_type_node, NULL_TREE);
ptr_void_ftype = build_pointer_type (void_ftype); ptr_void_ftype = build_pointer_type (void_ftype);
/* Now declare run-time functions. */ /* Now declare run-time functions. */
ftype = build_function_type_list (ptr_type_node, sizetype, NULL_TREE); ftype = build_function_type_list (ptr_type_node, sizetype, NULL_TREE);
/* malloc is a function declaration tree for a function to allocate
memory. */
malloc_decl malloc_decl
= create_subprog_decl (get_identifier ("__gnat_malloc"), NULL_TREE, = create_subprog_decl (get_identifier ("__gnat_malloc"), NULL_TREE,
ftype, ftype,
...@@ -402,12 +401,18 @@ gigi (Node_Id gnat_root, ...@@ -402,12 +401,18 @@ gigi (Node_Id gnat_root,
NULL, Empty); NULL, Empty);
DECL_IS_MALLOC (malloc_decl) = 1; DECL_IS_MALLOC (malloc_decl) = 1;
/* free is a function declaration tree for a function to free memory. */ ftype = build_function_type_list (void_type_node, ptr_type_node, NULL_TREE);
free_decl free_decl
= create_subprog_decl (get_identifier ("__gnat_free"), NULL_TREE, = create_subprog_decl (get_identifier ("__gnat_free"), NULL_TREE,
build_function_type_list (void_type_node, ftype,
ptr_type_node, NULL_TREE, is_disabled, true, true, true, false,
NULL_TREE), NULL, Empty);
ftype = build_function_type_list (ptr_type_node, ptr_type_node, sizetype,
NULL_TREE);
realloc_decl
= create_subprog_decl (get_identifier ("__gnat_realloc"), NULL_TREE,
ftype,
NULL_TREE, is_disabled, true, true, true, false, NULL_TREE, is_disabled, true, true, true, false,
NULL, Empty); NULL, Empty);
......
...@@ -5432,15 +5432,6 @@ static tree c_global_trees[CTI_MAX]; ...@@ -5432,15 +5432,6 @@ static tree c_global_trees[CTI_MAX];
#define intmax_type_node void_type_node #define intmax_type_node void_type_node
#define uintmax_type_node void_type_node #define uintmax_type_node void_type_node
/* Build the void_list_node (void_type_node having been created). */
static tree
build_void_list_node (void)
{
tree t = build_tree_list (NULL_TREE, void_type_node);
return t;
}
/* Used to help initialize the builtin-types.def table. When a type of /* Used to help initialize the builtin-types.def table. When a type of
the correct size doesn't exist, use error_mark_node instead of NULL. the correct size doesn't exist, use error_mark_node instead of NULL.
The later results in segfaults even when a decl using the type doesn't The later results in segfaults even when a decl using the type doesn't
...@@ -5461,7 +5452,6 @@ install_builtin_elementary_types (void) ...@@ -5461,7 +5452,6 @@ install_builtin_elementary_types (void)
{ {
signed_size_type_node = gnat_signed_type_for (size_type_node); signed_size_type_node = gnat_signed_type_for (size_type_node);
pid_type_node = integer_type_node; pid_type_node = integer_type_node;
void_list_node = build_void_list_node ();
string_type_node = build_pointer_type (char_type_node); string_type_node = build_pointer_type (char_type_node);
const_string_type_node const_string_type_node
......
...@@ -171,8 +171,8 @@ known_alignment (tree exp) ...@@ -171,8 +171,8 @@ known_alignment (tree exp)
case CALL_EXPR: case CALL_EXPR:
{ {
tree func = get_callee_fndecl (exp); tree fndecl = get_callee_fndecl (exp);
if (func && DECL_IS_MALLOC (func)) if (fndecl == malloc_decl || fndecl == realloc_decl)
return get_target_system_allocator_alignment () * BITS_PER_UNIT; return get_target_system_allocator_alignment () * BITS_PER_UNIT;
tree t = maybe_inline_call_in_expr (exp); tree t = maybe_inline_call_in_expr (exp);
...@@ -188,7 +188,8 @@ known_alignment (tree exp) ...@@ -188,7 +188,8 @@ known_alignment (tree exp)
have a dummy type here (e.g. a Taft Amendment type), for which the have a dummy type here (e.g. a Taft Amendment type), for which the
alignment is meaningless and should be ignored. */ alignment is meaningless and should be ignored. */
if (POINTER_TYPE_P (TREE_TYPE (exp)) if (POINTER_TYPE_P (TREE_TYPE (exp))
&& !TYPE_IS_DUMMY_P (TREE_TYPE (TREE_TYPE (exp)))) && !TYPE_IS_DUMMY_P (TREE_TYPE (TREE_TYPE (exp)))
&& !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (exp))))
this_alignment = TYPE_ALIGN (TREE_TYPE (TREE_TYPE (exp))); this_alignment = TYPE_ALIGN (TREE_TYPE (TREE_TYPE (exp)));
else else
this_alignment = 0; this_alignment = 0;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment