diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2023-02-22 17:00:06 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-05-23 09:59:06 +0200 |
commit | 544d5ff153b3470126cd2c9095617c1c084d418d (patch) | |
tree | cbd53567b4ae07c49696680b04676534fe29549e | |
parent | 6efcce36f571da77a7122d3d1ae75739d744fe88 (diff) | |
download | gcc-544d5ff153b3470126cd2c9095617c1c084d418d.zip gcc-544d5ff153b3470126cd2c9095617c1c084d418d.tar.gz gcc-544d5ff153b3470126cd2c9095617c1c084d418d.tar.bz2 |
ada: Fix address arithmetic issues in the expanded code
This is most notably the addition of addresses in Expand_Interface_Thunk.
There is also a small change to Expand_Dispatching_Call, which was directly
accessing a class-wide interface object as a tag, thus giving rise later to
unchecked conversions between either the root or the equivalent record type
and access types.
gcc/ada/
* exp_disp.adb (Expand_Dispatching_Call): In the abstract interface
class-wide case, use 'Tag of the object as the controlling tag.
(Expand_Interface_Thunk): Perform address arithmetic using operators
of System.Storage_Elements.
-rw-r--r-- | gcc/ada/exp_disp.adb | 69 |
1 files changed, 37 insertions, 32 deletions
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 1fb15fb..e7cae38 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1040,10 +1040,11 @@ package body Exp_Disp is -- Ada 2005 (AI-251): Abstract interface class-wide type - elsif Is_Interface (Ctrl_Typ) - and then Is_Class_Wide_Type (Ctrl_Typ) - then - Controlling_Tag := Duplicate_Subexpr (Ctrl_Arg); + elsif Is_Interface (Ctrl_Typ) and then Is_Class_Wide_Type (Ctrl_Typ) then + Controlling_Tag := + Make_Attribute_Reference (Loc, + Prefix => Duplicate_Subexpr (Ctrl_Arg), + Attribute_Name => Name_Tag); elsif Is_Access_Type (Ctrl_Typ) then Controlling_Tag := @@ -2030,8 +2031,8 @@ package body Exp_Disp is then -- Generate: -- type T is access all <<type of the target formal>> - -- S : Storage_Offset := Storage_Offset!(Formal) - -- + Offset_To_Top (address!(Formal)) + -- S : constant Address := Address!(Formal) + -- + Offset_To_Top (Address!(Formal)) Decl_2 := Make_Full_Type_Declaration (Loc, @@ -2063,16 +2064,20 @@ package body Exp_Disp is Defining_Identifier => Make_Temporary (Loc, 'S'), Constant_Present => True, Object_Definition => - New_Occurrence_Of (RTE (RE_Storage_Offset), Loc), + New_Occurrence_Of (RTE (RE_Address), Loc), Expression => - Make_Op_Add (Loc, - Left_Opnd => - Unchecked_Convert_To - (RTE (RE_Storage_Offset), - New_Occurrence_Of - (Defining_Identifier (Formal), Loc)), - Right_Opnd => - Offset_To_Top)); + Make_Function_Call (Loc, + Name => + Make_Expanded_Name (Loc, + Chars => Name_Op_Add, + Prefix => + New_Occurrence_Of + (RTU_Entity (System_Storage_Elements), Loc), + Selector_Name => + Make_Identifier (Loc, Name_Op_Add)), + Parameter_Associations => New_List ( + New_Copy_Tree (New_Arg), + Offset_To_Top))); Append_To (Decl, Decl_2); Append_To (Decl, Decl_1); @@ -2088,16 +2093,15 @@ package body Exp_Disp is elsif Is_Controlling_Formal (Target_Formal) then -- Generate: - -- S1 : Storage_Offset := Storage_Offset!(Formal'Address) - -- + Offset_To_Top (Formal'Address) - -- S2 : Addr_Ptr := Addr_Ptr!(S1) + -- S1 : constant Address := Formal'Address + -- + Offset_To_Top (Formal'Address) + -- S2 : constant Addr_Ptr := Addr_Ptr!(S1) New_Arg := Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Defining_Identifier (Formal), Loc), - Attribute_Name => - Name_Address); + Attribute_Name => Name_Address); if not RTE_Available (RE_Offset_To_Top) then Offset_To_Top := @@ -2114,19 +2118,20 @@ package body Exp_Disp is Defining_Identifier => Make_Temporary (Loc, 'S'), Constant_Present => True, Object_Definition => - New_Occurrence_Of (RTE (RE_Storage_Offset), Loc), + New_Occurrence_Of (RTE (RE_Address), Loc), Expression => - Make_Op_Add (Loc, - Left_Opnd => - Unchecked_Convert_To - (RTE (RE_Storage_Offset), - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of - (Defining_Identifier (Formal), Loc), - Attribute_Name => Name_Address)), - Right_Opnd => - Offset_To_Top)); + Make_Function_Call (Loc, + Name => + Make_Expanded_Name (Loc, + Chars => Name_Op_Add, + Prefix => + New_Occurrence_Of + (RTU_Entity (System_Storage_Elements), Loc), + Selector_Name => + Make_Identifier (Loc, Name_Op_Add)), + Parameter_Associations => New_List ( + New_Copy_Tree (New_Arg), + Offset_To_Top))); Decl_2 := Make_Object_Declaration (Loc, |