------------------------------------------------------------------------------
--                                                                         --
--                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
--                                                                         --
--              S Y S T E M . T A S K I N G . A B O R T I O N              --
--                                                                         --
--                                 B o d y                                 --
--                                                                         --
--                            $Revision: 1.12 $                             --
--                                                                         --
--       Copyright (c) 1991,1992,1993,1994, FSU, All Rights Reserved        --
--                                                                          --
-- GNARL 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.  GNARL is distributed  in the hope that  it will be use- --
-- ful, but but WITHOUT ANY WARRANTY;  without even the implied warranty of --
-- MERCHANTABILITY  or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
-- eral Library Public License  for more details.  You should have received --
-- a  copy of the GNU Library General Public License along with GNARL;  see --
-- file COPYING.LIB.  If not,  write to the  Free Software Foundation,  675 --
-- Mass Ave, Cambridge, MA 02139, USA.                                      --
--                                                                          --
------------------------------------------------------------------------------

with System.Tasking.Utilities;
--  Used for, Utilities.ID_To_ATCB,
--            Utilities.ATCB_To_ID,
--            Utilities.ATCB_Ptr,
--            Utilities.Terminated,
--            Utilities.Not_Accepting,
--            Utilities.All_Tasks_L,
--            Utilities.All_Tasks_List
--            Utilities.Abort_To_Level,
--            Utilities.Abort_Dependents

with System.Task_Primitives; use System.Task_Primitives;

package body System.Tasking.Abortion is

   function ID_To_ATCB (ID : Task_ID) return Utilities.ATCB_Ptr
     renames Utilities.ID_To_ATCB;

   function ATCB_To_ID (Ptr : Utilities.ATCB_Ptr) return Task_ID
     renames Utilities.ATCB_To_ID;

   function "=" (L, R : Utilities.Task_Stage) return Boolean
     renames Utilities."=";

   function "=" (L, R : Utilities.ATCB_Ptr) return Boolean
     renames Utilities."=";

   function "=" (L, R : Utilities.Accepting_State) return Boolean
     renames Utilities."=";

   --------------------------
   -- Change_Base_Priority --
   --------------------------

   procedure Change_Base_Priority (T : Utilities.ATCB_Ptr) is

   begin
      --  check for ceiling violations ???
      T.Pending_Priority_Change := False;
      T.Base_Priority := T.New_Base_Priority;
      T.Current_Priority := T.Base_Priority;
      Set_Priority (T.LL_TCB'Access, T. Current_Priority);
   end Change_Base_Priority;

   --------------------
   -- Defer_Abortion --
   --------------------

   procedure Defer_Abortion is
      T : Utilities.ATCB_Ptr := ID_To_ATCB (Self);

   begin
      T.Deferral_Level := T.Deferral_Level + 1;
   end Defer_Abortion;

   ----------------------
   -- Undefer_Abortion --
   ----------------------

   --  Precondition : Self does not hold any locks!

   --  Undefer_Abortion is called on any abortion completion point (aka.
   --  synchonization point). It performs the following actions if they
   --  are pending: (1) change the base priority, (2) abort the task.
   --  The priority change has to occur before abortion. Otherwise, it would
   --  take effect no earlier than the next abortion completion point.
   --  This version of Undefer_Abortion redefers abortion if abortion is
   --  in progress.  There has been some discussion of having
   --  the raise statement defer abortion to prevent abortion of
   --  handlers performing required completion.  This would make
   --  the explicit deferral unnecessary. ???

   procedure Undefer_Abortion is
      T : Utilities.ATCB_Ptr := ID_To_ATCB (Self);
      Error : Boolean;

   begin
      T.Deferral_Level := T.Deferral_Level - 1;

      if T.Deferral_Level = ATC_Level'First and then T.Pending_Action then
         Write_Lock (T.L, Error);
         T.Pending_Action := False;

         if T.Pending_Priority_Change then
            Change_Base_Priority (T);
         end if;

         Unlock (T.L);

         if T.Pending_ATC_Level < T.ATC_Nesting_Level then
            T.Deferral_Level := T.Deferral_Level + 1;
            raise Standard'Abort_Signal;
         end if;
      end if;

   end Undefer_Abortion;

   -----------------
   -- Abort_Tasks --
   -----------------

   --  Called to initiate abortion, however, the actual abortion
   --  is done by abortee by means of Abort_Handler

   procedure Abort_Tasks (Tasks : Task_List) is
      Abortee               : Utilities.ATCB_Ptr;
      Aborter               : Utilities.ATCB_Ptr;
      Activator             : Utilities.ATCB_Ptr;
      TAS_Result            : Boolean;
      Old_Pending_ATC_Level : ATC_Level_Base;

   begin
      Defer_Abortion;

      --  Begin non-abortable section

      Aborter := ID_To_ATCB (Self);

      for J in Tasks'Range loop

         Abortee := ID_To_ATCB (Tasks (J));

         if Abortee.Stage = Utilities.Created then
            Utilities.Complete (ATCB_To_ID (Abortee));
            Abortee.Stage := Utilities.Terminated;
            --  Task aborted before activation is safe to complete
            --  Mark This task to be terminated.
         else
            Abortee.Accepting := Utilities.Not_Accepting;
            Utilities.Complete_on_Sync_Point (ATCB_To_ID (Abortee));
            Utilities.Abort_To_Level (ATCB_To_ID (Abortee), 0);
            --  Process abortion of child tasks
            Utilities.Abort_Dependents (ATCB_To_ID (Abortee));
         end if;

      end loop;

      --  End non-abortable section

      Undefer_Abortion;
   end Abort_Tasks;

end System.Tasking.Abortion;
