------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--    S Y S T E M . F I N A L I Z A T I O N _ I M P L E M E N T A T I O N   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.14 $                              --
--                                                                          --
--           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
--                                                                          --
-- The GNAT library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU Library General Public License as published by --
-- the Free Software  Foundation; either version 2, or (at your option) any --
-- later version.  The GNAT library is distributed in the hope that it will --
-- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
-- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
-- Library  General  Public  License for  more  details.  You  should  have --
-- received  a copy of the GNU  Library  General Public License  along with --
-- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
-- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Finalization; use Ada.Finalization;

package body System.Finalization_Implementation is

   --------------------------
   -- Attach_To_Final_List --
   --------------------------

   procedure Attach_To_Final_List (
     L   : in out Finalizable_Ptr;
     Obj : in out Finalizable) is

   begin
      if L /= null then
         Obj.Next := L;
         Finalizable (L.all).Prev := Obj'Access;
      else
         Obj.Next := null;
      end if;

      Obj.Prev := null;
      L := Obj'Access;
   end Attach_To_Final_List;

   -------------------
   -- Finalize_List --
   -------------------

   procedure Finalize_List (L : Finalizable_Ptr) is
      P     : Finalizable_Ptr := L;
      Q     : Finalizable_Ptr;
      Error : Boolean := False;

   begin
      --  ??? pragma Abort_Defer;
      while P /= null loop
         Q := Finalizable (P.all).Next;
         begin
            Finalize (Root'Class (P.all));
         exception
            when others => Error := True;
         end;
         P := Q;
      end loop;

      if Error then
         raise Program_Error;
      end if;
   end Finalize_List;

   procedure Finalize_Global_List is
   begin
      Finalize_List (Global_Final_List);
   end Finalize_Global_List;

   ------------------
   -- Finalize_One --
   ------------------

   procedure Finalize_One (
     From   : in out Finalizable_Ptr;
     Obj    : in out  Finalizable) is

   begin
      --  ??? pragma Abort_Defer;
      if Obj.Prev = null then

         --  It must be the first of the list
         From := Obj.Next;
      else

         Finalizable (Obj.Prev.all).Next := Obj.Next;
      end if;

      if Obj.Next /= null then
         Finalizable (Obj.Next.all).Prev := Obj.Prev;
      end if;

      Finalize (Root'Class (Obj));

   exception
      when others => raise Program_Error;
   end Finalize_One;

end System.Finalization_Implementation;
