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

[multiple changes] 

2011-11-04  Yannick Moy  <moy@adacore.com>

	* sem_prag.adb: Minor refactoring (renaming of a parameter).

2011-11-04  Robert Dewar  <dewar@adacore.com>

	* atree.ads: Minor reformatting.

2011-11-04  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Atomic_Synchronization_Disabled): Check -gnatd.d
	and -gnatd.e here
	* exp_ch2.adb (Expand_Entity_Reference): Use
	Activate_Atomic_Synchronization
	* exp_ch4.adb (Expand_N_Explicit_Dereference): Use
	Activate_Atomic_Synchronization (Expand_N_Indexed_Compoonent):
	Activate_Atomic_Synchronization (Expand_N_Selected_Component):
	Use Activate_Atomic_Synchronization
	* exp_util.ads, exp_util.adb (Activate_Atomic_Synchronization): New
	procedure.
	* sinfo.ads, sinfo.adb (Atomic_Sync_Required): Can now apply to
	N_Selected_Component node

From-SVN: r180950
This commit is contained in:
Arnaud Charlet 2011-11-04 14:48:52 +01:00
parent 37765e95f1
commit 4c31825389
10 changed files with 125 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
2011-11-04 Yannick Moy <moy@adacore.com>
* sem_prag.adb: Minor refactoring (renaming of a parameter).
2011-11-04 Robert Dewar <dewar@adacore.com>
* atree.ads: Minor reformatting.
2011-11-04 Robert Dewar <dewar@adacore.com>
* checks.adb (Atomic_Synchronization_Disabled): Check -gnatd.d
and -gnatd.e here
* exp_ch2.adb (Expand_Entity_Reference): Use
Activate_Atomic_Synchronization
* exp_ch4.adb (Expand_N_Explicit_Dereference): Use
Activate_Atomic_Synchronization (Expand_N_Indexed_Compoonent):
Activate_Atomic_Synchronization (Expand_N_Selected_Component):
Use Activate_Atomic_Synchronization
* exp_util.ads, exp_util.adb (Activate_Atomic_Synchronization): New
procedure.
* sinfo.ads, sinfo.adb (Atomic_Sync_Required): Can now apply to
N_Selected_Component node
2011-11-04 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, atree.ads, prj-env.adb, prj-env.ads: Minor reformatting.

10
gcc/ada/atree.ads
View File

@ -895,9 +895,13 @@ package Atree is
-----------------------------------
-- This subpackage provides the functions for accessing and procedures for
-- setting fields that are normally referenced by their logical synonyms
-- defined in packages Sinfo and Einfo. The implementations of these
-- packages use the package Atree.Unchecked_Access.
-- setting fields that are normally referenced by wrapper subprograms (e.g.
-- logical synonyms defined in packages Sinfo and Einfo, or specialized
-- routines such as Rewrite (for Original_Node), or the node creation
-- routines (for Set_Nkind). The implementations of these wrapper
-- subprograms use the package Atree.Unchecked_Access as do various
-- special case accesses where no wrapper applies. Documentation is always
-- required for such a special case access explaining why it is needed.
package Unchecked_Access is

19
gcc/ada/checks.adb
View File

@ -2565,8 +2565,25 @@ package body Checks is
function Atomic_Synchronization_Disabled (E : Entity_Id) return Boolean is
begin
if Present (E) and then Checks_May_Be_Suppressed (E) then
-- If debug flag d.e is set, always return False, i.e. all atomic sync
-- looks enabled, since it is never disabled.
if Debug_Flag_Dot_E then
return False;
-- If debug flag d.d is set then always return True, i.e. all atomic
-- sync looks disabled, since it always tests True.
elsif Debug_Flag_Dot_D then
return True;
-- If entity present, then check result for that entity
elsif Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Atomic_Synchronization);
-- Otherwise result depends on current scope setting
else
return Scope_Suppress (Atomic_Synchronization);
end if;

37
gcc/ada/exp_ch2.adb
View File

