From: Yannick Moy Date: Tue, 2 Aug 2011 15:28:12 +0000 (+0000) Subject: sem_ch3.adb, [...]: Protect call to Current_Subprogram which might be costly when... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=83f331504ee98ff8a88d47bb91ea0feafd3f97b2;p=gcc.git sem_ch3.adb, [...]: Protect call to Current_Subprogram which might be costly when repeated. 2011-08-02 Yannick Moy * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b60f8713792..99cf2c347e1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2011-08-02 Yannick Moy + + * 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 * sem_res.adb: Protect calls to Matching_Static_Array_Bounds which diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 73926faa4bb..4f241127250 100644 --- a/gcc/ada/sem_ch11.adb +++ b/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 diff --git a/gcc/ada/sem_ch2.adb b/gcc/ada/sem_ch2.adb index 2a021d2d787..38003e22262 100644 --- a/gcc/ada/sem_ch2.adb +++ b/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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0f585a8d098..dfde2ed07a4 100644 --- a/gcc/ada/sem_ch3.adb +++ b/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 diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 7fd0d9b04df..47a43dd4401 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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))); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index d0d34431855..5370f701a8a 100644 --- a/gcc/ada/sem_ch5.adb +++ b/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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 1c0a3d96393..d02ac62324c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/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: diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 4392949dcbb..2a2c6c55223 100644 --- a/gcc/ada/sem_ch9.adb +++ b/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)); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 893faf37271..faf20d637f4 100644 --- a/gcc/ada/sem_res.adb +++ b/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)); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index a0a0e28397b..f6fa724e570 100644 --- a/gcc/ada/sem_util.adb +++ b/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 -- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 9fcd6c1dcff..c533b1d054f 100644 --- a/gcc/ada/sem_util.ads +++ b/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.