[Ada] RTEMS: use hardware interrupts instead of signals for interrupt handling

gcc/ada/

	* Makefile.rtl (VxWorks): Rename s-inmaop__vxworks.adb to
	s-inmaop__hwint.adb.
	(RTEMS): Use s-inmaop__hwint.adb, s-intman__rtems.adb/s,
	s-taprop__rtems.adb.
	* libgnarl/a-intnam__rtems.ads: Remove signals definitions and
	replace with Hardware_Interrupts.
	* libgnarl/s-inmaop__vxworks.adb: Rename as...
	* libgnarl/s-inmaop__hwint.adb: ... this.
	* libgnarl/s-interr__hwint.adb: Remove unnecessary comments.
	* libgnarl/s-intman__rtems.ads, libgnarl/s-intman__rtems.adb:
	New files.
	* libgnarl/s-osinte__rtems.adb: Add RTEMS API bindings.
	(Binary_Semaphore_Create, Binary_Semaphore_Delete,
	Binary_Semaphore_Obtain, Binary_Semaphore_Release,
	Binary_Semaphore_Flush, Interrupt_Connect,
	Interrupt_Number_To_Vector): New functions.
	* libgnarl/s-osinte__rtems.ads (Num_HW_Interrupts, Signal):
	Removed.
	(NSIG, Interrupt_Range): New.
	(Binary_Semaphore_Create, Binary_Semaphore_Delete,
	Binary_Semaphore_Obtain, Binary_Semaphore_Release,
	Binary_Semaphore_Flush, Interrupt_Connect,
	Interrupt_Number_To_Vector): Remove Import pragma.
	* libgnarl/s-taprop__rtems.adb: New file.

9 files changed, 1732 insertions, 152 deletions

diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 75d1725..7fef517 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -1084,7 +1084,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks vxworksspe vxworks7% vxworks7spe
   a-nuaufl.ads<libgnat/a-nuaufl__wraplf.ads \
   a-nashfl.ads<libgnat/a-nashfl__wraplf.ads \
   s-dorepr.adb<libgnat/s-dorepr__fma.adb \
-  s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \
+  s-inmaop.adb<libgnarl/s-inmaop__hwint.adb \
   s-intman.ads<libgnarl/s-intman__vxworks.ads \
   s-intman.adb<libgnarl/s-intman__vxworks.adb \
   s-osinte.ads<libgnarl/s-osinte__vxworks.ads \
