[multiple changes]

2011-10-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Earlier): make available globally. If both
	nodes have the same sloc, the freeze node that does not come
	from source is the later one.
	(True_Parent): Make available globally.
	(Previous_Instance): Subsidiary of
	Insert_Freeze_Node_For_Instance, to check whether the generic
	parent of the current instance is declared within a previous
	instance in the same unit or declarative  part, in which case the
	freeze nodes of both instances must appear in order to prevent
	elaboration problems in gigi.
	* sem_ch12.adb (Insert_Freeze_Node_For_Instance): A stub is a
	freeze point, and the freeze node of a preceding instantiation
	must be inserted before it.

2011-10-24  Robert Dewar  <dewar@adacore.com>

	* checks.ads, checks.adb: Add handling of Synchronization_Check
	* debug.adb: Add doc for -gnatd.d and -gnatd.e (disable/enable
	atomic sync).
	* exp_ch2.adb (Expand_Entity_Reference): Set Atomic_Sync_Required
	flag Minor code reorganization.
	* opt.ads (Warn_On_Atomic_Synchronization): New switch.
	* par-prag.adb: Add dummy entries for pragma
	Disable/Enable_Atomic_Synchronization.
	* sem_prag.adb (Process_Suppress_Unsuppress): Handle
	case of Atomic_Synchronization specially (not suppressed
	by All_Checks, cannot be set from Source).
	(Pragma Disable/Enable_Atomic_Synchronization): Add processing.
	* sinfo.ads, sinfo.adb: Add Atomic_Sync_Required flag
	* snames.ads-tmpl: Add entry for Atomic_Synchronization Add
	entry for pragma Disable/Enable_Atomic_Synchronization
	* switch-c.adb: The -gnatp switch does not disable
	Atomic_Synchronization Add -gnatep switch to disable
	Atomic_Synchronization.
	* types.ads: Add entry for Synchronization_Check
	* usage.adb: Add line for -gnated switch
	* warnsw.adb: Settings for Warn_On_Atomic_Synchronization

From-SVN: r180373

gcc/ada/ChangeLog

+2011-10-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Earlier): make available globally. If both
+	nodes have the same sloc, the freeze node that does not come
+	from source is the later one.
+	(True_Parent): Make available globally.
+	(Previous_Instance): Subsidiary of
+	Insert_Freeze_Node_For_Instance, to check whether the generic
+	parent of the current instance is declared within a previous
+	instance in the same unit or declarative  part, in which case the
+	freeze nodes of both instances must appear in order to prevent
+	elaboration problems in gigi.
+	* sem_ch12.adb (Insert_Freeze_Node_For_Instance): A stub is a
+	freeze point, and the freeze node of a preceding instantiation
+	must be inserted before it.
+
+2011-10-24  Robert Dewar  <dewar@adacore.com>
+
+	* checks.ads, checks.adb: Add handling of Synchronization_Check
+	* debug.adb: Add doc for -gnatd.d and -gnatd.e (disable/enable
+	atomic sync).
+	* exp_ch2.adb (Expand_Entity_Reference): Set Atomic_Sync_Required
+	flag Minor code reorganization.
+	* opt.ads (Warn_On_Atomic_Synchronization): New switch.
+	* par-prag.adb: Add dummy entries for pragma
+	Disable/Enable_Atomic_Synchronization.
+	* sem_prag.adb (Process_Suppress_Unsuppress): Handle
+	case of Atomic_Synchronization specially (not suppressed
+	by All_Checks, cannot be set from Source).
+	(Pragma Disable/Enable_Atomic_Synchronization): Add processing.
+	* sinfo.ads, sinfo.adb: Add Atomic_Sync_Required flag
+	* snames.ads-tmpl: Add entry for Atomic_Synchronization Add
+	entry for pragma Disable/Enable_Atomic_Synchronization
+	* switch-c.adb: The -gnatp switch does not disable
+	Atomic_Synchronization Add -gnatep switch to disable
+	Atomic_Synchronization.
+	* types.ads: Add entry for Synchronization_Check
+	* usage.adb: Add line for -gnated switch
+	* warnsw.adb: Settings for Warn_On_Atomic_Synchronization
+
 2011-10-24  Geert Bosch  <bosch@adacore.com>
 
 	* s-gearop.adb (Back_Substitute): Avoid overflow if matrix

gcc/ada/checks.adb

