[multiple changes]

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Generate freeze
	node for subprogram in Compile_Only mode.

2015-10-20  Dmitriy Anisimkov  <anisimko@adacore.com>

	* s-atocou.adb, s-atocou.ads, a-contai.adb, a-contai.ads,
	s-atocou-x86.adb, s-atocou-builtin.adb: Task safe over container
	iterations.

From-SVN: r229037

8 files changed, 127 insertions, 52 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d8bb5cb..948230a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2015-10-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Generate freeze
+	node for subprogram in Compile_Only mode.
+
+2015-10-20  Dmitriy Anisimkov  <anisimko@adacore.com>
+
+	* s-atocou.adb, s-atocou.ads, a-contai.adb, a-contai.ads,
+	s-atocou-x86.adb, s-atocou-builtin.adb: Task safe over container
+	iterations.
+
 2015-10-20  Philippe Gil  <gil@adacore.com>
 
 	* g-debpoo.ads (Dump): NEW print Debug_Pool statistics & main
diff --git a/gcc/ada/a-contai.adb b/gcc/ada/a-contai.adb
index 2cf589c..43b9473 100644
--- a/gcc/ada/a-contai.adb
+++ b/gcc/ada/a-contai.adb
@@ -29,6 +29,8 @@ package body Ada.Containers is
 
    package body Generic_Implementation is
 
+      use SAC;
+
       ------------
       -- Adjust --
       ------------
@@ -50,11 +52,7 @@ package body Ada.Containers is
       procedure Busy (T_Counts : in out Tamper_Counts) is
       begin
          if T_Check then
-            declare
-               B : Natural renames T_Counts.Busy;
-            begin
-               B := B + 1;
-            end;
+            Increment (T_Counts.Busy);
          end if;
       end Busy;
 
@@ -119,13 +117,8 @@ package body Ada.Containers is
       procedure Lock (T_Counts : in out Tamper_Counts) is
       begin
          if T_Check then
-            declare
-               B : Natural renames T_Counts.Busy;
-               L : Natural renames T_Counts.Lock;
-            begin
-               L := L + 1;
-               B := B + 1;
-            end;
+            Increment (T_Counts.Lock);
+            Increment (T_Counts.Busy);
          end if;
       end Lock;
 
@@ -160,11 +153,7 @@ package body Ada.Containers is
       procedure Unbusy (T_Counts : in out Tamper_Counts) is
       begin
          if T_Check then
-            declare
-               B : Natural renames T_Counts.Busy;
-            begin
-               B := B - 1;
-            end;
+            Decrement (T_Counts.Busy);
          end if;
       end Unbusy;
 
@@ -175,13 +164,8 @@ package body Ada.Containers is
       procedure Unlock (T_Counts : in out Tamper_Counts) is
       begin
          if T_Check then
-            declare
-               B : Natural renames T_Counts.Busy;
-               L : Natural renames T_Counts.Lock;
-            begin
-               L := L - 1;
-               B := B - 1;
-            end;
+            Decrement (T_Counts.Lock);
+            Decrement (T_Counts.Busy);
          end if;
       end Unlock;
 
diff --git a/gcc/ada/a-contai.ads b/gcc/ada/a-contai.ads
index 02dc28f..4b0b795 100644
--- a/gcc/ada/a-contai.ads
+++ b/gcc/ada/a-contai.ads
@@ -23,6 +23,7 @@ pragma Check_Name (Tampering_Check);
 --  checks.
 
 private with Ada.Finalization;
+with System.Atomic_Counters;
 
 package Ada.Containers is
    pragma Pure;
@@ -34,13 +35,15 @@ package Ada.Containers is
 
 private
 
+   package SAC renames System.Atomic_Counters;
+
    Count_Type_Last : constant := Count_Type'Last;
    --  Count_Type'Last as a universal_integer, so we can compare Index_Type
    --  values against this without type conversions that might overflow.
 
    type Tamper_Counts is record
-      Busy : Natural := 0;
-      Lock : Natural := 0;
+      Busy : aliased SAC.Atomic_Unsigned := 0;
+      Lock : aliased SAC.Atomic_Unsigned := 0;
    end record;
 
    --  Busy is positive when tampering with cursors is prohibited. Busy and
diff --git a/gcc/ada/s-atocou-builtin.adb b/gcc/ada/s-atocou-builtin.adb
index 55436aa..1df1c07 100644
--- a/gcc/ada/s-atocou-builtin.adb
+++ b/gcc/ada/s-atocou-builtin.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2015, 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- --
@@ -35,19 +35,31 @@
 package body System.Atomic_Counters is
 
    procedure Sync_Add_And_Fetch
