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 --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