@@ -2555,6 +2555,23 @@ package body Checks is
       end if;
    end Apply_Universal_Integer_Attribute_Checks;
 
+   -------------------------------------
+   -- Atomic_Synchronization_Disabled --
+   -------------------------------------
+
+   --  Note: internally Disable/Enable_Atomic_Synchronization is implemented
+   --  using a bogus check called Atomic_Synchronization. This is to make it
+   --  more convenient to get exactly the same semantics as [Un]Suppress.
+
+   function Atomic_Synchronization_Disabled (E : Entity_Id) return Boolean is
+   begin
+      if Present (E) and then Checks_May_Be_Suppressed (E) then
+         return Is_Check_Suppressed (E, Atomic_Synchronization);
+      else
+         return Scope_Suppress (Atomic_Synchronization);
+      end if;
+   end Atomic_Synchronization_Disabled;
+
    -------------------------------
    -- Build_Discriminant_Checks --
    -------------------------------

gcc/ada/checks.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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- --
@@ -46,19 +46,20 @@ package Checks is
    --  Called for each new main source program, to initialize internal
    --  variables used in the package body of the Checks unit.
 
-   function Access_Checks_Suppressed        (E : Entity_Id) return Boolean;
-   function Accessibility_Checks_Suppressed (E : Entity_Id) return Boolean;
-   function Alignment_Checks_Suppressed     (E : Entity_Id) return Boolean;
-   function Discriminant_Checks_Suppressed  (E : Entity_Id) return Boolean;
-   function Division_Checks_Suppressed      (E : Entity_Id) return Boolean;
-   function Elaboration_Checks_Suppressed   (E : Entity_Id) return Boolean;
-   function Index_Checks_Suppressed         (E : Entity_Id) return Boolean;
-   function Length_Checks_Suppressed        (E : Entity_Id) return Boolean;
-   function Overflow_Checks_Suppressed      (E : Entity_Id) return Boolean;
-   function Range_Checks_Suppressed         (E : Entity_Id) return Boolean;
-   function Storage_Checks_Suppressed       (E : Entity_Id) return Boolean;
-   function Tag_Checks_Suppressed           (E : Entity_Id) return Boolean;
-   function Validity_Checks_Suppressed      (E : Entity_Id) return Boolean;
+   function Access_Checks_Suppressed          (E : Entity_Id) return Boolean;
+   function Accessibility_Checks_Suppressed   (E : Entity_Id) return Boolean;
+   function Alignment_Checks_Suppressed       (E : Entity_Id) return Boolean;
+   function Atomic_Synchronization_Disabled   (E : Entity_Id) return Boolean;
+   function Discriminant_Checks_Suppressed    (E : Entity_Id) return Boolean;
+   function Division_Checks_Suppressed        (E : Entity_Id) return Boolean;
+   function Elaboration_Checks_Suppressed     (E : Entity_Id) return Boolean;
+   function Index_Checks_Suppressed           (E : Entity_Id) return Boolean;
+   function Length_Checks_Suppressed          (E : Entity_Id) return Boolean;
+   function Overflow_Checks_Suppressed        (E : Entity_Id) return Boolean;
+   function Range_Checks_Suppressed           (E : Entity_Id) return Boolean;
+   function Storage_Checks_Suppressed         (E : Entity_Id) return Boolean;
+   function Tag_Checks_Suppressed             (E : Entity_Id) return Boolean;
+   function Validity_Checks_Suppressed        (E : Entity_Id) return Boolean;
    --  These functions check to see if the named check is suppressed, either
    --  by an active scope suppress setting, or because the check has been
    --  specifically suppressed for the given entity. If no entity is relevant

gcc/ada/debug.adb

@@ -94,8 +94,8 @@ package body Debug is
    --  d.a  Force Target_Strict_Alignment mode to True
    --  d.b  Dump backend types
    --  d.c  Generate inline concatenation, do not call procedure
-   --  d.d
-   --  d.e
+   --  d.d  Disable atomic synchronization
+   --  d.e  Enable atomic synchronization
    --  d.f  Inhibit folding of static expressions
    --  d.g  Enable conversion of raise into goto
    --  d.h
@@ -513,6 +513,13 @@ package body Debug is
    --       System.Concat_n.Str_Concat_n routines in cases where the latter
    --       routines would normally be called.
 
