2011-10-24 Sergey Rybin <rybin@adacore.com frybin>

	* gnat_ugn.texi: For gnatelim, move the note about using the GNAT
	driver for getting the project support into gnatelim section.

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

	* gnat_rm.texi: Minor correction to documentation on address
	clause.

2011-10-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* s-finmas.adb (Attach): Synchronize and call the unprotected version.
	(Attach_Unprotected): New routine.
	(Delete_Finalize_Address): Removed.
	(Delete_Finalize_Address_Unprotected): New routine.
	(Detach): Synchronize and call the unprotected version.
	(Detach_Unprotected): Remove locking.
	(Finalize): Add various comment on synchronization. Lock the critical
	region and call the unprotected versions of routines.
	(Finalize_Address): Removed.
	(Finalize_Address_Unprotected): New routine.
	(Set_Finalize_Address): Synchronize and call
	the unprotected version.
	(Set_Finalize_Address_Unprotected): New routine.
	(Set_Heterogeneous_Finalize_Address): Removed.
	(Set_Heterogeneous_Finalize_Address_Unprotected): New routine.
	(Set_Is_Heterogeneous): Add comment on synchronization and
	locking.
	* s-finmas.ads: Flag Finalization_Started is no longer atomic
	because synchronization uses task locking / unlocking.
	(Attach): Add comment on usage.
	(Attach_Unprotected): New routine.
	(Delete_Finalize_Address): Renamed to
	Delete_Finalize_Address_Unprotected.
	(Detach): Add comment on usage.
	(Detach_Unprotected): New routine.
	(Finalize_Address): Renamed to Finalize_Address_Unprotected.
	(Set_Finalize_Address): Add comment on usage.
	(Set_Finalize_Address_Unprotected): New routine.
	(Set_Heterogeneous_Finalize_Address): Renamed to
	Set_Heterogeneous_Finalize_Address_Unprotected.
	* s-stposu.adb (Allocate_Any_Controlled): Add local variable
	Allocation_Locked. Add various comments on synchronization. Lock
	the critical region and call the unprotected version of
	routines.
	(Deallocate_Any_Controlled): Add various comments on
	synchronization. Lock the critical region and call the unprotected
	version of routines.

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

	* sem_ch3.adb (Set_Fixed_Range): The bounds of a fixed point type
	are universal and must carry the corresponding type.
	* sem_eval.adb (Check_Non_Static_Context): If the type of the
	expression is universal real, as may be the case for a fixed point
	expression with constant operands in the context of a conversion,
	there is nothing to check.
	* s-finmas.adb: Minor reformatting



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180368 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 301 insertions, 125 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5fa725d3cdf..297470c39fd 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,63 @@
+2011-10-24  Sergey Rybin  <rybin@adacore.com frybin>
+
+	* gnat_ugn.texi: For gnatelim, move the note about using the GNAT
+	driver for getting the project support into gnatelim section.
+
+2011-10-24  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_rm.texi: Minor correction to documentation on address
+	clause.
+
+2011-10-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* s-finmas.adb (Attach): Synchronize and call the unprotected version.
+	(Attach_Unprotected): New routine.
+	(Delete_Finalize_Address): Removed.
+	(Delete_Finalize_Address_Unprotected): New routine.
+	(Detach): Synchronize and call the unprotected version.
+	(Detach_Unprotected): Remove locking.
+	(Finalize): Add various comment on synchronization. Lock the critical
+	region and call the unprotected versions of routines.
+	(Finalize_Address): Removed.
+	(Finalize_Address_Unprotected): New routine.
+	(Set_Finalize_Address): Synchronize and call
+	the unprotected version.
+	(Set_Finalize_Address_Unprotected): New routine.
+	(Set_Heterogeneous_Finalize_Address): Removed.
+	(Set_Heterogeneous_Finalize_Address_Unprotected): New routine.
+	(Set_Is_Heterogeneous): Add comment on synchronization and
+	locking.
+	* s-finmas.ads: Flag Finalization_Started is no longer atomic
+	because synchronization uses task locking / unlocking.
+	(Attach): Add comment on usage.
+	(Attach_Unprotected): New routine.
+	(Delete_Finalize_Address): Renamed to
+	Delete_Finalize_Address_Unprotected.
+	(Detach): Add comment on usage.
+	(Detach_Unprotected): New routine.
+	(Finalize_Address): Renamed to Finalize_Address_Unprotected.
+	(Set_Finalize_Address): Add comment on usage.
+	(Set_Finalize_Address_Unprotected): New routine.
+	(Set_Heterogeneous_Finalize_Address): Renamed to
+	Set_Heterogeneous_Finalize_Address_Unprotected.
+	* s-stposu.adb (Allocate_Any_Controlled): Add local variable
+	Allocation_Locked. Add various comments on synchronization. Lock
+	the critical region and call the unprotected version of
+	routines.
+	(Deallocate_Any_Controlled): Add various comments on
+	synchronization. Lock the critical region and call the unprotected
+	version of routines.
+
+2011-10-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Set_Fixed_Range): The bounds of a fixed point type
+	are universal and must carry the corresponding type.
+	* sem_eval.adb (Check_Non_Static_Context): If the type of the
+	expression is universal real, as may be the case for a fixed point
+	expression with constant operands in the context of a conversion,
+	there is nothing to check.
+	* s-finmas.adb: Minor reformatting
+
 2011-10-23  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/decl.c (create_concat_name): Add explicit cast.
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 50cafb536c6..24893911525 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -11925,9 +11925,7 @@ The type of the item is non-elementary (e.g.@: a record or array).
 
 @item
 There is explicit or implicit initialization required for the object.
