From 5c34e9cd0723c1505b4f8fb4ce685df082d6d286 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 3 Aug 2011 09:52:00 +0200 Subject: [PATCH] [multiple changes] 2011-08-03 Robert Dewar * sem_util.ads, exp_aggr.adb, exp_ch3.adb: Minor reformatting. 2011-08-03 Ed Schonberg * sem_ch3.adb (Analyze_Object_Declaration): if a constant object of an unconstrained type with discriminants is initialized with an aggregate, use the constrained subtype of the aggregate as the type of the object, because it is immutable, and this allows the back-end to generate no code for the object declaration. From-SVN: r177234 --- gcc/ada/ChangeLog | 12 +++++++++++ gcc/ada/exp_aggr.adb | 48 ++++++++++++++++++++++++-------------------- gcc/ada/exp_ch3.adb | 3 +-- gcc/ada/sem_ch3.adb | 12 +++++++++++ gcc/ada/sem_util.ads | 12 +++++------ 5 files changed, 57 insertions(+), 30 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64dd7442b5e..47ec9bf44f7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2011-08-03 Robert Dewar + + * sem_util.ads, exp_aggr.adb, exp_ch3.adb: Minor reformatting. + +2011-08-03 Ed Schonberg + + * sem_ch3.adb (Analyze_Object_Declaration): if a constant object of an + unconstrained type with discriminants is initialized with an aggregate, + use the constrained subtype of the aggregate as the type of the object, + because it is immutable, and this allows the back-end to generate no + code for the object declaration. + 2011-08-03 Robert Dewar * exp_ch4.adb (Optimize_Length_Check): Fix bad handling of case where diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 079db9c9564..7ff4b7a49b1 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -308,23 +308,21 @@ package body Exp_Aggr is Lov : Uint; Hiv : Uint; - -- The following constant determines the maximum size of an - -- array aggregate produced by converting named to positional - -- notation (e.g. from others clauses). This avoids running - -- away with attempts to convert huge aggregates, which hit - -- memory limits in the backend. - - -- The normal limit is 5000, but we increase this limit to - -- 2**24 (about 16 million) if Restrictions (No_Elaboration_Code) - -- or Restrictions (No_Implicit_Loops) is specified, since in - -- either case, we are at risk of declaring the program illegal - -- because of this limit. + -- The following constant determines the maximum size of an array + -- aggregate produced by converting named to positional notation (e.g. + -- from others clauses). This avoids running away with attempts to + -- convert huge aggregates, which hit memory limits in the backend. + + -- The normal limit is 5000, but we increase this limit to 2**24 (about + -- 16 million) if Restrictions (No_Elaboration_Code) or Restrictions + -- (No_Implicit_Loops) is specified, since in either case, we are at + -- risk of declaring the program illegal because of this limit. Max_Aggr_Size : constant Nat := 5000 + (2 ** 24 - 5000) * Boolean'Pos (Restriction_Active (No_Elaboration_Code) - or else + or else Restriction_Active (No_Implicit_Loops)); function Component_Count (T : Entity_Id) return Int; @@ -5458,10 +5456,11 @@ package body Exp_Aggr is New_Occurrence_Of (Node (First_Elmt (Access_Disp_Table (Typ))), Loc), Parent_Expr => A); + + -- No tag is needed in the case of a VM + else - -- No tag is needed in the case of a VM - Expand_Record_Aggregate (N, - Parent_Expr => A); + Expand_Record_Aggregate (N, Parent_Expr => A); end if; end if; @@ -5646,17 +5645,17 @@ package body Exp_Aggr is Set_Expansion_Delayed (N, False); end if; - -- Gigi doesn't handle properly temporaries of variable size - -- so we generate it in the front-end + -- Gigi doesn't properly handle temporaries of variable size so we + -- generate it in the front-end elsif not Size_Known_At_Compile_Time (Typ) and then Tagged_Type_Expansion then Convert_To_Assignments (N, Typ); - -- Temporaries for controlled aggregates need to be attached to a - -- final chain in order to be properly finalized, so it has to - -- be created in the front-end + -- Temporaries for controlled aggregates need to be attached to a final + -- chain in order to be properly finalized, so it has to be created in + -- the front-end elsif Is_Controlled (Typ) or else Has_Controlled_Component (Base_Type (Typ)) @@ -5695,9 +5694,14 @@ package body Exp_Aggr is -- If some components are mutable, the size of the aggregate component -- may be distinct from the default size of the type component, so -- we need to expand to insure that the back-end copies the proper - -- size of the data. + -- size of the data. However, if the aggregate is the initial value of + -- a constant, the target is immutable and may be built statically. - elsif Has_Mutable_Components (Typ) then + elsif Has_Mutable_Components (Typ) + and then + (Nkind (Parent (N)) /= N_Object_Declaration + or else not Constant_Present (Parent (N))) + then Convert_To_Assignments (N, Typ); -- If the type involved has any non-bit aligned components, then we are diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index fc999c6d4d6..f4e103facc5 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5011,8 +5011,7 @@ package body Exp_Ch3 is Insert_Action (N, Make_Assignment_Statement (Loc, Name => New_Reference_To (Def_Id, Loc), - Expression => Convert_To (Typ, - Relocate_Node (Expr)))); + Expression => Convert_To (Typ, Relocate_Node (Expr)))); end if; return; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 79a0828603d..6a1e3e940ea 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3401,6 +3401,18 @@ package body Sem_Ch3 is -- It is unclear why this should make it acceptable to gcc. ??? Remove_Side_Effects (E); + + elsif not Is_Constrained (T) + and then Has_Discriminants (T) + and then Constant_Present (N) + and then not Has_Unchecked_Union (T) + and then Nkind (E) = N_Aggregate + then + -- If this is a constant declaration of an unconstrained type and + -- the initialization is an aggregate, we can use the subtype of the + -- aggregate for the declared entity because it is immutable. + + Act_T := Etype (E); end if; -- Check No_Wide_Characters restriction diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c176179058c..3d11069f476 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -279,15 +279,15 @@ package Sem_Util is procedure Mark_Non_ALFA_Subprogram; -- If Current_Subprogram is not Empty, mark either its specification or its - -- body as not being in ALFA. This procedure may be called either during - -- the analysis of a precondition or postcondition, as indicated by the - -- flag In_Pre_Post_Expression, or during the analysis of a subprogram's - -- body. In the first case, the specification of Current_Subprogram must be + -- body as not being in ALFA. This procedure may be called during the + -- analysis of a precondition or postcondition, as indicated by the flag + -- In_Pre_Post_Expression, or during the analysis of a subprogram's body. + -- In the first case, the specification of Current_Subprogram must be -- marked as not being in ALFA, as the contract is considered to be part of -- the specification, so that calls to this subprogram are not in ALFA. In -- the second case, mark the body as not being in ALFA, which does not - -- prevent the subprogram's specification, and calls to the subprogram, to - -- be in ALFA. + -- prevent the subprogram's specification, and calls to the subprogram, + -- from being in ALFA. function Defining_Entity (N : Node_Id) return Entity_Id; -- Given a declaration N, returns the associated defining entity. If the -- 2.30.2