@ -404,35 +404,15 @@ package body Exp_Ch2 is
if Nkind_In (N, N_Identifier, N_Expanded_Name)
and then Ekind (E) = E_Variable
and then (Is_Atomic (E) or else Is_Atomic (Etype (E)))
-- Don't go setting the flag for the prefix of an attribute because
-- we don't want atomic sync for X'Size, X'Access etc.
-- Is this right in all cases of attributes???
-- Are there other exemptions required ???
and then (Nkind (Parent (N)) /= N_Attribute_Reference
or else Prefix (Parent (N)) /= N)
then
declare
Set : Boolean;
MLoc : Node_Id;
begin
-- Always set if debug flag d.e is set
if Debug_Flag_Dot_E then
Set := True;
-- Never set if debug flag d.d is set
elsif Debug_Flag_Dot_D then
Set := False;
-- If variable is atomic, but type is not, setting depends on
-- disable/enable state for the variable.
elsif Is_Atomic (E) and then not Is_Atomic (Etype (E)) then
if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then
Set := not Atomic_Synchronization_Disabled (E);
-- If variable is not atomic, but its type is atomic, setting
@ -453,20 +433,7 @@ package body Exp_Ch2 is
-- Set flag if required
if Set then
Set_Atomic_Sync_Required (N);
-- Generate info message if requested
if Warn_On_Atomic_Synchronization then
if Nkind (N) = N_Identifier then
MLoc := N;
else
MLoc := Selector_Name (N);
end if;
Error_Msg_N
("?info: atomic synchronization set for &", MLoc);
end if;
Activate_Atomic_Synchronization (N);
end if;
end;
end if;

25
gcc/ada/exp_ch4.adb
View File

@ -4478,13 +4478,7 @@ package body Exp_Ch4 is
if Is_Atomic (Etype (N))
and then not Atomic_Synchronization_Disabled (Etype (N))
then
Set_Atomic_Sync_Required (N);
-- Generate info message if requested
if Warn_On_Atomic_Synchronization then
Error_Msg_N ("?info: atomic synchronization set", N);
end if;
Activate_Atomic_Synchronization (N);
end if;
end Expand_N_Explicit_Dereference;
@ -5326,13 +5320,7 @@ package body Exp_Ch4 is
or else (Is_Atomic (Typ)
and then not Atomic_Synchronization_Disabled (Typ))
then
Set_Atomic_Sync_Required (N);
-- Generate info message if requested
if Warn_On_Atomic_Synchronization then
Error_Msg_N ("?info: atomic synchronization set", N);
end if;
Activate_Atomic_Synchronization (N);
end if;
-- All done for the non-packed case
@ -8216,14 +8204,7 @@ package body Exp_Ch4 is
and then Is_Atomic (Etype (N))
and then not Atomic_Synchronization_Disabled (Etype (N))
then
Set_Atomic_Sync_Required (Selector_Name (N));
-- Generate info message if requested
if Warn_On_Atomic_Synchronization then
Error_Msg_N
("?info: atomic synchronization set for &", Selector_Name (N));
end if;
Activate_Atomic_Synchronization (N);
end if;
end Expand_N_Selected_Component;

47
gcc/ada/exp_util.adb
View File

@ -160,6 +160,53 @@ package body Exp_Util is
-- or body. Flag Nested_Constructs should be set when any nested packages
-- declared in L must be processed.
-------------------------------------
-- Activate_Atomic_Synchronization --
-------------------------------------
procedure Activate_Atomic_Synchronization (N : Node_Id) is
Msg_Node : Node_Id;
begin
-- Nothing to do if we are the prefix of an attribute, since we do not
-- want an atomic sync operation for things like A'Adress or A'Size).
if Nkind (Parent (N)) = N_Attribute_Reference
and then Prefix (Parent (N)) = N
then
return;
end if;
-- Go ahead and set the flag
Set_Atomic_Sync_Required (N);
-- Generate info message if requested
if Warn_On_Atomic_Synchronization then
case Nkind (N) is
when N_Identifier =>
Msg_Node := N;
when N_Selected_Component | N_Expanded_Name =>
Msg_Node := Selector_Name (N);
when N_Explicit_Dereference | N_Indexed_Component =>
Msg_Node := Empty;
when others =>
pragma Assert (False);
return;
end case;
if Present (Msg_Node) then
Error_Msg_N ("?info: atomic synchronization set for &", Msg_Node);
else
Error_Msg_N ("?info: atomic synchronization set", N);
end if;
end if;
end Activate_Atomic_Synchronization;
----------------------
-- Adjust_Condition --
----------------------

8
gcc/ada/exp_util.ads
View File