-Note that access values are always implicitly initialized, and also
-in GNAT, certain bit-packed arrays (those having a dynamic length or
-a length greater than 64) will also be implicitly initialized to zero.
+Note that access values are always implicitly initialized.
 
 @item
 The address value is non-static.  Here GNAT is more permissive than the
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 7e9b243b943..377eb75bd1a 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -10092,9 +10092,6 @@ and some of the techniques for making your program run faster.
 It then documents the @command{gnatelim} tool and unused subprogram/data
 elimination feature, which can reduce the size of program executables.
 
-Note: to invoke @command{gnatelim} with a project file, use the @code{gnat}
-driver (see @ref{The GNAT Driver and Project Files}).
-
 @ifnottex
 @menu
 * Performance Considerations::
@@ -11018,6 +11015,10 @@ indicate that the analysed set of sources is incomplete to make up a
 partition and that some subprogram bodies are missing are not generated.
 @end table
 
+@noindent
+Note: to invoke @command{gnatelim} with a project file, use the @code{gnat}
+driver (see @ref{The GNAT Driver and Project Files}).
+
 @node Processing Precompiled Libraries
 @subsection Processing Precompiled Libraries
 
@@ -12832,6 +12833,7 @@ the configuration file describing the corresponding naming scheme;
 see the description of the @command{gnatpp}
 switches below. Another possibility is to use a project file and to
 call @command{gnatpp} through the @command{gnat} driver
+(see @ref{The GNAT Driver and Project Files}).
 
 The @command{gnatpp} command has the form
 
@@ -13959,7 +13961,7 @@ in files with names that do not follow the GNAT file naming rules, you have to
 provide the configuration file describing the corresponding naming scheme (see
 the description of the @command{gnatmetric} switches below.)
 Alternatively, you may use a project file and invoke @command{gnatmetric}
-through the @command{gnat} driver.
+through the @command{gnat} driver (see @ref{The GNAT Driver and Project Files}).
 
 The @command{gnatmetric} command has the form
 
diff --git a/gcc/ada/s-finmas.adb b/gcc/ada/s-finmas.adb
index c663988f43a..8474ff4a8f3 100644
--- a/gcc/ada/s-finmas.adb
+++ b/gcc/ada/s-finmas.adb
@@ -77,18 +77,28 @@ package body System.Finalization_Masters is
    procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr) is
    begin
       Lock_Task.all;
