------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--        S Y S T E M . F I N A L I Z A T I O N _ P R I M I T I V E S       --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--         Copyright (C) 2023-2025, 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- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with System.OS_Locks;
with System.Storage_Elements;

--  This package encapsulates the types and operations used by the compiler
--  to support finalization of objects of finalizable types (types derived
--  from standard Ada types Controlled and Limited_Controlled, as well as
--  types declared with the GNAT Finalizable aspect).

package System.Finalization_Primitives with Preelaborate is

   use type System.Storage_Elements.Storage_Offset;

   type Finalize_Address_Ptr is access procedure (Obj : System.Address);
   --  Values of this type denote finalization procedures associated with
   --  objects that have controlled parts. For convenience, such objects
   --  are simply referred to as controlled objects in the remainder of
   --  this package.

   type Master_Node is private;
   --  Each controlled object associated with a finalization master has an
   --  associated master node created by the compiler.

   type Master_Node_Ptr is access all Master_Node;
   for Master_Node_Ptr'Storage_Size use 0;
   --  A reference to a master node. Since this type may not be used to
   --  allocate objects, its storage size is zero.

   --------------------------------------------------------------------------
   --  Types and operations of finalization masters: A finalization master
   --  is used to manage a set of controlled objects declared at the library
   --  level of the program or associated with the declarative part of a
   --  subprogram or other closed scopes (block statements, for example).

   type Finalization_Master
     (Exceptions_OK : Boolean;
      Extra_Info    : Boolean;
      Library_Level : Boolean) is limited private;
   --  Objects of this type encapsulate an ordered list of zero or more master
   --  nodes, each of which is associated with a controlled object.

   procedure Attach_Object_To_Master
     (Object_Address   : System.Address;
      Finalize_Address : not null Finalize_Address_Ptr;
      Node             : not null Master_Node_Ptr;
      Master           : in out Finalization_Master);
   --  Associates a controlled object and its master node with a given master.
   --  Finalize_Address denotes the operation to be called to finalize the
   --  object (which could be a user-declared Finalize procedure or a procedure
   --  generated by the compiler). An object can be associated with at most one
   --  finalization master.

   procedure Attach_Object_To_Node
     (Object_Address   : System.Address;
      Finalize_Address : not null Finalize_Address_Ptr;
      Node             : in out Master_Node);
   --  Associates a controlled object with its master node only. This is used
   --  when there is a single object to be finalized in the context, as well as
   --  for objects that need special processing (return object in an extended
   --  return statement or transient objects).

   procedure Chain_Node_To_Master
     (Node   : not null Master_Node_Ptr;
      Master : in out Finalization_Master);
   --  Chain a master node to the given master. This is used to chain the node
   --  to the master of the enclosing scope for the objects that need special
   --  processing mentioned for Attach_Object_To_Node.

   procedure Finalize_Master (Master : in out Finalization_Master);
   --  Finalizes each of the controlled objects associated with Master, in the
   --  reverse of the order in which they were attached. Calls to the procedure
   --  with a Master that has already been finalized have no effects.

   procedure Finalize_Object
     (Node             : in out Master_Node;
      Finalize_Address : Finalize_Address_Ptr);
   --  Finalizes the controlled object attached to Node by generating a call to
   --  Finalize_Address on it, which has to be equal to Node.Finalize_Address.
   --  The weird redundancy is intended to help the optimizer turn an indirect
   --  call to Finalize_Address into a direct one and then inline it if needed,
   --  after having inlined Finalize_Object itself. Calls to the procedure with
   --  a Node that has already been finalized have no effects.

   procedure Suppress_Object_Finalize_At_End (Node : in out Master_Node);
   --  Changes the state of Node to effectively suppress a call to Node's
   --  associated object's Finalize procedure. This is called at the end
   --  of an extended return statement of a function whose result type
   --  needs finalization, to ensure that the function's return object is
   --  not finalized within the function in the case the return statement
   --  is completed normally (it will still be finalized if an exception
   --  is raised before the normal completion of the return statement).

   --------------------------------------------------------------------------
   --  Types and operations of finalization collections: A finalization
   --  collection is used to manage a set of controlled objects associated
   --  with an access type. Such collections are always associated with a
   --  finalization master, either at the library-level or within a subprogram,
   --  depending on where the access type is declared, and the collection
   --  object itself is managed via a Master_Node attached to its finalization
   --  master.

   type Finalization_Collection is limited private
     with Finalizable => (Initialize           => Initialize,
                          Finalize             => Finalize,
                          Relaxed_Finalization => Standard.False);
   --  Objects of this type encapsulate a set of zero or more controlled
   --  objects associated with an access type. The compiler ensures that
   --  each finalization collection is in turn associated with a finalization
   --  master.

   type Finalization_Collection_Ptr is access all Finalization_Collection;
   for Finalization_Collection_Ptr'Storage_Size use 0;
   --  A reference to a collection. Since this type may not be used to
   --  allocate objects, its storage size is zero.

   procedure Initialize (Collection : in out Finalization_Collection);
   --  Initializes the dummy head of a collection

   procedure Finalize (Collection : in out Finalization_Collection);
   --  Finalizes each object that has been associated with a finalization
   --  collection, in some arbitrary order. Calls to this procedure with
   --  a collection that has already been finalized have no effect.

   procedure Attach_Object_To_Collection
     (Object_Address   : System.Address;
      Finalize_Address : not null Finalize_Address_Ptr;
      Collection       : in out Finalization_Collection);
   --  Associates a controlled object allocated for some access type with a
   --  given finalization collection. Finalize_Address denotes the operation
   --  to be called to finalize the object (which could be a user-declared
   --  Finalize procedure or a procedure generated by the compiler). An object
   --  can be associated with at most one finalization collection.

   procedure Detach_Object_From_Collection (Object_Address : System.Address);
   --  Removes a controlled object from its associated finalization collection.
   --  Calls to the procedure with an object that has already been detached
   --  have no effects.

   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;
  --  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

   --  Finalization masters:

   --  Master 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.

   type Master_Node is record
      Finalize_Address : Finalize_Address_Ptr := null;
      Object_Address   : System.Address       := Null_Address;
      Next             : Master_Node_Ptr      := null;
   end record;

    --  Finalization master type structure. A unique master is associated
    --  with each scope containing controlled objects.

   type Finalization_Master
     (Exceptions_OK : Boolean;
      Extra_Info    : Boolean;
      Library_Level : Boolean) is limited
   record
      Head : Master_Node_Ptr := null;
   end record;

   --  These operations need to be performed in line for maximum performance

   pragma Inline (Attach_Object_To_Master);
   pragma Inline (Attach_Object_To_Node);
   pragma Inline (Chain_Node_To_Master);
   pragma Inline (Finalize_Object);
   pragma Inline (Suppress_Object_Finalize_At_End);

   --  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.

   type Collection_Node is record
      Finalize_Address : Finalize_Address_Ptr := null;
      --  A pointer to the Finalize_Address procedure of the object

      Enclosing_Collection : Finalization_Collection_Ptr := null;
      --  A pointer to the collection to which the node is attached

      Prev : Collection_Node_Ptr := null;
      Next : Collection_Node_Ptr := null;
      --  Collection nodes are managed as a circular doubly-linked list
   end record;

   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

   type Finalization_Collection is limited record
      Head : aliased Collection_Node;
      --  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;
      --  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.
   end record;

   --  This operation is very simple and thus can be performed in line

   pragma Inline (Initialize);

end System.Finalization_Primitives;
