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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cb053612702577a7d290725c51a92c0117e188e1..50b466a4fd8ac8d1140fb0460d766cfe63af7a76 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+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.

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 96f484191285c472fa57b031a0416929f7f3c674..252f11e4258ab09a6e218c1e63dec1f15da2e308 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -603,6 +603,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
     case E_Out_Parameter:
     case E_Variable:
       {
+       const Entity_Id gnat_type = Etype (gnat_entity);
        /* Always create a variable for volatile objects and variables seen
           constant but with a Linker_Section pragma.  */
        bool const_flag
@@ -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.  */
-       gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
-
-       /* If this is a standard exception definition, then use the standard
-          exception type.  This is necessary to make sure that imported and
-          exported views of exceptions are properly merged in LTO mode.  */
-       if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL
-           && DECL_NAME (TYPE_NAME (gnu_type)) == exception_data_name_id)
-         gnu_type = except_type_node;
+       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, use the standard
+              exception type.  This is necessary to make sure that imported
+              and exported views of exceptions are merged in LTO mode.  */
+           if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL
+               && DECL_NAME (TYPE_NAME (gnu_type)) == exception_data_name_id)
+             gnu_type = except_type_node;
+         }
 
        /* For a debug renaming declaration, build a debug-only 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)
             || (TYPE_SIZE (gnu_type)
                 && integer_zerop (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 (Address_Clause (gnat_entity)))
          gnu_size = bitsize_unit_node;
@@ -828,8 +835,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                || (!Optimize_Alignment_Space (gnat_entity)
                    && kind != E_Exception
                    && kind != E_Out_Parameter
-                   && Is_Composite_Type (Etype (gnat_entity))
-                   && !Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
+                   && Is_Composite_Type (gnat_type)
+                   && !Is_Constr_Subt_For_UN_Aliased (gnat_type)
                    && !Is_Exported (gnat_entity)
                    && !imported_p
                    && No (Renamed_Object (gnat_entity))
@@ -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
           subtype, make a type that includes the template.  We will either
           allocate or create a variable of that type, see below.  */
-       if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
-           && Is_Array_Type (Underlying_Type (Etype (gnat_entity)))
+       if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
+           && Is_Array_Type (Underlying_Type (gnat_type))
            && !type_annotate_only)
          {
-           tree gnu_array
-             = gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));
+           tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_type));
            gnu_type
              = build_unc_object_type_from_ptr (TREE_TYPE (gnu_array),
                                                gnu_type,
@@ -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
           because we don't support dynamic alignment.  */
        if (align == 0
-           && Ekind (Etype (gnat_entity)) == E_Class_Wide_Subtype
+           && Ekind (gnat_type) == E_Class_Wide_Subtype
            && No (Renamed_Object (gnat_entity))
            && No (Address_Clause (gnat_entity)))
          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)
            /* If this is an aliased object with an unconstrained array nominal
               subtype, then it can overlay only another aliased object with an
               unconstrained array nominal subtype and compatible template.  */
-           if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
-               && Is_Array_Type (Underlying_Type (Etype (gnat_entity)))
+           if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
+               && Is_Array_Type (Underlying_Type (gnat_type))
                && !type_annotate_only)
              {
                tree rec_type = TREE_TYPE (gnu_type);
@@ -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
           object.  Note that we have to do it this late because of the
           couple of allocation adjustments that might be made above.  */
-       if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
-           && Is_Array_Type (Underlying_Type (Etype (gnat_entity)))
+       if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
+           && Is_Array_Type (Underlying_Type (gnat_type))
            && !type_annotate_only)
          {
            /* 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)
                gnu_size = NULL_TREE;
              }
 
-           tree gnu_array
-             = gnat_to_gnu_type (Base_Type (Etype (gnat_entity)));
+           tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_type));
            gnu_type
              = 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)
                    && No (Address_Clause (gnat_entity)))
                || Address_Taken (gnat_entity)
                || Is_Aliased (gnat_entity)
-               || Is_Aliased (Etype (gnat_entity))))
+               || Is_Aliased (gnat_type)))
          {
            tree gnu_corr_var
              = 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)
            DECL_BY_REF_P (gnu_decl) = 1;
          }
 
+       /* If this is a mere subprogram type, just create the declaration.  */
        else if (kind == E_Subprogram_Type)
          {
            process_attributes (&gnu_type, &attr_list, false, gnat_entity);
@@ -4278,17 +4284,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                                  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
          {
-           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,
-                                    attr_list, gnat_entity);
-
-           DECL_STUBBED_P (gnu_decl)
-             = (Convention (gnat_entity) == Convention_Stubbed);
+           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
+             {
+               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, attr_list, gnat_entity);
+
+               DECL_STUBBED_P (gnu_decl)
+                 = (Convention (gnat_entity) == Convention_Stubbed);
+             }
          }
       }
       break;