-
-      L.Next.Prev := N;
-      N.Next := L.Next;
-      L.Next := N;
-      N.Prev := L;
-
+      Attach_Unprotected (N, L);
       Unlock_Task.all;
 
       --  Note: No need to unlock in case of an exception because the above
       --  code can never raise one.
    end Attach;
 
+   ------------------------
+   -- Attach_Unprotected --
+   ------------------------
+
+   procedure Attach_Unprotected
+     (N : not null FM_Node_Ptr;
+      L : not null FM_Node_Ptr)
+   is
+   begin
+      L.Next.Prev := N;
+      N.Next := L.Next;
+      L.Next := N;
+      N.Prev := L;
+   end Attach_Unprotected;
+
    ---------------
    -- Base_Pool --
    ---------------
@@ -100,16 +110,14 @@ package body System.Finalization_Masters is
       return Master.Base_Pool;
    end Base_Pool;
 
-   -----------------------------
-   -- Delete_Finalize_Address --
-   -----------------------------
+   -----------------------------------------
+   -- Delete_Finalize_Address_Unprotected --
+   -----------------------------------------
 
-   procedure Delete_Finalize_Address (Obj : System.Address) is
+   procedure Delete_Finalize_Address_Unprotected (Obj : System.Address) is
    begin
-      Lock_Task.all;
       Finalize_Address_Table.Remove (Obj);
-      Unlock_Task.all;
-   end Delete_Finalize_Address;
+   end Delete_Finalize_Address_Unprotected;
 
    ------------
    -- Detach --
@@ -117,20 +125,27 @@ package body System.Finalization_Masters is
 
    procedure Detach (N : not null FM_Node_Ptr) is
    begin
-      if N.Prev /= null and then N.Next /= null then
-         Lock_Task.all;
+      Lock_Task.all;
+      Detach_Unprotected (N);
+      Unlock_Task.all;
+
+      --  Note: No need to unlock in case of an exception because the above
+      --  code can never raise one.
+   end Detach;
 
+   ------------------------
+   -- Detach_Unprotected --
+   ------------------------
+
+   procedure Detach_Unprotected (N : not null FM_Node_Ptr) is
+   begin
+      if N.Prev /= null and then N.Next /= null then
          N.Prev.Next := N.Next;
          N.Next.Prev := N.Prev;
          N.Prev := null;
          N.Next := null;
-
-         Unlock_Task.all;
-
-         --  Note: No need to unlock in case of an exception because the above
-         --  code can never raise one.
       end if;
-   end Detach;
+   end Detach_Unprotected;
 
    --------------
    -- Finalize --
@@ -158,10 +173,14 @@ package body System.Finalization_Masters is
    --  Start of processing for Finalize
 
    begin
-      --  It is possible for multiple tasks to cause the finalization of the
-      --  same master. Let only one task finalize the objects.
+      Lock_Task.all;
+
+      --  Synchronization:
+      --    Read  - allocation, finalization
+      --    Write - finalization
 
       if Master.Finalization_Started then
+         Unlock_Task.all;
          return;
       end if;
 
@@ -170,12 +189,19 @@ package body System.Finalization_Masters is
       --  is explicitly deallocated or the associated access type is about to
       --  go out of scope.
 
