mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2014-10-31 Eric Botcazou <ebotcazou@adacore.com> * exp_ch4.adb: Minor tweak. 2014-10-31 Eric Botcazou <ebotcazou@adacore.com> * 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 <schonberg@adacore.com> * 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 <ebotcazou@adacore.com> * inline.adb: Minor reformatting. 2014-10-31 Ed Schonberg <schonberg@adacore.com> * 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 <gingold@adacore.com> * prj-conf.adb (Locate_Runtime): Remove procedure. From-SVN: r216963
This commit is contained in:
parent
c288810f69
commit
62a64085ba
|
|
@ -1,3 +1,36 @@
|
||||||
|
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
|
* exp_ch4.adb: Minor tweak.
|
||||||
|
|
||||||
|
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
|
* 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 <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* 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 <ebotcazou@adacore.com>
|
||||||
|
|
||||||
|
* inline.adb: Minor reformatting.
|
||||||
|
|
||||||
|
2014-10-31 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* 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 <gingold@adacore.com>
|
||||||
|
|
||||||
|
* prj-conf.adb (Locate_Runtime): Remove procedure.
|
||||||
|
|
||||||
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
|
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
* inline.adb (Has_Excluded_Declaration): With back-end inlining,
|
* inline.adb (Has_Excluded_Declaration): With back-end inlining,
|
||||||
|
|
|
||||||
|
|
@ -3610,7 +3610,7 @@ package body Exp_Ch4 is
|
||||||
if Atyp = Standard_String
|
if Atyp = Standard_String
|
||||||
and then NN in 2 .. 9
|
and then NN in 2 .. 9
|
||||||
and then (Lib_Level_Target
|
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))
|
and then not Debug_Flag_Dot_C))
|
||||||
then
|
then
|
||||||
declare
|
declare
|
||||||
|
|
|
||||||
|
|
@ -5383,8 +5383,13 @@ package body Freeze is
|
||||||
Check_Suspicious_Modulus (E);
|
Check_Suspicious_Modulus (E);
|
||||||
end if;
|
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)
|
elsif Is_Access_Type (E)
|
||||||
and then not Is_Access_Subprogram_Type (E)
|
and then not Is_Access_Subprogram_Type (E)
|
||||||
|
and then Ekind (E) /= E_Access_Attribute_Type
|
||||||
then
|
then
|
||||||
-- If a pragma Default_Storage_Pool applies, and this type has no
|
-- If a pragma Default_Storage_Pool applies, and this type has no
|
||||||
-- Storage_Pool or Storage_Size clause (which must have occurred
|
-- Storage_Pool or Storage_Size clause (which must have occurred
|
||||||
|
|
|
||||||
|
|
@ -3826,9 +3826,7 @@ package body Inline is
|
||||||
|
|
||||||
-- Generate listing of subprograms passed to the backend
|
-- Generate listing of subprograms passed to the backend
|
||||||
|
|
||||||
if Present (Backend_Inlined_Subps)
|
if Present (Backend_Inlined_Subps) and then Back_End_Inlining then
|
||||||
and then Back_End_Inlining
|
|
||||||
then
|
|
||||||
Count := 0;
|
Count := 0;
|
||||||
|
|
||||||
Elmt := First_Elmt (Backend_Inlined_Subps);
|
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
|
-- Generate listing of subprograms that cannot be inlined by the backend
|
||||||
|
|
||||||
if Present (Backend_Not_Inlined_Subps)
|
if Present (Backend_Not_Inlined_Subps) and then Back_End_Inlining then
|
||||||
and then Back_End_Inlining
|
|
||||||
then
|
|
||||||
Count := 0;
|
Count := 0;
|
||||||
|
|
||||||
Elmt := First_Elmt (Backend_Not_Inlined_Subps);
|
Elmt := First_Elmt (Backend_Not_Inlined_Subps);
|
||||||
|
|
|
||||||
|
|
@ -63,14 +63,6 @@ package body Prj.Conf is
|
||||||
-- Stores the runtime names for the various languages. This is in general
|
-- Stores the runtime names for the various languages. This is in general
|
||||||
-- set from a --RTS command line option.
|
-- 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 --
|
-- Local_Subprograms --
|
||||||
-----------------------
|
-----------------------
|
||||||
|
|
@ -732,7 +724,6 @@ package body Prj.Conf is
|
||||||
Set_Runtime_For
|
Set_Runtime_For
|
||||||
(Name_Ada,
|
(Name_Ada,
|
||||||
Name_Buffer (7 .. Name_Len));
|
Name_Buffer (7 .. Name_Len));
|
||||||
Locate_Runtime (Name_Ada, Env);
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
elsif Name_Len > 7
|
elsif Name_Len > 7
|
||||||
|
|
@ -759,7 +750,6 @@ package body Prj.Conf is
|
||||||
|
|
||||||
if not Runtime_Name_Set_For (Lang) then
|
if not Runtime_Name_Set_For (Lang) then
|
||||||
Set_Runtime_For (Lang, RTS);
|
Set_Runtime_For (Lang, RTS);
|
||||||
Locate_Runtime (Lang, Env);
|
|
||||||
end if;
|
end if;
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
|
@ -1544,48 +1534,6 @@ package body Prj.Conf is
|
||||||
end if;
|
end if;
|
||||||
end Locate_Config_File;
|
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 --
|
-- Parse_Project_And_Apply_Config --
|
||||||
------------------------------------
|
------------------------------------
|
||||||
|
|
|
||||||
|
|
@ -3636,11 +3636,6 @@ package body Sem_Ch12 is
|
||||||
-- but it is simpler than detecting the need for the body at the point
|
-- 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.
|
-- 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 --
|
-- Delay_Descriptors --
|
||||||
-----------------------
|
-----------------------
|
||||||
|
|
@ -3678,34 +3673,6 @@ package body Sem_Ch12 is
|
||||||
return False;
|
return False;
|
||||||
end Might_Inline_Subp;
|
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
|
-- Local declarations
|
||||||
|
|
||||||
Vis_Prims_List : Elist_Id := No_Elist;
|
Vis_Prims_List : Elist_Id := No_Elist;
|
||||||
|
|
@ -4006,14 +3973,6 @@ package body Sem_Ch12 is
|
||||||
then
|
then
|
||||||
Inline_Now := True;
|
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
|
-- In configurable_run_time mode we force the inlining of
|
||||||
-- predefined subprograms marked Inline_Always, to minimize
|
-- predefined subprograms marked Inline_Always, to minimize
|
||||||
-- the use of the run-time library.
|
-- the use of the run-time library.
|
||||||
|
|
|
||||||
|
|
@ -6943,6 +6943,28 @@ package body Sem_Ch3 is
|
||||||
|
|
||||||
Set_Is_Frozen (Full_Der);
|
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 up links between real entity and underlying record view
|
||||||
|
|
||||||
Set_Underlying_Record_View (Derived_Type, Base_Type (Full_Der));
|
Set_Underlying_Record_View (Derived_Type, Base_Type (Full_Der));
|
||||||
|
|
|
||||||
|
|
@ -12945,11 +12945,16 @@ package body Sem_Prag is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- The expected type for a non-"null" argument is
|
-- 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
|
Analyze_And_Resolve
|
||||||
(Get_Pragma_Arg (Arg1),
|
(Get_Pragma_Arg (Arg1),
|
||||||
Typ => Class_Wide_Type (RTE (RE_Root_Storage_Pool)));
|
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;
|
end if;
|
||||||
|
|
||||||
-- Finally, record the pool name (or null). Freeze.Freeze_Entity
|
-- Finally, record the pool name (or null). Freeze.Freeze_Entity
|
||||||
|
|
|
||||||
|
|
@ -13350,24 +13350,6 @@ package body Sem_Util is
|
||||||
Mark_Allocators (Root_Nod);
|
Mark_Allocators (Root_Nod);
|
||||||
end Mark_Coextensions;
|
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 --
|
-- Needs_One_Actual --
|
||||||
----------------------
|
----------------------
|
||||||
|
|
|
||||||
|
|
@ -1541,9 +1541,6 @@ package Sem_Util is
|
||||||
-- to guarantee this in all cases. Note that it is more possible to give
|
-- to guarantee this in all cases. Note that it is more possible to give
|
||||||
-- correct answer if the tree is fully analyzed.
|
-- 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;
|
function Needs_One_Actual (E : Entity_Id) return Boolean;
|
||||||
-- Returns True if a function has defaults for all but its first
|
-- Returns True if a function has defaults for all but its first
|
||||||
-- formal. Used in Ada 2005 mode to solve the syntactic ambiguity that
|
-- formal. Used in Ada 2005 mode to solve the syntactic ambiguity that
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue