diff mbox series

[Ada] Fix type mismatch warnings during LTO bootstrap #4

Message ID 20210507093823.GA140763@adacore.com
State New
Headers show
Series [Ada] Fix type mismatch warnings during LTO bootstrap #4 | expand

Commit Message

Pierre-Marie de Rodat May 7, 2021, 9:38 a.m. UTC
There are 3 views of the exception record type in an Ada program: the
master is declared as Exception_Data in System.Standard_Library, the
compiler view is built by Cstand at the beginning of the compilation,
and the C view is declared in the raise.h header file.  These views must
be sufficiently alike in order for the LTO compiler to merge them into a
single type.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* libgnat/s-stalib.ads (Exception_Data): Mark components as aliased.
	* stand.ads (Standard_Entity_Type): Enhance comments.
	* cstand.adb (Make_Component): Rename into...
	(Make_Aliased_Component): ...this; set Is_Aliased and Is_Independent
	flags on the component.
	(Create_Standard): Adjust the types of the component of the record
	Standard_Exception_Type and mark them as aliased.
	* exp_ch11.adb (Expand_N_Exception_Declaration): Use OK
	conversion to Standard_Address for Full_Name component, except
	in CodePeer_Mode (set it to 0).
	* exp_prag.adb (Expand_Pragma_Import_Or_Interface): Likewise.
	* raise.h (struct Exception_Data): Change the type of Full_Name,
	HTable_Ptr and Foreign_Data.
diff mbox series

Patch

diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -133,12 +133,12 @@  package body CStand is
    --  Returns an identifier node with the same name as the defining identifier
    --  corresponding to the given Standard_Entity_Type value.
 
-   procedure Make_Component
+   procedure Make_Aliased_Component
      (Rec : Entity_Id;
       Typ : Entity_Id;
       Nam : String);
-   --  Build a record component with the given type and name, and append to
-   --  the list of components of Rec.
+   --  Build an aliased record component with the given type and name,
+   --  and append to the list of components of Rec.
 
    function Make_Formal (Typ : Entity_Id; Nam : String) return Entity_Id;
    --  Construct entity for subprogram formal with given name and type
@@ -1495,38 +1495,40 @@  package body CStand is
       --  known by the run-time. Components of the record are documented in
       --  the declaration in System.Standard_Library.
 
-      Standard_Exception_Type := New_Standard_Entity ("exception");
-      Set_Ekind       (Standard_Exception_Type, E_Record_Type);
-      Set_Etype       (Standard_Exception_Type, Standard_Exception_Type);
-      Set_Scope       (Standard_Exception_Type, Standard_Standard);
-      Set_Stored_Constraint
-                      (Standard_Exception_Type, No_Elist);
-      Init_Size_Align (Standard_Exception_Type);
-      Set_Size_Known_At_Compile_Time
-                      (Standard_Exception_Type, True);
-
-      Make_Component
-        (Standard_Exception_Type, Standard_Boolean,   "Not_Handled_By_Others");
-      Make_Component
-        (Standard_Exception_Type, Standard_Character, "Lang");
-      Make_Component
-        (Standard_Exception_Type, Standard_Natural,   "Name_Length");
-      Make_Component
-        (Standard_Exception_Type, Standard_A_Char,    "Full_Name");
-      Make_Component
-        (Standard_Exception_Type, Standard_A_Char,    "HTable_Ptr");
-      Make_Component
-        (Standard_Exception_Type, Standard_A_Char,    "Foreign_Data");
-      Make_Component
-        (Standard_Exception_Type, Standard_A_Char,    "Raise_Hook");
-
-      --  Build tree for record declaration, for use by the back-end
-
-      declare
-         Comp_List : List_Id;
-         Comp      : Entity_Id;
+      Build_Exception_Type : declare
+         Comp_List      : List_Id;
+         Comp           : Entity_Id;
 
       begin