+      --  Synchronization:
+      --    Read  - allocation, finalization
+      --    Write - finalization
+
       Master.Finalization_Started := True;
 
       while not Is_Empty_List (Master.Objects'Unchecked_Access) loop
          Curr_Ptr := Master.Objects.Next;
 
-         Detach (Curr_Ptr);
+         --  Synchronization:
+         --    Write - allocation, deallocation, finalization
+
+         Detach_Unprotected (Curr_Ptr);
 
          --  Skip the list header in order to offer proper object layout for
          --  finalization.
@@ -185,20 +211,28 @@ package body System.Finalization_Masters is
          --  Retrieve TSS primitive Finalize_Address depending on the master's
          --  mode of operation.
 
+         --  Synchronization:
+         --    Read  - allocation, finalization
+         --    Write - outside
+
          if Master.Is_Homogeneous then
+
+            --  Synchronization:
+            --    Read  - finalization
+            --    Write - allocation, outside
+
             Cleanup := Master.Finalize_Address;
-         else
-            Cleanup := Finalize_Address (Obj_Addr);
-         end if;
 
-         --  If Finalize_Address is not available, then this is most likely an
-         --  error in the expansion of the designated type or the allocator.
+         else
+            --  Synchronization:
+            --    Read  - finalization
+            --    Write - allocation, deallocation
 
-         pragma Assert (Cleanup /= null);
+            Cleanup := Finalize_Address_Unprotected (Obj_Addr);
+         end if;
 
          begin
             Cleanup (Obj_Addr);
-
          exception
             when Fin_Occur : others =>
                if not Raised then
@@ -210,11 +244,22 @@ package body System.Finalization_Masters is
          --  When the master is a heterogeneous collection, destroy the object
          --  - Finalize_Address pair since it is no longer needed.
 
+         --  Synchronization:
+         --    Read  - finalization
+         --    Write - outside
+
          if not Master.Is_Homogeneous then
-            Delete_Finalize_Address (Obj_Addr);
+
+            --  Synchronization:
+            --    Read  - finalization
+            --    Write - allocation, deallocation, finalization
+
+            Delete_Finalize_Address_Unprotected (Obj_Addr);
          end if;
       end loop;
 
+      Unlock_Task.all;
+
       --  If the finalization of a particular object failed or Finalize_Address
       --  was not set, reraise the exception now.
 
@@ -234,20 +279,16 @@ package body System.Finalization_Masters is
       return Master.Finalize_Address;
    end Finalize_Address;
 
-   ----------------------
-   -- Finalize_Address --
-   ----------------------
+   ----------------------------------
+   -- Finalize_Address_Unprotected --
+   ----------------------------------
 
-   function Finalize_Address
+   function Finalize_Address_Unprotected
      (Obj : System.Address) return Finalize_Address_Ptr
    is
-      Result : Finalize_Address_Ptr;
    begin
-      Lock_Task.all;
-      Result := Finalize_Address_Table.Get (Obj);
-      Unlock_Task.all;
-      return Result;
-   end Finalize_Address;
+      return Finalize_Address_Table.Get (Obj);
+   end Finalize_Address_Unprotected;
 
    --------------------------
    -- Finalization_Started --
@@ -463,36 +504,40 @@ package body System.Finalization_Masters is
       Fin_Addr_Ptr : Finalize_Address_Ptr)
    is
    begin
-      --  TSS primitive Finalize_Address is set at the point of allocation,
-      --  either through Allocate_Any_Controlled or through this routine.
-      --  Since multiple tasks can allocate on the same finalization master,
-      --  access to this attribute must be protected.
+      --  Synchronization:
+      --    Read  - finalization
+      --    Write - allocation, outside
 
       Lock_Task.all;
+      Set_Finalize_Address_Unprotected (Master, Fin_Addr_Ptr);
+      Unlock_Task.all;
+   end Set_Finalize_Address;
 
+   --------------------------------------
+   -- Set_Finalize_Address_Unprotected --
+   --------------------------------------
+
+   procedure Set_Finalize_Address_Unprotected
+     (Master       : in out Finalization_Master;
+      Fin_Addr_Ptr : Finalize_Address_Ptr)
+   is
+   begin
       if Master.Finalize_Address = null then
          Master.Finalize_Address := Fin_Addr_Ptr;
       end if;
+   end Set_Finalize_Address_Unprotected;
 
-      Unlock_Task.all;
-   end Set_Finalize_Address;
-
-   ----------------------------------------
-   -- Set_Heterogeneous_Finalize_Address --
-   ----------------------------------------
+   ----------------------------------------------------
+   -- Set_Heterogeneous_Finalize_Address_Unprotected --
+   ----------------------------------------------------
 
-   procedure Set_Heterogeneous_Finalize_Address
+   procedure Set_Heterogeneous_Finalize_Address_Unprotected
      (Obj          : System.Address;
       Fin_Addr_Ptr : Finalize_Address_Ptr)
    is
    begin