-     (Ptr   : access Unsigned_32;
-      Value : Unsigned_32);
+     (Ptr   : access Atomic_Unsigned;
+      Value : Atomic_Unsigned);
    pragma Import (Intrinsic, Sync_Add_And_Fetch, "__sync_add_and_fetch_4");
 
    function Sync_Sub_And_Fetch
-     (Ptr   : access Unsigned_32;
-      Value : Unsigned_32) return Unsigned_32;
+     (Ptr   : access Atomic_Unsigned;
+      Value : Atomic_Unsigned) return Atomic_Unsigned;
    pragma Import (Intrinsic, Sync_Sub_And_Fetch, "__sync_sub_and_fetch_4");
 
    ---------------
    -- Decrement --
    ---------------
 
+   procedure Decrement (Item : aliased in out Atomic_Unsigned) is
+   begin
+      if Sync_Sub_And_Fetch (Item'Unrestricted_Access, 1) = 0 then
+         null;
+      end if;
+   end Decrement;
+
+   function Decrement (Item : aliased in out Atomic_Unsigned) return Boolean is
+   begin
+      return Sync_Sub_And_Fetch (Item'Unrestricted_Access, 1) = 0;
+   end Decrement;
+
    function Decrement (Item : in out Atomic_Counter) return Boolean is
    begin
       --  Note: the use of Unrestricted_Access here is required because we
@@ -62,6 +74,11 @@ package body System.Atomic_Counters is
    -- Increment --
    ---------------
 
+   procedure Increment (Item : aliased in out Atomic_Unsigned) is
+   begin
+      Sync_Add_And_Fetch (Item'Unrestricted_Access, 1);
+   end Increment;
+
    procedure Increment (Item : in out Atomic_Counter) is
    begin
       --  Note: the use of Unrestricted_Access here is required because we are
diff --git a/gcc/ada/s-atocou-x86.adb b/gcc/ada/s-atocou-x86.adb
index b85b402..bee6755 100644
--- a/gcc/ada/s-atocou-x86.adb
+++ b/gcc/ada/s-atocou-x86.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2015, 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- --
@@ -44,7 +44,7 @@ package body System.Atomic_Counters is
    -- Decrement --
    ---------------
 
-   function Decrement (Item : in out Atomic_Counter) return Boolean is
+   function Decrement (Item : aliased in out Atomic_Unsigned) return Boolean is
       Aux : Boolean;
 
    begin
@@ -53,27 +53,44 @@ package body System.Atomic_Counters is
            "lock%; decl" & ASCII.HT & "%0" & ASCII.LF & ASCII.HT
              & "sete %1",
          Outputs  =>
-           (Unsigned_32'Asm_Output ("=m", Item.Value),
+           (Atomic_Unsigned'Asm_Output ("=m", Item),
             Boolean'Asm_Output ("=qm", Aux)),
-         Inputs   => Unsigned_32'Asm_Input ("m", Item.Value),
+         Inputs   => Atomic_Unsigned'Asm_Input ("m", Item),
          Volatile => True);
 
       return Aux;
    end Decrement;
 
+   procedure Decrement (Item : aliased in out Atomic_Unsigned) is
+   begin
+      if Decrement (Item) then
+         null;
+      end if;
+   end Decrement;
+
+   function Decrement (Item : in out Atomic_Counter) return Boolean is
+   begin
+      return Decrement (Item.Value);
+   end Decrement;
+
    ---------------
    -- Increment --
    ---------------
 
-   procedure Increment (Item : in out Atomic_Counter) is
+   procedure Increment (Item : aliased in out Atomic_Unsigned) is
    begin
       System.Machine_Code.Asm
         (Template => "lock%; incl" & ASCII.HT & "%0",
-         Outputs  => Unsigned_32'Asm_Output ("=m", Item.Value),
-         Inputs   => Unsigned_32'Asm_Input ("m", Item.Value),
+         Outputs  => Atomic_Unsigned'Asm_Output ("=m", Item),
+         Inputs   => Atomic_Unsigned'Asm_Input ("m", Item),
          Volatile => True);
    end Increment;
 
+   procedure Increment (Item : in out Atomic_Counter) is
+   begin
+      Increment (Item.Value);
+   end Increment;
+
    ----------------
    -- Initialize --
    ----------------
diff --git a/gcc/ada/s-atocou.adb b/gcc/ada/s-atocou.adb
index 51cc79b..87e7818 100644
--- a/gcc/ada/s-atocou.adb
+++ b/gcc/ada/s-atocou.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2015, 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- --
@@ -48,6 +48,18 @@ package body System.Atomic_Counters is
       return False;
    end Decrement;
 
+   function Decrement (Item : aliased in out Atomic_Unsigned) return Boolean is
+   begin
+      --  Could not use Item := Item - 1; because it is disabled in spec.
+      Item := Atomic_Unsigned'Pred (Item);
+      return Item = 0;
+   end Decrement;
+
+   procedure Decrement (Item : aliased in out Atomic_Unsigned) is
+   begin
+      Item := Atomic_Unsigned'Pred (Item);
+   end Decrement;
+
    ---------------
    -- Increment --
    ---------------
@@ -57,6 +69,11 @@ package body System.Atomic_Counters is
       raise Program_Error;
    end Increment;
 
+   procedure Increment (Item : aliased in out Atomic_Unsigned) is
+   begin
+      Item := Atomic_Unsigned'Succ (Item);
+   end Increment;
+
    ----------------
    -- Initialize --
    ----------------
diff --git a/gcc/ada/s-atocou.ads b/gcc/ada/s-atocou.ads
index a2e6d89..1147de7 100644
--- a/gcc/ada/s-atocou.ads
+++ b/gcc/ada/s-atocou.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2011-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2015, 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- --
@@ -39,6 +39,7 @@
 
 package System.Atomic_Counters is
 
+   pragma Pure;
    pragma Preelaborate;
 
    type Atomic_Counter is limited private;
@@ -50,6 +51,8 @@ package System.Atomic_Counters is
    --  Atomic_Counter is declared as private limited type to provide highest
    --  level of protection from unexpected use. All available operations are
    --  declared below, and this set should be as small as possible.
+   --  Increment/Decrement operations for this type raise Program_Error on
+   --  platforms not supporting the atomic primitives.
 
    procedure Increment (Item : in out Atomic_Counter);
    pragma Inline_Always (Increment);
@@ -69,11 +72,35 @@ package System.Atomic_Counters is
    --  intended to be used in special cases when the counter object cannot be
    --  initialized in standard way.
 
+   type Atomic_Unsigned is mod 2 ** 32 with Default_Value => 0, Atomic;
+   --  Modular compatible atomic unsigned type.
+   --  Increment/Decrement operations for this type are atomic only on
+   --  supported platforms. See top of the file.
+
+   procedure Increment
+     (Item : aliased in out Atomic_Unsigned) with Inline_Always;
+   --  Increments value of atomic counter
+
+   function Decrement
+     (Item : aliased in out Atomic_Unsigned) return Boolean with Inline_Always;
+
+   procedure Decrement
+     (Item : aliased in out Atomic_Unsigned) with Inline_Always;
+   --  Decrements value of atomic counter
+
+   --  The "+" and "-" abstract routine provided below to disable BT := BT + 1
+   --  constructions.
+
+   function "+"
+     (Left, Right : Atomic_Unsigned) return Atomic_Unsigned is abstract;
+
+   function "-"
+     (Left, Right : Atomic_Unsigned) return Atomic_Unsigned is abstract;
+
 private
-   type Unsigned_32 is mod 2 ** 32;
 
-   type Atomic_Counter is limited record
-      Value : aliased Unsigned_32 := 1;
+   type Atomic_Counter is record
+      Value : aliased Atomic_Unsigned := 1;
       pragma Atomic (Value);
    end record;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 2151cf8..0d61181 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -3215,18 +3215,17 @@ package body Sem_Ch6 is
          --  the freeze actions that include the bodies. In particular, extra
          --  formals for accessibility or for return-in-place may need to be
          --  generated. Freeze nodes, if any, are inserted before the current
-         --  body. These freeze actions are also needed in ASIS mode to enable
-         --  the proper back-annotations.
+         --  body. These freeze actions are also needed in ASIS mode and in
+         --  Compile_Only mode to enable the proper back-end type annotations.
+         --  They are necessary in any case to insure order of elaboration
+         --  in gigi.
 
          if not Is_Frozen (Spec_Id)
-           and then (Expander_Active or ASIS_Mode)
+           and then (Expander_Active
+                       or else ASIS_Mode
+                       or else (Operating_Mode = Check_Semantics
+                                  and then Serious_Errors_Detected = 0))
          then
-            --  Force the generation of its freezing node to ensure proper
-            --  management of access types in the backend.
-
-            --  This is definitely needed for some cases, but it is not clear
-            --  why, to be investigated further???
-
             Set_Has_Delayed_Freeze (Spec_Id);
             Freeze_Before (N, Spec_Id);
          end if;