@@ -5754,7 +5771,11 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 
   else
     {
-      gnu_return_type = gnat_to_gnu_profile_type (gnat_return_type);
+      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);
 
       /* If this function returns by reference, make the actual return type
         the reference type and make a note of that.  */
@@ -5914,7 +5935,12 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
       else
        {
          Entity_Id gnat_param_type = Etype (gnat_param);
-         gnu_param_type = gnat_to_gnu_profile_type (gnat_param_type);
+
+         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);
 
          /* If the parameter type is incomplete, there are 2 cases: if it is
             passed by reference, then the type is only linked indirectly in

diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index fcd866c37cca5d21dd49a72e814086388d15e414..b4fa83f28c282b5d4be1bcbf193589a6f7c6268b 100644 (file)
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -394,13 +394,15 @@ enum standard_datatypes
   /* Value BITS_PER_UNIT in signed bitsizetype.  */
   ADT_sbitsize_unit_node,
 
-  /* Function declaration nodes for run-time functions for allocating memory.
-     Ada allocators cause calls to this function to be generated.  */
+  /* Function declaration node for run-time allocation function.  */
   ADT_malloc_decl,
 
-  /* Likewise for freeing memory.  */
+  /* Function declaration node for run-time freeing function.  */
   ADT_free_decl,
 
+  /* Function declaration node for run-time reallocation function.  */
+  ADT_realloc_decl,
+
   /* Function decl node for 64-bit multiplication with overflow checking.  */
   ADT_mulv64_decl,
 
@@ -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 malloc_decl gnat_std_decls[(int) ADT_malloc_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 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]

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index f110e928b93f1b3a776584ec101c2db5aaf3fcbc..e23724312b711815c1c8a1c8d7bf0b797c7748aa 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -387,14 +387,13 @@ gigi (Node_Id gnat_root,
                       true, false, NULL, gnat_literal);
   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);
   ptr_void_ftype = build_pointer_type (void_ftype);
 
   /* Now declare run-time functions.  */
   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
     = create_subprog_decl (get_identifier ("__gnat_malloc"), NULL_TREE,
                           ftype,
@@ -402,12 +401,18 @@ gigi (Node_Id gnat_root,
                           NULL, Empty);
   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
     = create_subprog_decl (get_identifier ("__gnat_free"), NULL_TREE,
-                          build_function_type_list (void_type_node,
-                                                    ptr_type_node,
-                                                    NULL_TREE),
+                          ftype,
+                          NULL_TREE, is_disabled, true, true, true, false,
+                          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, Empty);
 

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 8e4f863825888ed3b24c746f25a6f795bb1e049f..66c5408c564d810b9ed4306d9c4d09a2121fd140 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -5432,15 +5432,6 @@ static tree c_global_trees[CTI_MAX];
 #define intmax_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
    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
@@ -5461,7 +5452,6 @@ install_builtin_elementary_types (void)
 {
   signed_size_type_node = gnat_signed_type_for (size_type_node);
   pid_type_node = integer_type_node;
-  void_list_node = build_void_list_node ();
 
   string_type_node = build_pointer_type (char_type_node);
   const_string_type_node

diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index aeb6cc3a3f7384217911c21e6f70ad27bafe30bf..638d59b6f9ca392cd2265b4de607e7f7e6af3f38 100644 (file)
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -171,8 +171,8 @@ known_alignment (tree exp)
 
     case CALL_EXPR:
       {
-       tree func = get_callee_fndecl (exp);
-       if (func && DECL_IS_MALLOC (func))
+       tree fndecl = get_callee_fndecl (exp);
+       if (fndecl == malloc_decl || fndecl == realloc_decl)
          return get_target_system_allocator_alignment () * BITS_PER_UNIT;
 
        tree t = maybe_inline_call_in_expr (exp);
@@ -188,7 +188,8 @@ known_alignment (tree exp)
         have a dummy type here (e.g. a Taft Amendment type), for which the
         alignment is meaningless and should be ignored.  */
       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)));
       else
        this_alignment = 0;