-      --  Protected access is required in this case because
-      --  Finalize_Address_Table is a global data structure.
-
-      Lock_Task.all;
       Finalize_Address_Table.Set (Obj, Fin_Addr_Ptr);
-      Unlock_Task.all;
-   end Set_Heterogeneous_Finalize_Address;
+   end Set_Heterogeneous_Finalize_Address_Unprotected;
 
    --------------------------
    -- Set_Is_Heterogeneous --
@@ -500,7 +545,13 @@ package body System.Finalization_Masters is
 
    procedure Set_Is_Heterogeneous (Master : in out Finalization_Master) is
    begin
+      --  Synchronization:
+      --    Read  - finalization
+      --    Write - outside
+
+      Lock_Task.all;
       Master.Is_Homogeneous := False;
+      Unlock_Task.all;
    end Set_Is_Heterogeneous;
 
 end System.Finalization_Masters;
diff --git a/gcc/ada/s-finmas.ads b/gcc/ada/s-finmas.ads
index bb9ff5bdc3c..f0dd5b8767e 100644
--- a/gcc/ada/s-finmas.ads
+++ b/gcc/ada/s-finmas.ads
@@ -74,13 +74,23 @@ package System.Finalization_Masters is
    for Finalization_Master_Ptr'Storage_Size use 0;
 
    procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr);
+   --  Compiler interface, do not call from withing the run-time. Prepend a
+   --  node to a specific finalization master.
+
+   procedure Attach_Unprotected
+     (N : not null FM_Node_Ptr;
+      L : not null FM_Node_Ptr);
    --  Prepend a node to a specific finalization master
 
-   procedure Delete_Finalize_Address (Obj : System.Address);
+   procedure Delete_Finalize_Address_Unprotected (Obj : System.Address);
    --  Destroy the relation pair object - Finalize_Address from the internal
    --  hash table.
 
    procedure Detach (N : not null FM_Node_Ptr);
+   --  Compiler interface, do not call from within the run-time. Remove a node
+   --  from an arbitrary finalization master.
+
+   procedure Detach_Unprotected (N : not null FM_Node_Ptr);
    --  Remove a node from an arbitrary finalization master
 
    overriding procedure Finalize (Master : in out Finalization_Master);
@@ -93,7 +103,7 @@ package System.Finalization_Masters is
    --  Return a reference to the TSS primitive Finalize_Address associated with
    --  a master.
 
-   function Finalize_Address
+   function Finalize_Address_Unprotected
      (Obj : System.Address) return Finalize_Address_Ptr;
    --  Retrieve the Finalize_Address primitive associated with a particular
    --  object.
@@ -119,9 +129,15 @@ package System.Finalization_Masters is
    procedure Set_Finalize_Address
      (Master       : in out Finalization_Master;
       Fin_Addr_Ptr : Finalize_Address_Ptr);
+   --  Compiler interface, do not call from within the run-time. Set the clean
+   --  up routine of a finalization master
+
+   procedure Set_Finalize_Address_Unprotected
+     (Master       : in out Finalization_Master;
+      Fin_Addr_Ptr : Finalize_Address_Ptr);
    --  Set the clean up routine of a finalization master
 
-   procedure Set_Heterogeneous_Finalize_Address
+   procedure Set_Heterogeneous_Finalize_Address_Unprotected
      (Obj          : System.Address;
       Fin_Addr_Ptr : Finalize_Address_Ptr);
    --  Add a relation pair object - Finalize_Address to the internal hash
@@ -165,11 +181,9 @@ private
       --  is used only when the master is in homogeneous mode.
 
       Finalization_Started : Boolean := False;
-      pragma Atomic (Finalization_Started);
       --  A flag used to detect allocations which occur during the finalization
       --  of a master. The allocations must raise Program_Error. This scenario
-      --  may arise in a multitask environment. The flag is atomic because it
-      --  is accessed without Lock_Task / Unlock_Task.
+      --  may arise in a multitask environment.
    end record;
 
    --  Since RTSfind cannot contain names of the form RE_"+", the following
diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb
index b8ad53d613b..4bbff767d96 100644
--- a/gcc/ada/s-stposu.adb
+++ b/gcc/ada/s-stposu.adb
@@ -109,6 +109,9 @@ package body System.Storage_Pools.Subpools is
       N_Size  : Storage_Count;
       Subpool : Subpool_Handle := null;
 
+      Allocation_Locked : Boolean;
+      --  This flag stores the state of the associated collection
+
       Header_And_Padding : Storage_Offset;
       --  This offset includes the size of a FM_Node plus any additional
       --  padding due to a larger alignment.
@@ -156,22 +159,22 @@ package body System.Storage_Pools.Subpools is
          --  failed to create one. This is a serious error.
 
          if Context_Master = null then
-            raise Program_Error with "missing master in pool allocation";
-         end if;
+            raise Program_Error
+              with "missing master in pool allocation";
 
          --  If a subpool is present, then this is the result of erroneous
          --  allocator expansion. This is not a serious error, but it should
          --  still be detected.
 
-         if Context_Subpool /= null then
-            raise Program_Error with "subpool not required in pool allocation";
-         end if;
+         elsif Context_Subpool /= null then
+            raise Program_Error
+              with "subpool not required in pool allocation";
 
          --  If the allocation is intended to be on a subpool, but the access
          --  type's pool does not support subpools, then this is the result of
          --  erroneous end-user code.
 
-         if On_Subpool then
+         elsif On_Subpool then
             raise Program_Error
               with "pool of access type does not support subpools";
          end if;
@@ -187,10 +190,18 @@ package body System.Storage_Pools.Subpools is
 
       if Is_Controlled then
 
+         --  Synchronization:
+         --    Read  - allocation, finalization
+         --    Write - finalization
+
+         Lock_Task.all;
+         Allocation_Locked := Finalization_Started (Master.all);
+         Unlock_Task.all;
+
          --  Do not allow the allocation of controlled objects while the
          --  associated master is being finalized.
 
-         if Finalization_Started (Master.all) then
+         if Allocation_Locked then
             raise Program_Error with "allocation after finalization started";
          end if;
 
@@ -240,6 +251,7 @@ package body System.Storage_Pools.Subpools is
       --  Step 4: Attachment
 
       if Is_Controlled then
+         Lock_Task.all;
 
          --  Map the allocated memory into a FM_Node record. This converts the
          --  top of the allocated bits into a list header. If there is padding
@@ -262,7 +274,10 @@ package body System.Storage_Pools.Subpools is
 
          --  Prepend the allocated object to the finalization master
 
-         Attach (N_Ptr, Objects (Master.all));
+         --  Synchronization:
+         --    Write - allocation, deallocation, finalization
+
+         Attach_Unprotected (N_Ptr, Objects (Master.all));
 
          --  Move the address from the hidden list header to the start of the
          --  object. This operation effectively hides the list header.
@@ -275,8 +290,17 @@ package body System.Storage_Pools.Subpools is
          --    2) Named access types
          --    3) Most cases of anonymous access types usage
 
+         --  Synchronization:
+         --    Read  - allocation, finalization
+         --    Write - outside
+
          if Master.Is_Homogeneous then
-            Set_Finalize_Address (Master.all, Fin_Address);
+
+            --  Synchronization:
+            --    Read  - finalization
+            --    Write - allocation, outside
+
+            Set_Finalize_Address_Unprotected (Master.all, Fin_Address);
 
          --  Heterogeneous masters service the following:
 
@@ -284,10 +308,16 @@ package body System.Storage_Pools.Subpools is
          --    2) Certain cases of anonymous access types usage
 
          else
-            Set_Heterogeneous_Finalize_Address (Addr, Fin_Address);
+            --  Synchronization:
+            --    Read  - finalization
+            --    Write - allocation, deallocation
+
+            Set_Heterogeneous_Finalize_Address_Unprotected (Addr, Fin_Address);
             Finalize_Address_Table_In_Use := True;
          end if;
 
