------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                S Y S T E M . L I S T _ F I N A L I Z A T I O N           --
--                                                                          --
--                                B o d y                                   --
--                                                                          --
--                            $Revision: 1.2 $                              --
--                                                                          --
--     Copyright (C) 1992,1993,1994, 1995 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 2,  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.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

with System.Finalization_Implementation;

package body Ada.Finalization.List_Controller is

   --  List controllers are in charge of finalizing dynamic objects
   --  at the latest when the execution leave the scope of their access
   --  type. Since an objet can be allocated with a pointer type and
   --  deallocated with another, The objects attached to the list controller
   --  must know at run-time what list_controller it is attached to, so
   --  that, the first element can be detached properly by updating the
   --  list controller. This is achieved by using a Mark that is attached to
   --  the prev of the first element and which points to the List_Controller

   --  Empty List_Controller:
   --                                             +----------------+
   --                                +--------->  |    Mark tag    |
   --         +-----------------+    |            +----------------+
   --         |      LC tag     | <---------------|----- prev      |
   --         +-----------------+    |            +----------------+
   --         |     prev        |    |            |    next (null) |
   --         +-----------------+    |            +----------------+
   --         |     next        |    |
   --         +-----------------+    |
   --         |    F  ----------|----+
   --         +-----------------+


   --  non-empty List_Controller:
   --                                             +----------------+
   --                                          +->|    Mark tag    |
   --         +-----------------+              |  +----------------+
   --         |      LC tag     | <------------|--|----- prev      |
   --         +-----------------+              |  +----------------+
   --         |     prev        |              |  |    next (null) |
   --         +-----------------+              |  +----------------+
   --         |     next        |              |
   --         +-----------------+     +--------|--+   +------+   +------+
   --         |    F  ----------|---->|  tag   |  |   | tag  |   | tag  |
   --         +-----------------+     +--------|--+   +------+   +------+
   --                                 | prev --+  |<--|---   |<--|---   |
   --                                 +-----------+   +------+   +------+
   --                                 | next -----|-->|  ----|-->|  ----|--->
   --                                 +-----------+   +------+   +------+

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (Object : in out List_Controller) is
   begin
      Object.F := Object.M'Unchecked_Access;
      Object.M.Prev := Object'Unchecked_Access;
   end Initialize;

   --------------
   -- Finalize --
   --------------

   procedure Finalize   (Object : in out List_Controller) is
      use System.Finalization_Implementation;

   begin

      if Object.F = null then           -- double finalization
         null;

      elsif Object.F.all in Mark then   -- Empty list controller
         Object.F := null;

      else                              -- Normal case
         Finalize_List (Object.F);
         Object.F := null;
      end if;
   end Finalize;

   ------------------------
   -- Is_List_Controller --
   ------------------------

   function Is_List_Controller (L : Finalizable_Ptr) return Boolean is
   begin
      return L.all in Mark;
   end Is_List_Controller;

   -------------------------------
   --  Is_Empty_List_Controller --
   -------------------------------

   function Is_Empty_List_Controller (L : Finalizable_Ptr) return Boolean is
   begin
      return L.all in Mark;
   end Is_Empty_List_Controller;


   -----------------------------
   --  Update_List_Controller --
   -----------------------------

   procedure Update_List_Controller (L, Obj_Ref : Finalizable_Ptr) is
   begin
      if Obj_Ref /= null then
         List_Controller (Mark (L.all).Prev.all).F := Obj_Ref;
      else
         List_Controller (Mark (L.all).Prev.all).F := L;
      end if;
   end Update_List_Controller;

   procedure Initialize (M : in out Mark) is
   begin
      null;
   end Initialize;

   procedure Finalize   (M : in out Mark) is
   begin
      null;
   end Finalize;
end Ada.Finalization.List_Controller;
