Minor refactoring to clarify where full expansion applies wrt Alfa mode.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-30 Yannick Moy <m...@adacore.com>
* opt.adb, opt.ads (Full_Expander_Active): New function defines a
common shorthand for (Expander_Active and not ALFA_Mode) that can be
used for testing full expansion, that is active expansion not in the
reduced mode for Alfa
* exp_ch4.adb, exp_ch9.adb, exp_disp.adb, sem_ch10.adb, sem_ch12.adb,
sem_ch6.adb, sem_ch9.adb, sem_res.adb: Use newly defined "flag" instead
of the verbose (Expander_Active and not ALFA_Mode)
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 178310)
+++ exp_ch9.adb (working copy)
@@ -4904,9 +4904,7 @@
Ldecl2 : Node_Id;
begin
- if Expander_Active
- and then not ALFA_Mode
- then
+ if Full_Expander_Active then
-- If we have no handled statement sequence, we may need to build
-- a dummy sequence consisting of a null statement. This can be
-- skipped if the trivial accept optimization is permitted.
@@ -5227,9 +5225,7 @@
-- barrier just as a protected function, and discard the protected
-- version of it because it is never called.
- if Expander_Active
- and then not ALFA_Mode
- then
+ if Full_Expander_Active then
B_F := Build_Barrier_Function (N, Ent, Prot);
Func := Barrier_Function (Ent);
Set_Corresponding_Spec (B_F, Func);
@@ -5267,8 +5263,7 @@
-- condition does not reference any of the generated renamings
-- within the function.
- if Expander_Active
- and then not ALFA_Mode
+ if Full_Expander_Active
and then Scope (Entity (Cond)) /= Func
then
Set_Declarations (B_F, Empty_List);
@@ -5320,12 +5315,6 @@
Tasknm : Node_Id;
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
Aggr := Make_Aggregate (Loc, Component_Associations => New_List);
Count := 0;
@@ -5457,12 +5446,6 @@
-- Start of processing for Expand_N_Accept_Statement
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
-- If accept statement is not part of a list, then its parent must be
-- an accept alternative, and, as described above, we do not do any
-- expansion for such accept statements at this level.
@@ -5913,12 +5896,6 @@
T : Entity_Id; -- Additional status flag
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
Process_Statements_For_Controlled_Objects (Trig);
Process_Statements_For_Controlled_Objects (Abrt);
@@ -6868,12 +6845,6 @@
S : Entity_Id; -- Primitive operation slot
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
Process_Statements_For_Controlled_Objects (N);
if Ada_Version >= Ada_2005
@@ -7190,12 +7161,6 @@
procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RO_CA_Delay_For), Loc),
@@ -7215,12 +7180,6 @@
Typ : Entity_Id;
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
if Is_RTE (Base_Type (Etype (Expression (N))), RO_CA_Time) then
Typ := RTE (RO_CA_Delay_Until);
else
@@ -7241,12 +7200,6 @@
procedure Expand_N_Entry_Body (N : Node_Id) is
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
-- Associate discriminals with the next protected operation body to be
-- expanded.
@@ -7268,12 +7221,6 @@
Index : Node_Id;
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
if No_Run_Time_Mode then
Error_Msg_CRT ("entry call", N);
return;
@@ -7330,12 +7277,6 @@
Acc_Ent : Entity_Id;
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
Formal := First_Formal (Entry_Ent);
Last_Decl := N;
@@ -7604,12 +7545,6 @@
-- Start of processing for Expand_N_Protected_Body
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
if No_Run_Time_Mode then
Error_Msg_CRT ("protected body", N);
return;
@@ -9162,12 +9097,6 @@
-- Start of processing for Expand_N_Requeue_Statement
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
-- Extract the components of the entry call
Extract_Entry (N, Concval, Ename, Index);
@@ -9754,12 +9683,6 @@
-- Start of processing for Expand_N_Selective_Accept
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
Process_Statements_For_Controlled_Objects (N);
-- First insert some declarations before the select. The first is:
@@ -10390,12 +10313,6 @@
-- Used to determine the proper location of wrapper body insertions
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
-- Add renaming declarations for discriminals and a declaration for the
-- entry family index (if applicable).
@@ -11142,12 +11059,6 @@
S : Entity_Id; -- Primitive operation slot
begin
- -- Do not expand tasking constructs in formal verification mode
-
- if ALFA_Mode then
- return;
- end if;
-
-- Under the Ravenscar profile, timed entry calls are excluded. An error
-- was already reported on spec, so do not attempt to expand the call.
@@ -11592,9 +11503,7 @@
Error_Msg_CRT ("protected body", N);
return;
- elsif Expander_Active
- and then not ALFA_Mode
- then
+ elsif Full_Expander_Active then
-- Associate discriminals with the first subprogram or entry body to
-- be expanded.
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb (revision 178310)
+++ sem_ch9.adb (working copy)
@@ -727,8 +727,7 @@
-- for the discriminals and privals and finally a declaration for the
-- entry family index (if applicable).
- if Expander_Active
- and then not ALFA_Mode
+ if Full_Expander_Active
and then Is_Protected_Type (P_Type)
then
Install_Private_Data_Declarations
@@ -1283,11 +1282,7 @@
-- Also skip if expander is not active
- and then Expander_Active
-
- -- Also skip if in ALFA mode, this expansion is not needed
-
- and then not ALFA_Mode
+ and then Full_Expander_Active
then
Expand_N_Protected_Type_Declaration (N);
Process_Full_View (N, T, Def_Id);
@@ -2094,10 +2089,7 @@
-- Also skip if expander is not active
- and then Expander_Active
-
- -- Or if in ALFA mode, this expansion is not needed
- and then not ALFA_Mode
+ and then Full_Expander_Active
then
Expand_N_Task_Type_Declaration (N);
Process_Full_View (N, T, Def_Id);
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 178293)
+++ sem_ch10.adb (working copy)
@@ -2289,7 +2289,7 @@
-- expansion is active, because the context may be generic and the
-- flag not defined yet.
- if Expander_Active then
+ if Full_Expander_Active then
Insert_After (N,
Make_Assignment_Statement (Loc,
Name =>
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb (revision 178308)
+++ sem_ch12.adb (working copy)
@@ -4050,11 +4050,10 @@
if (Is_In_Main_Unit (N)
or else Is_Inlined (Subp)
or else Is_Inlined (Alias (Subp)))
- and then not ALFA_Mode
and then (Operating_Mode = Generate_Code
or else (Operating_Mode = Check_Semantics
and then ASIS_Mode))
- and then (Expander_Active or else ASIS_Mode)
+ and then (Full_Expander_Active or else ASIS_Mode)
and then not ABE_Is_Certain (N)
and then not Is_Eliminated (Subp)
then
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 178310)
+++ sem_res.adb (working copy)
@@ -3442,8 +3442,7 @@
elsif Nkind (A) = N_Function_Call
and then Is_Limited_Record (Etype (F))
and then not Is_Constrained (Etype (F))
- and then Expander_Active
- and then not ALFA_Mode
+ and then Full_Expander_Active
and then (Is_Controlled (Etype (F)) or else Has_Task (Etype (F)))
then
Establish_Transient_Scope (A, False);
@@ -3458,8 +3457,7 @@
elsif Nkind (A) = N_Op_Concat
and then Nkind (N) = N_Procedure_Call_Statement
- and then Expander_Active
- and then not ALFA_Mode
+ and then Full_Expander_Active
and then
not (Is_Intrinsic_Subprogram (Nam)
and then Chars (Nam) = Name_Asm)
@@ -3522,8 +3520,7 @@
-- be removed in the expansion of the wrapped construct.
if (Is_Controlled (DDT) or else Has_Task (DDT))
- and then Expander_Active
- and then not ALFA_Mode
+ and then Full_Expander_Active
then
Establish_Transient_Scope (A, False);
end if;
@@ -5494,8 +5491,7 @@
then
null;
- elsif Expander_Active
- and then not ALFA_Mode
+ elsif Full_Expander_Active
and then Is_Type (Etype (Nam))
and then Requires_Transient_Scope (Etype (Nam))
and then
@@ -6616,8 +6612,7 @@
-- Protected functions can return on the secondary stack, in which
-- case we must trigger the transient scope mechanism.
- elsif Expander_Active
- and then not ALFA_Mode
+ elsif Full_Expander_Active
and then Requires_Transient_Scope (Etype (Nam))
then
Establish_Transient_Scope (N, Sec_Stack => True);
@@ -8088,8 +8083,6 @@
procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
begin
- -- Normal mode (not ALFA)
-
if not ALFA_Mode then
-- The loop structure is already resolved during its analysis, only
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 178303)
+++ exp_ch4.adb (working copy)
@@ -7258,10 +7258,9 @@
end;
end if;
- -- Only array types need any other processing. In formal verification
- -- mode, no other processing is done.
+ -- Only array types need any other processing
- if not Is_Array_Type (Typ) or else ALFA_Mode then
+ if not Is_Array_Type (Typ) then
return;
end if;
@@ -7717,13 +7716,6 @@
Test : Node_Id;
begin
- -- Do not expand quantified expressions in ALFA mode
- -- why not???
-
- if ALFA_Mode then
- return;
- end if;
-
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Tnn,
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 178310)
+++ sem_ch6.adb (working copy)
@@ -2709,8 +2709,7 @@
-- when the Expander is active because Install_Private_Data_Declarations
-- references entities which were created during regular expansion.
- if Expander_Active
- and then not ALFA_Mode
+ if Full_Expander_Active
and then Comes_From_Source (N)
and then Present (Prot_Typ)
and then Present (Spec_Id)
@@ -9787,10 +9786,9 @@
-- If expansion is active, the formal is replaced by a local
-- variable that renames the corresponding entry of the
-- parameter block, and it is this local variable that may
- -- require an actual subtype. In ALFA mode, expansion of accept
- -- statements is skipped.
+ -- require an actual subtype.
- if Expander_Active and not ALFA_Mode then
+ if Full_Expander_Active then
Decl := Build_Actual_Subtype (T, Renamed_Object (Formal));
else
Decl := Build_Actual_Subtype (T, Formal);
@@ -9829,8 +9827,7 @@
end if;
if Nkind (N) = N_Accept_Statement
- and then Expander_Active
- and then not ALFA_Mode
+ and then Full_Expander_Active
then
Set_Actual_Subtype (Renamed_Object (Formal),
Defining_Identifier (Decl));
Index: exp_disp.adb
===================================================================
--- exp_disp.adb (revision 178310)
+++ exp_disp.adb (working copy)
@@ -697,12 +697,8 @@
-- Expand_Dispatching_Call is called directly from the semantics,
-- so we only proceed if the expander is active.
- if not Expander_Active
+ if not Full_Expander_Active
- -- And this expansion is not required in special ALFA mode expansion
-
- or else ALFA_Mode
-
-- And there is no need to expand the call if we are compiling under
-- restriction No_Dispatching_Calls; the semantic analyzer has
-- previously notified the violation of this restriction.
Index: opt.adb
===================================================================
--- opt.adb (revision 178293)
+++ opt.adb (working copy)
@@ -38,6 +38,15 @@
SU : constant := Storage_Unit;
-- Shorthand for System.Storage_Unit
+ --------------------------
+ -- Full_Expander_Active --
+ --------------------------
+
+ function Full_Expander_Active return Boolean is
+ begin
+ return Expander_Active and not ALFA_Mode;
+ end Full_Expander_Active;
+
----------------------------------
-- Register_Opt_Config_Switches --
----------------------------------
Index: opt.ads
===================================================================
--- opt.ads (revision 178293)
+++ opt.ads (working copy)
@@ -1832,6 +1832,14 @@
-- behavior can be disabled using switch -gnatd.t which will set this flag
-- to False and revert to the previous dynamic behavior.
+ function Full_Expander_Active return Boolean;
+ -- Returns the value of (Expander_Active and not ALFA_Mode). This "flag"
+ -- indicates that expansion is fully active, that is, not in the reduced
+ -- mode for Alfa (True) or that expansion is either deactivated, or active
+ -- in the reduced mode for Alfa (False). For more information on full
+ -- expansion, see package Expander. For more information on reduced
+ -- Alfa expansion, see package Exp_Alfa.
+
-----------------------
-- Tree I/O Routines --
-----------------------