+         Unlock_Task.all;
+
       --  Non-controlled allocation
 
       else
@@ -341,12 +371,18 @@ package body System.Storage_Pools.Subpools is
       --  Step 1: Detachment
 
       if Is_Controlled then
+         Lock_Task.all;
 
          --  Destroy the relation pair object - Finalize_Address since it is no
          --  longer needed.
 
          if Finalize_Address_Table_In_Use then
-            Delete_Finalize_Address (Addr);
+
+            --  Synchronization:
+            --    Read  - finalization
+            --    Write - allocation, deallocation
+
+            Delete_Finalize_Address_Unprotected (Addr);
          end if;
 
          --  Account for possible padding space before the header due to a
@@ -376,7 +412,10 @@ package body System.Storage_Pools.Subpools is
          --  action does not need to know the prior context used during
          --  allocation.
 
-         Detach (N_Ptr);
+         --  Synchronization:
+         --    Write - allocation, deallocation, finalization
+
+         Detach_Unprotected (N_Ptr);
 
          --  Move the address from the object to the beginning of the list
          --  header.
@@ -388,6 +427,8 @@ package body System.Storage_Pools.Subpools is
 
          N_Size := Storage_Size + Header_And_Padding;
 
+         Unlock_Task.all;
+
       else
          N_Addr := Addr;
          N_Size := Storage_Size;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index cd833d5d04e..98169b276d1 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -19570,17 +19570,16 @@ package body Sem_Ch3 is
    --  do not know the exact end points at the time of the declaration. This
    --  is true for three reasons:
 
-   --     A size clause may affect the fudging of the end-points
-   --     A small clause may affect the values of the end-points
-   --     We try to include the end-points if it does not affect the size
+   --     A size clause may affect the fudging of the end-points.
+   --     A small clause may affect the values of the end-points.
+   --     We try to include the end-points if it does not affect the size.
 
