+2011-08-30 Yannick Moy <moy@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)
+
+2011-08-30 Tristan Gingold <gingold@adacore.com>
+
+ * s-parame-vms-alpha.ads, s-parame-hpux.ads, s-tassta.adb,
+ s-tarest.adb, s-parame-vms-ia64.ads, s-soflin.adb, s-secsta.adb,
+ s-secsta.ads, s-parame.ads, s-parame-vxworks.ads: Renames Ratio to
+ Percentage, and Sec_Stack_Ratio to Sec_Stack_Percentage.
+
2011-08-30 Gary Dismukes <dismukes@adacore.com>
* sem_res.adb (Valid_Conversion): Revise test for implicit anonymous
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;
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,
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.
-- 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);
-- 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);
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;
-- 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.
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);
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
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),
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
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.
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;
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;
-- 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;
-- 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);
-- 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:
-- 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).
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.
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.
-- Expand_Dispatching_Call is called directly from the semantics,
-- so we only proceed if the expander is active.
- if not Expander_Active
-
- -- And this expansion is not required in special ALFA mode expansion
-
- or else ALFA_Mode
+ if not Full_Expander_Active
-- And there is no need to expand the call if we are compiling under
-- restriction No_Dispatching_Calls; the semantic analyzer has
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 --
----------------------------------
-- 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 --
-----------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set
- subtype Ratio is Size_Type range -1 .. 100;
+ subtype Percentage is Size_Type range -1 .. 100;
Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is
-- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead.
- Sec_Stack_Ratio : constant Ratio := Dynamic;
+ Sec_Stack_Percentage : constant Percentage := Dynamic;
-- This constant defines the handling of the secondary stack
- Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Ratio = Dynamic;
+ Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic;
-- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set
- subtype Ratio is Size_Type range -1 .. 100;
+ subtype Percentage is Size_Type range -1 .. 100;
Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is
-- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead.
- Sec_Stack_Ratio : constant Ratio := Dynamic;
+ Sec_Stack_Percentage : constant Percentage := Dynamic;
-- This constant defines the handling of the secondary stack
- Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Ratio = Dynamic;
+ Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic;
-- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set
- subtype Ratio is Size_Type range -1 .. 100;
+ subtype Percentage is Size_Type range -1 .. 100;
Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is
-- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead.
- Sec_Stack_Ratio : constant Ratio := Dynamic;
+ Sec_Stack_Percentage : constant Percentage := Dynamic;
-- This constant defines the handling of the secondary stack
- Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Ratio = Dynamic;
+ Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic;
-- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set
- subtype Ratio is Size_Type range -1 .. 100;
+ subtype Percentage is Size_Type range -1 .. 100;
Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is
-- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead.
- Sec_Stack_Ratio : constant Ratio := Dynamic;
+ Sec_Stack_Percentage : constant Percentage := Dynamic;
-- This constant defines the handling of the secondary stack
- Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Ratio = Dynamic;
+ Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic;
-- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set
- subtype Ratio is Size_Type range -1 .. 100;
+ subtype Percentage is Size_Type range -1 .. 100;
Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is
-- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead.
- Sec_Stack_Ratio : constant Ratio := Dynamic;
+ Sec_Stack_Percentage : constant Percentage := Dynamic;
-- This constant defines the handling of the secondary stack
- Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Ratio = Dynamic;
+ Sec_Stack_Dynamic : constant Boolean := Sec_Stack_Percentage = Dynamic;
-- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
use type System.Parameters.Size_Type;
SS_Ratio_Dynamic : constant Boolean :=
- Parameters.Sec_Stack_Ratio = Parameters.Dynamic;
+ Parameters.Sec_Stack_Percentage = Parameters.Dynamic;
-- There are two entirely different implementations of the secondary
-- stack mechanism in this unit, and this Boolean is used to select
-- between them (at compile time, so the generated code will contain
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Size : Natural := Default_Secondary_Stack_Size);
-- Initialize the secondary stack with a main stack of the given Size.
--
- -- If System.Parameters.Sec_Stack_Ratio equals Dynamic, Stk is really an
- -- OUT parameter that will be allocated on the heap. Then all further
+ -- If System.Parameters.Sec_Stack_Percentage equals Dynamic, Stk is really
+ -- an OUT parameter that will be allocated on the heap. Then all further
-- allocations which do not overflow the main stack will not generate
-- dynamic (de)allocation calls. If the main Stack overflows, a new
-- chuck of at least the same size will be allocated and linked to the
-- previous chunk.
--
- -- Otherwise (Sec_Stack_Ratio between 0 and 100), Stk is an IN parameter
- -- that is already pointing to a Stack_Id. The secondary stack in this case
- -- is fixed, and any attempt to allocate more than the initial size will
- -- result in a Storage_Error being raised.
+ -- Otherwise (Sec_Stack_Percentage between 0 and 100), Stk is an IN
+ -- parameter that is already pointing to a Stack_Id. The secondary stack
+ -- in this case is fixed, and any attempt to allocate more than the initial
+ -- size will result in a Storage_Error being raised.
--
-- Note: the reason that Stk is passed is that SS_Init is called before
-- the proper interface is established to obtain the address of the
use type Parameters.Size_Type;
SS_Ratio_Dynamic : constant Boolean :=
- Parameters.Sec_Stack_Ratio = Parameters.Dynamic;
+ Parameters.Sec_Stack_Percentage = Parameters.Dynamic;
begin
if SS_Ratio_Dynamic then
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2011, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Secondary_Stack : aliased SSE.Storage_Array
(1 .. Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size *
- SSE.Storage_Offset (Parameters.Sec_Stack_Ratio) / 100);
+ SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100);
pragma Warnings (Off);
Secondary_Stack_Address : System.Address := Secondary_Stack'Address;
Secondary_Stack_Size :
constant SSE.Storage_Offset :=
Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size *
- SSE.Storage_Offset (Parameters.Sec_Stack_Ratio) / 100;
+ SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100;
Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size);
-- 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 =>
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
-- 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)
-- 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);
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));
-- 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
-- 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);
-- 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);
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);
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)
-- 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;
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
-- 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);
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
projects / thirdparty / gcc.git / commitdiff
