[multiple changes]
2014-10-31 Eric Botcazou <ebotcazou@adacore.com> * inline.adb (Check_And_Split_Unconstrained_Function): Do not test for the presence of nested subprograms. 2014-10-31 Ed Schonberg <schonberg@adacore.com> * aspects.ads, aspects.adb: Add aspect Default_Storage_Pool. * sem_ch13.adb (Analyze_One_Aspect): Generate pragma for aspect Default_Storage_Pool. From-SVN: r216959
This commit is contained in:
parent
88f7d2d148
commit
2ef051289c
@ -1,3 +1,14 @@
|
||||
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* inline.adb (Check_And_Split_Unconstrained_Function): Do not
|
||||
test for the presence of nested subprograms.
|
||||
|
||||
2014-10-31 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* aspects.ads, aspects.adb: Add aspect Default_Storage_Pool.
|
||||
* sem_ch13.adb (Analyze_One_Aspect): Generate pragma for aspect
|
||||
Default_Storage_Pool.
|
||||
|
||||
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* sem_ch6.adb: Remove obsolete comment.
|
||||
|
@ -511,6 +511,7 @@ package body Aspects is
|
||||
Aspect_Default_Component_Value => Aspect_Default_Component_Value,
|
||||
Aspect_Default_Initial_Condition => Aspect_Default_Initial_Condition,
|
||||
Aspect_Default_Iterator => Aspect_Default_Iterator,
|
||||
Aspect_Default_Storage_Pool => Aspect_Default_Storage_Pool,
|
||||
Aspect_Default_Value => Aspect_Default_Value,
|
||||
Aspect_Depends => Aspect_Depends,
|
||||
Aspect_Dimension => Aspect_Dimension,
|
||||
|
@ -88,6 +88,7 @@ package Aspects is
|
||||
Aspect_Default_Component_Value,
|
||||
Aspect_Default_Initial_Condition, -- GNAT
|
||||
Aspect_Default_Iterator,
|
||||
Aspect_Default_Storage_Pool,
|
||||
Aspect_Default_Value,
|
||||
Aspect_Depends, -- GNAT
|
||||
Aspect_Dimension, -- GNAT
|
||||
@ -314,6 +315,7 @@ package Aspects is
|
||||
Aspect_Default_Component_Value => Expression,
|
||||
Aspect_Default_Initial_Condition => Optional_Expression,
|
||||
Aspect_Default_Iterator => Name,
|
||||
Aspect_Default_Storage_Pool => Expression,
|
||||
Aspect_Default_Value => Expression,
|
||||
Aspect_Depends => Expression,
|
||||
Aspect_Dimension => Expression,
|
||||
@ -401,6 +403,7 @@ package Aspects is
|
||||
Aspect_Default_Component_Value => Name_Default_Component_Value,
|
||||
Aspect_Default_Initial_Condition => Name_Default_Initial_Condition,
|
||||
Aspect_Default_Iterator => Name_Default_Iterator,
|
||||
Aspect_Default_Storage_Pool => Name_Default_Storage_Pool,
|
||||
Aspect_Default_Value => Name_Default_Value,
|
||||
Aspect_Depends => Name_Depends,
|
||||
Aspect_Dimension => Name_Dimension,
|
||||
@ -616,6 +619,7 @@ package Aspects is
|
||||
Aspect_Constant_Indexing => Always_Delay,
|
||||
Aspect_CPU => Always_Delay,
|
||||
Aspect_Default_Iterator => Always_Delay,
|
||||
Aspect_Default_Storage_Pool => Always_Delay,
|
||||
Aspect_Default_Value => Always_Delay,
|
||||
Aspect_Default_Component_Value => Always_Delay,
|
||||
Aspect_Discard_Names => Always_Delay,
|
||||
|
@ -1894,44 +1894,6 @@ package body Inline is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Do not inline any subprogram that contains nested subprograms,
|
||||
-- since the backend inlining circuit seems to generate uninitialized
|
||||
-- references in this case. We know this happens in the case of front
|
||||
-- end ZCX support, but it also appears it can happen in other cases
|
||||
-- as well. The backend often rejects attempts to inline in the case
|
||||
-- of nested procedures anyway, so little if anything is lost by this.
|
||||
-- Note that this is test is for the benefit of the back-end. There
|
||||
-- is a separate test for front-end inlining that also rejects nested
|
||||
-- subprograms.
|
||||
|
||||
-- Do not do this test if errors have been detected, because in some
|
||||
-- error cases, this code blows up, and we don't need it anyway if
|
||||
-- there have been errors, since we won't get to the linker anyway.
|
||||
|
||||
declare
|
||||
P_Ent : Node_Id;
|
||||
|
||||
begin
|
||||
P_Ent := Body_Id;
|
||||
loop
|
||||
P_Ent := Scope (P_Ent);
|
||||
exit when No (P_Ent) or else P_Ent = Standard_Standard;
|
||||
|
||||
if Is_Subprogram (P_Ent) then
|
||||
Set_Is_Inlined (P_Ent, False);
|
||||
|
||||
if Comes_From_Source (P_Ent)
|
||||
and then (Has_Pragma_Inline (P_Ent))
|
||||
then
|
||||
Cannot_Inline
|
||||
("cannot inline& (nested subprogram)?", N, P_Ent,
|
||||
Is_Serious => True);
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
end;
|
||||
|
||||
-- No action needed in stubs since the attribute Body_To_Inline
|
||||
-- is not available
|
||||
|
||||
|
@ -2236,6 +2236,20 @@ package body Sem_Ch13 is
|
||||
Insert_Pragma (Aitem);
|
||||
goto Continue;
|
||||
|
||||
-- Default_Storage_Pool
|
||||
|
||||
when Aspect_Default_Storage_Pool =>
|
||||
Make_Aitem_Pragma
|
||||
(Pragma_Argument_Associations => New_List (
|
||||
Make_Pragma_Argument_Association (Loc,
|
||||
Expression => Relocate_Node (Expr))),
|
||||
Pragma_Name =>
|
||||
Name_Default_Storage_Pool);
|
||||
|
||||
Decorate (Aspect, Aitem);
|
||||
Insert_Pragma (Aitem);
|
||||
goto Continue;
|
||||
|
||||
-- Depends
|
||||
|
||||
-- Aspect Depends is never delayed because it is equivalent to
|
||||
@ -8693,6 +8707,9 @@ package body Sem_Ch13 is
|
||||
when Aspect_Default_Component_Value =>
|
||||
T := Component_Type (Entity (ASN));
|
||||
|
||||
when Aspect_Default_Storage_Pool =>
|
||||
T := Class_Wide_Type (RTE (RE_Root_Storage_Pool));
|
||||
|
||||
-- Default_Value is resolved with the type entity in question
|
||||
|
||||
when Aspect_Default_Value =>
|
||||
|
Loading…
Reference in New Issue
Block a user