------------------------------------------------------------------------------
--                                                                          --
--                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
--                                                                          --
--     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
--                                                                          --
--                                  B o d y                                 --
--                         (Version for new GNARL)                          --
--                                                                          --
--                             $Revision: 1.4 $                             --
--                                                                          --
--             Copyright (C) 1991-1997, Florida State University            --
--                                                                          --
-- GNARL 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. GNARL 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 GNARL; see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNARL was developed by the GNARL team at Florida State University. It is --
-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
-- State University (http://www.gnat.com).                                  --
--                                                                          --
------------------------------------------------------------------------------

--  This is a HP-UX version of this package.

with Interfaces.C;
--  used for int
--           size_t

with System.Error_Reporting;
--  used for Shutdown

with System.Interrupt_Management;
--  used for Keep_Unmasked
--           Abort_Task_Interrupt
--           Interrupt_ID

with System.Interrupt_Management.Operations;
--  used for Set_Interrupt_Mask
--           All_Tasks_Mask
pragma Elaborate_All (System.Interrupt_Management.Operations);

with System.OS_Interface;
--  used for various type, constant, and operations

with System.Parameters;
--  used for Size_Type

with System.Tasking;
--  used for Ada_Task_Control_Block
--           Task_ID

with Unchecked_Conversion;
with Unchecked_Deallocation;

package body System.Task_Primitives.Operations is

   use System.Tasking;
   use Interfaces.C;
   use System.Error_Reporting;
   use System.OS_Interface;
   use System.Parameters;

   ------------------
   --  Local Data  --
   ------------------

   --  The followings are logically constants, but need to be initialized
   --  at run time.

   ATCB_Key : aliased pthread_key_t;
   --  Key used to find the Ada Task_ID associated with a thread

   --  The followings are internal configuration constants needed.

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Abort_Handler
     (Sig     : Signal;
      Code    : access siginfo_t;
      Context : System.Address);

   function To_Task_ID is new Unchecked_Conversion (System.Address, Task_ID);

   function To_Address is new Unchecked_Conversion (Task_ID, System.Address);

   -------------------
   -- Abort_Handler --
   -------------------

   --  Target-dependent binding of inter-thread Abort signal to
   --  the raising of the Abort_Signal exception.

   --  The technical issues and alternatives here are essentially
   --  the same as for raising exceptions in response to other
   --  signals (e.g. Storage_Error).  See code and comments in
   --  the package body System.Interrupt_Management.

   --  Some implementations may not allow an exception to be propagated
   --  out of a handler, and others might leave the signal or
   --  interrupt that invoked this handler masked after the exceptional
   --  return to the application code.

   --  GNAT exceptions are originally implemented using setjmp()/longjmp().
   --  On most UNIX systems, this will allow transfer out of a signal handler,
   --  which is usually the only mechanism available for implementing
   --  asynchronous handlers of this kind.  However, some
   --  systems do not restore the signal mask on longjmp(), leaving the
   --  abort signal masked.

   --  Alternative solutions include:

   --       1. Change the PC saved in the system-dependent Context
   --          parameter to point to code that raises the exception.
   --          Normal return from this handler will then raise
   --          the exception after the mask and other system state has
   --          been restored (see example below).
   --       2. Use siglongjmp()/sigsetjmp() to implement exceptions.
   --       3. Unmask the signal in the Abortion_Signal exception handler
   --          (in the RTS).

   --  The following procedure would be needed if we can't lonjmp out of
   --  a signal handler.  (See below.)
   --  procedure Raise_Abort_Signal is
   --  begin
   --     raise Standard'Abort_Signal;
   --  end if;

   procedure Abort_Handler
     (Sig     : Signal;
      Code    : access siginfo_t;
      Context : System.Address) is

      T : Task_ID := Self;

   begin
      --  Assuming it is safe to longjmp out of a signal handler, the
      --  following code can be used:

      if T.Deferral_Level = 0
        and then T.Pending_ATC_Level < T.ATC_Nesting_Level then
         raise Standard'Abort_Signal;
      end if;

      --  Otherwise, something like this is required:
      --  if not Abort_Is_Deferred.all then
      --    --  Overwrite the return PC address with the address of the
      --    --  special raise routine, and "return" to that routine's
      --    --  starting address.
      --    Context.PC := Raise_Abort_Signal'Address;
      --    return;
      --  end if;

   end Abort_Handler;

   ----------
   -- Self --
   ----------

   function Self return Task_ID is
      Result : System.Address;

   begin
      Result := pthread_getspecific (ATCB_Key);
      pragma Assert (Result /= System.Null_Address
        or else Shutdown ("GNULLI failure---pthread_getspecific"));
      return To_Task_ID (Result);
   end Self;

   ---------------------
   -- Initialize_Lock --
   ---------------------

   --  Note: mutexes and cond_variables needed per-task basis are
   --        initialized in Intialize_TCB and the Storage_Error is
   --        handled. Other mutexes (such as All_Tasks_Lock, Memory_Lock...)
   --        used in RTS is initialized before any status change of RTS.
   --        Therefore rasing Storage_Error in the following routines
   --        should be able to be handled safely.

   procedure Initialize_Lock
     (Prio : System.Any_Priority;
      L    : access Lock)
   is
      Attributes : aliased pthread_mutexattr_t;
      Result : Interfaces.C.int;
   begin
      Result := pthread_mutexattr_init (Attributes'Access);
      pragma Assert (Result = 0 or else Result = ENOMEM
        or else Shutdown ("GNULLI failure---pthread_mutexattr_init"));

      if Result = ENOMEM then
         raise STORAGE_ERROR;
      end if;

      L.Prio_Save := 0;
      L.Prio := Interfaces.C.Int (Prio);
      L.Prio_Array := (Prio_Array_Type'Range => 0);

      Result := pthread_mutex_init (L.L'Access, Attributes'Access);

      pragma Assert (Result = 0 or else Result = ENOMEM
        or else Shutdown ("GNULLI failure---pthread_mutex_init"));

      if Result = ENOMEM then
         raise STORAGE_ERROR;
      end if;

   end Initialize_Lock;

   procedure Initialize_Lock (L : access RTS_Lock) is
      Attributes : aliased pthread_mutexattr_t;
      Result : Interfaces.C.int;

   begin
      Result := pthread_mutexattr_init (Attributes'Access);
      pragma Assert (Result = 0 or else Result = ENOMEM
        or else Shutdown ("GNULLI failure---pthread_mutexattr_init"));

      if Result = ENOMEM then
         raise STORAGE_ERROR;
      end if;

      Result := pthread_mutex_init (L, Attributes'Access);

      pragma Assert (Result = 0 or else Result = ENOMEM
        or else Shutdown ("GNULLI failure---pthread_mutex_init"));

      if Result = ENOMEM then
         raise STORAGE_ERROR;
      end if;

   end Initialize_Lock;

   -------------------
   -- Finalize_Lock --
   -------------------

   procedure Finalize_Lock (L : access Lock) is
      Result : Interfaces.C.int;

   begin
      Result := pthread_mutex_destroy (L.L'Access);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---pthread_mutex_destroy"));
   end Finalize_Lock;

   procedure Finalize_Lock (L : access RTS_Lock) is
      Result : Interfaces.C.int;

   begin
      Result := pthread_mutex_destroy (L);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---pthread_mutex_destroy"));
   end Finalize_Lock;

   ----------------
   -- Write_Lock --
   ----------------

   procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
      Result         : Interfaces.C.int;
      Self_ID        : constant Task_ID := Self;
      All_Tasks_Link : constant Task_ID := Self.All_Tasks_Link;
      Current_Prio   : System.Any_Priority;
      Array_Item     : Integer;
   begin
      Current_Prio := Get_Priority (Self_ID);

      --  if there is no other task, no need to check priorities
      if All_Tasks_Link /= Null_Task and then
         L.Prio < Interfaces.C.Int (Current_Prio) then
         Ceiling_Violation := True;
         return;
      end if;

      --  annex d requirements:
      --  if Base_Priority_Changed, the process is moved to the end of
      --  the queue
      if Self_ID.LL.Base_Priority_Changed then
         loop
            --  let other processes run
            Yield;
            exit when L.Prio_Array (Current_Prio) = 0;
         end loop;
         Self_ID.LL.Base_Priority_Changed := False;

      --  else, if there just was a lower priority, then the process is
      --  moved to the head of the queue
      elsif Self_ID.LL.Lower_Priority then
         Array_Item := L.Prio_Array (Current_Prio) + 1;
         L.Prio_Array (Current_Prio) := Array_Item;
         loop
            --  let some processes a chance to arrive
            Yield;
            --  then wait for our turn to proceed
            exit when Array_Item = L.Prio_Array (Current_Prio) or else
                      L.Prio_Array (Current_Prio) = 1;
         end loop;
      end if;

      Result := pthread_mutex_lock (L.L'Access);
      pragma Assert (Result = 0
          or else Shutdown ("GNULLI failure---pthread_mutex_lock"));
      Ceiling_Violation := False;
      L.Prio_Save := Interfaces.C.int (Current_Prio);
   end Write_Lock;

   procedure Write_Lock (L : access RTS_Lock) is
      Result : Interfaces.C.int;

   begin
      Result := pthread_mutex_lock (L);
      pragma Assert (Result = 0
          or else Shutdown ("GNULLI failure---pthread_mutex_lock"));
   end Write_Lock;

   procedure Write_Lock (T : Task_ID) is
      Result : Interfaces.C.int;

   begin
      Result := pthread_mutex_lock (T.LL.L'Access);
      pragma Assert (Result = 0
          or else Shutdown ("GNULLI failure---pthread_mutex_lock"));
   end Write_Lock;

   ---------------
   -- Read_Lock --
   ---------------

   procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
   begin
      Write_Lock (L, Ceiling_Violation);
   end Read_Lock;

   ------------
   -- Unlock --
   ------------

   procedure Unlock (L : access Lock) is
      Result    : Interfaces.C.int;
      Self_ID   : constant Task_ID := Self;
   begin
      if Self_ID.LL.Lower_Priority then
         --  set right values for this variables if they were
         --  changed in Write_Lock
         Self_ID.LL.Lower_Priority := False;
         L.Prio_Array (Any_Priority (L.Prio_Save)) :=
            L.Prio_Array (Any_Priority (L.Prio_Save)) - 1;
      end if;

      --  we assure that the process will recover its priority
      --  after releasing the Lock
      if L.Prio_Save /= Interfaces.C.int (Get_Priority (Self_ID)) then
         Set_Priority (Self_ID, System.Any_Priority (L.Prio_Save));
         Self_ID.LL.Lower_Priority := False;
      end if;

      Result := pthread_mutex_unlock (L.L'Access);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---pthread_mutex_unlock"));
   end Unlock;

   procedure Unlock (L : access RTS_Lock) is
      Result : Interfaces.C.int;

   begin
      Result := pthread_mutex_unlock (L);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---pthread_mutex_unlock"));
   end Unlock;

   procedure Unlock (T : Task_ID) is
      Result : Interfaces.C.int;

   begin
      Result := pthread_mutex_unlock (T.LL.L'Access);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---pthread_mutex_unlock"));
   end Unlock;

   -------------
   --  Sleep  --
   -------------

   procedure Sleep (Self_ID : Task_ID) is
      Result : Interfaces.C.int;

   begin
      pragma Assert (Self_ID = Self
        or else Shutdown ("GNULLI failure---Self in Sleep"));
      Result := pthread_cond_wait (Self_ID.LL.CV'Access, Self_ID.LL.L'Access);
      --  EINTR is not considered a failure.
      pragma Assert (Result = 0 or else Result = EINTR
        or else Shutdown ("GNULLI failure---Sleep"));
   end Sleep;

   ---------------
   -- Sleep_For --
   ---------------

   procedure Sleep_For
     (Self_ID : Task_ID; Rel_Time : Duration; Timedout : out Boolean) is
   begin
      Sleep_Until (Self_ID, Rel_Time + Clock, Timedout);
   end Sleep_For;

   -----------------
   -- Sleep_Until --
   -----------------

   --  For the delay implementation, we need to make sure we achieve
   --  following criterias:
   --  1) We have to delay at least for the amount requested.
   --  2) We have to give up CPU even though the actual delay does not
   --     result in blocking.
   --  3) The implementation has to be efficient so that the delay overhead
   --     is relatively cheap.
   --  1) and 2) are Ada requirements. Even though 2) is an Annex-D
   --     requirement we still want to provide the effect in all cases.
   --     The reason is that users may want to use short delays to implement
   --     their own scheduling effect in the absence of language provided
   --     scheduling policies.

   procedure Sleep_Until
     (Self_ID  : Task_ID;
      Abs_Time : Duration;
      Timedout : out Boolean)
   is
      Request : aliased timespec;
      Result  : Interfaces.C.int;
      Check_Time : constant Duration := Clock;
   begin
      pragma Assert (Self_ID = Self
        or else Shutdown ("GNULLI failure---Self in Sleep_Until"));

      Timedout := True;
      if Abs_Time > Check_Time then
         Request := To_Timespec (Abs_Time);
         loop
            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
              or else (Self_ID.Pending_Priority_Change);
            Result := pthread_cond_timedwait
              (Self_ID.LL.CV'Access, Self_ID.LL.L'Access, Request'Access);
            exit when Abs_Time <= Clock;
            if Result = 0 or Result = EINTR then
               --  somebody may have called Wakeup for us
               Timedout := False;
               exit;
            end if;
            pragma Assert (Result = ETIMEDOUT or else
              Shutdown ("pthread_cond_timedwait failed"));
         end loop;
      end if;
      Yield;
   end Sleep_Until;

   type Delay_Mode is (Relative, Absolute_RT, Absolute_Calendar);

   procedure Timed_Delay
     (Self_ID  : Task_ID;
      Time     : Duration;
      Mode     : Delay_Mode);

   pragma Export (C, Timed_Delay, "__timed_delay");
   --  We use pragma Export to avoid changing the specs for this package,
   --  because we only want to change target specific files to resolve a
   --  problem occuring with Delay_For.

   procedure Timed_Delay
     (Self_ID  : Task_ID;
      Time     : Duration;
      Mode     : Delay_Mode)
   is
      Check_Time : constant Duration := Clock;
      Abs_Time   : Duration;
      Request    : aliased timespec;
      Result     : Interfaces.C.int;
   begin

      --  Only the little window between deferring abort and
      --  locking Self_ID is the reason we need to
      --  check for pending abort and priority change below! :(

      Write_Lock (Self_ID);
      if Mode = Relative then
         Abs_Time := Time + Check_Time;
      else Abs_Time := Time;
      end if;
      if Abs_Time > Check_Time then
         Request := To_Timespec (Abs_Time);
         --  Self_ID.State := Delay_Sleep;
         loop
            if Self_ID.Pending_Priority_Change then
               Self_ID.Pending_Priority_Change := False;
               Self_ID.Base_Priority := Self_ID.New_Base_Priority;
               Set_Priority (Self_ID, Self_ID.Base_Priority);
            end if;
            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
            Result := pthread_cond_timedwait
              (Self_ID.LL.CV'Access, Self_ID.LL.L'Access, Request'Access);
            exit when Abs_Time <= Clock;
            pragma Assert (Result = 0 or else
              Result = ETIME or else
              Result = EINTR or else
              Shutdown ("pthread_cond_timedwait failed"));
         end loop;
         --  Self_ID.State := Runnable;
      end if;
      Yield;
      Unlock (Self_ID);
   end Timed_Delay;

   -----------
   -- Clock --
   -----------

   function Clock return Duration is
      TS     : aliased timespec;
      Result : Interfaces.C.int;

   begin
      Result := Clock_Gettime (CLOCK_REALTIME, TS'Unchecked_Access);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---clock_gettime"));
      return To_Duration (TS);
   exception
   when others =>
      pragma Assert (Shutdown ("exception in Clock"));
      return 0.0;
   end Clock;

   ------------
   -- Wakeup --
   ------------

   procedure Wakeup (T : Task_ID) is
      Result : Interfaces.C.int;

   begin
      Result := pthread_cond_signal (T.LL.CV'Access);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---Wakeup"));
   end Wakeup;

   -----------
   -- Yield --
   -----------

   procedure Yield is
      Result : Interfaces.C.int;
   begin
      Result := sched_yield;
   end Yield;

   ------------------
   -- Set_Priority --
   ------------------

   procedure Set_Priority (T : Task_ID; Prio : System.Any_Priority) is
      Result     : Interfaces.C.int;
      Param      : aliased struct_sched_param;
      L_Prio     : Interfaces.C.int;
   begin
      --  HP priorities start from 1 and not 0.
      if Prio < PRI_BG_MIN_NP then
         L_Prio := PRI_BG_MIN_NP;
      else
         L_Prio := Interfaces.C.int (Prio);
      end if;

      --  set the values of Lower_Priority and Base_Priority_Changed
      --  for next Write_Lock call
      T.LL.Lower_Priority := L_Prio < T.LL.Current_Priority;
      T.LL.Base_Priority_Changed := False;
      if T.LL.Base_Priority = 0 then
         T.LL.Base_Priority := T.Base_Priority;
      elsif T.LL.Base_Priority /= T.Base_Priority then
         T.LL.Lower_Priority := False;
         T.LL.Base_Priority_Changed := True;
         T.LL.Base_Priority := T.Base_Priority;
      end if;

      T.LL.Current_Priority := L_Prio;
      Param.sched_priority := L_Prio;

      --  SCHED_FIFO doesn't have enough priorities, so we have to
      --  work around this restriction.
      if Prio >= PRI_FIFO_MIN then
         Result := pthread_setschedparam
           (T.LL.Thread, SCHED_FIFO, Param'Access);
      elsif Prio >= PRI_FG_MIN_NP then
         --  The only alternative for priorities between 8 and 15 is "other",
         --  aka "fg" for foreground.  I'm not sure the semantics of this
         --  policy is quite right.
         Result := pthread_setschedparam
           (T.LL.Thread, SCHED_FG_NP, Param'Access);
      else
         --  Priorities between 0 and 7 need "bg (background) fifo".
         Result := pthread_setschedparam
           (T.LL.Thread, SCHED_BG_NP, Param'Access);
      end if;

      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---Set_Priority"));

   end Set_Priority;

   ------------------
   -- Get_Priority --
   ------------------

   function Get_Priority (T : Task_ID) return System.Any_Priority is
   begin
      return System.Any_Priority (T.LL.Current_Priority);
   end Get_Priority;

   ----------------
   -- Enter_Task --
   ----------------

   procedure Enter_Task (Self_ID : Task_ID) is
      Result  : Interfaces.C.int;

   begin

      Self_ID.LL.Thread := pthread_self;

      Result := pthread_setspecific (ATCB_Key, To_Address (Self_ID));
      pragma Assert (Result = 0 or else
        Shutdown ("GNULLI failure---Enter_Task (pthread_setspecific)"));
   end Enter_Task;

   ----------------------
   --  Initialize_TCB  --
   ----------------------

   procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is
      Mutex_Attr : aliased pthread_mutexattr_t;
      Result : Interfaces.C.int;
      Cond_Attr : aliased pthread_condattr_t;

   begin
      Result := pthread_mutexattr_init (Mutex_Attr'Access);
      pragma Assert (Result = 0 or else Result = ENOMEM
        or else Shutdown ("GNULLI failure---pthread_mutexattr_init"));

      if Result /= 0 then
         Succeeded := False;
         return;
      end if;

      Result := pthread_mutex_init (Self_ID.LL.L'Access, Mutex_Attr'Access);
      pragma Assert (Result = 0 or else Result = ENOMEM
        or else Shutdown ("GNULLI failure---pthread_mutex_init"));

      if Result /= 0 then
         Succeeded := False;
         return;
      end if;

      Result := pthread_condattr_init (Cond_Attr'Access);
      pragma Assert (Result = 0 or else Result = ENOMEM
        or else Shutdown ("GNULLI failure---pthread_condattr_init"));

      if Result /= 0 then
         Result := pthread_mutex_destroy (Self_ID.LL.L'Access);
         pragma Assert (Result = 0
           or else Shutdown ("GNULLI failure---pthread_mutex_destory"));
         Succeeded := False;
         return;
      end if;

      Result := pthread_cond_init (Self_ID.LL.CV'Access, Cond_Attr'Access);
      pragma Assert (Result = 0 or else Result = ENOMEM
        or else Shutdown ("GNULLI failure---pthread_cond_init"));

      if Result /= 0 then
         Result := pthread_mutex_destroy (Self_ID.LL.L'Access);
         pragma Assert (Result = 0
           or else Shutdown ("GNULLI failure---pthread_mutex_destory"));
         Succeeded := False;
         return;
      end if;

      Succeeded := True;

   end Initialize_TCB;

   -----------------
   -- Create_Task --
   -----------------

   procedure Create_Task
     (T          : Task_ID;
      Wrapper    : System.Address;
      Stack_Size : System.Parameters.Size_Type;
      Priority   : System.Any_Priority;
      Succeeded  : out Boolean)
   is
      Attributes          : aliased pthread_attr_t;
      Adjusted_Stack_Size : Interfaces.C.size_t;
      Result              : Interfaces.C.int;

      function Thread_Body_Access is new
        Unchecked_Conversion (System.Address, Thread_Body);

   begin
      if Stack_Size = System.Parameters.Unspecified_Size then
         Adjusted_Stack_Size := Interfaces.C.size_t (2 * Default_Stack_Size);
         --  Let's change the s-parame.adb to give a larger Stack_Size ?????
      else
         if Stack_Size < Size_Type (Minimum_Stack_Size) then
            Adjusted_Stack_Size :=
              Interfaces.C.size_t (Stack_Size + Minimum_Stack_Size);

            --  sum, instead of max:  may be overkill, but should be safe
            --  thr_min_stack is a function call.

            --  Actually, we want to get the Default_Stack_Size and
            --  Minimum_Stack_Size from the file System.Parameters.
            --  Right now the package is not made target specific.
            --  We use our own local definitions for now ???

         else
            Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size);
         end if;

      end if;

      Result := pthread_attr_init (Attributes'Access);
      pragma Assert (Result = 0 or else Result = ENOMEM
        or else Shutdown ("GNULLI failure---pthread_attr_init"));

      if Result /= 0 then
         Succeeded := False;
         return;
      end if;

--      Result := pthread_attr_setdetachstate
--        (Attributes'Access, PTHREAD_CREATE_DETACHED);
--      pragma Assert (Result = 0
--        or else Shutdown ("GNULLI failure---pthread_setdetachstate"));

      Result := pthread_attr_setstacksize
        (Attributes'Access, Interfaces.C.size_t (Adjusted_Stack_Size));
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---pthread_attr_setstacksize"));

      --  Since the initial signal mask of a thread is inherited from the
      --  creator, and the Environment task has all its signals masked, we
      --  do not need to manipulate caller's signal mask at this point.
      --  All tasks in RTS will have All_Tasks_Mask initially.

      Result := pthread_create
        (T.LL.Thread'Access,
         Attributes'Access,
         Thread_Body_Access (Wrapper),
         To_Address (T));
      pragma Assert (Result = 0 or else Result = EAGAIN
        or else Shutdown ("GNULLI failure---Create_Task (pthread_create)"));

      Succeeded := Result = 0;

      Set_Priority (T, Priority);

   end Create_Task;

   ------------------
   -- Finalize_TCB --
   ------------------

   procedure Finalize_TCB (T : Task_ID) is
      Result : Interfaces.C.int;
      Tmp    : Task_ID := T;

      procedure Free is new
        Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID);

   begin
      Result := pthread_mutex_destroy (T.LL.L'Access);
      pragma Assert (Result = 0 or else
        Shutdown ("GNULLI failure---Finalize_TCB (pthread_mutex_destroy)"));
      Result := pthread_cond_destroy (T.LL.CV'Access);
      pragma Assert (Result = 0 or else
        Shutdown ("GNULLI failure---Finalize_TCB (pthread_cond_destroy)"));
      Free (Tmp);
   end Finalize_TCB;

   ---------------
   -- Exit_Task --
   ---------------

   procedure Exit_Task is
   begin
      pthread_exit (System.Null_Address);
   end Exit_Task;

   ----------------
   -- Abort_Task --
   ----------------

   procedure Abort_Task (T : Task_ID) is
      Result : Interfaces.C.int;

   begin
      Result := pthread_kill (T.LL.Thread,
        Signal (System.Interrupt_Management.Abort_Task_Interrupt));
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---Abort_Task"));
   end Abort_Task;

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

   procedure Initialize (Environment_Task : Task_ID) is
      act       : aliased struct_sigaction;
      old_act   : aliased struct_sigaction;
      Tmp_Set   : aliased sigset_t;
      Result    : Interfaces.C.int;

   begin

      Enter_Task (Environment_Task);

      --  Install the abort-signal handler

      act.sa_flags := 0;
      act.sa_handler := Abort_Handler'Address;

      Result := sigemptyset (Tmp_Set'Access);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---Initialize (sigemptyset)"));
      act.sa_mask := Tmp_Set;

      Result :=
        sigaction (
          Signal (System.Interrupt_Management.Abort_Task_Interrupt),
          act'Access,
          old_act'Unchecked_Access);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---Initialize (sigaction)"));

   end Initialize;

   procedure do_nothing (arg : System.Address);

   procedure do_nothing (arg : System.Address) is
   begin
      null;
   end do_nothing;

begin

   declare
      Result : Interfaces.C.int;
   begin

      --  Mask Environment task for all signals. The original mask of the
      --  Environment task will be recovered by Interrupt_Server task
      --  during the elaboration of s-interr.adb.

      System.Interrupt_Management.Operations.Set_Interrupt_Mask
        (System.Interrupt_Management.Operations.All_Tasks_Mask'Access);

      Result := pthread_key_create (ATCB_Key'Access, do_nothing'Access);
      pragma Assert (Result = 0
        or else Shutdown ("GNULLI failure---Initialize (pthread_keycreate)"));
   end;

end System.Task_Primitives.Operations;