@@ -394,14 +394,14 @@ package body System.Finalization_Primitives is
(Collection : in out Finalization_Collection)
is
begin
- Collection.Finalization_Started := False;
-
-- The dummy head must point to itself in both directions
Collection.Head.Prev := Collection.Head'Unchecked_Access;
Collection.Head.Next := Collection.Head'Unchecked_Access;
Initialize_RTS_Lock (Collection.Lock'Address);
+
+ Collection.Finalization_Started := False;
end Initialize;
---------------------
@@ -146,16 +146,6 @@ package System.Finalization_Primitives with Preelaborate is
-- collection, in some arbitrary order. Calls to this procedure with
-- a collection that has already been finalized have no effect.
- type Collection_Node is private;
- -- Each controlled object associated with a finalization collection has
- -- an associated object of this type.
-
- type Collection_Node_Ptr is access all Collection_Node;
- for Collection_Node_Ptr'Storage_Size use 0;
- pragma No_Strict_Aliasing (Collection_Node_Ptr);
- -- A reference to a collection node. Since this type may not be used to
- -- allocate objects, its storage size is zero.
-
procedure Attach_Object_To_Collection
(Object_Address : System.Address;
Finalize_Address : not null Finalize_Address_Ptr;
@@ -171,13 +161,13 @@ package System.Finalization_Primitives with Preelaborate is
-- Calls to the procedure with an object that has already been detached
-- have no effects.
- function Header_Alignment return System.Storage_Elements.Storage_Count is
- (Collection_Node'Alignment);
- -- Return the alignment of type Collection_Node as Storage_Count
+ function Header_Alignment return System.Storage_Elements.Storage_Count;
+ -- Return the alignment of the header to be placed immediately in front of
+ -- a controlled object allocated for some access type, in storage units.
- function Header_Size return System.Storage_Elements.Storage_Count is
- (Collection_Node'Object_Size / Storage_Unit);
- -- Return the object size of type Collection_Node as Storage_Count
+ function Header_Size return System.Storage_Elements.Storage_Count;
+ -- Return the size of the header to be placed immediately in front of a
+ -- controlled object allocated for some access type, in storage units.
private
@@ -221,6 +211,16 @@ private
-- Finalization collections:
+ type Collection_Node;
+ -- Each controlled object associated with a finalization collection has
+ -- an associated object of this type.
+
+ type Collection_Node_Ptr is access all Collection_Node;
+ for Collection_Node_Ptr'Storage_Size use 0;
+ pragma No_Strict_Aliasing (Collection_Node_Ptr);
+ -- A reference to a collection node. Since this type may not be used to
+ -- allocate objects, its storage size is zero.
+
-- Collection node type structure. Finalize_Address comes first because it
-- is an access-to-subprogram and, therefore, might be twice as large and
-- as aligned as an access-to-object on some platforms.
@@ -237,7 +237,11 @@ private
-- Collection nodes are managed as a circular doubly-linked list
end record;
- type Lock_Type is mod 2**8 with Size => 8;
+ function Header_Alignment return System.Storage_Elements.Storage_Count is
+ (Collection_Node'Alignment);
+
+ function Header_Size return System.Storage_Elements.Storage_Count is
+ (Collection_Node'Object_Size / Storage_Unit);
-- Finalization collection type structure
@@ -245,15 +249,15 @@ private
new Ada.Finalization.Limited_Controlled with
record
Head : aliased Collection_Node;
- -- The head of the circular doubly-linked list of Collection_Nodes
+ -- The head of the circular doubly-linked list of collection nodes
+
+ Lock : aliased System.OS_Locks.RTS_Lock;
+ -- A lock to synchronize concurrent accesses to the collection
- Finalization_Started : Boolean := False;
+ Finalization_Started : Boolean;
-- A flag used to detect allocations which occur during the finalization
-- of a collection. The allocations must raise Program_Error. This may
-- arise in a multitask environment.
-
- Lock : aliased System.OS_Locks.RTS_Lock;
- -- A lock to synchronize concurrent accesses to the collection
end record;
-- This operation is very simple and thus can be performed in line
From: Eric Botcazou <ebotcazou@adacore.com> It has been made possible by recent changes. gcc/ada/ * libgnat/s-finpri.ads (Collection_Node): Move to private part. (Collection_Node_Ptr): Likewise. (Header_Alignment): Change to declaration and move completion to private part. (Header_Size): Likewise. (Lock_Type): Delete. (Finalization_Collection): Move Lock component and remove default value for Finalization_Started component. * libgnat/s-finpri.adb (Initialize): Reorder statements. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/s-finpri.adb | 4 +-- gcc/ada/libgnat/s-finpri.ads | 48 +++++++++++++++++++----------------- 2 files changed, 28 insertions(+), 24 deletions(-)