+   --  d.d  Disable atomic synchronization for all atomic variable references.
+   --       Pragma Enable_Atomic_Synchronization is ignored.
+
+   --  d.e  Enable atomic synchronization for all atomic variable references.
+   --       Pragma Disable_Atomic_Synchronization is ignored, and also the
+   --       compiler switch -gnated is ignored.
+
    --  d.f  Suppress folding of static expressions. This of course results
    --       in seriously non-conforming behavior, but is useful sometimes
    --       when tracking down handling of complex expressions.

gcc/ada/exp_ch2.adb

@@ -24,6 +24,7 @@
 ------------------------------------------------------------------------------
 
 with Atree;    use Atree;
+with Checks;   use Checks;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
@@ -354,10 +355,10 @@ package body Exp_Ch2 is
       elsif Is_Protected_Component (E) then
          if No_Run_Time_Mode then
             return;
+         else
+            Expand_Protected_Component (N);
          end if;
 
-         Expand_Protected_Component (N);
-
       elsif Ekind (E) = E_Entry_Index_Parameter then
          Expand_Entry_Index_Parameter (N);
 
@@ -398,6 +399,52 @@ package body Exp_Ch2 is
          Write_Eol;
       end if;
 
+      --  Set Atomic_Sync_Required if necessary for atomic variable
+
+      if Is_Atomic (E) 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;
+
+            --  Otherwise setting comes from Atomic_Synchronization state
+
+            else
+               Set := not Atomic_Synchronization_Disabled (E);
+            end if;
+
+            --  Set flag if required
+
+            if Set then
+
+               --  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;
+
+               Set_Atomic_Sync_Required (N);
+            end if;
+         end;
+      end if;
+
       --  Interpret possible Current_Value for variable case
 
       if Is_Assignable (E)

gcc/ada/opt.ads

@@ -1448,6 +1448,11 @@ package Opt is
    --  with literals or S'Length, presumably assuming a lower bound of one. Set
    --  False by -gnatwW.
 
+   Warn_On_Atomic_Synchronization : Boolean := False;
+   --  GNAT
+   --  Set to True to generate information messages for atomic synchronization.
+   --  Set True by use of -gnatw.n.
+
    Warn_On_Bad_Fixed_Value : Boolean := False;
    --  GNAT
    --  Set to True to generate warnings for static fixed-point expression

gcc/ada/sinfo.adb

@@ -249,6 +249,15 @@ package body Sinfo is
       return Node3 (N);
    end Ancestor_Part;
 
+   function Atomic_Sync_Required
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Expanded_Name
+        or else NT (N).Nkind = N_Identifier);
+      return Flag14 (N);
+   end Atomic_Sync_Required;
+
    function Array_Aggregate
       (N : Node_Id) return Node_Id is
    begin
@@ -3309,6 +3318,15 @@ package body Sinfo is
       Set_Node3_With_Parent (N, Val);
    end Set_Ancestor_Part;
 
+   procedure Set_Atomic_Sync_Required
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Expanded_Name
+        or else NT (N).Nkind = N_Identifier);
+      Set_Flag14 (N, Val);
+   end Set_Atomic_Sync_Required;
+
    procedure Set_Array_Aggregate
       (N : Node_Id; Val : Node_Id) is
    begin

gcc/ada/sinfo.ads

@@ -605,6 +605,12 @@ package Sinfo is
    --    Since the back end is expected to ignore generic templates, this 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.
+
    --  At_End_Proc (Node1)
    --    This field is present in an N_Handled_Sequence_Of_Statements node.
    --    It contains an identifier reference for the cleanup procedure to be
@@ -1917,6 +1923,7 @@ package Sinfo is
       --  Associated_Node (Node4-Sem)
       --  Original_Discriminant (Node2-Sem)
       --  Redundant_Use (Flag13-Sem)
+      --  Atomic_Sync_Required (Flag14-Sem)
       --  Has_Private_View (Flag11-Sem) (set in generic units)
       --  plus fields for expression
 
@@ -6982,8 +6989,9 @@ package Sinfo is
       --  Selector_Name (Node2)
       --  Entity (Node4-Sem)
       --  Associated_Node (Node4-Sem)
-      --  Redundant_Use (Flag13-Sem)
       --  Has_Private_View (Flag11-Sem) set in generic units.
+      --  Redundant_Use (Flag13-Sem)
+      --  Atomic_Sync_Required (Flag14-Sem)
       --  plus fields for expression
 
       -----------------------------
