From patchwork Tue Aug 30 14:09:59 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 112320 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id EB353B6F87 for ; Wed, 31 Aug 2011 00:10:24 +1000 (EST) Received: (qmail 29812 invoked by alias); 30 Aug 2011 14:10:21 -0000 Received: (qmail 29796 invoked by uid 22791); 30 Aug 2011 14:10:18 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00,TW_KN X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 30 Aug 2011 14:10:00 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 0067E2BAF51; Tue, 30 Aug 2011 10:10:00 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id MZA6FeGE5dus; Tue, 30 Aug 2011 10:09:59 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id CF7882BAF42; Tue, 30 Aug 2011 10:09:59 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id C58EB3FEE8; Tue, 30 Aug 2011 10:09:59 -0400 (EDT) Date: Tue, 30 Aug 2011 10:09:59 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Yannick Moy Subject: [Ada] Define full expansion "flag" to distinguish from reduced Alfa expansion Message-ID: <20110830140959.GA28243@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * 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 -- -----------------------