OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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.

From-SVN: r178313
This commit is contained in:
Arnaud Charlet 2011-08-30 16:06:25 +02:00
parent 315f5f1bfb
commit da94696d33
21 changed files with 88 additions and 176 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/ada/ChangeLog
View File

@ -1,3 +1,20 @@
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> 2011-08-30 Gary Dismukes <dismukes@adacore.com>
* sem_res.adb (Valid_Conversion): Revise test for implicit anonymous * sem_res.adb (Valid_Conversion): Revise test for implicit anonymous

12
gcc/ada/exp_ch4.adb
View File

@ -7258,10 +7258,9 @@ package body Exp_Ch4 is
end; end;
end if; end if;
-- Only array types need any other processing. In formal verification -- Only array types need any other processing
-- mode, no other processing is done.
if not Is_Array_Type (Typ) or else ALFA_Mode then if not Is_Array_Type (Typ) then
return; return;
end if; end if;
@ -7717,13 +7716,6 @@ package body Exp_Ch4 is
Test : Node_Id; Test : Node_Id;
begin begin
-- Do not expand quantified expressions in ALFA mode
-- why not???
if ALFA_Mode then
return;
end if;
Decl := Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Tnn, Defining_Identifier => Tnn,

99
gcc/ada/exp_ch9.adb
View File