-   --  This means that the actual end-points must be established at the point
-   --  when the type is frozen. Meanwhile, we first narrow the range as
-   --  permitted (so that it will fit if necessary in a small specified size),
-   --  and then build a range subtree with these narrowed bounds.
-
-   --  Set_Fixed_Range constructs the range from real literal values, and sets
-   --  the range as the Scalar_Range of the given fixed-point type entity.
+   --  This means that the actual end-points must be established at the
+   --  point when the type is frozen. Meanwhile, we first narrow the range
+   --  as permitted (so that it will fit if necessary in a small specified
+   --  size), and then build a range subtree with these narrowed bounds.
+   --  Set_Fixed_Range constructs the range from real literal values, and
+   --  sets the range as the Scalar_Range of the given fixed-point type entity.
 
    --  The parent of this range is set to point to the entity so that it is
    --  properly hooked into the tree (unlike normal Scalar_Range entries for
@@ -19605,6 +19604,12 @@ package body Sem_Ch3 is
    begin
       Set_Scalar_Range (E, S);
       Set_Parent (S, E);
+
+      --  Before the freeze point, the bounds of a fixed point are universal
+      --  and carry the corresponding type.
+
+      Set_Etype (Low_Bound (S),  Universal_Real);
+      Set_Etype (High_Bound (S), Universal_Real);
    end Set_Fixed_Range;
 
    ----------------------------------
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 5be584307af..64db8d634b6 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -250,27 +250,32 @@ package body Sem_Eval is
                       and not Range_Checks_Suppressed (T);
 
    begin
-      --  Ignore cases of non-scalar types or error types
+      --  Ignore cases of non-scalar types, error types, or universal real
+      --  types that have no usable bounds.
 
-      if T = Any_Type or else not Is_Scalar_Type (T) then
+      if T = Any_Type
+        or else not Is_Scalar_Type (T)
+        or else T = Universal_Fixed
+        or else T = Universal_Real
+      then
          return;
       end if;
 
-      --  At this stage we have a scalar type. If we have an expression
-      --  that raises CE, then we already issued a warning or error msg
-      --  so there is nothing more to be done in this routine.
+      --  At this stage we have a scalar type. If we have an expression that
+      --  raises CE, then we already issued a warning or error msg so there
+      --  is nothing more to be done in this routine.
 
       if Raises_Constraint_Error (N) then
          return;
       end if;
 
-      --  Now we have a scalar type which is not marked as raising a
-      --  constraint error exception. The main purpose of this routine
-      --  is to deal with static expressions appearing in a non-static
-      --  context. That means that if we do not have a static expression
-      --  then there is not much to do. The one case that we deal with
-      --  here is that if we have a floating-point value that is out of
-      --  range, then we post a warning that an infinity will result.
+      --  Now we have a scalar type which is not marked as raising a constraint
+      --  error exception. The main purpose of this routine is to deal with
+      --  static expressions appearing in a non-static context. That means
+      --  that if we do not have a static expression then there is not much
+      --  to do. The one case that we deal with here is that if we have a
+      --  floating-point value that is out of range, then we post a warning
+      --  that an infinity will result.
 
       if not Is_Static_Expression (N) then
          if Is_Floating_Point_Type (T)
@@ -283,17 +288,17 @@ package body Sem_Eval is
          return;
       end if;
 
-      --  Here we have the case of outer level static expression of
-      --  scalar type, where the processing of this procedure is needed.
+      --  Here we have the case of outer level static expression of scalar
+      --  type, where the processing of this procedure is needed.
 
       --  For real types, this is where we convert the value to a machine
-      --  number (see RM 4.9(38)). Also see ACVC test C490001. We should
-      --  only need to do this if the parent is a constant declaration,
-      --  since in other cases, gigi should do the necessary conversion
-      --  correctly, but experimentation shows that this is not the case
-      --  on all machines, in particular if we do not convert all literals
-      --  to machine values in non-static contexts, then ACVC test C490001
-      --  fails on Sparc/Solaris and SGI/Irix.
+      --  number (see RM 4.9(38)). Also see ACVC test C490001. We should only
+      --  need to do this if the parent is a constant declaration, since in
+      --  other cases, gigi should do the necessary conversion correctly, but
+      --  experimentation shows that this is not the case on all machines, in
+      --  particular if we do not convert all literals to machine values in
+      --  non-static contexts, then ACVC test C490001 fails on Sparc/Solaris
+      --  and SGI/Irix.
 
       if Nkind (N) = N_Real_Literal
         and then not Is_Machine_Number (N)
@@ -320,12 +325,12 @@ package body Sem_Eval is
 
          elsif not UR_Is_Zero (Realval (N)) then
 
-            --  Note: even though RM 4.9(38) specifies biased rounding,
-            --  this has been modified by AI-100 in order to prevent
-            --  confusing differences in rounding between static and
-            --  non-static expressions. AI-100 specifies that the effect
-            --  of such rounding is implementation dependent, and in GNAT
-            --  we round to nearest even to match the run-time behavior.
+            --  Note: even though RM 4.9(38) specifies biased rounding, this
+            --  has been modified by AI-100 in order to prevent confusing
+            --  differences in rounding between static and non-static
+            --  expressions. AI-100 specifies that the effect of such rounding
+            --  is implementation dependent, and in GNAT we round to nearest
+            --  even to match the run-time behavior.
 
             Set_Realval
               (N, Machine (Base_Type (T), Realval (N), Round_Even, N));
@@ -455,10 +460,10 @@ package body Sem_Eval is
       --  simple cases can be recognized.
 
       function Is_Same_Value (L, R : Node_Id) return Boolean;
-      --  Returns True iff L and R represent expressions that definitely
-      --  have identical (but not necessarily compile time known) values
-      --  Indeed the caller is expected to have already dealt with the
-      --  cases of compile time known values, so these are not tested here.
+      --  Returns True iff L and R represent expressions that definitely have
+      --  identical (but not necessarily compile time known) values Indeed the
+      --  caller is expected to have already dealt with the cases of compile
+      --  time known values, so these are not tested here.
 
       -----------------------
       -- Compare_Decompose --