@@ -8121,6 +8129,9 @@ package Sinfo is
    function Ancestor_Part
      (N : Node_Id) return Node_Id;    -- Node3
 
+   function Atomic_Sync_Required
+     (N : Node_Id) return Boolean;    -- Flag14
+
    function Array_Aggregate
      (N : Node_Id) return Node_Id;    -- Node3
 
@@ -9096,6 +9107,9 @@ package Sinfo is
    procedure Set_Ancestor_Part
      (N : Node_Id; Val : Node_Id);            -- Node3
 
+   procedure Set_Atomic_Sync_Required
+     (N : Node_Id; Val : Boolean := True);    -- Flag14
+
    procedure Set_Array_Aggregate
      (N : Node_Id; Val : Node_Id);            -- Node3
 
@@ -11764,6 +11778,7 @@ package Sinfo is
    pragma Inline (All_Present);
    pragma Inline (Alternatives);
    pragma Inline (Ancestor_Part);
+   pragma Inline (Atomic_Sync_Required);
    pragma Inline (Array_Aggregate);
    pragma Inline (Aspect_Rep_Item);
    pragma Inline (Assignment_OK);
@@ -12086,6 +12101,7 @@ package Sinfo is
    pragma Inline (Set_All_Present);
    pragma Inline (Set_Alternatives);
    pragma Inline (Set_Ancestor_Part);
+   pragma Inline (Set_Atomic_Sync_Required);
    pragma Inline (Set_Array_Aggregate);
    pragma Inline (Set_Aspect_Rep_Item);
    pragma Inline (Set_Assignment_OK);

gcc/ada/snames.ads-tmpl

@@ -361,10 +361,12 @@ package Snames is
    Name_Debug_Policy                   : constant Name_Id := N + $; -- GNAT
    Name_Detect_Blocking                : constant Name_Id := N + $; -- Ada 05
    Name_Default_Storage_Pool           : constant Name_Id := N + $; -- Ada 12
+   Name_Disable_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT
    Name_Discard_Names                  : constant Name_Id := N + $;
    Name_Dispatching_Domain             : constant Name_Id := N + $; -- Ada 12
    Name_Elaboration_Checks             : constant Name_Id := N + $; -- GNAT
    Name_Eliminate                      : constant Name_Id := N + $; -- GNAT
+   Name_Enable_Atomic_Synchronization  : constant Name_Id := N + $; -- GNAT
    Name_Extend_System                  : constant Name_Id := N + $; -- GNAT
    Name_Extensions_Allowed             : constant Name_Id := N + $; -- GNAT
    Name_External_Name_Casing           : constant Name_Id := N + $; -- GNAT
@@ -941,10 +943,14 @@ package Snames is
 
    --  Names of recognized checks for pragma Suppress
 
+   --  Note: the name Atomic_Synchronization can only be specified internally
+   --  as a result of using pragma Enable/Disable_Atomic_Synchronization.
+
    First_Check_Name                    : constant Name_Id := N + $;
    Name_Access_Check                   : constant Name_Id := N + $;
    Name_Accessibility_Check            : constant Name_Id := N + $;
    Name_Alignment_Check                : constant Name_Id := N + $; -- GNAT
+   Name_Atomic_Synchronization         : constant Name_Id := N + $; -- GNAT
    Name_Discriminant_Check             : constant Name_Id := N + $;
    Name_Division_Check                 : constant Name_Id := N + $;
    Name_Elaboration_Check              : constant Name_Id := N + $;
@@ -1532,10 +1538,12 @@ package Snames is
       Pragma_Debug_Policy,
       Pragma_Detect_Blocking,
       Pragma_Default_Storage_Pool,
+      Pragma_Disable_Atomic_Synchronization,
       Pragma_Discard_Names,
       Pragma_Dispatching_Domain,
       Pragma_Elaboration_Checks,
       Pragma_Eliminate,
+      Pragma_Enable_Atomic_Synchronization,
       Pragma_Extend_System,
       Pragma_Extensions_Allowed,
       Pragma_External_Name_Casing,

gcc/ada/switch-c.adb

@@ -440,6 +440,11 @@ package body Switch.C is
                   --     Ptr := Ptr + 1;
                   --     Generate_SCIL := True;
 
+                  --  -gnated switch (disable atomic synchronization)
+
+                  when 'd' =>
+                     Suppress_Options (Atomic_Synchronization) := True;
+
                   --  -gnateD switch (preprocessing symbol definition)
 
                   when 'D' =>