@ -4904,9 +4904,7 @@ package body Exp_Ch9 is
Ldecl2 : Node_Id; Ldecl2 : Node_Id;
begin begin
if Expander_Active if Full_Expander_Active then
and then not ALFA_Mode
then
-- If we have no handled statement sequence, we may need to build -- If we have no handled statement sequence, we may need to build
-- a dummy sequence consisting of a null statement. This can be -- a dummy sequence consisting of a null statement. This can be
-- skipped if the trivial accept optimization is permitted. -- skipped if the trivial accept optimization is permitted.
@ -5227,9 +5225,7 @@ package body Exp_Ch9 is
-- barrier just as a protected function, and discard the protected -- barrier just as a protected function, and discard the protected
-- version of it because it is never called. -- version of it because it is never called.
if Expander_Active if Full_Expander_Active then
and then not ALFA_Mode
then
B_F := Build_Barrier_Function (N, Ent, Prot); B_F := Build_Barrier_Function (N, Ent, Prot);
Func := Barrier_Function (Ent); Func := Barrier_Function (Ent);
Set_Corresponding_Spec (B_F, Func); Set_Corresponding_Spec (B_F, Func);
@ -5267,8 +5263,7 @@ package body Exp_Ch9 is
-- condition does not reference any of the generated renamings -- condition does not reference any of the generated renamings
-- within the function. -- within the function.
if Expander_Active if Full_Expander_Active
and then not ALFA_Mode
and then Scope (Entity (Cond)) /= Func and then Scope (Entity (Cond)) /= Func
then then
Set_Declarations (B_F, Empty_List); Set_Declarations (B_F, Empty_List);
@ -5320,12 +5315,6 @@ package body Exp_Ch9 is
Tasknm : Node_Id; Tasknm : Node_Id;
begin 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); Aggr := Make_Aggregate (Loc, Component_Associations => New_List);
Count := 0; Count := 0;
@ -5457,12 +5446,6 @@ package body Exp_Ch9 is
-- Start of processing for Expand_N_Accept_Statement -- Start of processing for Expand_N_Accept_Statement
begin 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 -- 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 -- an accept alternative, and, as described above, we do not do any
-- expansion for such accept statements at this level. -- expansion for such accept statements at this level.
@ -5913,12 +5896,6 @@ package body Exp_Ch9 is
T : Entity_Id; -- Additional status flag T : Entity_Id; -- Additional status flag
begin 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 (Trig);
Process_Statements_For_Controlled_Objects (Abrt); Process_Statements_For_Controlled_Objects (Abrt);
@ -6868,12 +6845,6 @@ package body Exp_Ch9 is
S : Entity_Id; -- Primitive operation slot S : Entity_Id; -- Primitive operation slot
begin begin
-- Do not expand tasking constructs in formal verification mode
if ALFA_Mode then
return;
end if;
Process_Statements_For_Controlled_Objects (N); Process_Statements_For_Controlled_Objects (N);
if Ada_Version >= Ada_2005 if Ada_Version >= Ada_2005
@ -7190,12 +7161,6 @@ package body Exp_Ch9 is
procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
begin begin
-- Do not expand tasking constructs in formal verification mode
if ALFA_Mode then
return;
end if;
Rewrite (N, Rewrite (N,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (RTE (RO_CA_Delay_For), Loc), Name => New_Reference_To (RTE (RO_CA_Delay_For), Loc),
@ -7215,12 +7180,6 @@ package body Exp_Ch9 is
Typ : Entity_Id; Typ : Entity_Id;
begin 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 if Is_RTE (Base_Type (Etype (Expression (N))), RO_CA_Time) then
Typ := RTE (RO_CA_Delay_Until); Typ := RTE (RO_CA_Delay_Until);
else else
@ -7241,12 +7200,6 @@ package body Exp_Ch9 is
procedure Expand_N_Entry_Body (N : Node_Id) is procedure Expand_N_Entry_Body (N : Node_Id) is
begin 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 -- Associate discriminals with the next protected operation body to be
-- expanded. -- expanded.
@ -7268,12 +7221,6 @@ package body Exp_Ch9 is
Index : Node_Id; Index : Node_Id;
begin begin
-- Do not expand tasking constructs in formal verification mode
if ALFA_Mode then
return;
end if;
if No_Run_Time_Mode then if No_Run_Time_Mode then
Error_Msg_CRT ("entry call", N); Error_Msg_CRT ("entry call", N);
return; return;
@ -7330,12 +7277,6 @@ package body Exp_Ch9 is
Acc_Ent : Entity_Id; Acc_Ent : Entity_Id;
begin begin
-- Do not expand tasking constructs in formal verification mode
if ALFA_Mode then
return;
end if;
Formal := First_Formal (Entry_Ent); Formal := First_Formal (Entry_Ent);
Last_Decl := N; Last_Decl := N;
@ -7604,12 +7545,6 @@ package body Exp_Ch9 is
-- Start of processing for Expand_N_Protected_Body -- Start of processing for Expand_N_Protected_Body
begin begin
-- Do not expand tasking constructs in formal verification mode
if ALFA_Mode then
return;
end if;
if No_Run_Time_Mode then if No_Run_Time_Mode then
Error_Msg_CRT ("protected body", N); Error_Msg_CRT ("protected body", N);
return; return;
@ -9162,12 +9097,6 @@ package body Exp_Ch9 is
-- Start of processing for Expand_N_Requeue_Statement -- Start of processing for Expand_N_Requeue_Statement
begin 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 the components of the entry call
Extract_Entry (N, Concval, Ename, Index); Extract_Entry (N, Concval, Ename, Index);
@ -9754,12 +9683,6 @@ package body Exp_Ch9 is
-- Start of processing for Expand_N_Selective_Accept -- Start of processing for Expand_N_Selective_Accept
begin begin
-- Do not expand tasking constructs in formal verification mode
if ALFA_Mode then
return;
end if;
Process_Statements_For_Controlled_Objects (N); Process_Statements_For_Controlled_Objects (N);
-- First insert some declarations before the select. The first is: -- First insert some declarations before the select. The first is:
@ -10390,12 +10313,6 @@ package body Exp_Ch9 is
-- Used to determine the proper location of wrapper body insertions -- Used to determine the proper location of wrapper body insertions
begin 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 -- Add renaming declarations for discriminals and a declaration for the
-- entry family index (if applicable). -- entry family index (if applicable).
@ -11142,12 +11059,6 @@ package body Exp_Ch9 is
S : Entity_Id; -- Primitive operation slot S : Entity_Id; -- Primitive operation slot
begin 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 -- Under the Ravenscar profile, timed entry calls are excluded. An error
-- was already reported on spec, so do not attempt to expand the call. -- was already reported on spec, so do not attempt to expand the call.
@ -11592,9 +11503,7 @@ package body Exp_Ch9 is
Error_Msg_CRT ("protected body", N); Error_Msg_CRT ("protected body", N);
return; return;
elsif Expander_Active elsif Full_Expander_Active then
and then not ALFA_Mode
then
-- Associate discriminals with the first subprogram or entry body to -- Associate discriminals with the first subprogram or entry body to
-- be expanded. -- be expanded.

6
gcc/ada/exp_disp.adb
View File

@ -697,11 +697,7 @@ package body Exp_Disp is
-- Expand_Dispatching_Call is called directly from the semantics, -- Expand_Dispatching_Call is called directly from the semantics,
-- so we only proceed if the expander is active. -- 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 -- And there is no need to expand the call if we are compiling under
-- restriction No_Dispatching_Calls; the semantic analyzer has -- restriction No_Dispatching_Calls; the semantic analyzer has

9
gcc/ada/opt.adb
View File

@ -38,6 +38,15 @@ package body Opt is
SU : constant := Storage_Unit; SU : constant := Storage_Unit;
-- Shorthand for System.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 -- -- Register_Opt_Config_Switches --
---------------------------------- ----------------------------------

8
gcc/ada/opt.ads
View File

@ -1832,6 +1832,14 @@ package Opt is
-- behavior can be disabled using switch -gnatd.t which will set this flag -- behavior can be disabled using switch -gnatd.t which will set this flag
-- to False and revert to the previous dynamic behavior. -- 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 -- -- Tree I/O Routines --
----------------------- -----------------------

8
gcc/ada/s-parame-hpux.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -62,7 +62,7 @@ package System.Parameters is
Unspecified_Size : constant Size_Type := Size_Type'First; Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set -- 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; Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which -- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is -- determines the percentage of the allocated task stack that is
@ -70,10 +70,10 @@ package System.Parameters is
-- The special value of minus one indicates that the secondary -- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead. -- 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 -- 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 -- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type; function Default_Stack_Size return Size_Type;

8
gcc/ada/s-parame-vms-alpha.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -62,7 +62,7 @@ package System.Parameters is
Unspecified_Size : constant Size_Type := Size_Type'First; Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set -- 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; Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which -- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is -- determines the percentage of the allocated task stack that is
@ -70,10 +70,10 @@ package System.Parameters is
-- The special value of minus one indicates that the secondary -- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead. -- 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 -- 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 -- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type; function Default_Stack_Size return Size_Type;

8
gcc/ada/s-parame-vms-ia64.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -62,7 +62,7 @@ package System.Parameters is
Unspecified_Size : constant Size_Type := Size_Type'First; Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set -- 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; Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which -- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is -- determines the percentage of the allocated task stack that is
@ -70,10 +70,10 @@ package System.Parameters is
-- The special value of minus one indicates that the secondary -- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead. -- 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 -- 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 -- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type; function Default_Stack_Size return Size_Type;

8
gcc/ada/s-parame-vxworks.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -62,7 +62,7 @@ package System.Parameters is
Unspecified_Size : constant Size_Type := Size_Type'First; Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set -- 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; Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which -- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is -- determines the percentage of the allocated task stack that is
@ -70,10 +70,10 @@ package System.Parameters is
-- The special value of minus one indicates that the secondary -- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead. -- 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 -- 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 -- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type; function Default_Stack_Size return Size_Type;

8
gcc/ada/s-parame.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -64,7 +64,7 @@ package System.Parameters is
Unspecified_Size : constant Size_Type := Size_Type'First; Unspecified_Size : constant Size_Type := Size_Type'First;
-- Value used to indicate that no size type is set -- 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; Dynamic : constant Size_Type := -1;
-- The secondary stack ratio is a constant between 0 and 100 which -- The secondary stack ratio is a constant between 0 and 100 which
-- determines the percentage of the allocated task stack that is -- determines the percentage of the allocated task stack that is
@ -72,10 +72,10 @@ package System.Parameters is
-- The special value of minus one indicates that the secondary -- The special value of minus one indicates that the secondary
-- stack is to be allocated from the heap instead. -- 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 -- 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 -- Convenient Boolean for testing for dynamic secondary stack
function Default_Stack_Size return Size_Type; function Default_Stack_Size return Size_Type;

4
gcc/ada/s-secsta.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -44,7 +44,7 @@ package body System.Secondary_Stack is
use type System.Parameters.Size_Type; use type System.Parameters.Size_Type;
SS_Ratio_Dynamic : constant Boolean := 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 -- There are two entirely different implementations of the secondary
-- stack mechanism in this unit, and this Boolean is used to select -- stack mechanism in this unit, and this Boolean is used to select
-- between them (at compile time, so the generated code will contain -- between them (at compile time, so the generated code will contain

14
gcc/ada/s-secsta.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -47,17 +47,17 @@ package System.Secondary_Stack is
Size : Natural := Default_Secondary_Stack_Size); Size : Natural := Default_Secondary_Stack_Size);
-- Initialize the secondary stack with a main stack of the given 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 -- If System.Parameters.Sec_Stack_Percentage equals Dynamic, Stk is really
-- OUT parameter that will be allocated on the heap. Then all further -- an OUT parameter that will be allocated on the heap. Then all further
-- allocations which do not overflow the main stack will not generate -- allocations which do not overflow the main stack will not generate
-- dynamic (de)allocation calls. If the main Stack overflows, a new -- 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 -- chuck of at least the same size will be allocated and linked to the
-- previous chunk. -- previous chunk.
-- --
-- Otherwise (Sec_Stack_Ratio between 0 and 100), Stk is an IN parameter -- Otherwise (Sec_Stack_Percentage between 0 and 100), Stk is an IN
-- that is already pointing to a Stack_Id. The secondary stack in this case -- parameter that is already pointing to a Stack_Id. The secondary stack
-- is fixed, and any attempt to allocate more than the initial size will -- in this case is fixed, and any attempt to allocate more than the initial
-- result in a Storage_Error being raised. -- size will result in a Storage_Error being raised.
-- --
-- Note: the reason that Stk is passed is that SS_Init is called before -- 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 -- the proper interface is established to obtain the address of the

2
gcc/ada/s-soflin.adb
View File

@ -123,7 +123,7 @@ package body System.Soft_Links is
use type Parameters.Size_Type; use type Parameters.Size_Type;
SS_Ratio_Dynamic : constant Boolean := SS_Ratio_Dynamic : constant Boolean :=
Parameters.Sec_Stack_Ratio = Parameters.Dynamic; Parameters.Sec_Stack_Percentage = Parameters.Dynamic;
begin begin
if SS_Ratio_Dynamic then if SS_Ratio_Dynamic then

4
gcc/ada/s-tarest.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -184,7 +184,7 @@ package body System.Tasking.Restricted.Stages is
Secondary_Stack : aliased SSE.Storage_Array Secondary_Stack : aliased SSE.Storage_Array
(1 .. Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size * (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); pragma Warnings (Off);
Secondary_Stack_Address : System.Address := Secondary_Stack'Address; Secondary_Stack_Address : System.Address := Secondary_Stack'Address;

2
gcc/ada/s-tassta.adb
View File

@ -1023,7 +1023,7 @@ package body System.Tasking.Stages is
Secondary_Stack_Size : Secondary_Stack_Size :
constant SSE.Storage_Offset := constant SSE.Storage_Offset :=
Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size * 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); Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size);

2
gcc/ada/sem_ch10.adb
View File

@ -2289,7 +2289,7 @@ package body Sem_Ch10 is
-- expansion is active, because the context may be generic and the -- expansion is active, because the context may be generic and the
-- flag not defined yet. -- flag not defined yet.
if Expander_Active then if Full_Expander_Active then
Insert_After (N, Insert_After (N,
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
Name => Name =>

3
gcc/ada/sem_ch12.adb
View File

@ -4050,11 +4050,10 @@ package body Sem_Ch12 is
if (Is_In_Main_Unit (N) if (Is_In_Main_Unit (N)
or else Is_Inlined (Subp) or else Is_Inlined (Subp)
or else Is_Inlined (Alias (Subp))) or else Is_Inlined (Alias (Subp)))
and then not ALFA_Mode
and then (Operating_Mode = Generate_Code and then (Operating_Mode = Generate_Code
or else (Operating_Mode = Check_Semantics or else (Operating_Mode = Check_Semantics
and then ASIS_Mode)) 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 ABE_Is_Certain (N)
and then not Is_Eliminated (Subp) and then not Is_Eliminated (Subp)
then then

11
gcc/ada/sem_ch6.adb
View File

@ -2709,8 +2709,7 @@ package body Sem_Ch6 is
-- when the Expander is active because Install_Private_Data_Declarations -- when the Expander is active because Install_Private_Data_Declarations
-- references entities which were created during regular expansion. -- references entities which were created during regular expansion.
if Expander_Active if Full_Expander_Active
and then not ALFA_Mode
and then Comes_From_Source (N) and then Comes_From_Source (N)
and then Present (Prot_Typ) and then Present (Prot_Typ)
and then Present (Spec_Id) and then Present (Spec_Id)
@ -9787,10 +9786,9 @@ package body Sem_Ch6 is
-- If expansion is active, the formal is replaced by a local -- If expansion is active, the formal is replaced by a local
-- variable that renames the corresponding entry of the -- variable that renames the corresponding entry of the
-- parameter block, and it is this local variable that may -- parameter block, and it is this local variable that may
-- require an actual subtype. In ALFA mode, expansion of accept -- require an actual subtype.
-- statements is skipped.
if Expander_Active and not ALFA_Mode then if Full_Expander_Active then
Decl := Build_Actual_Subtype (T, Renamed_Object (Formal)); Decl := Build_Actual_Subtype (T, Renamed_Object (Formal));
else else
Decl := Build_Actual_Subtype (T, Formal); Decl := Build_Actual_Subtype (T, Formal);
@ -9829,8 +9827,7 @@ package body Sem_Ch6 is
end if; end if;
if Nkind (N) = N_Accept_Statement if Nkind (N) = N_Accept_Statement
and then Expander_Active and then Full_Expander_Active
and then not ALFA_Mode
then then
Set_Actual_Subtype (Renamed_Object (Formal), Set_Actual_Subtype (Renamed_Object (Formal),
Defining_Identifier (Decl)); Defining_Identifier (Decl));

14
gcc/ada/sem_ch9.adb
View File

@ -727,8 +727,7 @@ package body Sem_Ch9 is
-- for the discriminals and privals and finally a declaration for the -- for the discriminals and privals and finally a declaration for the
-- entry family index (if applicable). -- entry family index (if applicable).
if Expander_Active if Full_Expander_Active
and then not ALFA_Mode
and then Is_Protected_Type (P_Type) and then Is_Protected_Type (P_Type)
then then
Install_Private_Data_Declarations Install_Private_Data_Declarations
@ -1283,11 +1282,7 @@ package body Sem_Ch9 is
-- Also skip if expander is not active -- Also skip if expander is not active
and then Expander_Active and then Full_Expander_Active
-- Also skip if in ALFA mode, this expansion is not needed
and then not ALFA_Mode
then then
Expand_N_Protected_Type_Declaration (N); Expand_N_Protected_Type_Declaration (N);
Process_Full_View (N, T, Def_Id); Process_Full_View (N, T, Def_Id);
@ -2094,10 +2089,7 @@ package body Sem_Ch9 is
-- Also skip if expander is not active -- Also skip if expander is not active
and then Expander_Active and then Full_Expander_Active
-- Or if in ALFA mode, this expansion is not needed
and then not ALFA_Mode
then then
Expand_N_Task_Type_Declaration (N); Expand_N_Task_Type_Declaration (N);
Process_Full_View (N, T, Def_Id); Process_Full_View (N, T, Def_Id);

17
gcc/ada/sem_res.adb
View File

@ -3442,8 +3442,7 @@ package body Sem_Res is
elsif Nkind (A) = N_Function_Call elsif Nkind (A) = N_Function_Call
and then Is_Limited_Record (Etype (F)) and then Is_Limited_Record (Etype (F))
and then not Is_Constrained (Etype (F)) and then not Is_Constrained (Etype (F))
and then Expander_Active and then Full_Expander_Active
and then not ALFA_Mode
and then (Is_Controlled (Etype (F)) or else Has_Task (Etype (F))) and then (Is_Controlled (Etype (F)) or else Has_Task (Etype (F)))
then then
Establish_Transient_Scope (A, False); Establish_Transient_Scope (A, False);
@ -3458,8 +3457,7 @@ package body Sem_Res is
elsif Nkind (A) = N_Op_Concat elsif Nkind (A) = N_Op_Concat
and then Nkind (N) = N_Procedure_Call_Statement and then Nkind (N) = N_Procedure_Call_Statement
and then Expander_Active and then Full_Expander_Active
and then not ALFA_Mode
and then and then
not (Is_Intrinsic_Subprogram (Nam) not (Is_Intrinsic_Subprogram (Nam)
and then Chars (Nam) = Name_Asm) and then Chars (Nam) = Name_Asm)
@ -3522,8 +3520,7 @@ package body Sem_Res is
-- be removed in the expansion of the wrapped construct. -- be removed in the expansion of the wrapped construct.
if (Is_Controlled (DDT) or else Has_Task (DDT)) if (Is_Controlled (DDT) or else Has_Task (DDT))
and then Expander_Active and then Full_Expander_Active
and then not ALFA_Mode
then then
Establish_Transient_Scope (A, False); Establish_Transient_Scope (A, False);
end if; end if;
@ -5494,8 +5491,7 @@ package body Sem_Res is
then then
null; null;
elsif Expander_Active elsif Full_Expander_Active
and then not ALFA_Mode
and then Is_Type (Etype (Nam)) and then Is_Type (Etype (Nam))
and then Requires_Transient_Scope (Etype (Nam)) and then Requires_Transient_Scope (Etype (Nam))
and then and then
@ -6616,8 +6612,7 @@ package body Sem_Res is
-- Protected functions can return on the secondary stack, in which -- Protected functions can return on the secondary stack, in which
-- case we must trigger the transient scope mechanism. -- case we must trigger the transient scope mechanism.
elsif Expander_Active elsif Full_Expander_Active
and then not ALFA_Mode
and then Requires_Transient_Scope (Etype (Nam)) and then Requires_Transient_Scope (Etype (Nam))
then then
Establish_Transient_Scope (N, Sec_Stack => True); Establish_Transient_Scope (N, Sec_Stack => True);
@ -8088,8 +8083,6 @@ package body Sem_Res is
procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
begin begin
-- Normal mode (not ALFA)
if not ALFA_Mode then if not ALFA_Mode then
-- The loop structure is already resolved during its analysis, only -- The loop structure is already resolved during its analysis, only