diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-08 12:32:07 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-08 12:32:07 +0200 |
commit | 094cefda513d464a72d77a6e892fc3c721d67dd6 (patch) | |
tree | c604f48cd1d2146c097de1c9ebfebfdbcf9457ec /gcc | |
parent | 0ac2a660757afcfe00a3e81973ac4c00555dde40 (diff) | |
download | gcc-094cefda513d464a72d77a6e892fc3c721d67dd6.zip gcc-094cefda513d464a72d77a6e892fc3c721d67dd6.tar.gz gcc-094cefda513d464a72d77a6e892fc3c721d67dd6.tar.bz2 |
[multiple changes]
2010-10-08 Ed Schonberg <schonberg@adacore.com>
* sem_aggr.adb (Resolve_Array_Aggregate): If the expression in an
others choice is a literal analyze it now to enable later optimizations.
* exp_aggr.adb (Expand_Record_Aggregate): An aggregate with static size
and components can be handled by the backend even if it is of a limited
type.
2010-10-08 Arnaud Charlet <charlet@adacore.com>
* a-rttiev.adb (task Timer): Since this package may be elaborated
before System.Interrupt, we need to call Setup_Interrupt_Mask
explicitly to ensure that this task has the proper signal mask.
2010-10-08 Robert Dewar <dewar@adacore.com>
* freeze.adb (Freeze_Entity): For array case, move some processing for
pragma Pack, Component_Size clause and atomic/volatile components here
instead of trying to do the job in Sem_Ch13 and Freeze.
* layout.adb: Use new Addressable function
* sem_ch13.adb (Analyze_Attribute_Representation_Clause, case
Component_Size): Move some handling to freeze point in
Freeze.Freeze_Entity.
* sem_prag.adb (Analyze_pragma, case Pack): Move some handling to
freeze point in Freese.Freeze_Entity.
* sem_util.ads, sem_util.adb (Addressable): New function.
From-SVN: r165159
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 27 | ||||
-rw-r--r-- | gcc/ada/a-rttiev.adb | 9 | ||||
-rw-r--r-- | gcc/ada/exp_aggr.adb | 44 | ||||
-rw-r--r-- | gcc/ada/freeze.adb | 135 | ||||
-rw-r--r-- | gcc/ada/layout.adb | 9 | ||||
-rw-r--r-- | gcc/ada/sem_aggr.adb | 13 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 68 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 103 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 22 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 6 |
10 files changed, 268 insertions, 168 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 98b10bc..a61e306 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2010-10-08 Ed Schonberg <schonberg@adacore.com> + + * sem_aggr.adb (Resolve_Array_Aggregate): If the expression in an + others choice is a literal analyze it now to enable later optimizations. + * exp_aggr.adb (Expand_Record_Aggregate): An aggregate with static size + and components can be handled by the backend even if it is of a limited + type. + +2010-10-08 Arnaud Charlet <charlet@adacore.com> + + * a-rttiev.adb (task Timer): Since this package may be elaborated + before System.Interrupt, we need to call Setup_Interrupt_Mask + explicitly to ensure that this task has the proper signal mask. + +2010-10-08 Robert Dewar <dewar@adacore.com> + + * freeze.adb (Freeze_Entity): For array case, move some processing for + pragma Pack, Component_Size clause and atomic/volatile components here + instead of trying to do the job in Sem_Ch13 and Freeze. + * layout.adb: Use new Addressable function + * sem_ch13.adb (Analyze_Attribute_Representation_Clause, case + Component_Size): Move some handling to freeze point in + Freeze.Freeze_Entity. + * sem_prag.adb (Analyze_pragma, case Pack): Move some handling to + freeze point in Freese.Freeze_Entity. + * sem_util.ads, sem_util.adb (Addressable): New function. + 2010-10-08 Robert Dewar <dewar@adacore.com> * sprint.adb: Minor reformatting. diff --git a/gcc/ada/a-rttiev.adb b/gcc/ada/a-rttiev.adb index 2fe7821..1c1fe85 100644 --- a/gcc/ada/a-rttiev.adb +++ b/gcc/ada/a-rttiev.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2005-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2005-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,6 +32,7 @@ with System.Task_Primitives.Operations; with System.Tasking.Utilities; with System.Soft_Links; +with System.Interrupt_Management.Operations; with Ada.Containers.Doubly_Linked_Lists; pragma Elaborate_All (Ada.Containers.Doubly_Linked_Lists); @@ -98,6 +99,12 @@ package body Ada.Real_Time.Timing_Events is begin System.Tasking.Utilities.Make_Independent; + -- Since this package may be elaborated before System.Interrupt, + -- we need to call Setup_Interrupt_Mask explicitly to ensure that + -- this task has the proper signal mask. + + System.Interrupt_Management.Operations.Setup_Interrupt_Mask; + -- We await the call to Start to ensure that Event_Queue_Lock has been -- initialized by the package executable part prior to accessing it in -- the loop. The task is activated before the first statement of the diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 3a7e46f..ba3d5de 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -3773,6 +3773,13 @@ package body Exp_Aggr is then null; + elsif Is_Entity_Name (Expression (Expr)) + and then Present (Entity (Expression (Expr))) + and then Ekind (Entity (Expression (Expr))) = + E_Enumeration_Literal + then + null; + elsif Nkind (Expression (Expr)) /= N_Aggregate or else not Compile_Time_Known_Aggregate (Expression (Expr)) or else Expansion_Delayed (Expression (Expr)) @@ -5491,6 +5498,14 @@ package body Exp_Aggr is C := First (Comps); while Present (C) loop + + -- If the component has box initialization, expansion is needed + -- and component is not ready for backend. + + if Box_Present (C) then + return True; + end if; + if Nkind (Expression (C)) = N_Qualified_Expression then Expr_Q := Expression (Expression (C)); else @@ -5576,13 +5591,32 @@ package body Exp_Aggr is end if; -- Ada 2005 (AI-318-2): We need to convert to assignments if components - -- are build-in-place function calls. This test could be more specific, - -- but doing it for all inherently limited aggregates seems harmless. - -- The assignments will turn into build-in-place function calls (see - -- Make_Build_In_Place_Call_In_Assignment). + -- are build-in-place function calls. The assignments will each turn + -- into a build-in-place function call. If components are all static, + -- we can pass the aggregate to the backend regardless of limitedness. + + -- Extension aggregates, aggregates in extended return statements, and + -- aggregates for C++ imported types must be expanded. if Ada_Version >= Ada_05 and then Is_Inherently_Limited_Type (Typ) then - Convert_To_Assignments (N, Typ); + if Nkind (Parent (N)) /= N_Object_Declaration then + Convert_To_Assignments (N, Typ); + + elsif Nkind (N) = N_Extension_Aggregate + or else Convention (Typ) = Convention_CPP + then + Convert_To_Assignments (N, Typ); + + elsif not Size_Known_At_Compile_Time (Typ) + or else Component_Not_OK_For_Backend + or else not Static_Components + then + Convert_To_Assignments (N, Typ); + + else + Set_Compile_Time_Known_Aggregate (N); + Set_Expansion_Delayed (N, False); + end if; -- Gigi doesn't handle properly temporaries of variable size -- so we generate it in the front-end diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index ff32684..91def2d 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3097,7 +3097,9 @@ package body Freeze is if Is_Array_Type (E) then declare - Ctyp : constant Entity_Id := Component_Type (E); + FS : constant Entity_Id := First_Subtype (E); + Ctyp : constant Entity_Id := Component_Type (E); + Clause : Entity_Id; Non_Standard_Enum : Boolean := False; -- Set true if any of the index types is an enumeration type @@ -3150,8 +3152,8 @@ package body Freeze is begin if (Is_Packed (E) or else Has_Pragma_Pack (E)) - and then not Has_Atomic_Components (E) and then Known_Static_RM_Size (Ctyp) + and then not Has_Component_Size_Clause (E) then Csiz := UI_Max (RM_Size (Ctyp), 1); @@ -3213,6 +3215,7 @@ package body Freeze is if Present (Comp_Size_C) and then Has_Pragma_Pack (Ent) + and then Warn_On_Redundant_Constructs then Error_Msg_Sloc := Sloc (Comp_Size_C); Error_Msg_NE @@ -3221,6 +3224,8 @@ package body Freeze is Error_Msg_N ("\?explicit component size given#!", Pack_Pragma); + Set_Is_Packed (Base_Type (Ent), False); + Set_Is_Bit_Packed_Array (Base_Type (Ent), False); end if; -- Set component size if not already set by a @@ -3277,19 +3282,129 @@ package body Freeze is -- a representation characteristic, and this -- request may be ignored. - Set_Is_Packed (Base_Type (E), False); + Set_Is_Packed (Base_Type (E), False); + Set_Is_Bit_Packed_Array (Base_Type (E), False); - -- In all other cases, packing is indeed needed + if Known_Static_Esize (Component_Type (E)) + and then Esize (Component_Type (E)) = Csiz + then + Set_Has_Non_Standard_Rep + (Base_Type (E), False); + end if; + + -- In all other cases, packing is indeed needed else - Set_Has_Non_Standard_Rep (Base_Type (E)); - Set_Is_Bit_Packed_Array (Base_Type (E)); - Set_Is_Packed (Base_Type (E)); + Set_Has_Non_Standard_Rep (Base_Type (E), True); + Set_Is_Bit_Packed_Array (Base_Type (E), True); + Set_Is_Packed (Base_Type (E), True); end if; end; end if; end; + -- Check for Atomic_Components or Aliased with unsuitable + -- packing or explicit component size clause given. + + if (Has_Atomic_Components (E) + or else Has_Aliased_Components (E)) + and then (Has_Component_Size_Clause (E) + or else Is_Packed (E)) + then + Alias_Atomic_Check : declare + + procedure Complain_CS (T : String); + -- Outputs error messages for incorrect CS clause or + -- pragma Pack for aliased or atomic components (T is + -- "aliased" or "atomic"); + + ----------------- + -- Complain_CS -- + ----------------- + + procedure Complain_CS (T : String) is + begin + if Has_Component_Size_Clause (E) then + Clause := + Get_Attribute_Definition_Clause + (FS, Attribute_Component_Size); + + if Known_Static_Esize (Ctyp) then + Error_Msg_N + ("incorrect component size for " + & T & " components", Clause); + Error_Msg_Uint_1 := Esize (Ctyp); + Error_Msg_N + ("\only allowed value is^", Clause); + + else + Error_Msg_N + ("component size cannot be given for " + & T & " components", Clause); + end if; + + else + Error_Msg_N + ("cannot pack " & T & " components", + Get_Rep_Pragma (FS, Name_Pack)); + end if; + + return; + end Complain_CS; + + -- Start of processing for Alias_Atomic_Check + + begin + -- Case where component size has no effect + + if Known_Static_Esize (Ctyp) + and then Known_Static_RM_Size (Ctyp) + and then Esize (Ctyp) = RM_Size (Ctyp) + and then Esize (Ctyp) mod 8 = 0 + then + null; + + elsif Has_Aliased_Components (E) + or else Is_Aliased (Ctyp) + then + Complain_CS ("aliased"); + + elsif Has_Atomic_Components (E) + or else Is_Atomic (Ctyp) + then + Complain_CS ("atomic"); + end if; + end Alias_Atomic_Check; + end if; + + -- Warn for case of atomic type + + Clause := Get_Rep_Pragma (FS, Name_Atomic); + + if Present (Clause) + and then not Addressable (Component_Size (FS)) + then + Error_Msg_NE + ("non-atomic components of type& may not be " + & "accessible by separate tasks?", Clause, E); + + if Has_Component_Size_Clause (E) then + Error_Msg_Sloc := + Sloc + (Get_Attribute_Definition_Clause + (FS, Attribute_Component_Size)); + Error_Msg_N + ("\because of component size clause#?", + Clause); + + elsif Has_Pragma_Pack (E) then + Error_Msg_Sloc := + Sloc (Get_Rep_Pragma (FS, Name_Pack)); + Error_Msg_N + ("\because of pragma Pack#?", Clause); + end if; + end if; + -- Processing that is done only for subtypes else @@ -4749,11 +4864,7 @@ package body Freeze is -- natural boundary of size. elsif Size_Incl_EP /= Size_Excl_EP - and then - (Size_Excl_EP = 8 or else - Size_Excl_EP = 16 or else - Size_Excl_EP = 32 or else - Size_Excl_EP = 64) + and then Addressable (Size_Excl_EP) then Actual_Size := Size_Excl_EP; Actual_Lo := Loval_Excl_EP; diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index be2bd80..ec685b9 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -2568,14 +2568,9 @@ package body Layout is then declare S : constant Uint := Esize (CT); - begin - if S = 8 or else - S = 16 or else - S = 32 or else - S = 64 - then - Set_Component_Size (E, Esize (CT)); + if Addressable (S) then + Set_Component_Size (E, S); end if; end; end if; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 8077491..b910ac7 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1795,6 +1795,19 @@ package body Sem_Aggr is Expander_Mode_Save_And_Set (False); Full_Analysis := False; Analyze (Expr); + + -- If the expression is a literal, propagate this info + -- to the expression in the association, to enable some + -- optimizations downstream. + + if Is_Entity_Name (Expr) + and then Present (Entity (Expr)) + and then Ekind (Entity (Expr)) = E_Enumeration_Literal + then + Analyze_And_Resolve + (Expression (Assoc), Component_Typ); + end if; + Full_Analysis := Save_Analysis; Expander_Mode_Restore; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 4085431..b0752a5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1298,34 +1298,6 @@ package body Sem_Ch13 is Biased : Boolean; New_Ctyp : Entity_Id; Decl : Node_Id; - Ignore : Boolean := False; - - procedure Complain_CS (T : String); - -- Outputs error messages for incorrect CS clause for aliased or - -- atomic components (T is "aliased" or "atomic"); - - ----------------- - -- Complain_CS -- - ----------------- - - procedure Complain_CS (T : String) is - begin - if Known_Static_Esize (Ctyp) then - Error_Msg_N - ("incorrect component size for " & T & " components", N); - Error_Msg_Uint_1 := Esize (Ctyp); - Error_Msg_N ("\only allowed value is^", N); - - else - Error_Msg_N - ("component size cannot be given for " & T & " components", - N); - end if; - - return; - end Complain_CS; - - -- Start of processing for Component_Size_Case begin if not Is_Array_Type (U_Ent) then @@ -1340,41 +1312,12 @@ package body Sem_Ch13 is Error_Msg_N ("component size clause for& previously given", Nam); + elsif Rep_Item_Too_Early (Btype, N) then + null; + elsif Csize /= No_Uint then Check_Size (Expr, Ctyp, Csize, Biased); - -- Case where component size has no effect - - if Known_Static_Esize (Ctyp) - and then Known_Static_RM_Size (Ctyp) - and then Esize (Ctyp) = RM_Size (Ctyp) - and then (Esize (Ctyp) = 8 or else - Esize (Ctyp) = 16 or else - Esize (Ctyp) = 32 or else - Esize (Ctyp) = 64) - then - Ignore := True; - - -- Cannot give component size for aliased/atomic components - - elsif Has_Aliased_Components (Btype) - or else Is_Aliased (Ctyp) - then - Complain_CS ("aliased"); - - elsif Has_Atomic_Components (Btype) - or else Is_Atomic (Ctyp) - then - Complain_CS ("atomic"); - - -- Warn for case of atomic type - - elsif Is_Atomic (Btype) then - Error_Msg_NE - ("non-atomic components of type& may not be accessible " - & "by separate tasks?", N, Btype); - end if; - -- For the biased case, build a declaration for a subtype -- that will be used to represent the biased subtype that -- reflects the biased representation of components. We need @@ -1435,10 +1378,7 @@ package body Sem_Ch13 is end if; Set_Has_Component_Size_Clause (Btype, True); - - if not Ignore then - Set_Has_Non_Standard_Rep (Btype, True); - end if; + Set_Has_Non_Standard_Rep (Btype, True); end if; end Component_Size_Case; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 84f50ac..62e7568 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5928,7 +5928,6 @@ package body Sem_Prag is E : Entity_Id; D : Node_Id; K : Node_Kind; - Ctyp : Entity_Id; begin Check_Ada_83_Warning; @@ -5970,24 +5969,6 @@ package body Sem_Prag is if Prag_Id = Pragma_Atomic_Components then Set_Has_Atomic_Components (E); - - if Is_Packed (E) then - Set_Is_Packed (E, False); - - if Is_Array_Type (E) then - Ctyp := Component_Type (E); - else - Ctyp := Component_Type (Etype (E)); - end if; - - if not (Known_Static_Esize (Ctyp) - and then Known_Static_RM_Size (Ctyp) - and then Esize (Ctyp) = RM_Size (Ctyp)) - then - Error_Pragma_Arg - ("cannot pack atomic components", Arg1); - end if; - end if; end if; else @@ -8091,9 +8072,9 @@ package body Sem_Prag is Record_Rep_Item (Proc_Id, N); end Implemented; - ----------------------- + ---------------------- -- Implicit_Packing -- - ----------------------- + ---------------------- -- pragma Implicit_Packing; @@ -9991,76 +9972,40 @@ package body Sem_Prag is if Known_Static_Esize (Ctyp) and then Known_Static_RM_Size (Ctyp) and then Esize (Ctyp) = RM_Size (Ctyp) - and then (Esize (Ctyp) = 8 or else - Esize (Ctyp) = 16 or else - Esize (Ctyp) = 32 or else - Esize (Ctyp) = 64) + and then Addressable (Esize (Ctyp)) then Ignore := True; - - -- Pack not allowed for aliased/atomic components - - elsif Has_Aliased_Components (Base_Type (Typ)) then - Error_Pragma ("cannot pack aliased components"); - - elsif Has_Atomic_Components (Typ) - or else Is_Atomic (Component_Type (Typ)) - then - Error_Pragma ("cannot pack atomic components"); - - -- Warn for cases of packing non-atomic components of atomic - - elsif Is_Atomic (Typ) then - Error_Msg_NE - ("non-atomic components of type& may not be accessible " - & "by separate tasks?", N, Typ); end if; - -- If we had an explicit component size given, then we do not - -- let Pack override this given size. We also give a warning - -- that Pack is being ignored unless we can tell for sure that - -- the Pack would not have had any effect anyway. - - if Has_Component_Size_Clause (Typ) then - if Known_Static_RM_Size (Component_Type (Typ)) - and then - RM_Size (Component_Type (Typ)) = Component_Size (Typ) - then - null; - else - Error_Pragma - ("?pragma% ignored, explicit component size given"); - end if; - - -- If no prior array component size given, Pack is effective + -- Process OK pragma Pack. Note that if there is a separate + -- component clause present, the Pack will be cancelled. This + -- processing is in Freeze. - else - if not Rep_Item_Too_Late (Typ, N) then + if not Rep_Item_Too_Late (Typ, N) then - -- In the context of static code analysis, we do not need - -- complex front-end expansions related to pragma Pack, - -- so disable handling of pragma Pack in this case. + -- In the context of static code analysis, we do not need + -- complex front-end expansions related to pragma Pack, + -- so disable handling of pragma Pack in this case. - if CodePeer_Mode then - null; + if CodePeer_Mode then + null; - -- For normal non-VM target, do the packing + -- For normal non-VM target, do the packing - elsif VM_Target = No_VM then - if not Ignore then - Set_Is_Packed (Base_Type (Typ)); - Set_Has_Non_Standard_Rep (Base_Type (Typ)); - end if; + elsif VM_Target = No_VM then + if not Ignore then + Set_Is_Packed (Base_Type (Typ)); + Set_Has_Non_Standard_Rep (Base_Type (Typ)); + end if; - Set_Has_Pragma_Pack (Base_Type (Typ)); + Set_Has_Pragma_Pack (Base_Type (Typ)); - -- If we ignore the pack for VM_Targets, then warn about - -- this, except suppress the warning in GNAT mode. + -- If we ignore the pack for VM_Targets, then warn about + -- this, except suppress the warning in GNAT mode. - elsif not GNAT_Mode then - Error_Pragma - ("?pragma% ignored in this configuration"); - end if; + elsif not GNAT_Mode then + Error_Pragma + ("?pragma% ignored in this configuration"); end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c1d3fb4..1550a47 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -245,6 +245,28 @@ package body Sem_Util is Analyze (N); end Add_Global_Declaration; + ----------------- + -- Addressable -- + ----------------- + + -- For now, just 8/16/32/64. but analyze later if AAMP is special??? + + function Addressable (V : Uint) return Boolean is + begin + return V = Uint_8 or else + V = Uint_16 or else + V = Uint_32 or else + V = Uint_64; + end Addressable; + + function Addressable (V : Int) return Boolean is + begin + return V = 8 or else + V = 16 or else + V = 32 or else + V = 64; + end Addressable; + ----------------------- -- Alignment_In_Bits -- ----------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index faa363c..9c8bdd1 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -51,6 +51,12 @@ package Sem_Util is -- for the current unit. The declarations are added in the current scope, -- so the caller should push a new scope as required before the call. + function Addressable (V : Uint) return Boolean; + function Addressable (V : Int) return Boolean; + pragma Inline (Addressable); + -- Returns True if the value of V is the word size of an addressable + -- factor of the word size (typically 8, 16, 32 or 64). + function Alignment_In_Bits (E : Entity_Id) return Uint; -- If the alignment of the type or object E is currently known to the -- compiler, then this function returns the alignment value in bits. |