@@ -1207,7 +1207,7 @@ ifeq ($(strip $(filter-out %86 x86_64 wrs vxworks vxworks7%,$(target_cpu) $(targ
   a-nashfl.ads<libgnat/a-nashfl__wraplf.ads \
   s-osinte.adb<libgnarl/s-osinte__vxworks.adb \
   s-osinte.ads<libgnarl/s-osinte__vxworks.ads \
-  s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \
+  s-inmaop.adb<libgnarl/s-inmaop__hwint.adb \
   s-intman.ads<libgnarl/s-intman__vxworks.ads \
   s-intman.adb<libgnarl/s-intman__vxworks.adb \
   s-osprim.adb<libgnat/s-osprim__posix.adb \
@@ -1351,7 +1351,7 @@ ifeq ($(strip $(filter-out aarch64 arm% coff wrs vx%,$(target_cpu) $(target_vend
   a-naliop.ads<libgnat/a-naliop__nolibm.ads \
   a-nuaufl.ads<libgnat/a-nuaufl__wraplf.ads \
   a-nashfl.ads<libgnat/a-nashfl__wraplf.ads \
-  s-inmaop.adb<libgnarl/s-inmaop__vxworks.adb \
+  s-inmaop.adb<libgnarl/s-inmaop__hwint.adb \
   s-interr.adb<libgnarl/s-interr__vxworks.adb \
   s-intman.ads<libgnarl/s-intman__vxworks.ads \
   s-intman.adb<libgnarl/s-intman__vxworks.adb \
@@ -2047,14 +2047,15 @@ ifeq ($(strip $(filter-out rtems%,$(target_os))),)
   LIBGNAT_TARGET_PAIRS = \
   system.ads<libgnat/system-rtems.ads \
   a-intnam.ads<libgnarl/a-intnam__rtems.ads \
-  s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
-  s-intman.adb<libgnarl/s-intman__posix.adb \
+  s-inmaop.adb<libgnarl/s-inmaop__hwint.adb \
+  s-intman.adb<libgnarl/s-intman__rtems.adb \
+  s-intman.ads<libgnarl/s-intman__rtems.ads \
   s-osinte.adb<libgnarl/s-osinte__rtems.adb \
   s-osinte.ads<libgnarl/s-osinte__rtems.ads \
   s-osprim.adb<libgnat/s-osprim__rtems.adb \
   s-parame.adb<libgnat/s-parame__rtems.adb \
   s-parame.ads<libgnat/s-parame__posix2008.ads \
-  s-taprop.adb<libgnarl/s-taprop__posix.adb \
+  s-taprop.adb<libgnarl/s-taprop__rtems.adb \
   s-taspri.ads<libgnarl/s-taspri__posix.ads \
   s-tpopsp.adb<libgnarl/s-tpopsp__tls.adb \
   s-interr.adb<libgnarl/s-interr__hwint.adb
diff --git a/gcc/ada/libgnarl/a-intnam__rtems.ads b/gcc/ada/libgnarl/a-intnam__rtems.ads
index 89618f6..4654f00 100644
--- a/gcc/ada/libgnarl/a-intnam__rtems.ads
+++ b/gcc/ada/libgnarl/a-intnam__rtems.ads
@@ -34,81 +34,17 @@
 ------------------------------------------------------------------------------
 
 --  This is a RTEMS version of this package
---
---  The following signals are reserved by the run time:
---
---  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
---  SIGALRM, SIGEMT, SIGKILL
---
---  The pragma Unreserve_All_Interrupts affects the following signal(s):
---
---  SIGINT: made available for Ada handlers
-
---  This target-dependent package spec contains names of interrupts
---  supported by the local system.
 
 with System.OS_Interface;
---  used for names of interrupts
 
 package Ada.Interrupts.Names is
 
-   --  Beware that the mapping of names to signals may be
-   --  many-to-one.  There may be aliases.  Also, for all
-   --  signal names that are not supported on the current system
-   --  the value of the corresponding constant will be zero.
-
-   SIGHUP : constant Interrupt_ID :=
-     System.OS_Interface.SIGHUP;      --  hangup
-
-   SIGINT : constant Interrupt_ID :=
-     System.OS_Interface.SIGINT;      --  interrupt (rubout)
-
-   SIGQUIT : constant Interrupt_ID :=
-     System.OS_Interface.SIGQUIT;     --  quit (ASCD FS)
-
-   SIGILL : constant Interrupt_ID :=
-     System.OS_Interface.SIGILL;      --  illegal instruction (not reset)
-
-   SIGTRAP : constant Interrupt_ID :=
-     System.OS_Interface.SIGTRAP;     --  trace trap (not reset)
-
-   SIGIOT : constant Interrupt_ID :=
-     System.OS_Interface.SIGIOT;      --  IOT instruction
-
-   SIGABRT : constant Interrupt_ID := --  used by abort,
-     System.OS_Interface.SIGABRT;     --  replace SIGIOT in the  future
-
-   SIGEMT : constant Interrupt_ID :=
-     System.OS_Interface.SIGEMT;      --  EMT instruction
-
-   SIGFPE : constant Interrupt_ID :=
-     System.OS_Interface.SIGFPE;      --  floating point exception
-
-   SIGKILL : constant Interrupt_ID :=
-     System.OS_Interface.SIGKILL;     --  kill (cannot be caught or ignored)
-
-   SIGBUS : constant Interrupt_ID :=
-     System.OS_Interface.SIGBUS;      --  bus error
-
-   SIGSEGV : constant Interrupt_ID :=
-     System.OS_Interface.SIGSEGV;     --  segmentation violation
-
-   SIGSYS : constant Interrupt_ID :=
-     System.OS_Interface.SIGSYS;      --  bad argument to system call
-
-   SIGPIPE : constant Interrupt_ID := --  write on a pipe with
-     System.OS_Interface.SIGPIPE;     --  no one to read it
-
-   SIGALRM : constant Interrupt_ID :=
-     System.OS_Interface.SIGALRM;     --  alarm clock
-
-   SIGTERM : constant Interrupt_ID :=
-     System.OS_Interface.SIGTERM;     --  software termination signal from kill
+   --  All identifiers in this unit are implementation defined
 
-   SIGUSR1 : constant Interrupt_ID :=
-     System.OS_Interface.SIGUSR1;     --  user defined signal 1
+   pragma Implementation_Defined;
 
-   SIGUSR2 : constant Interrupt_ID :=
-     System.OS_Interface.SIGUSR2;     --  user defined signal 2
+   subtype Hardware_Interrupts is Interrupt_ID
+     range Interrupt_ID'First .. System.OS_Interface.Max_HW_Interrupt;
+   --  Range of values that can be used for hardware interrupts
 
 end Ada.Interrupts.Names;
diff --git a/gcc/ada/libgnarl/s-inmaop__vxworks.adb b/gcc/ada/libgnarl/s-inmaop__hwint.adb
index 8496c82..52a92ac 100644
--- a/gcc/ada/libgnarl/s-inmaop__vxworks.adb
+++ b/gcc/ada/libgnarl/s-inmaop__hwint.adb
@@ -30,9 +30,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is a VxWorks version of this package. Many operations are null as this
---  package supports the use of Ada interrupt handling facilities for signals,
---  while those facilities are used for hardware interrupts on these targets.
+--  This is a hardware interrupt version of this package. Many operations are
+--  null as this package supports the use of Ada interrupt handling facilities
+--  for signals, while those facilities are used for hardware interrupts on
+--  these targets.
 
 with Ada.Exceptions;
 
diff --git a/gcc/ada/libgnarl/s-interr__hwint.adb b/gcc/ada/libgnarl/s-interr__hwint.adb
index be6b559..5f80174 100644
--- a/gcc/ada/libgnarl/s-interr__hwint.adb
+++ b/gcc/ada/libgnarl/s-interr__hwint.adb
@@ -29,29 +29,15 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Invariants:
-
---  All user-handlable signals are masked at all times in all tasks/threads
---  except possibly for the Interrupt_Manager task.
-
---  When a user task wants to have the effect of masking/unmasking an signal,
---  it must call Block_Interrupt/Unblock_Interrupt, which will have the effect
---  of unmasking/masking the signal in the Interrupt_Manager task. These
---  comments do not apply to vectored hardware interrupts, which may be masked
---  or unmasked using routined interfaced to the relevant embedded RTOS system
---  calls.
+--  This is reasonably generic version of this package, supporting vectored
+--  hardware interrupts using non-RTOS specific adapter routines which should
+--  easily implemented on any RTOS capable of supporting GNAT.
 
---  Once we associate a Signal_Server_Task with an signal, the task never goes
---  away, and we never remove the association. On the other hand, it is more
---  convenient to terminate an associated Interrupt_Server_Task for a vectored
---  hardware interrupt (since we use a binary semaphore for synchronization
---  with the umbrella handler).
+--  Invariants:
 
---  There is no more than one signal per Signal_Server_Task and no more than
---  one Signal_Server_Task per signal. The same relation holds for hardware
---  interrupts and Interrupt_Server_Task's at any given time. That is, only
---  one non-terminated Interrupt_Server_Task exists for a give interrupt at
---  any time.
+--  There is no more than one interrupt per Interrupt_Server_Task and no more
+--  than one Interrupt_Server_Task per interrupt. If an interrupt handler is
+--  detached, the corresponding Interrupt_Server_Task is terminated.
 
 --  Within this package, the lock L is used to protect the various status
 --  tables. If there is a Server_Task associated with a signal or interrupt,
@@ -59,10 +45,6 @@
 --  status between Interrupt_Manager and Server_Task. Protection among service
 --  requests are ensured via user calls to the Interrupt_Manager entries.
 
---  This is reasonably generic version of this package, supporting vectored
---  hardware interrupts using non-RTOS specific adapter routines which should
---  easily implemented on any RTOS capable of supporting GNAT.
-
 with Ada.Unchecked_Conversion;
 with Ada.Task_Identification;
 
@@ -151,13 +133,13 @@ package body System.Interrupts is
      (others => (null, Static => False));
    pragma Volatile_Components (User_Handler);
    --  Holds the protected procedure handler (if any) and its Static
-   --  information for each interrupt or signal. A handler is static iff it
+   --  information for each interrupt. A handler is static if and only if it
    --  is specified through the pragma Attach_Handler.
 
    User_Entry : array (Interrupt_ID) of Entry_Assoc :=
                   (others => (T => Null_Task, E => Null_Task_Entry));
    pragma Volatile_Components (User_Entry);
-   --  Holds the task and entry index (if any) for each interrupt / signal
+   --  Holds the task and entry index (if any) for each interrupt
 
    --  Type and Head, Tail of the list containing Registered Interrupt
    --  Handlers. These definitions are used to register the handlers
diff --git a/gcc/ada/libgnarl/s-intman__rtems.adb b/gcc/ada/libgnarl/s-intman__rtems.adb
new file mode 100644
index 0000000..dedc67c
--- /dev/null
+++ b/gcc/ada/libgnarl/s-intman__rtems.adb
@@ -0,0 +1,93 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
+--                                                                          --
+--           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--          Copyright (C) 1992-2021, Free Software Foundation, Inc.         --
+--                                                                          --
+-- 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 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/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the RTEMS version of this package
+
+--  It is simpler than other versions because the Ada interrupt handling
+--  mechanisms are used for hardware interrupts rather than signals.
+
+package body System.Interrupt_Management is
+
+   use System.OS_Interface;
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   function State (Int : Interrupt_ID) return Character;
+   pragma Import (C, State, "__gnat_get_interrupt_state");
+   --  Get interrupt state. Defined in init.c The input argument is the
+   --  hardware interrupt number, and the result is one of the following:
+
+   Runtime : constant Character := 'r';
+   Default : constant Character := 's';
+   --    'n'   this interrupt not set by any Interrupt_State pragma
+   --    'u'   Interrupt_State pragma set state to User
+   --    'r'   Interrupt_State pragma set state to Runtime
+   --    's'   Interrupt_State pragma set state to System (use "default"
+   --           system handler)
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   Initialized : Boolean := False;
+   --  Set to True once Initialize is called, further calls have no effect
+
+   procedure Initialize is
+
+   begin
+      if Initialized then
+         return;
+      end if;
+
+      Initialized := True;
+
+      --  Set the signal used to signal an abort to another task as defined in
+      --  System.OS_Interface.
+
+      Abort_Task_Interrupt := SIGADAABORT;
+
+      --  Initialize hardware interrupt handling
+
+      pragma Assert (Reserve = (Interrupt_ID'Range => False));
+
+      --  Check all interrupts for state that requires keeping them reserved
+
+      for J in Interrupt_ID'Range loop
+         if State (J) = Default or else State (J) = Runtime then
+            Reserve (J) := True;
+         end if;
+      end loop;
+
+   end Initialize;
+
+end System.Interrupt_Management;
diff --git a/gcc/ada/libgnarl/s-intman__rtems.ads b/gcc/ada/libgnarl/s-intman__rtems.ads
new file mode 100644
index 0000000..f3d53ec
--- /dev/null
+++ b/gcc/ada/libgnarl/s-intman__rtems.ads
@@ -0,0 +1,99 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
+--                                                                          --
+--            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T         --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--          Copyright (C) 1992-2021, Free Software Foundation, Inc.         --
+--                                                                          --
+-- 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 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/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the RTEMS version of this package
+
+--  This package encapsulates and centralizes information about all
+--  uses of interrupts (or signals), including the target-dependent
+--  mapping of interrupts (or signals) to exceptions.
+
+--  Unlike the original design, System.Interrupt_Management can only
+--  be used for tasking systems.
+
+--  PLEASE DO NOT put any subprogram declarations with arguments of
+--  type Interrupt_ID into the visible part of this package. The type
+--  Interrupt_ID is used to derive the type in Ada.Interrupts, and
+--  adding more operations to that type would be illegal according
+--  to the Ada Reference Manual. This is the reason why the signals
+--  sets are implemented using visible arrays rather than functions.
+
+with System.OS_Interface;
+
+with Interfaces.C;
+
+package System.Interrupt_Management is
+   pragma Preelaborate;
+
+   type Interrupt_Mask is limited private;
+
+   type Interrupt_ID is new Interfaces.C.int
+     range 0 .. System.OS_Interface.Max_Interrupt;
+
+   type Interrupt_Set is array (Interrupt_ID) of Boolean;
+
+   subtype Signal_ID is Interrupt_ID range 0 .. System.OS_Interface.NSIG - 1;
+
+   type Signal_Set is array (Signal_ID) of Boolean;
+
+   --  The following objects serve as constants, but are initialized in the
+   --  body to aid portability. This permits us to use more portable names for
+   --  interrupts, where distinct names may map to the same interrupt ID
+   --  value.
+
+   --  For example, suppose SIGRARE is a signal that is not defined on all
+   --  systems, but is always reserved when it is defined. If we have the
+   --  convention that ID zero is not used for any "real" signals, and SIGRARE
+   --  = 0 when SIGRARE is not one of the locally supported signals, we can
+   --  write:
+   --     Reserved (SIGRARE) := True;
+   --  and the initialization code will be portable.
+
+   Abort_Task_Interrupt : Signal_ID;
+   --  The signal that is used to implement task abort if an interrupt is used
+   --  for that purpose. This is one of the reserved signals.
+
+   Reserve : Interrupt_Set := (others => False);
+   --  Reserve (I) is true iff the interrupt I is one that cannot be permitted
+   --  to be attached to a user handler. The possible reasons are many. For
+   --  example, it may be mapped to an exception used to implement task abort,
+   --  or used to implement time delays.
+
+   procedure Initialize;
+   --  Initialize the various variables defined in this package. This procedure
+   --  must be called before accessing any object from this package and can be
+   --  called multiple times (only the first call has any effect).
+
+private
+   type Interrupt_Mask is new System.OS_Interface.sigset_t;
+   --  In some implementation Interrupt_Mask can be represented as a linked
+   --  list.
+
+end System.Interrupt_Management;
diff --git a/gcc/ada/libgnarl/s-osinte__rtems.adb b/gcc/ada/libgnarl/s-osinte__rtems.adb
index cd977d0..96883af 100644
--- a/gcc/ada/libgnarl/s-osinte__rtems.adb
+++ b/gcc/ada/libgnarl/s-osinte__rtems.adb
@@ -44,6 +44,54 @@ with Interfaces.C; use Interfaces.C;
 
 package body System.OS_Interface is
 
+   ---------------
+   -- RTEMS API --
+   ---------------
+
+   type RTEMS_Attributes is new unsigned;
+
+   RTEMS_SIMPLE_BINARY_SEMAPHORE : constant := 16#00000020#;
+   RTEMS_FIFO                    : constant := 16#00000000#;
+
+   type RTEMS_Interval is new unsigned;
+
+   RTEMS_NO_TIMEOUT : constant := 0;
+
+   type RTEMS_Options is new unsigned;
+
+   RTEMS_WAIT             : constant := 16#00000000#;
+   RTEMS_INTERRUPT_UNIQUE : constant := 16#00000001#;
+
+   type RTEMS_Name is new unsigned;
+
+   function RTEMS_Build_Name (C1, C2, C3, C4 : Character) return RTEMS_Name
+     with Import, External_Name => "rtems_build_name", Convention => C;
+
+   function RTEMS_Semaphore_Create
+     (Name             : RTEMS_Name;
+      Count            : unsigned;
+      Attributes       : RTEMS_Attributes;
+      Priority_Ceiling : unsigned;
+      Semaphore        : out Binary_Semaphore_Id) return int
+     with Import, External_Name => "rtems_semaphore_create", Convention => C;
+
+   function RTEMS_Semaphore_Delete (Semaphore : Binary_Semaphore_Id) return int
+     with Import, External_Name => "rtems_semaphore_delete", Convention => C;
+
+   function RTEMS_Semaphore_Flush (Semaphore : Binary_Semaphore_Id)
+     return int
+     with Import, External_Name => "rtems_semaphore_flush", Convention => C;
+
+   function RTEMS_Semaphore_Obtain
+     (Semaphore : Binary_Semaphore_Id;
+      Options   : RTEMS_Options;
+      Timeout   : RTEMS_Interval) return int
+     with Import, External_Name => "rtems_semaphore_obtain", Convention => C;
+
+   function RTEMS_Semaphore_Release (Semaphore : Binary_Semaphore_Id)
+     return int
+     with Import, External_Name => "rtems_semaphore_release", Convention => C;
+
    -----------------
    -- To_Duration --
    -----------------
@@ -85,6 +133,108 @@ package body System.OS_Interface is
                        tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
    end To_Timespec;
 
+   -----------------------------
+   -- Binary_Semaphore_Create --
+   -----------------------------
+
+   function Binary_Semaphore_Create return Binary_Semaphore_Id is
+      Semaphore : Binary_Semaphore_Id;
+      Status    : int;
+   begin
+      Status :=
+        RTEMS_Semaphore_Create
+          (Name             => RTEMS_Build_Name ('G', 'N', 'A', 'T'),
+           Count            => 0,
+           Attributes       => RTEMS_SIMPLE_BINARY_SEMAPHORE or RTEMS_FIFO,
+           Priority_Ceiling => 0,
+           Semaphore        => Semaphore);
+
+      pragma Assert (Status = 0);
+
+      return Semaphore;
+   end Binary_Semaphore_Create;
+
+   -----------------------------
+   -- Binary_Semaphore_Delete --
+   -----------------------------
+
+   function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id)
+     return int is
+   begin
+      return RTEMS_Semaphore_Delete (ID);
+   end Binary_Semaphore_Delete;
+
+   -----------------------------
+   -- Binary_Semaphore_Obtain --
+   -----------------------------
+
+   function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id)
+     return int is
+   begin
+      return RTEMS_Semaphore_Obtain (ID, RTEMS_WAIT, RTEMS_NO_TIMEOUT);
+   end Binary_Semaphore_Obtain;
+
+   ------------------------------
+   -- Binary_Semaphore_Release --
+   ------------------------------
+
+   function Binary_Semaphore_Release (ID : Binary_Semaphore_Id)
+     return int is
+   begin
+      return RTEMS_Semaphore_Release (ID);
+   end Binary_Semaphore_Release;
+
+   ----------------------------
+   -- Binary_Semaphore_Flush --
+   ----------------------------
+
+   function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int is
+   begin
+      return RTEMS_Semaphore_Flush (ID);
+   end Binary_Semaphore_Flush;
+
+   -----------------------
+   -- Interrupt_Connect --
+   -----------------------
+
+   function Interrupt_Connect
+     (Vector    : Interrupt_Vector;
+      Handler   : Interrupt_Handler;
+      Parameter : System.Address := System.Null_Address) return int
+   is
+      function RTEMS_Interrupt_Handler_Install
+         (Vector    : Interrupt_Vector;
+          Info      : char_array;
+          Options   : RTEMS_Options;
+          Handler   : Interrupt_Handler;
+          Parameter : System.Address) return int
+        with Import,
+             External_Name => "rtems_interrupt_handler_install",
+             Convention => C;
+
+      Info_String : constant char_array := To_C ("GNAT Interrupt Handler");
+      --  Handler name that is registered with RTEMS
+   begin
+      return
+        RTEMS_Interrupt_Handler_Install
+          (Vector    => Vector,
+           Info      => Info_String,
+           Options   => RTEMS_INTERRUPT_UNIQUE,
+           Handler   => Handler,
+           Parameter => Parameter);
+   end Interrupt_Connect;
+
+   --------------------------------
+   -- Interrupt_Number_To_Vector --
+   --------------------------------
+
+   function Interrupt_Number_To_Vector (intNum : int)
+     return Interrupt_Vector
+   is
+   begin
+      return Interrupt_Vector (intNum);
+   end Interrupt_Number_To_Vector;
+
    ------------------
    -- pthread_init --
    ------------------
diff --git a/gcc/ada/libgnarl/s-osinte__rtems.ads b/gcc/ada/libgnarl/s-osinte__rtems.ads
index ffbfc3a..5743a6a 100644
--- a/gcc/ada/libgnarl/s-osinte__rtems.ads
+++ b/gcc/ada/libgnarl/s-osinte__rtems.ads
@@ -85,18 +85,20 @@ package System.OS_Interface is
    ENOMEM    : constant := System.OS_Constants.ENOMEM;
    ETIMEDOUT : constant := System.OS_Constants.ETIMEDOUT;
 
-   -------------
-   -- Signals --
-   -------------
+   ----------------------------
+   -- Signals and Interrupts --
+   ----------------------------
 
-   Num_HW_Interrupts : constant := 256;
+   NSIG : constant := 64;
+   --  Number of signals on the target OS
+   type Signal is new int range 0 .. Interfaces.C."-" (NSIG, 1);
 
-   Max_HW_Interrupt : constant := Num_HW_Interrupts - 1;
+   Max_HW_Interrupt : constant := 255;
    type HW_Interrupt is new int range 0 .. Max_HW_Interrupt;
 
    Max_Interrupt : constant := Max_HW_Interrupt;
-
-   type Signal is new int range 0 .. Max_Interrupt;
+   subtype Interrupt_Range is Natural range 0 .. Max_HW_Interrupt;
+   --  For s-interr
 
    SIGXCPU     : constant := 0; --  XCPU
    SIGHUP      : constant := 1; --  hangup
@@ -546,34 +548,19 @@ package System.OS_Interface is
    type Binary_Semaphore_Id is new rtems_id;
 
    function Binary_Semaphore_Create return Binary_Semaphore_Id;
-   pragma Import (
-      C,
-      Binary_Semaphore_Create,
-      "__gnat_binary_semaphore_create");
+   pragma Inline (Binary_Semaphore_Create);
 
    function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int;
-   pragma Import (
-      C,
-      Binary_Semaphore_Delete,
-      "__gnat_binary_semaphore_delete");
+   pragma Inline (Binary_Semaphore_Delete);
 
    function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int;
-   pragma Import (
-      C,
-      Binary_Semaphore_Obtain,
-      "__gnat_binary_semaphore_obtain");
+   pragma Inline (Binary_Semaphore_Obtain);
 
    function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int;
-   pragma Import (
-      C,
-      Binary_Semaphore_Release,
-      "__gnat_binary_semaphore_release");
+   pragma Inline (Binary_Semaphore_Release);
 
    function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int;
-   pragma Import (
-      C,
-      Binary_Semaphore_Flush,
-      "__gnat_binary_semaphore_flush");
+   pragma Inline (Binary_Semaphore_Flush);
 
    ------------------------------------------------------------
    -- Hardware Interrupt Wrappers to Support Interrupt Tasks --
@@ -581,36 +568,20 @@ package System.OS_Interface is
 
    type Interrupt_Handler is access procedure (parameter : System.Address);
    pragma Convention (C, Interrupt_Handler);
+
    type Interrupt_Vector is new System.Address;
 
    function Interrupt_Connect
-     (vector    : Interrupt_Vector;
-      handler   : Interrupt_Handler;
-      parameter : System.Address := System.Null_Address) return int;
-   pragma Import (C, Interrupt_Connect, "__gnat_interrupt_connect");
+     (Vector    : Interrupt_Vector;
+      Handler   : Interrupt_Handler;
+      Parameter : System.Address := System.Null_Address) return int;
    --  Use this to set up an user handler. The routine installs a
    --  a user handler which is invoked after RTEMS has saved enough
    --  context for a high-level language routine to be safely invoked.
 
-   function Interrupt_Vector_Get
-     (Vector : Interrupt_Vector) return Interrupt_Handler;
-   pragma Import (C, Interrupt_Vector_Get, "__gnat_interrupt_get");
-   --  Use this to get the existing handler for later restoral.
-
-   procedure Interrupt_Vector_Set
-     (Vector  : Interrupt_Vector;
-      Handler : Interrupt_Handler);
-   pragma Import (C, Interrupt_Vector_Set, "__gnat_interrupt_set");
-   --  Use this to restore a handler obtained using Interrupt_Vector_Get.
-
    function Interrupt_Number_To_Vector (intNum : int) return Interrupt_Vector;
    --  Convert a logical interrupt number to the hardware interrupt vector
    --  number used to connect the interrupt.
-   pragma Import (
-      C,
-      Interrupt_Number_To_Vector,
-      "__gnat_interrupt_number_to_vector"
-   );
 
 private
 
diff --git a/gcc/ada/libgnarl/s-taprop__rtems.adb b/gcc/ada/libgnarl/s-taprop__rtems.adb
new file mode 100644
index 0000000..9153032
--- /dev/null
+++ b/gcc/ada/libgnarl/s-taprop__rtems.adb
@@ -0,0 +1,1347 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME 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                                 --
+--                                                                          --
+--          Copyright (C) 1992-2021, Free Software Foundation, Inc.         --
+--                                                                          --
+-- 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 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/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the RTEMS version of this package
+
+--  This package contains all the GNULL primitives that interface directly with
+--  the underlying OS.
+
+with Ada.Unchecked_Conversion;
+
+with Interfaces.C;
+
+with System.Tasking.Debug;
+with System.Interrupt_Management;
+with System.OS_Constants;
+with System.OS_Primitives;
+with System.Task_Info;
+
+with System.Soft_Links;
+--  We use System.Soft_Links instead of System.Tasking.Initialization
+--  because the later is a higher level package that we shouldn't depend on.
+--  For example when using the restricted run time, it is replaced by
+--  System.Tasking.Restricted.Stages.
+
+package body System.Task_Primitives.Operations is
+
+   package OSC renames System.OS_Constants;
+   package SSL renames System.Soft_Links;
+
+   use System.Tasking.Debug;
+   use System.Tasking;
+   use Interfaces.C;
+   use System.OS_Interface;
+   use System.Parameters;
+   use System.OS_Primitives;
+
+   ----------------
+   -- Local Data --
+   ----------------
+
+   --  The followings are logically constants, but need to be initialized
+   --  at run time.
+
+   Single_RTS_Lock : aliased RTS_Lock;
+   --  This is a lock to allow only one thread of control in the RTS at
+   --  a time; it is used to execute in mutual exclusion from all other tasks.
+   --  Used to protect All_Tasks_List
+
+   Environment_Task_Id : Task_Id;
+   --  A variable to hold Task_Id for the environment task
+
+   Locking_Policy : constant Character;
+   pragma Import (C, Locking_Policy, "__gl_locking_policy");
+   --  Value of the pragma Locking_Policy:
+   --    'C' for Ceiling_Locking
+   --    'I' for Inherit_Locking
+   --    ' ' for none.
+
+   --  The followings are internal configuration constants needed
+
+   Next_Serial_Number : Task_Serial_Number := 100;
+   --  We start at 100, to reserve some special values for
+   --  using in error checking.
+
+   Time_Slice_Val : constant Integer;
+   pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
+
+   Dispatching_Policy : constant Character;
+   pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
+
+   Foreign_Task_Elaborated : aliased Boolean := True;
+   --  Used to identified fake tasks (i.e., non-Ada Threads)
+
+   Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0;
+   --  Whether to use an alternate signal stack for stack overflows
+
+   Abort_Handler_Installed : Boolean := False;
+   --  True if a handler for the abort signal is installed
+
+   --------------------
+   -- Local Packages --
+   --------------------
+
+   package Specific is
+
+      procedure Initialize (Environment_Task : Task_Id);
+      pragma Inline (Initialize);
+      --  Initialize various data needed by this package
+
+      function Is_Valid_Task return Boolean;
+      pragma Inline (Is_Valid_Task);
+      --  Does executing thread have a TCB?
+
+      procedure Set (Self_Id : Task_Id);
+      pragma Inline (Set);
+      --  Set the self id for the current task
+
+      function Self return Task_Id;
+      pragma Inline (Self);
+      --  Return a pointer to the Ada Task Control Block of the calling task
+
+   end Specific;
+
+   package body Specific is separate;
+   --  The body of this package is target specific
+
+   package Monotonic is
+
+      function Monotonic_Clock return Duration;
+      pragma Inline (Monotonic_Clock);
+      --  Returns an absolute time, represented as an offset relative to some
+      --  unspecified starting point, typically system boot time.  This clock
+      --  is not affected by discontinuous jumps in the system time.
+
+      function RT_Resolution return Duration;
+      pragma Inline (RT_Resolution);
+      --  Returns resolution of the underlying clock used to implement RT_Clock
+
+      procedure Timed_Sleep
+        (Self_ID  : ST.Task_Id;
+         Time     : Duration;
+         Mode     : ST.Delay_Modes;
+         Reason   : System.Tasking.Task_States;
+         Timedout : out Boolean;
+         Yielded  : out Boolean);
+      --  Combination of Sleep (above) and Timed_Delay
+
+      procedure Timed_Delay
+        (Self_ID : ST.Task_Id;
+         Time    : Duration;
+         Mode    : ST.Delay_Modes);
+      --  Implement the semantics of the delay statement.
+      --  The caller should be abort-deferred and should not hold any locks.
+
+   end Monotonic;
+
+   package body Monotonic is separate;
+
+   ----------------------------------
+   -- ATCB allocation/deallocation --
+   ----------------------------------
+
+   package body ATCB_Allocation is separate;
+   --  The body of this package is shared across several targets
+
+   ---------------------------------
+   -- Support for foreign threads --
+   ---------------------------------
+
+   function Register_Foreign_Thread
+     (Thread         : Thread_Id;
+      Sec_Stack_Size : Size_Type := Unspecified_Size) return Task_Id;
+   --  Allocate and initialize a new ATCB for the current Thread. The size of
+   --  the secondary stack can be optionally specified.
+
+   function Register_Foreign_Thread
+     (Thread         : Thread_Id;
+      Sec_Stack_Size : Size_Type := Unspecified_Size)
+     return Task_Id is separate;
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   procedure Abort_Handler (Sig : Signal);
+   --  Signal handler used to implement asynchronous abort.
+   --  See also comment before body, below.
+
+   function To_Address is
+     new Ada.Unchecked_Conversion (Task_Id, System.Address);
+
+   function GNAT_pthread_condattr_setup
+     (attr : access pthread_condattr_t) return int;
+   pragma Import (C,
+     GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
+
+   -------------------
+   -- 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.
+
+   procedure Abort_Handler (Sig : Signal) is
+      pragma Unreferenced (Sig);
+
+      T              : constant Task_Id := Self;
+      Old_Set        : aliased sigset_t;
+      Unblocked_Mask : aliased sigset_t;
+      Result         : Interfaces.C.int;
+      pragma Warnings (Off, Result);
+
+   begin
+      --  It's not safe to raise an exception when using GCC ZCX mechanism.
+      --  Note that we still need to install a signal handler, since in some
+      --  cases (e.g. shutdown of the Server_Task in System.Interrupts) we
+      --  need to send the Abort signal to a task.
+
+      if ZCX_By_Default then
+         return;
+      end if;
+
+      if T.Deferral_Level = 0
+        and then T.Pending_ATC_Level < T.ATC_Nesting_Level and then
+        not T.Aborting
+      then
+         T.Aborting := True;
+
+         --  Make sure signals used for RTS internal purpose are unmasked
+
+         Result := sigemptyset (Unblocked_Mask'Access);
+         pragma Assert (Result = 0);
+         Result :=
+           sigaddset
+           (Unblocked_Mask'Access,
+            Signal (Interrupt_Management.Abort_Task_Interrupt));
+         pragma Assert (Result = 0);
+         Result := sigaddset (Unblocked_Mask'Access, SIGBUS);
+         pragma Assert (Result = 0);
+         Result := sigaddset (Unblocked_Mask'Access, SIGFPE);
+         pragma Assert (Result = 0);
+         Result := sigaddset (Unblocked_Mask'Access, SIGILL);
+         pragma Assert (Result = 0);
+         Result := sigaddset (Unblocked_Mask'Access, SIGSEGV);
+         pragma Assert (Result = 0);
+
+         Result :=
+           pthread_sigmask
+             (SIG_UNBLOCK,
+              Unblocked_Mask'Access,
+              Old_Set'Access);
+         pragma Assert (Result = 0);
+
+         raise Standard'Abort_Signal;
+      end if;
+   end Abort_Handler;
+
+   -----------------
+   -- Stack_Guard --
+   -----------------
+
+   procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is
+      Stack_Base : constant Address := Get_Stack_Base (T.Common.LL.Thread);
+      Page_Size  : Address;
+      Res        : Interfaces.C.int;
+
+   begin
+      if Stack_Base_Available then
+
+         --  Compute the guard page address
+
+         Page_Size := Address (Get_Page_Size);
+         Res :=
+           mprotect
+             (Stack_Base - (Stack_Base mod Page_Size) + Page_Size,
+              size_t (Page_Size),
+              prot => (if On then PROT_ON else PROT_OFF));
+         pragma Assert (Res = 0);
+      end if;
+   end Stack_Guard;
+
+   --------------------
+   -- Get_Thread_Id  --
+   --------------------
+
+   function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id is
+   begin
+      return T.Common.LL.Thread;
+   end Get_Thread_Id;
+
+   ----------
+   -- Self --
+   ----------
+
+   function Self return Task_Id renames Specific.Self;
+
+   ---------------------
+   -- Initialize_Lock --
+   ---------------------
+
+   --  Note: mutexes and cond_variables needed per-task basis are initialized
+   --  in Initialize_TCB and the Storage_Error is handled. Other mutexes (such
+   --  as RTS_Lock, Memory_Lock...) used in RTS is initialized before any
+   --  status change of RTS. Therefore raising Storage_Error in the following
+   --  routines should be able to be handled safely.
+
+   procedure Initialize_Lock
+     (Prio : System.Any_Priority;
+      L    : not null 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);
+
+      if Result = ENOMEM then
+         raise Storage_Error;
+      end if;
+
+      if Locking_Policy = 'C' then
+         Result := pthread_mutexattr_setprotocol
+           (Attributes'Access, PTHREAD_PRIO_PROTECT);
+         pragma Assert (Result = 0);
+
+         Result := pthread_mutexattr_setprioceiling
+            (Attributes'Access, Interfaces.C.int (Prio));
+         pragma Assert (Result = 0);
+
+      elsif Locking_Policy = 'I' then
+         Result := pthread_mutexattr_setprotocol
+           (Attributes'Access, PTHREAD_PRIO_INHERIT);
+         pragma Assert (Result = 0);
+      end if;
+
+      Result := pthread_mutex_init (L.WO'Access, Attributes'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = ENOMEM then
+         Result := pthread_mutexattr_destroy (Attributes'Access);
+         raise Storage_Error;
+      end if;
+
+      Result := pthread_mutexattr_destroy (Attributes'Access);
+      pragma Assert (Result = 0);
+   end Initialize_Lock;
+
+   procedure Initialize_Lock
+     (L : not null access RTS_Lock; Level : Lock_Level)
+   is
+      pragma Unreferenced (Level);
+
+      Attributes : aliased pthread_mutexattr_t;
+      Result     : Interfaces.C.int;
+
+   begin
+      Result := pthread_mutexattr_init (Attributes'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = ENOMEM then
+         raise Storage_Error;
+      end if;
+
+      if Locking_Policy = 'C' then
+         Result := pthread_mutexattr_setprotocol
+           (Attributes'Access, PTHREAD_PRIO_PROTECT);
+         pragma Assert (Result = 0);
+
+         Result := pthread_mutexattr_setprioceiling
+            (Attributes'Access, Interfaces.C.int (System.Any_Priority'Last));
+         pragma Assert (Result = 0);
+
+      elsif Locking_Policy = 'I' then
+         Result := pthread_mutexattr_setprotocol
+           (Attributes'Access, PTHREAD_PRIO_INHERIT);
+         pragma Assert (Result = 0);
+      end if;
+
+      Result := pthread_mutex_init (L, Attributes'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = ENOMEM then
+         Result := pthread_mutexattr_destroy (Attributes'Access);
+         raise Storage_Error;
+      end if;
+
+      Result := pthread_mutexattr_destroy (Attributes'Access);
+      pragma Assert (Result = 0);
+   end Initialize_Lock;
+
+   -------------------
+   -- Finalize_Lock --
+   -------------------
+
+   procedure Finalize_Lock (L : not null access Lock) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_destroy (L.WO'Access);
+      pragma Assert (Result = 0);
+   end Finalize_Lock;
+
+   procedure Finalize_Lock (L : not null access RTS_Lock) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_destroy (L);
+      pragma Assert (Result = 0);
+   end Finalize_Lock;
+
+   ----------------
+   -- Write_Lock --
+   ----------------
+
+   procedure Write_Lock
+     (L : not null access Lock; Ceiling_Violation : out Boolean)
+   is
+      Result : Interfaces.C.int;
+
+   begin
+      Result := pthread_mutex_lock (L.WO'Access);
+
+      --  The cause of EINVAL is a priority ceiling violation
+
+      Ceiling_Violation := Result = EINVAL;
+      pragma Assert (Result = 0 or else Ceiling_Violation);
+   end Write_Lock;
+
+   procedure Write_Lock (L : not null access RTS_Lock) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_lock (L);
+      pragma Assert (Result = 0);
+   end Write_Lock;
+
+   procedure Write_Lock (T : Task_Id) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_lock (T.Common.LL.L'Access);
+      pragma Assert (Result = 0);
+   end Write_Lock;
+
+   ---------------
+   -- Read_Lock --
+   ---------------
+
+   procedure Read_Lock
+     (L : not null access Lock; Ceiling_Violation : out Boolean) is
+   begin
+      Write_Lock (L, Ceiling_Violation);
+   end Read_Lock;
+
+   ------------
+   -- Unlock --
+   ------------
+
+   procedure Unlock (L : not null access Lock) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_unlock (L.WO'Access);
+      pragma Assert (Result = 0);
+   end Unlock;
+
+   procedure Unlock (L : not null access RTS_Lock) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_unlock (L);
+      pragma Assert (Result = 0);
+   end Unlock;
+
+   procedure Unlock (T : Task_Id) is
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_mutex_unlock (T.Common.LL.L'Access);
+      pragma Assert (Result = 0);
+   end Unlock;
+
+   -----------------
+   -- Set_Ceiling --
+   -----------------
+
+   --  Dynamic priority ceilings are not supported by the underlying system
+
+   procedure Set_Ceiling
+     (L    : not null access Lock;
+      Prio : System.Any_Priority)
+   is
+      pragma Unreferenced (L, Prio);
+   begin
+      null;
+   end Set_Ceiling;
+
+   -----------
+   -- Sleep --
+   -----------
+
+   procedure Sleep
+     (Self_ID : Task_Id;
+      Reason  : System.Tasking.Task_States)
+   is
+      pragma Unreferenced (Reason);
+
+      Result : Interfaces.C.int;
+
+   begin
+      Result :=
+        pthread_cond_wait
+          (cond  => Self_ID.Common.LL.CV'Access,
+           mutex => Self_ID.Common.LL.L'Access);
+
+      --  EINTR is not considered a failure
+
+      pragma Assert (Result = 0 or else Result = EINTR);
+   end Sleep;
+
+   -----------------
+   -- Timed_Sleep --
+   -----------------
+
+   --  This is for use within the run-time system, so abort is
+   --  assumed to be already deferred, and the caller should be
+   --  holding its own ATCB lock.
+
+   procedure Timed_Sleep
+     (Self_ID  : Task_Id;
+      Time     : Duration;
+      Mode     : ST.Delay_Modes;
+      Reason   : Task_States;
+      Timedout : out Boolean;
+      Yielded  : out Boolean) renames Monotonic.Timed_Sleep;
+
+   -----------------
+   -- Timed_Delay --
+   -----------------
+
+   --  This is for use in implementing delay statements, so we assume the
+   --  caller is abort-deferred but is holding no locks.
+
+   procedure Timed_Delay
+     (Self_ID : Task_Id;
+      Time    : Duration;
+      Mode    : ST.Delay_Modes) renames Monotonic.Timed_Delay;
+
+   ---------------------
+   -- Monotonic_Clock --
+   ---------------------
+
+   function Monotonic_Clock return Duration renames Monotonic.Monotonic_Clock;
+
+   -------------------
+   -- RT_Resolution --
+   -------------------
+
+   function RT_Resolution return Duration renames Monotonic.RT_Resolution;
+
+   ------------
+   -- Wakeup --
+   ------------
+
+   procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
+      pragma Unreferenced (Reason);
+      Result : Interfaces.C.int;
+   begin
+      Result := pthread_cond_signal (T.Common.LL.CV'Access);
+      pragma Assert (Result = 0);
+   end Wakeup;
+
+   -----------
+   -- Yield --
+   -----------
+
+   procedure Yield (Do_Yield : Boolean := True) is
+      Result : Interfaces.C.int;
+      pragma Unreferenced (Result);
+   begin
+      if Do_Yield then
+         Result := sched_yield;
+      end if;
+   end Yield;
+
+   ------------------
+   -- Set_Priority --
+   ------------------
+
+   procedure Set_Priority
+     (T                   : Task_Id;
+      Prio                : System.Any_Priority;
+      Loss_Of_Inheritance : Boolean := False)
+   is
+      pragma Unreferenced (Loss_Of_Inheritance);
+
+      Result : Interfaces.C.int;
+      Param  : aliased struct_sched_param;
+
+      function Get_Policy (Prio : System.Any_Priority) return Character;
+      pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching");
+      --  Get priority specific dispatching policy
+
+      Priority_Specific_Policy : constant Character := Get_Policy (Prio);
+      --  Upper case first character of the policy name corresponding to the
+      --  task as set by a Priority_Specific_Dispatching pragma.
+
+   begin
+      T.Common.Current_Priority := Prio;
+      Param.sched_priority := To_Target_Priority (Prio);
+
+      if Time_Slice_Supported
+        and then (Dispatching_Policy = 'R'
+                  or else Priority_Specific_Policy = 'R'
+                  or else Time_Slice_Val > 0)
+      then
+         Result := pthread_setschedparam
+           (T.Common.LL.Thread, SCHED_RR, Param'Access);
+
+      elsif Dispatching_Policy = 'F'
+        or else Priority_Specific_Policy = 'F'
+        or else Time_Slice_Val = 0
+      then
+         Result := pthread_setschedparam
+           (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
+
+      else
+         Result := pthread_setschedparam
+           (T.Common.LL.Thread, SCHED_OTHER, Param'Access);
+      end if;
+
+      pragma Assert (Result = 0);
+   end Set_Priority;
+
+   ------------------
+   -- Get_Priority --
+   ------------------
+
+   function Get_Priority (T : Task_Id) return System.Any_Priority is
+   begin
+      return T.Common.Current_Priority;
+   end Get_Priority;
+
+   ----------------
+   -- Enter_Task --
+   ----------------
+
+   procedure Enter_Task (Self_ID : Task_Id) is
+   begin
+      Self_ID.Common.LL.Thread := pthread_self;
+      Self_ID.Common.LL.LWP := lwp_self;
+
+      Specific.Set (Self_ID);
+
+      if Use_Alternate_Stack then
+         declare
+            Stack  : aliased stack_t;
+            Result : Interfaces.C.int;
+         begin
+            Stack.ss_sp    := Self_ID.Common.Task_Alternate_Stack;
+            Stack.ss_size  := Alternate_Stack_Size;
+            Stack.ss_flags := 0;
+            Result := sigaltstack (Stack'Access, null);
+            pragma Assert (Result = 0);
+         end;
+      end if;
+   end Enter_Task;
+
+   -------------------
+   -- Is_Valid_Task --
+   -------------------
+
+   function Is_Valid_Task return Boolean renames Specific.Is_Valid_Task;
+
+   -----------------------------
+   -- Register_Foreign_Thread --
+   -----------------------------
+
+   function Register_Foreign_Thread return Task_Id is
+   begin
+      if Is_Valid_Task then
+         return Self;
+      else
+         return Register_Foreign_Thread (pthread_self);
+      end if;
+   end Register_Foreign_Thread;
+
+   --------------------
+   -- 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
+      --  Give the task a unique serial number
+
+      Self_ID.Serial_Number := Next_Serial_Number;
+      Next_Serial_Number := Next_Serial_Number + 1;
+      pragma Assert (Next_Serial_Number /= 0);
+
+      Result := pthread_mutexattr_init (Mutex_Attr'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = 0 then
+         if Locking_Policy = 'C' then
+            Result :=
+              pthread_mutexattr_setprotocol
+                (Mutex_Attr'Access,
+                 PTHREAD_PRIO_PROTECT);
+            pragma Assert (Result = 0);
+
+            Result :=
+              pthread_mutexattr_setprioceiling
+                (Mutex_Attr'Access,
+                 Interfaces.C.int (System.Any_Priority'Last));
+            pragma Assert (Result = 0);
+
+         elsif Locking_Policy = 'I' then
+            Result :=
+              pthread_mutexattr_setprotocol
+                (Mutex_Attr'Access,
+                 PTHREAD_PRIO_INHERIT);
+            pragma Assert (Result = 0);
+         end if;
+
+         Result :=
+           pthread_mutex_init
+                (Self_ID.Common.LL.L'Access,
+              Mutex_Attr'Access);
+         pragma Assert (Result = 0 or else Result = ENOMEM);
+      end if;
+
+      if Result /= 0 then
+         Succeeded := False;
+         return;
+      end if;
+
+      Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+      pragma Assert (Result = 0);
+
+      Result := pthread_condattr_init (Cond_Attr'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = 0 then
+         Result := GNAT_pthread_condattr_setup (Cond_Attr'Access);
+         pragma Assert (Result = 0);
+
+         Result :=
+           pthread_cond_init
+             (Self_ID.Common.LL.CV'Access, Cond_Attr'Access);
+         pragma Assert (Result = 0 or else Result = ENOMEM);
+      end if;
+
+      if Result = 0 then
+         Succeeded := True;
+      else
+         Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
+         pragma Assert (Result = 0);
+         Succeeded := False;
+      end if;
+
+      Result := pthread_condattr_destroy (Cond_Attr'Access);
+      pragma Assert (Result = 0);
+   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;
+      Page_Size           : constant Interfaces.C.size_t :=
+                              Interfaces.C.size_t (Get_Page_Size);
+      Result              : Interfaces.C.int;
+
+      function Thread_Body_Access is new
+        Ada.Unchecked_Conversion (System.Address, Thread_Body);
+
+      use System.Task_Info;
+
+   begin
+      Adjusted_Stack_Size :=
+         Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size);
+
+      if Stack_Base_Available then
+
+         --  If Stack Checking is supported then allocate 2 additional pages:
+
+         --  In the worst case, stack is allocated at something like
+         --  N * Get_Page_Size - epsilon, we need to add the size for 2 pages
+         --  to be sure the effective stack size is greater than what
+         --  has been asked.
+
+         Adjusted_Stack_Size := Adjusted_Stack_Size + 2 * Page_Size;
+      end if;
+
+      --  Round stack size as this is required by some OSes (Darwin)
+
+      Adjusted_Stack_Size := Adjusted_Stack_Size + Page_Size - 1;
+      Adjusted_Stack_Size :=
+        Adjusted_Stack_Size - Adjusted_Stack_Size mod Page_Size;
+
+      Result := pthread_attr_init (Attributes'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result /= 0 then
+         Succeeded := False;
+         return;
+      end if;
+
+      Result :=
+        pthread_attr_setdetachstate
+          (Attributes'Access, PTHREAD_CREATE_DETACHED);
+      pragma Assert (Result = 0);
+
+      Result :=
+        pthread_attr_setstacksize
+          (Attributes'Access, Adjusted_Stack_Size);
+      pragma Assert (Result = 0);
+
+      if T.Common.Task_Info /= Default_Scope then
+         case T.Common.Task_Info is
+            when System.Task_Info.Process_Scope =>
+               Result :=
+                 pthread_attr_setscope
+                   (Attributes'Access, PTHREAD_SCOPE_PROCESS);
+
+            when System.Task_Info.System_Scope =>
+               Result :=
+                 pthread_attr_setscope
+                   (Attributes'Access, PTHREAD_SCOPE_SYSTEM);
+
+            when System.Task_Info.Default_Scope =>
+               Result := 0;
+         end case;
+
+         pragma Assert (Result = 0);
+      end if;
+
+      --  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.
+
+      --  Note: the use of Unrestricted_Access in the following call is needed
+      --  because otherwise we have an error of getting a access-to-volatile
+      --  value which points to a non-volatile object. But in this case it is
+      --  safe to do this, since we know we have no problems with aliasing and
+      --  Unrestricted_Access bypasses this check.
+
+      Result := pthread_create
+        (T.Common.LL.Thread'Unrestricted_Access,
+         Attributes'Access,
+         Thread_Body_Access (Wrapper),
+         To_Address (T));
+      pragma Assert (Result = 0 or else Result = EAGAIN);
+
+      Succeeded := Result = 0;
+
+      Result := pthread_attr_destroy (Attributes'Access);
+      pragma Assert (Result = 0);
+
+      if Succeeded then
+         Set_Priority (T, Priority);
+      end if;
+   end Create_Task;
+
+   ------------------
+   -- Finalize_TCB --
+   ------------------
+
+   procedure Finalize_TCB (T : Task_Id) is
+      Result : Interfaces.C.int;
+
+   begin
+      Result := pthread_mutex_destroy (T.Common.LL.L'Access);
+      pragma Assert (Result = 0);
+
+      Result := pthread_cond_destroy (T.Common.LL.CV'Access);
+      pragma Assert (Result = 0);
+
+      if T.Known_Tasks_Index /= -1 then
+         Known_Tasks (T.Known_Tasks_Index) := null;
+      end if;
+
+      ATCB_Allocation.Free_ATCB (T);
+   end Finalize_TCB;
+
+   ---------------
+   -- Exit_Task --
+   ---------------
+
+   procedure Exit_Task is
+   begin
+      --  Mark this task as unknown, so that if Self is called, it won't
+      --  return a dangling pointer.
+
+      Specific.Set (null);
+   end Exit_Task;
+
+   ----------------
+   -- Abort_Task --
+   ----------------
+
+   procedure Abort_Task (T : Task_Id) is
+      Result : Interfaces.C.int;
+   begin
+      if Abort_Handler_Installed then
+         Result :=
+           pthread_kill
+             (T.Common.LL.Thread,
+              Signal (System.Interrupt_Management.Abort_Task_Interrupt));
+         pragma Assert (Result = 0);
+      end if;
+   end Abort_Task;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize (S : in out Suspension_Object) is
+      Mutex_Attr : aliased pthread_mutexattr_t;
+      Cond_Attr  : aliased pthread_condattr_t;
+      Result     : Interfaces.C.int;
+
+   begin
+      --  Initialize internal state (always to False (RM D.10 (6)))
+
+      S.State := False;
+      S.Waiting := False;
+
+      --  Initialize internal mutex
+
+      Result := pthread_mutexattr_init (Mutex_Attr'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = ENOMEM then
+         raise Storage_Error;
+      end if;
+
+      Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result = ENOMEM then
+         Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+         pragma Assert (Result = 0);
+
+         raise Storage_Error;
+      end if;
+
+      Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+      pragma Assert (Result = 0);
+
+      --  Initialize internal condition variable
+
+      Result := pthread_condattr_init (Cond_Attr'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result /= 0 then
+         Result := pthread_mutex_destroy (S.L'Access);
+         pragma Assert (Result = 0);
+
+         --  Storage_Error is propagated as intended if the allocation of the
+         --  underlying OS entities fails.
+
+         raise Storage_Error;
+
+      else
+         Result := GNAT_pthread_condattr_setup (Cond_Attr'Access);
+         pragma Assert (Result = 0);
+      end if;
+
+      Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+      pragma Assert (Result = 0 or else Result = ENOMEM);
+
+      if Result /= 0 then
+         Result := pthread_mutex_destroy (S.L'Access);
+         pragma Assert (Result = 0);
+
+         Result := pthread_condattr_destroy (Cond_Attr'Access);
+         pragma Assert (Result = 0);
+
+         --  Storage_Error is propagated as intended if the allocation of the
+         --  underlying OS entities fails.
+
+         raise Storage_Error;
+      end if;
+
+      Result := pthread_condattr_destroy (Cond_Attr'Access);
+      pragma Assert (Result = 0);
+   end Initialize;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize (S : in out Suspension_Object) is
+      Result : Interfaces.C.int;
+
+   begin
+      --  Destroy internal mutex
+
+      Result := pthread_mutex_destroy (S.L'Access);
+      pragma Assert (Result = 0);
+
+      --  Destroy internal condition variable
+
+      Result := pthread_cond_destroy (S.CV'Access);
+      pragma Assert (Result = 0);
+   end Finalize;
+
+   -------------------
+   -- Current_State --
+   -------------------
+
+   function Current_State (S : Suspension_Object) return Boolean is
+   begin
+      --  We do not want to use lock on this read operation. State is marked
+      --  as Atomic so that we ensure that the value retrieved is correct.
+
+      return S.State;
+   end Current_State;
+
+   ---------------
+   -- Set_False --
+   ---------------
+
+   procedure Set_False (S : in out Suspension_Object) is
+      Result : Interfaces.C.int;
+
+   begin
+      SSL.Abort_Defer.all;
+
+      Result := pthread_mutex_lock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      S.State := False;
+
+      Result := pthread_mutex_unlock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
+   end Set_False;
+
+   --------------
+   -- Set_True --
+   --------------
+
+   procedure Set_True (S : in out Suspension_Object) is
+      Result : Interfaces.C.int;
+
+   begin
+      SSL.Abort_Defer.all;
+
+      Result := pthread_mutex_lock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      --  If there is already a task waiting on this suspension object then
+      --  we resume it, leaving the state of the suspension object to False,
+      --  as it is specified in (RM D.10(9)). Otherwise, it just leaves
+      --  the state to True.
+
+      if S.Waiting then
+         S.Waiting := False;
+         S.State := False;
+
+         Result := pthread_cond_signal (S.CV'Access);
+         pragma Assert (Result = 0);
+
+      else
+         S.State := True;
+      end if;
+
+      Result := pthread_mutex_unlock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      SSL.Abort_Undefer.all;
+   end Set_True;
+
+   ------------------------
+   -- Suspend_Until_True --
+   ------------------------
+
+   procedure Suspend_Until_True (S : in out Suspension_Object) is
+      Result : Interfaces.C.int;
+
+   begin
+      SSL.Abort_Defer.all;
+
+      Result := pthread_mutex_lock (S.L'Access);
+      pragma Assert (Result = 0);
+
+      if S.Waiting then
+
+         --  Program_Error must be raised upon calling Suspend_Until_True
+         --  if another task is already waiting on that suspension object
+         --  (RM D.10(10)).
+
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+
+         raise Program_Error;
+
+      else
+         --  Suspend the task if the state is False. Otherwise, the task
+         --  continues its execution, and the state of the suspension object
+         --  is set to False (ARM D.10 par. 9).
+
+         if S.State then
+            S.State := False;
+         else
+            S.Waiting := True;
+
+            loop
+               --  Loop in case pthread_cond_wait returns earlier than expected
+               --  (e.g. in case of EINTR caused by a signal).
+
+               Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+               pragma Assert (Result = 0 or else Result = EINTR);
+
+               exit when not S.Waiting;
+            end loop;
+         end if;
+
+         Result := pthread_mutex_unlock (S.L'Access);
+         pragma Assert (Result = 0);
+
+         SSL.Abort_Undefer.all;
+      end if;
+   end Suspend_Until_True;
+
+   ----------------
+   -- Check_Exit --
+   ----------------
+
+   --  Dummy version
+
+   function Check_Exit (Self_ID : ST.Task_Id) return Boolean is
+      pragma Unreferenced (Self_ID);
+   begin
+      return True;
+   end Check_Exit;
+
+   --------------------
+   -- Check_No_Locks --
+   --------------------
+
+   function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean is
+      pragma Unreferenced (Self_ID);
+   begin
+      return True;
+   end Check_No_Locks;
+
+   ----------------------
+   -- Environment_Task --
+   ----------------------
+
+   function Environment_Task return Task_Id is
+   begin
+      return Environment_Task_Id;
+   end Environment_Task;
+
+   --------------
+   -- Lock_RTS --
+   --------------
+
+   procedure Lock_RTS is
+   begin
+      Write_Lock (Single_RTS_Lock'Access);
+   end Lock_RTS;
+
+   ----------------
+   -- Unlock_RTS --
+   ----------------
+
+   procedure Unlock_RTS is
+   begin
+      Unlock (Single_RTS_Lock'Access);
+   end Unlock_RTS;
+
+   ------------------
+   -- Suspend_Task --
+   ------------------
+
+   function Suspend_Task
+     (T           : ST.Task_Id;
+      Thread_Self : Thread_Id) return Boolean
+   is
+      pragma Unreferenced (T, Thread_Self);
+   begin
+      return False;
+   end Suspend_Task;
+
+   -----------------
+   -- Resume_Task --
+   -----------------
+
+   function Resume_Task
+     (T           : ST.Task_Id;
+      Thread_Self : Thread_Id) return Boolean
+   is
+      pragma Unreferenced (T, Thread_Self);
+   begin
+      return False;
+   end Resume_Task;
+
+   --------------------
+   -- Stop_All_Tasks --
+   --------------------
+
+   procedure Stop_All_Tasks is
+   begin
+      null;
+   end Stop_All_Tasks;
+
+   ---------------
+   -- Stop_Task --
+   ---------------
+
+   function Stop_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Stop_Task;
+
+   -------------------
+   -- Continue_Task --
+   -------------------
+
+   function Continue_Task (T : ST.Task_Id) return Boolean is
+      pragma Unreferenced (T);
+   begin
+      return False;
+   end Continue_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;
+
+      function State
+        (Int : System.Interrupt_Management.Interrupt_ID) return Character;
+      pragma Import (C, State, "__gnat_get_interrupt_state");
+      --  Get interrupt state.  Defined in a-init.c
+      --  The input argument is the interrupt number,
+      --  and the result is one of the following:
+
+      Default : constant Character := 's';
+      --    'n'   this interrupt not set by any Interrupt_State pragma
+      --    'u'   Interrupt_State pragma set state to User
+      --    'r'   Interrupt_State pragma set state to Runtime
+      --    's'   Interrupt_State pragma set state to System (use "default"
+      --           system handler)
+
+   begin
+      Environment_Task_Id := Environment_Task;
+
+      Interrupt_Management.Initialize;
+
+      --  Initialize the lock used to synchronize chain of all ATCBs
+
+      Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
+
+      Specific.Initialize (Environment_Task);
+
+      if Use_Alternate_Stack then
+         Environment_Task.Common.Task_Alternate_Stack :=
+           Alternate_Stack'Address;
+      end if;
+
+      --  Make environment task known here because it doesn't go through
+      --  Activate_Tasks, which does it for all other tasks.
+
+      Known_Tasks (Known_Tasks'First) := Environment_Task;
+      Environment_Task.Known_Tasks_Index := Known_Tasks'First;
+
+      Enter_Task (Environment_Task);
+
+      if State
+          (System.Interrupt_Management.Abort_Task_Interrupt) /= Default
+      then
+         act.sa_flags := 0;
+         act.sa_handler := Abort_Handler'Address;
+
+         Result := sigemptyset (Tmp_Set'Access);
+         pragma Assert (Result = 0);
+         act.sa_mask := Tmp_Set;
+
+         Result :=
+           sigaction
+             (Signal (System.Interrupt_Management.Abort_Task_Interrupt),
+              act'Unchecked_Access,
+              old_act'Unchecked_Access);
+         pragma Assert (Result = 0);
+         Abort_Handler_Installed := True;
+      end if;
+   end Initialize;
+
+   -----------------------
+   -- Set_Task_Affinity --
+   -----------------------
+
+   procedure Set_Task_Affinity (T : ST.Task_Id) is
+      pragma Unreferenced (T);
+
+   begin
+      --  Setting task affinity is not supported by the underlying system
+
+      null;
+   end Set_Task_Affinity;
+
+end System.Task_Primitives.Operations;