diff options
| author | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-12-14 08:52:21 +0000 |
|---|---|---|
| committer | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-12-14 08:52:21 +0000 |
| commit | d0b175bffc2f2cb91d1fb529b7c36d3e984d9594 (patch) | |
| tree | eb438cb5c7cabed8d102b2c0c1bdd1b0aebb59eb /gcc/ada/exp_util.adb | |
| parent | 5e3123db0a9b4c8def9fee64446b130ce81ace45 (diff) | |
| download | gcc-d0b175bffc2f2cb91d1fb529b7c36d3e984d9594.tar.gz | |
2011-12-14 Basile Starynkevitch <basile@starynkevitch.net>
MELT branch merged with trunk rev 182322 using svnmerge
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@182325 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/exp_util.adb')
| -rw-r--r-- | gcc/ada/exp_util.adb | 40 |
1 files changed, 31 insertions, 9 deletions
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index c67d0117897..52541ed67eb 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -755,7 +755,30 @@ package body Exp_Util is Append_To (Actuals, New_Reference_To (Addr_Id, Loc)); Append_To (Actuals, New_Reference_To (Size_Id, Loc)); - Append_To (Actuals, New_Reference_To (Alig_Id, Loc)); + + if Is_Allocate or else not Is_Class_Wide_Type (Desig_Typ) then + Append_To (Actuals, New_Reference_To (Alig_Id, Loc)); + + -- For deallocation of class wide types we obtain the value of + -- alignment from the Type Specific Record of the deallocated object. + -- This is needed because the frontend expansion of class-wide types + -- into equivalent types confuses the backend. + + else + -- Generate: + -- Obj.all'Alignment + + -- ... because 'Alignment applied to class-wide types is expanded + -- into the code that reads the value of alignment from the TSD + -- (see Expand_N_Attribute_Reference) + + Append_To (Actuals, + Unchecked_Convert_To (RTE (RE_Storage_Offset), + Make_Attribute_Reference (Loc, + Prefix => + Make_Explicit_Dereference (Loc, Relocate_Node (Expr)), + Attribute_Name => Name_Alignment))); + end if; -- h) Is_Controlled @@ -854,6 +877,7 @@ package body Exp_Util is else Append_To (Actuals, New_Reference_To (Standard_True, Loc)); end if; + else Append_To (Actuals, New_Reference_To (Standard_False, Loc)); end if; @@ -892,8 +916,7 @@ package body Exp_Util is -- P : Root_Storage_Pool Make_Parameter_Specification (Loc, - Defining_Identifier => - Make_Temporary (Loc, 'P'), + Defining_Identifier => Make_Temporary (Loc, 'P'), Parameter_Type => New_Reference_To (RTE (RE_Root_Storage_Pool), Loc)), @@ -901,22 +924,22 @@ package body Exp_Util is Make_Parameter_Specification (Loc, Defining_Identifier => Addr_Id, - Out_Present => Is_Allocate, - Parameter_Type => + Out_Present => Is_Allocate, + Parameter_Type => New_Reference_To (RTE (RE_Address), Loc)), -- S : Storage_Count Make_Parameter_Specification (Loc, Defining_Identifier => Size_Id, - Parameter_Type => + Parameter_Type => New_Reference_To (RTE (RE_Storage_Count), Loc)), -- L : Storage_Count Make_Parameter_Specification (Loc, Defining_Identifier => Alig_Id, - Parameter_Type => + Parameter_Type => New_Reference_To (RTE (RE_Storage_Count), Loc)))), Declarations => No_List, @@ -925,8 +948,7 @@ package body Exp_Util is Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List ( Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To (Proc_To_Call, Loc), + Name => New_Reference_To (Proc_To_Call, Loc), Parameter_Associations => Actuals))))); -- The newly generated Allocate / Deallocate becomes the default |