+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>
* inline.adb (Has_Excluded_Declaration): With back-end inlining,
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
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
-- 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);
-- 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);
-- 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 --
-----------------------
Set_Runtime_For
(Name_Ada,
Name_Buffer (7 .. Name_Len));
- Locate_Runtime (Name_Ada, Env);
end if;
elsif Name_Len > 7
if not Runtime_Name_Set_For (Lang) then
Set_Runtime_For (Lang, RTS);
- Locate_Runtime (Lang, Env);
end if;
end;
end if;
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 --
------------------------------------
-- 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 --
-----------------------
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;
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.
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));
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
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 --
----------------------
-- 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
projects / gcc.git / commitdiff