From: Arnaud Charlet Date: Fri, 31 Oct 2014 11:18:47 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=62a64085bac5eec7bb46c2ea678e3928d8787329;p=gcc.git [multiple changes] 2014-10-31 Eric Botcazou * exp_ch4.adb: Minor tweak. 2014-10-31 Eric Botcazou * sem_ch12.adb (Analyze_Package_Instantiation): Do not inline with back-end inlining. (Must_Inline_Subp): Delete. * sem_util.ads, sem_util.adb (Must_Inline): Likewise. 2014-10-31 Ed Schonberg * freeze.adb (Freeze_Entity): A default_pool does not apply to internal access types generated for 'access references. * sem_prag (Analyze_Pragma, case Default_Pool): If the name is not null it must designate a variable. 2014-10-31 Eric Botcazou * inline.adb: Minor reformatting. 2014-10-31 Ed Schonberg * sem_ch3.adb (Build_Derived_Private_Type): If the derived type has access discriminants, create itype references for their anonymous types, so that they are elaborated before the generated bodies for the primitive operations of the type. 2014-10-31 Tristan Gingold * prj-conf.adb (Locate_Runtime): Remove procedure. From-SVN: r216963 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ec9daba8df5..a31639b95a7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,36 @@ +2014-10-31 Eric Botcazou + + * exp_ch4.adb: Minor tweak. + +2014-10-31 Eric Botcazou + + * sem_ch12.adb (Analyze_Package_Instantiation): Do not inline with + back-end inlining. + (Must_Inline_Subp): Delete. + * sem_util.ads, sem_util.adb (Must_Inline): Likewise. + +2014-10-31 Ed Schonberg + + * freeze.adb (Freeze_Entity): A default_pool does not apply to + internal access types generated for 'access references. + * sem_prag (Analyze_Pragma, case Default_Pool): If the name is + not null it must designate a variable. + +2014-10-31 Eric Botcazou + + * inline.adb: Minor reformatting. + +2014-10-31 Ed Schonberg + + * sem_ch3.adb (Build_Derived_Private_Type): If the derived + type has access discriminants, create itype references for their + anonymous types, so that they are elaborated before the generated + bodies for the primitive operations of the type. + +2014-10-31 Tristan Gingold + + * prj-conf.adb (Locate_Runtime): Remove procedure. + 2014-10-31 Eric Botcazou * inline.adb (Has_Excluded_Declaration): With back-end inlining, diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index eeada2c8ff1..1ed8f3bf146 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3610,7 +3610,7 @@ package body Exp_Ch4 is if Atyp = Standard_String and then NN in 2 .. 9 and then (Lib_Level_Target - or else ((Opt.Optimization_Level = 0 or else Debug_Flag_Dot_CC) + or else ((Optimization_Level = 0 or else Debug_Flag_Dot_CC) and then not Debug_Flag_Dot_C)) then declare diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index bccec208e45..caef71f9197 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -5383,8 +5383,13 @@ package body Freeze is Check_Suspicious_Modulus (E); end if; + -- the pool applies to named and anonymous access types, but not + -- to subprogram and to internal types generated for 'Access + -- references. + elsif Is_Access_Type (E) and then not Is_Access_Subprogram_Type (E) + and then Ekind (E) /= E_Access_Attribute_Type then -- If a pragma Default_Storage_Pool applies, and this type has no -- Storage_Pool or Storage_Size clause (which must have occurred diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index dc26d21e136..9646cc2fdc7 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -3826,9 +3826,7 @@ package body Inline is -- Generate listing of subprograms passed to the backend - if Present (Backend_Inlined_Subps) - and then Back_End_Inlining - then + if Present (Backend_Inlined_Subps) and then Back_End_Inlining then Count := 0; Elmt := First_Elmt (Backend_Inlined_Subps); @@ -3858,9 +3856,7 @@ package body Inline is -- Generate listing of subprograms that cannot be inlined by the backend - if Present (Backend_Not_Inlined_Subps) - and then Back_End_Inlining - then + if Present (Backend_Not_Inlined_Subps) and then Back_End_Inlining then Count := 0; Elmt := First_Elmt (Backend_Not_Inlined_Subps); diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index b88f1a15659..1afdb2ce55a 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -63,14 +63,6 @@ package body Prj.Conf is -- Stores the runtime names for the various languages. This is in general -- set from a --RTS command line option. - procedure Locate_Runtime - (Language : Name_Id; - Env : Prj.Tree.Environment); - -- If RTS_Name is a base name (a name without path separator), then - -- do nothing. Otherwise, convert it to an absolute path (possibly by - -- searching it in the project path) and call Set_Runtime_For with the - -- absolute path. Raise Invalid_Config if the path does not exist. - ----------------------- -- Local_Subprograms -- ----------------------- @@ -732,7 +724,6 @@ package body Prj.Conf is Set_Runtime_For (Name_Ada, Name_Buffer (7 .. Name_Len)); - Locate_Runtime (Name_Ada, Env); end if; elsif Name_Len > 7 @@ -759,7 +750,6 @@ package body Prj.Conf is if not Runtime_Name_Set_For (Lang) then Set_Runtime_For (Lang, RTS); - Locate_Runtime (Lang, Env); end if; end; end if; @@ -1544,48 +1534,6 @@ package body Prj.Conf is end if; end Locate_Config_File; - -------------------- - -- Locate_Runtime -- - -------------------- - - procedure Locate_Runtime - (Language : Name_Id; - Env : Prj.Tree.Environment) - is - function Is_RTS_Directory (Path : String) return Boolean; - -- Returns True if Path is a directory for a runtime. This simply check - -- that Path has a "adalib" subdirectoy, which is a property for - -- runtimes on the project path. - - ---------------------- - -- Is_RTS_Directory -- - ---------------------- - - function Is_RTS_Directory (Path : String) return Boolean is - begin - return Is_Directory (Path & Directory_Separator & "adalib"); - end Is_RTS_Directory; - - -- Local declarations - - function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path - (Check_Filename => Is_RTS_Directory); - - RTS_Name : constant String := Runtime_Name_For (Language); - - Full_Path : String_Access; - - -- Start of processing for Locate_Runtime - - begin - Full_Path := Find_Rts_In_Path (Env.Project_Path, RTS_Name); - - if Full_Path /= null then - Set_Runtime_For (Language, Normalize_Pathname (Full_Path.all)); - Free (Full_Path); - end if; - end Locate_Runtime; - ------------------------------------ -- Parse_Project_And_Apply_Config -- ------------------------------------ diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 88126e428cf..5420a79b118 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3636,11 +3636,6 @@ package body Sem_Ch12 is -- but it is simpler than detecting the need for the body at the point -- of inlining, when the context of the instance is not available. - function Must_Inline_Subp return Boolean; - -- If inlining is active and the generic contains inlined subprograms, - -- return True if some of the inlined subprograms must be inlined by - -- the frontend. - ----------------------- -- Delay_Descriptors -- ----------------------- @@ -3678,34 +3673,6 @@ package body Sem_Ch12 is return False; end Might_Inline_Subp; - ---------------------- - -- Must_Inline_Subp -- - ---------------------- - - function Must_Inline_Subp return Boolean is - E : Entity_Id; - - begin - if not Inline_Processing_Required then - return False; - - else - E := First_Entity (Gen_Unit); - while Present (E) loop - if Is_Subprogram (E) - and then Is_Inlined (E) - and then Must_Inline (E) - then - return True; - end if; - - Next_Entity (E); - end loop; - end if; - - return False; - end Must_Inline_Subp; - -- Local declarations Vis_Prims_List : Elist_Id := No_Elist; @@ -4006,14 +3973,6 @@ package body Sem_Ch12 is then Inline_Now := True; - elsif Back_End_Inlining - and then Must_Inline_Subp - and then (Is_In_Main_Unit (N) - or else In_Main_Context (Current_Scope)) - and then Nkind (Parent (N)) /= N_Compilation_Unit - then - Inline_Now := True; - -- In configurable_run_time mode we force the inlining of -- predefined subprograms marked Inline_Always, to minimize -- the use of the run-time library. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c9b86ba41ad..c60f7c01281 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6943,6 +6943,28 @@ package body Sem_Ch3 is Set_Is_Frozen (Full_Der); + -- If the derived type has access discriminants, create + -- references to their anonymous types now, to prevent + -- back-end problems when their first use is in generated + -- bodies of primitives. + + declare + E : Entity_Id; + + begin + E := First_Entity (Full_Der); + + while Present (E) loop + if Ekind (E) = E_Discriminant + and then Ekind (Etype (E)) = E_Anonymous_Access_Type + then + Build_Itype_Reference (Etype (E), Decl); + end if; + + Next_Entity (E); + end loop; + end; + -- Set up links between real entity and underlying record view Set_Underlying_Record_View (Derived_Type, Base_Type (Full_Der)); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index b5ca29e4a04..0eddd64ee1a 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -12945,11 +12945,16 @@ package body Sem_Prag is end if; -- The expected type for a non-"null" argument is - -- Root_Storage_Pool'Class. + -- Root_Storage_Pool'Class, and the pool must be a variable. Analyze_And_Resolve (Get_Pragma_Arg (Arg1), Typ => Class_Wide_Type (RTE (RE_Root_Storage_Pool))); + + if not Is_Variable (Expression (Arg1)) then + Error_Pragma_Arg + ("default storage pool must be a variable", Arg1); + end if; end if; -- Finally, record the pool name (or null). Freeze.Freeze_Entity diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 09afaaaafa5..9fc89825ba7 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -13350,24 +13350,6 @@ package body Sem_Util is Mark_Allocators (Root_Nod); end Mark_Coextensions; - ----------------- - -- Must_Inline -- - ----------------- - - function Must_Inline (Subp : Entity_Id) return Boolean is - begin - return - (Optimization_Level = 0 - - -- AAMP and VM targets have no support for inlining in the backend. - -- Hence we do as much inlining as possible in the front end. - - or else AAMP_On_Target - or else VM_Target /= No_VM) - and then Has_Pragma_Inline (Subp) - and then (Has_Pragma_Inline_Always (Subp) or else Front_End_Inlining); - end Must_Inline; - ---------------------- -- Needs_One_Actual -- ---------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index bd3a4e9a7a0..5fdc5fb6c21 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1541,9 +1541,6 @@ package Sem_Util is -- to guarantee this in all cases. Note that it is more possible to give -- correct answer if the tree is fully analyzed. - function Must_Inline (Subp : Entity_Id) return Boolean; - -- Return true if Subp must be inlined by the frontend - function Needs_One_Actual (E : Entity_Id) return Boolean; -- Returns True if a function has defaults for all but its first -- formal. Used in Ada 2005 mode to solve the syntactic ambiguity that