Skip to content

R
riscv-gcc-1
Commit 83f33150 by Yannick Moy Committed by Arnaud Charlet
Options

sem_ch3.adb, [...]: Protect call to Current_Subprogram which might be costly when repeated. 

2011-08-02  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb, sem_ch5.adb, sem_ch9.adb, sem_util.adb, sem_util.ads,
	sem_res.adb, sem_ch2.adb, sem_ch4.adb, sem_ch6.adb,
	sem_ch11.adb: Protect call to Current_Subprogram which might be costly
	when repeated. Rename Current_Subprogram_Is_Not_In_ALFA into
	Mark_Non_ALFA_Subprogram_Body.
	Split body of Mark_Non_ALFA_Subprogram_Body to get body small and
	inlined.

From-SVN: r177182
parent 7b98672f
Showing with 96 additions and 70 deletions
gcc/ada/ChangeLog
2011-08-02 Yannick Moy <moy@adacore.com>
* sem_ch3.adb, sem_ch5.adb, sem_ch9.adb, sem_util.adb, sem_util.ads,
sem_res.adb, sem_ch2.adb, sem_ch4.adb, sem_ch6.adb,
sem_ch11.adb: Protect call to Current_Subprogram which might be costly
when repeated. Rename Current_Subprogram_Is_Not_In_ALFA into
Mark_Non_ALFA_Subprogram_Body.
Split body of Mark_Non_ALFA_Subprogram_Body to get body small and
inlined.
2011-08-02 Yannick Moy <moy@adacore.com>
* sem_res.adb: Protect calls to Matching_Static_Array_Bounds which
might be costly.
......
gcc/ada/sem_ch11.adb
......@@ -443,7 +443,7 @@ package body Sem_Ch11 is
P : Node_Id;
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("raise statement is not allowed", N);
Check_Unreachable_Code (N);
......@@ -611,7 +611,7 @@ package body Sem_Ch11 is
-- Start of processing for Analyze_Raise_xxx_Error
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("raise statement is not allowed", N);
if No (Etype (N)) then
......
gcc/ada/sem_ch2.adb
......@@ -81,7 +81,7 @@ package body Sem_Ch2 is
and then Is_Object (Entity (N))
and then not Is_In_ALFA (Entity (N))
then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
end if;
end if;
end Analyze_Identifier;
......
gcc/ada/sem_ch3.adb
......@@ -3036,7 +3036,7 @@ package body Sem_Ch3 is
if Is_In_ALFA (T) and then not Aliased_Present (N) then
Set_Is_In_ALFA (Id);
else
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
end if;
-- These checks should be performed before the initialization expression
......
gcc/ada/sem_ch4.adb
......@@ -350,7 +350,7 @@ package body Sem_Ch4 is
procedure Analyze_Aggregate (N : Node_Id) is
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
if No (Etype (N)) then
Set_Etype (N, Any_Composite);
......@@ -371,7 +371,7 @@ package body Sem_Ch4 is
C : Node_Id;
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("allocator is not allowed", N);
-- Deal with allocator restrictions
......@@ -991,7 +991,7 @@ package body Sem_Ch4 is
if not Is_Subprogram (Nam_Ent)
or else not Is_In_ALFA (Nam_Ent)
then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
end if;
Analyze_One_Call (N, Nam_Ent, True, Success);
......@@ -1370,7 +1370,7 @@ package body Sem_Ch4 is
L : Node_Id;
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Candidate_Type := Empty;
......@@ -1520,7 +1520,7 @@ package body Sem_Ch4 is
return;
end if;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("conditional expression is not allowed", N);
Else_Expr := Next (Then_Expr);
......@@ -1721,7 +1721,7 @@ package body Sem_Ch4 is
-- Start of processing for Analyze_Explicit_Dereference
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("explicit dereference is not allowed", N);
Analyze (P);
......@@ -2483,7 +2483,7 @@ package body Sem_Ch4 is
-- Start of processing for Analyze_Membership_Op
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Analyze_Expression (L);
......@@ -2606,7 +2606,7 @@ package body Sem_Ch4 is
procedure Analyze_Null (N : Node_Id) is
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("null is not allowed", N);
Set_Etype (N, Any_Access);
......@@ -3235,7 +3235,7 @@ package body Sem_Ch4 is
T : Entity_Id;
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Analyze_Expression (Expr);
......@@ -3295,7 +3295,7 @@ package body Sem_Ch4 is
Iterator : Node_Id;
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("quantified expression is not allowed", N);
Set_Etype (Ent, Standard_Void_Type);
......@@ -3461,7 +3461,7 @@ package body Sem_Ch4 is
Acc_Type : Entity_Id;
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Analyze (P);
......@@ -4326,7 +4326,7 @@ package body Sem_Ch4 is
-- Start of processing for Analyze_Slice
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("slice is not allowed", N);
Analyze (P);
......@@ -4371,7 +4371,7 @@ package body Sem_Ch4 is
T : Entity_Id;
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
-- If Conversion_OK is set, then the Etype is already set, and the
-- only processing required is to analyze the expression. This is
......@@ -4503,7 +4503,7 @@ package body Sem_Ch4 is
procedure Analyze_Unchecked_Type_Conversion (N : Node_Id) is
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Find_Type (Subtype_Mark (N));
Analyze_Expression (Expression (N));
Set_Etype (N, Entity (Subtype_Mark (N)));
......
gcc/ada/sem_ch5.adb
......@@ -1113,7 +1113,7 @@ package body Sem_Ch5 is
if Others_Present
and then List_Length (Alternatives (N)) = 1
then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction
("OTHERS as unique case alternative is not allowed", N);
end if;
......@@ -1195,7 +1195,7 @@ package body Sem_Ch5 is
else
if Has_Loop_In_Inner_Open_Scopes (U_Name) then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction
("exit label must name the closest enclosing loop", N);
end if;
......@@ -1242,14 +1242,14 @@ package body Sem_Ch5 is
if Present (Cond) then
if Nkind (Parent (N)) /= N_Loop_Statement then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction
("exit with when clause must be directly in loop", N);
end if;
else
if Nkind (Parent (N)) /= N_If_Statement then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
if Nkind (Parent (N)) = N_Elsif_Part then
Check_SPARK_Restriction
("exit must be in IF without ELSIF", N);
......@@ -1258,7 +1258,7 @@ package body Sem_Ch5 is
end if;
elsif Nkind (Parent (Parent (N))) /= N_Loop_Statement then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction
("exit must be in IF directly in loop", N);
......@@ -1266,14 +1266,14 @@ package body Sem_Ch5 is
-- leads to an error mentioning the ELSE.
elsif Present (Else_Statements (Parent (N))) then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("exit must be in IF without ELSE", N);
-- An exit in an ELSIF does not reach here, as it would have been
-- detected in the case (Nkind (Parent (N)) /= N_If_Statement).
elsif Present (Elsif_Parts (Parent (N))) then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("exit must be in IF without ELSIF", N);
end if;
end if;
......@@ -1302,7 +1302,7 @@ package body Sem_Ch5 is
Label_Ent : Entity_Id;
begin
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("goto statement is not allowed", N);
-- Actual semantic checks
......
gcc/ada/sem_ch6.adb
......@@ -638,13 +638,13 @@ package body Sem_Ch6 is
(Nkind (Parent (Parent (N))) /= N_Subprogram_Body
or else Present (Next (N)))
then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction
("RETURN should be the last statement in function", N);
end if;
else
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("extended RETURN is not allowed", N);
-- Analyze parts specific to extended_return_statement:
......
gcc/ada/sem_ch9.adb
......@@ -101,7 +101,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("abort statement is not allowed", N);
T_Name := First (Names (N));
......@@ -140,7 +140,7 @@ package body Sem_Ch9 is
procedure Analyze_Accept_Alternative (N : Node_Id) is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
if Present (Pragmas_Before (N)) then
Analyze_List (Pragmas_Before (N));
......@@ -174,7 +174,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("accept statement is not allowed", N);
-- Entry name is initialized to Any_Id. It should get reset to the
......@@ -406,7 +406,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("select statement is not allowed", N);
Check_Restriction (Max_Asynchronous_Select_Nesting, N);
Check_Restriction (No_Select_Statements, N);
......@@ -453,7 +453,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("select statement is not allowed", N);
Check_Restriction (No_Select_Statements, N);
......@@ -500,7 +500,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_Restriction (No_Delay, N);
if Present (Pragmas_Before (N)) then
......@@ -552,7 +552,7 @@ package body Sem_Ch9 is
E : constant Node_Id := Expression (N);
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("delay statement is not allowed", N);
Check_Restriction (No_Relative_Delay, N);
Check_Restriction (No_Delay, N);
......@@ -571,7 +571,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("delay statement is not allowed", N);
Check_Restriction (No_Delay, N);
Check_Potentially_Blocking_Operation (N);
......@@ -600,7 +600,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
-- Entry_Name is initialized to Any_Id. It should get reset to the
-- matching entry entity. An error is signalled if it is not reset
......@@ -833,7 +833,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
if Present (Index) then
Analyze (Index);
......@@ -861,7 +861,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("entry call is not allowed", N);
if Present (Pragmas_Before (N)) then
......@@ -897,7 +897,7 @@ package body Sem_Ch9 is
begin
Generate_Definition (Def_Id);
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
-- Case of no discrete subtype definition
......@@ -967,7 +967,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Analyze (Def);
-- There is no elaboration of the entry index specification. Therefore,
......@@ -1009,7 +1009,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Set_Ekind (Body_Id, E_Protected_Body);
Spec_Id := Find_Concurrent_Spec (Body_Id);
......@@ -1128,7 +1128,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("protected definition is not allowed", N);
Analyze_Declarations (Visible_Declarations (N));
......@@ -1182,7 +1182,7 @@ package body Sem_Ch9 is
end if;
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_Restriction (No_Protected_Types, N);
T := Find_Type_Name (N);
......@@ -1324,7 +1324,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("requeue statement is not allowed", N);
Check_Restriction (No_Requeue_Statements, N);
Check_Unreachable_Code (N);
......@@ -1599,7 +1599,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("select statement is not allowed", N);
Check_Restriction (No_Select_Statements, N);
......@@ -1720,7 +1720,7 @@ package body Sem_Ch9 is
begin
Generate_Definition (Id);
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
-- The node is rewritten as a protected type declaration, in exact
-- analogy with what is done with single tasks.
......@@ -1782,7 +1782,7 @@ package body Sem_Ch9 is
begin
Generate_Definition (Id);
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
-- The node is rewritten as a task type declaration, followed by an
-- object declaration of that anonymous task type.
......@@ -1860,7 +1860,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Set_Ekind (Body_Id, E_Task_Body);
Set_Scope (Body_Id, Current_Scope);
Spec_Id := Find_Concurrent_Spec (Body_Id);
......@@ -1981,7 +1981,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("task definition is not allowed", N);
if Present (Visible_Declarations (N)) then
......@@ -2016,7 +2016,7 @@ package body Sem_Ch9 is
begin
Check_Restriction (No_Tasking, N);
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
T := Find_Type_Name (N);
Generate_Definition (T);
......@@ -2122,7 +2122,7 @@ package body Sem_Ch9 is
procedure Analyze_Terminate_Alternative (N : Node_Id) is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
if Present (Pragmas_Before (N)) then
Analyze_List (Pragmas_Before (N));
......@@ -2144,7 +2144,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction ("select statement is not allowed", N);
Check_Restriction (No_Select_Statements, N);
......@@ -2181,7 +2181,7 @@ package body Sem_Ch9 is
begin
Tasking_Used := True;
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
if Present (Pragmas_Before (N)) then
Analyze_List (Pragmas_Before (N));
......
gcc/ada/sem_res.adb
......@@ -5964,12 +5964,12 @@ package body Sem_Res is
-- types or array types except String.
if Is_Boolean_Type (T) then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
Check_SPARK_Restriction
("comparison is not defined on Boolean type", N);
elsif Is_Array_Type (T) then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
if Base_Type (T) /= Standard_String then
Check_SPARK_Restriction
......@@ -6828,7 +6828,7 @@ package body Sem_Res is
-- operands have equal static bounds.
if Is_Array_Type (T) then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
-- Protect call to Matching_Static_Array_Bounds to avoid costly
-- operation if not needed.
......@@ -7378,7 +7378,7 @@ package body Sem_Res is
if Is_Array_Type (B_Typ)
and then Nkind (N) in N_Binary_Op
then
Current_Subprogram_Body_Is_Not_In_ALFA;
Mark_Non_ALFA_Subprogram_Body;
declare
Left_Typ : constant Node_Id := Etype (Left_Opnd (N));
......
gcc/ada/sem_util.adb
......@@ -2311,20 +2311,36 @@ package body Sem_Util is
end if;
end Current_Subprogram;
--------------------------------------------
-- Current_Subprogram_Body_Is_Not_In_ALFA --
--------------------------------------------
-----------------------------------
-- Mark_Non_ALFA_Subprogram_Body --
-----------------------------------
procedure Mark_Non_ALFA_Subprogram_Body is
procedure Unconditional_Mark;
-- Isolate marking of the current subprogram body so that the body of
-- Mark_Non_ALFA_Subprogram_Body is small and inlined.
------------------------
-- Unconditional_Mark --
------------------------
procedure Unconditional_Mark is
Cur_Subp : constant Entity_Id := Current_Subprogram;
begin
if Present (Cur_Subp)
and then (Is_Subprogram (Cur_Subp)
or else Is_Generic_Subprogram (Cur_Subp))
then
Set_Body_Is_In_ALFA (Cur_Subp, False);
end if;
end Unconditional_Mark;
procedure Current_Subprogram_Body_Is_Not_In_ALFA is
Cur_Subp : constant Entity_Id := Current_Subprogram;
begin
if Present (Cur_Subp)
and then (Is_Subprogram (Cur_Subp)
or else Is_Generic_Subprogram (Cur_Subp))
then
Set_Body_Is_In_ALFA (Cur_Subp, False);
if ALFA_Mode then
Unconditional_Mark;
end if;
end Current_Subprogram_Body_Is_Not_In_ALFA;
end Mark_Non_ALFA_Subprogram_Body;
---------------------
-- Defining_Entity --
......
gcc/ada/sem_util.ads
......@@ -277,7 +277,7 @@ package Sem_Util is
-- Current_Scope is returned. The returned value is Empty if this is called
-- from a library package which is not within any subprogram.
procedure Current_Subprogram_Body_Is_Not_In_ALFA;
procedure Mark_Non_ALFA_Subprogram_Body;
-- If Current_Subprogram is not Empty, set its flag Body_Is_In_ALFA to
-- False, otherwise do nothing.
......
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