+         Standard_Exception_Type := New_Standard_Entity ("exception");
+         Set_Ekind       (Standard_Exception_Type, E_Record_Type);
+         Set_Etype       (Standard_Exception_Type, Standard_Exception_Type);
+         Set_Scope       (Standard_Exception_Type, Standard_Standard);
+         Set_Stored_Constraint
+                         (Standard_Exception_Type, No_Elist);
+         Init_Size_Align (Standard_Exception_Type);
+         Set_Size_Known_At_Compile_Time
+                         (Standard_Exception_Type, True);
+
+         Make_Aliased_Component (Standard_Exception_Type, Standard_Boolean,
+                         "Not_Handled_By_Others");
+         Make_Aliased_Component (Standard_Exception_Type, Standard_Character,
+                         "Lang");
+         Make_Aliased_Component (Standard_Exception_Type, Standard_Natural,
+                         "Name_Length");
+         Make_Aliased_Component (Standard_Exception_Type, Standard_Address,
+                         "Full_Name");
+         Make_Aliased_Component (Standard_Exception_Type, Standard_A_Char,
+                         "HTable_Ptr");
+         Make_Aliased_Component (Standard_Exception_Type, Standard_Address,
+                         "Foreign_Data");
+         Make_Aliased_Component (Standard_Exception_Type, Standard_A_Char,
+                         "Raise_Hook");
+
+         Layout_Type (Standard_Exception_Type);
+
+         --  Build tree for record declaration, for use by the back-end
+
          Comp      := First_Entity (Standard_Exception_Type);
          Comp_List := New_List;
          while Present (Comp) loop
@@ -1535,9 +1537,9 @@  package body CStand is
                 Defining_Identifier => Comp,
                 Component_Definition =>
                   Make_Component_Definition (Stloc,
-                    Aliased_Present    => False,
-                    Subtype_Indication => New_Occurrence_Of (Etype (Comp),
-                                                             Stloc))),
+                    Aliased_Present    => True,
+                    Subtype_Indication =>
+                      New_Occurrence_Of (Etype (Comp), Stloc))),
               Comp_List);
 
             Next_Entity (Comp);
@@ -1547,15 +1549,13 @@  package body CStand is
            Defining_Identifier => Standard_Exception_Type,
            Type_Definition =>
              Make_Record_Definition (Stloc,
-               End_Label => Empty,
+               End_Label      => Empty,
                Component_List =>
                  Make_Component_List (Stloc,
                    Component_Items => Comp_List)));
-      end;
 
-      Append (Decl, Decl_S);
-
-      Layout_Type (Standard_Exception_Type);
+         Append (Decl, Decl_S);
+      end Build_Exception_Type;
 
       --  Create declarations of standard exceptions
 
@@ -1711,11 +1711,11 @@  package body CStand is
       return Ident_Node;
    end Identifier_For;
 
-   --------------------
-   -- Make_Component --
-   --------------------
+   ----------------------------
+   -- Make_Aliased_Component --
+   ----------------------------
 
-   procedure Make_Component
+   procedure Make_Aliased_Component
      (Rec : Entity_Id;
       Typ : Entity_Id;
       Nam : String)
@@ -1728,8 +1728,10 @@  package body CStand is
       Set_Scope                     (Id, Rec);
       Init_Component_Location       (Id);
       Set_Original_Record_Component (Id, Id);
+      Set_Is_Aliased                (Id);
+      Set_Is_Independent            (Id);
       Append_Entity (Id, Rec);
-   end Make_Component;
+   end Make_Aliased_Component;
 
    -----------------
    -- Make_Formal --


diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1246,16 +1246,13 @@  package body Exp_Ch11 is
           Prefix         => New_Occurrence_Of (Ex_Id, Loc),
           Attribute_Name => Name_Length));
 
-      --  Full_Name component: Standard.A_Char!(Nam'Address)
-
-      --  The unchecked conversion causes capacity issues for CodePeer in some
-      --  cases and is never useful, so we set the Full_Name component to null
-      --  instead for CodePeer.
+      --  Full_Name component: Standard_Address?(Nam'Address)
+      --  or 0 if CodePeer_Mode
 
       if CodePeer_Mode then
-         Append_To (L, Make_Null (Loc));
+         Append_To (L, Make_Integer_Literal (Loc, Uint_0));
       else
-         Append_To (L, Unchecked_Convert_To (Standard_A_Char,
+         Append_To (L, OK_Convert_To (Standard_Address,
            Make_Attribute_Reference (Loc,
              Prefix         => New_Occurrence_Of (Ex_Id, Loc),
              Attribute_Name => Name_Address)));
@@ -1265,9 +1262,9 @@  package body Exp_Ch11 is
 
       Append_To (L, Make_Null (Loc));
 
-      --  Foreign_Data component: null
+      --  Foreign_Data component: null address
 
-      Append_To (L, Make_Null (Loc));
+      Append_To (L, Make_Integer_Literal (Loc, Uint_0));
 
       --  Raise_Hook component: null
 


diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -2039,7 +2039,7 @@  package body Exp_Prag is
                     Expression => Relocate_Node (Rtti_Name))))));
 
             Rewrite (Expression (Foreign_Data),
-              Unchecked_Convert_To (Standard_A_Char,
+              OK_Convert_To (Standard_Address,
                 Make_Attribute_Reference (Loc,
                   Prefix         => Make_Identifier (Loc, Chars (Dum)),
                   Attribute_Name => Name_Address)));


diff --git a/gcc/ada/libgnat/s-stalib.ads b/gcc/ada/libgnat/s-stalib.ads
--- a/gcc/ada/libgnat/s-stalib.ads
+++ b/gcc/ada/libgnat/s-stalib.ads
@@ -86,44 +86,46 @@  package System.Standard_Library is
 
    --  The following record defines the underlying representation of exceptions
 
-   --  WARNING: Any changes to this may need to be reflected in the following
+   --  WARNING: Any change to the record needs to be reflected in the following
    --  locations in the compiler and runtime code:
 
-   --    1. The Internal_Exception routine in s-exctab.adb
-   --    2. The processing in gigi that tests Not_Handled_By_Others
-   --    3. Expand_N_Exception_Declaration in Exp_Ch11
-   --    4. The construction of the exception type in Cstand
+   --    1. The construction of the exception type in Cstand
+   --    2. Expand_N_Exception_Declaration in Exp_Ch11
+   --    3. Expand_Pragma_Import_Or_Interface in Exp_Prag
+   --    4. The processing in gigi that tests Not_Handled_By_Others
+   --    5. The Internal_Exception routine in s-exctab.adb
+   --    6. The declaration of the corresponding C type in raise.h
 
    type Exception_Data is record
-      Not_Handled_By_Others : Boolean;
+      Not_Handled_By_Others : aliased Boolean;
       --  Normally set False, indicating that the exception is handled in the
       --  usual way by others (i.e. an others handler handles the exception).
       --  Set True to indicate that this exception is not caught by others
       --  handlers, but must be explicitly named in a handler. This latter
       --  setting is currently used by the Abort_Signal.
 
-      Lang : Character;
+      Lang : aliased Character;
       --  A character indicating the language raising the exception.
       --  Set to "A" for exceptions defined by an Ada program.
       --  Set to "C" for imported C++ exceptions.
 
-      Name_Length : Natural;
+      Name_Length : aliased Natural;
       --  Length of fully expanded name of exception
 
-      Full_Name : System.Address;
+      Full_Name : aliased System.Address;
       --  Fully expanded name of exception, null terminated
       --  You can use To_Ptr to convert this to a string.
 
-      HTable_Ptr : Exception_Data_Ptr;
+      HTable_Ptr : aliased Exception_Data_Ptr;
       --  Hash table pointer used to link entries together in the hash table
       --  built (by Register_Exception in s-exctab.adb) for converting between
       --  identities and names.
 
-      Foreign_Data : Address;
+      Foreign_Data : aliased System.Address;
       --  Data for imported exceptions. Not used in the Ada case. This
       --  represents the address of the RTTI for the C++ case.
 
-      Raise_Hook : Raise_Action;
+      Raise_Hook : aliased Raise_Action;
       --  This field can be used to place a "hook" on an exception. If the
       --  value is non-null, then it points to a procedure which is called
       --  whenever the exception is raised. This call occurs immediately,


diff --git a/gcc/ada/raise.h b/gcc/ada/raise.h
--- a/gcc/ada/raise.h
+++ b/gcc/ada/raise.h
@@ -40,9 +40,9 @@  struct Exception_Data
   char Not_Handled_By_Others;
   char Lang;
   int Name_Length;
-  char *Full_Name;
-  char *Htable_Ptr;
-  void *Foreign_Data;
+  __UINTPTR_TYPE__ Full_Name;
+  void *HTable_Ptr;
+  __UINTPTR_TYPE__ Foreign_Data;
   void (*Raise_Hook)(void);
 };
 


diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads
--- a/gcc/ada/stand.ads
+++ b/gcc/ada/stand.ads
@@ -335,12 +335,12 @@  package Stand is
    --  This is a type used to represent the Etype of exceptions
 
    Standard_A_String : Entity_Id;
-   --  An access to String type used for building elements of tables
-   --  carrying the enumeration literal names.
+   --  An access to String type used for building elements of tables carrying
+   --  the enumeration literal names.
 
    Standard_A_Char : Entity_Id;
-   --  Access to character, used as a component of the exception type to denote
-   --  a thin pointer component.
+   --  An access to character type, used as a component of the exception type
+   --  to denote a thin pointer component. Needed for non-GCC back-ends.
 
    Standard_Debug_Renaming_Type : Entity_Id;
    --  A zero-size subtype of Integer, used as the type of variables used to