@ -149,6 +149,14 @@ package Exp_Util is
-- Other Subprograms --
-----------------------
procedure Activate_Atomic_Synchronization (N : Node_Id);
-- N is a node for which atomic synchronization may be required (it is
-- either an identifier, expanded name, or selected/indexed component or
-- an explicit dereference). The caller has checked the basic conditions
-- (atomic variable appearing and Atomic_Sync not disabled). This function
-- checks if atomic synchronization is required and if so sets the flag
-- and if appropriate generates a warning (in -gnatw.n mode).
procedure Adjust_Condition (N : Node_Id);
-- The node N is an expression whose root-type is Boolean, and which
-- represents a boolean value used as a condition (i.e. a True/False

20
gcc/ada/sem_prag.adb
View File

@ -528,9 +528,9 @@ package body Sem_Prag is
-- case, and if found, issues an appropriate error message.
procedure Check_Expr_Is_Static_Expression
(Argx : Node_Id;
(Expr : Node_Id;
Typ : Entity_Id := Empty);
-- Check the specified expression Argx to make sure that it is a static
-- Check the specified expression Expr to make sure that it is a static
-- expression of the given type (i.e. it will be analyzed and resolved
-- using this type, which can be any valid argument to Resolve, e.g.
-- Any_Integer is OK). If not, given error and raise Pragma_Exit. If
@ -1456,20 +1456,20 @@ package body Sem_Prag is
-------------------------------------
procedure Check_Expr_Is_Static_Expression
(Argx : Node_Id;
(Expr : Node_Id;
Typ : Entity_Id := Empty)
is
begin
if Present (Typ) then
Analyze_And_Resolve (Argx, Typ);
Analyze_And_Resolve (Expr, Typ);
else
Analyze_And_Resolve (Argx);
Analyze_And_Resolve (Expr);
end if;
if Is_OK_Static_Expression (Argx) then
if Is_OK_Static_Expression (Expr) then
return;
elsif Etype (Argx) = Any_Type then
elsif Etype (Expr) = Any_Type then
raise Pragma_Exit;
-- An interesting special case, if we have a string literal and we
@ -1479,14 +1479,14 @@ package body Sem_Prag is
-- warnings as usual, but will not cause errors.
elsif Ada_Version = Ada_83
and then Nkind (Argx) = N_String_Literal
and then Nkind (Expr) = N_String_Literal
then
return;
-- Static expression that raises Constraint_Error. This has already
-- been flagged, so just exit from pragma processing.
elsif Is_Static_Expression (Argx) then
elsif Is_Static_Expression (Expr) then
raise Pragma_Exit;
-- Finally, we have a real error
@ -1499,7 +1499,7 @@ package body Sem_Prag is
"argument for pragma% must be a static expression!";
begin
Fix_Error (Msg);
Flag_Non_Static_Expr (Msg, Argx);
Flag_Non_Static_Expr (Msg, Expr);
end;
raise Pragma_Exit;

6
gcc/ada/sinfo.adb
View File

@ -256,7 +256,8 @@ package body Sinfo is
or else NT (N).Nkind = N_Expanded_Name
or else NT (N).Nkind = N_Explicit_Dereference
or else NT (N).Nkind = N_Identifier
or else NT (N).Nkind = N_Indexed_Component);
or else NT (N).Nkind = N_Indexed_Component
or else NT (N).Nkind = N_Selected_Component);
return Flag14 (N);
end Atomic_Sync_Required;
@ -3327,7 +3328,8 @@ package body Sinfo is
or else NT (N).Nkind = N_Expanded_Name
or else NT (N).Nkind = N_Explicit_Dereference
or else NT (N).Nkind = N_Identifier
or else NT (N).Nkind = N_Indexed_Component);
or else NT (N).Nkind = N_Indexed_Component
or else NT (N).Nkind = N_Selected_Component);
Set_Flag14 (N, Val);
end Set_Atomic_Sync_Required;

13
gcc/ada/sinfo.ads
View File

@ -606,16 +606,8 @@ package Sinfo is
-- harmless.
-- Atomic_Sync_Required (Flag14-Sem)
-- This flag is set in an identifier or expanded name node if the
-- corresponding reference (or assignment when on the left side of
-- an assignment) requires atomic synchronization, as a result of
-- Atomic_Synchronization being enabled for the corresponding entity
-- or its type. Also set for Selector_Name of an N_Selected Component
-- node if the type is atomic and requires atomic synchronization.
-- Also set on an N_Explicit Dereference node if the resulting type
-- is atomic and requires atomic synchronization. Finally it is set
-- on an N_Indexed_Component node if the resulting type is Atomic, or
-- if the array type or the array has pragma Atomic_Components set.
-- This flag is set on a node for which atomic synchronization is
-- required for the corresponding reference or modification.
-- At_End_Proc (Node1)
-- This field is present in an N_Handled_Sequence_Of_Statements node.
@ -3248,6 +3240,7 @@ package Sinfo is
-- Associated_Node (Node4-Sem)
-- Do_Discriminant_Check (Flag13-Sem)
-- Is_In_Discriminant_Check (Flag11-Sem)
-- Atomic_Sync_Required (Flag14-Sem)
-- plus fields for expression
--------------------------