@@ -743,10 +748,14 @@ package body Switch.C is
                   --  Set all specific options as well as All_Checks in the
                   --  Suppress_Options array, excluding Elaboration_Check,
                   --  since this is treated specially because we do not want
-                  --  -gnatp to disable static elaboration processing.
+                  --  -gnatp to disable static elaboration processing. Also
+                  --  exclude Atomic_Synchronization, since this is not a real
+                  --  check.
 
                   for J in Suppress_Options'Range loop
-                     if J /= Elaboration_Check then
+                     if J /= Elaboration_Check
+                       and then J /= Atomic_Synchronization
+                     then
                         Suppress_Options (J) := True;
                      end if;
                   end loop;

gcc/ada/types.ads

@@ -660,22 +660,25 @@ package Types is
    No_Check_Id         : constant := 0;
    --  Check_Id value used to indicate no check
 
-   Access_Check        : constant :=  1;
-   Accessibility_Check : constant :=  2;
-   Alignment_Check     : constant :=  3;
-   Discriminant_Check  : constant :=  4;
-   Division_Check      : constant :=  5;
-   Elaboration_Check   : constant :=  6;
-   Index_Check         : constant :=  7;
-   Length_Check        : constant :=  8;
-   Overflow_Check      : constant :=  9;
-   Range_Check         : constant := 10;
-   Storage_Check       : constant := 11;
-   Tag_Check           : constant := 12;
-   Validity_Check      : constant := 13;
-   --  Values used to represent individual predefined checks
-
-   All_Checks          : constant := 14;
+   Access_Check           : constant :=  1;
+   Accessibility_Check    : constant :=  2;
+   Alignment_Check        : constant :=  3;
+   Atomic_Synchronization : constant :=  4;
+   Discriminant_Check     : constant :=  5;
+   Division_Check         : constant :=  6;
+   Elaboration_Check      : constant :=  7;
+   Index_Check            : constant :=  8;
+   Length_Check           : constant :=  9;
+   Overflow_Check         : constant := 10;
+   Range_Check            : constant := 11;
+   Storage_Check          : constant := 12;
+   Tag_Check              : constant := 13;
+   Validity_Check         : constant := 14;
+   --  Values used to represent individual predefined checks (including the
+   --  setting of Atomic_Synchronization, which is implemented internally using
+   --  a "check" whose name is Atomic_Synchronization.
+
+   All_Checks : constant := 15;
    --  Value used to represent All_Checks value
 
    subtype Predefined_Check_Id is Check_Id range 1 .. All_Checks;

gcc/ada/usage.adb

@@ -172,6 +172,11 @@ begin
    Write_Switch_Char ("ec=?");
    Write_Line ("Specify configuration pragmas file, e.g. -gnatec=/x/f.adc");
 
+   --  Line for -gnated switch
+
+   Write_Switch_Char ("ed");
+   Write_Line ("Disable synchronization of atomic variables");
+
    --  Line for -gnateD switch
 
    Write_Switch_Char ("eD?");

gcc/ada/warnsw.adb

@@ -67,6 +67,7 @@ package body Warnsw is
             Warn_On_All_Unread_Out_Parameters   := True;
             Warn_On_Assertion_Failure           := True;
             Warn_On_Assumed_Low_Bound           := True;
+            Warn_On_Atomic_Synchronization      := True;
             Warn_On_Bad_Fixed_Value             := True;
             Warn_On_Biased_Representation       := True;
             Warn_On_Constant                    := True;
@@ -120,6 +121,12 @@ package body Warnsw is
          when 'M' =>
             Warn_On_Suspicious_Modulus_Value    := False;
 
+         when 'n' =>
+            Warn_On_Atomic_Synchronization      := True;
+
+         when 'N' =>
+            Warn_On_Atomic_Synchronization      := False;
+
          when 'o' =>
             Warn_On_All_Unread_Out_Parameters   := True;
 
@@ -202,6 +209,7 @@ package body Warnsw is
       Warn_On_All_Unread_Out_Parameters   := False;
       Warn_On_Assertion_Failure           := True;
       Warn_On_Assumed_Low_Bound           := True;
+      Warn_On_Atomic_Synchronization      := False;
       Warn_On_Bad_Fixed_Value             := True;
       Warn_On_Biased_Representation       := True;
       Warn_On_Constant                    := True;