Commit eb1ee757 by Arnaud Charlet

[multiple changes]

2014-07-30  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb, sem_ch6.adb: Minor code reorganization.
	* inline.adb: Minor reformatting.

2014-07-30  Javier Miranda  <miranda@adacore.com>

	* a-tags.ads: Add comments.

From-SVN: r213272
parent 2178830b
2014-07-30 Robert Dewar <dewar@adacore.com>
* sem_res.adb, sem_ch6.adb: Minor code reorganization.
* inline.adb: Minor reformatting.
2014-07-30 Javier Miranda <miranda@adacore.com>
* a-tags.ads: Add comments.
2014-07-30 Pat Rogers <rogers@adacore.com> 2014-07-30 Pat Rogers <rogers@adacore.com>
* gnat_rm.texi: Minor word error. * gnat_rm.texi: Minor word error.
......
...@@ -33,11 +33,12 @@ ...@@ -33,11 +33,12 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- The operations in this package provide the guarantee that all dispatching -- For performance analysis, take into account that the operations in this
-- calls on primitive operations of tagged types and interfaces take constant -- package provide the guarantee that all dispatching calls on primitive
-- time (in terms of source lines executed), that is to say, the cost of these -- operations of tagged types and interfaces take constant time (in terms
-- calls is independent of the number of primitives of the type or interface, -- of source lines executed), that is to say, the cost of these calls is
-- and independent of the number of ancestors or interface progenitors that a -- independent of the number of primitives of the type or interface, and
-- independent of the number of ancestors or interface progenitors that a
-- tagged type may have. -- tagged type may have.
-- The following subprograms of the public part of this package take constant -- The following subprograms of the public part of this package take constant
...@@ -51,9 +52,17 @@ ...@@ -51,9 +52,17 @@
-- The following subprograms of the public part of this package take non -- The following subprograms of the public part of this package take non
-- constant time (in terms of sources line executed): -- constant time (in terms of sources line executed):
-- Descendant_Tag (when used with a locally defined tagged type) -- Internal_Tag (when used with a locally defined tagged type), because in
-- Internal_Tag (when used with a locally defined tagged type) -- such case this routine processes the external tag, extract from it an
-- Interface_Ancestor_Tags -- address available there, and convert it into the tag value returned by
-- this function. The number of instructions executed is not constant since
-- it depends on the length of the external tag string.
-- Descendant_Tag (when used with a locally defined tagged type), because
-- it relies on the subprogram Internal_Tag() to provide its functionality.
-- Interface_Ancestor_Tags, because this function returns a table whose
-- length depends on the number of interfaces covered by a tagged type.
with System.Storage_Elements; with System.Storage_Elements;
......
...@@ -1697,9 +1697,9 @@ package body Inline is ...@@ -1697,9 +1697,9 @@ package body Inline is
-- is analyzed, as this is where a pragma SPARK_Mode might be inserted. -- is analyzed, as this is where a pragma SPARK_Mode might be inserted.
elsif Present (Spec_Id) elsif Present (Spec_Id)
and then (No (SPARK_Pragma (Spec_Id)) and then
or else (No (SPARK_Pragma (Spec_Id))
Get_SPARK_Mode_From_Pragma (SPARK_Pragma (Spec_Id)) /= On) or else Get_SPARK_Mode_From_Pragma (SPARK_Pragma (Spec_Id)) /= On)
then then
return False; return False;
...@@ -1709,8 +1709,7 @@ package body Inline is ...@@ -1709,8 +1709,7 @@ package body Inline is
elsif Instantiation_Location (Sloc (Id)) /= No_Location then elsif Instantiation_Location (Sloc (Id)) /= No_Location then
return False; return False;
-- Predicate functions are treated specially by GNATprove. Do not inline -- Don't inline predicate functions (treated specially by GNATprove)
-- them.
elsif Is_Predicate_Function (Id) then elsif Is_Predicate_Function (Id) then
return False; return False;
......
...@@ -3073,6 +3073,7 @@ package body Sem_Ch6 is ...@@ -3073,6 +3073,7 @@ package body Sem_Ch6 is
New_Decl : constant Node_Id := New_Decl : constant Node_Id :=
Make_Subprogram_Declaration (Loc, Make_Subprogram_Declaration (Loc,
Copy_Separate_Tree (Specification (N))); Copy_Separate_Tree (Specification (N)));
SPARK_Mode_Aspect : Node_Id; SPARK_Mode_Aspect : Node_Id;
Aspects : List_Id; Aspects : List_Id;
Prag, Aspect : Node_Id; Prag, Aspect : Node_Id;
...@@ -3093,8 +3094,7 @@ package body Sem_Ch6 is ...@@ -3093,8 +3094,7 @@ package body Sem_Ch6 is
Analyze (New_Decl); Analyze (New_Decl);
-- The analysis of the generated subprogram declaration -- The analysis of the generated subprogram declaration
-- may have introduced pragmas, which need to be -- may have introduced pragmas that need to be analyzed.
-- analyzed.
Prag := Next (New_Decl); Prag := Next (New_Decl);
while Prag /= N loop while Prag /= N loop
...@@ -3113,8 +3113,7 @@ package body Sem_Ch6 is ...@@ -3113,8 +3113,7 @@ package body Sem_Ch6 is
SPARK_Mode_Aspect := SPARK_Mode_Aspect :=
New_Copy (Find_Aspect (Spec_Id, Aspect_SPARK_Mode)); New_Copy (Find_Aspect (Spec_Id, Aspect_SPARK_Mode));
Set_Analyzed (SPARK_Mode_Aspect, False); Set_Analyzed (SPARK_Mode_Aspect, False);
Aspects := New_List; Aspects := New_List (SPARK_Mode_Aspect);
Append (SPARK_Mode_Aspect, Aspects);
Set_Aspect_Specifications (N, Aspects); Set_Aspect_Specifications (N, Aspects);
end if; end if;
......
...@@ -6216,15 +6216,16 @@ package body Sem_Res is ...@@ -6216,15 +6216,16 @@ package body Sem_Res is
-- being inlined. -- being inlined.
declare declare
Nam_Alias : constant Entity_Id := Ultimate_Alias (Nam); Nam_UA : constant Entity_Id := Ultimate_Alias (Nam);
Decl : constant Node_Id := Unit_Declaration_Node (Nam_Alias); Decl : constant Node_Id := Unit_Declaration_Node (Nam_UA);
begin begin
-- If the subprogram is not eligible for inlining in GNATprove -- If the subprogram is not eligible for inlining in GNATprove
-- mode, do nothing. -- mode, do nothing.
if not Can_Be_Inlined_In_GNATprove_Mode (Nam_Alias, Empty) if Nkind (Decl) /= N_Subprogram_Declaration
or else Nkind (Decl) /= N_Subprogram_Declaration or else not Is_Inlined_Always (Nam_UA)
or else not Is_Inlined_Always (Nam_Alias) or else not Can_Be_Inlined_In_GNATprove_Mode (Nam_UA, Empty)
then then
null; null;
...@@ -6234,7 +6235,7 @@ package body Sem_Res is ...@@ -6234,7 +6235,7 @@ package body Sem_Res is
elsif In_Assertion_Expr /= 0 then elsif In_Assertion_Expr /= 0 then
Error_Msg_NE ("?cannot inline call to &", N, Nam); Error_Msg_NE ("?cannot inline call to &", N, Nam);
Error_Msg_N ("\call appears in assertion expression", N); Error_Msg_N ("\call appears in assertion expression", N);
Set_Is_Inlined_Always (Nam_Alias, False); Set_Is_Inlined_Always (Nam_UA, False);
-- Inlining should not be performed during pre-analysis -- Inlining should not be performed during pre-analysis
...@@ -6246,7 +6247,7 @@ package body Sem_Res is ...@@ -6246,7 +6247,7 @@ package body Sem_Res is
if No (Corresponding_Body (Decl)) then if No (Corresponding_Body (Decl)) then
Error_Msg_NE Error_Msg_NE
("?cannot inline call to & (body not seen yet)", N, Nam); ("?cannot inline call to & (body not seen yet)", N, Nam);
Set_Is_Inlined_Always (Nam_Alias, False); Set_Is_Inlined_Always (Nam_UA, False);
-- Nothing to do if there is no body to inline, indicating that -- Nothing to do if there is no body to inline, indicating that
-- the subprogram is not suitable for inlining in GNATprove -- the subprogram is not suitable for inlining in GNATprove
...@@ -6263,12 +6264,12 @@ package body Sem_Res is ...@@ -6263,12 +6264,12 @@ package body Sem_Res is
Error_Msg_NE ("?cannot inline call to &", N, Nam); Error_Msg_NE ("?cannot inline call to &", N, Nam);
Error_Msg_N Error_Msg_N
("\call appears in potentially unevaluated context", N); ("\call appears in potentially unevaluated context", N);
Set_Is_Inlined_Always (Nam_Alias, False); Set_Is_Inlined_Always (Nam_UA, False);
-- Otherwise, inline the call -- Otherwise, inline the call
else else
Expand_Inlined_Call (N, Nam_Alias, Nam); Expand_Inlined_Call (N, Nam_UA, Nam);
end if; end if;
end if; end if;
end; end;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment