[multiple changes]

2017-11-09  Piotr Trojanek  <trojanek@adacore.com>

	* lib-xref-spark_specific.adb (Add_SPARK_Xrefs): Ignore loop parameters
	in expression funtions that are expanded into variables.

2017-11-09  Piotr Trojanek  <trojanek@adacore.com>

	* sem_util.adb: Minor whitespace cleanup.

2017-11-09  Jerome Lambourg  <lambourg@adacore.com>

	* libgnarl/s-taprop__qnx.adb: Refine aarch64-qnx. Use the POSIX
	s-taprop version rather than a custom one.
	* sigtramp-qnx.c (aarch64-qnx): Implement the signal trampoline.

From-SVN: r254563

5 files changed, 82 insertions, 1639 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ce7872b..2819640 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2017-11-09  Piotr Trojanek  <trojanek@adacore.com>
+
+	* lib-xref-spark_specific.adb (Add_SPARK_Xrefs): Ignore loop parameters
+	in expression funtions that are expanded into variables.
+
+2017-11-09  Piotr Trojanek  <trojanek@adacore.com>
+
+	* sem_util.adb: Minor whitespace cleanup.
+
+2017-11-09  Jerome Lambourg  <lambourg@adacore.com>
+
+	* libgnarl/s-taprop__qnx.adb: Refine aarch64-qnx. Use the POSIX
+	s-taprop version rather than a custom one.
+	* sigtramp-qnx.c (aarch64-qnx): Implement the signal trampoline.
+
 2017-11-08  Piotr Trojanek  <trojanek@adacore.com>
 
 	* lib-xref.ads, lib-xref-spark_specific.adb
diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb
index 48bb91d..a30cb84 100644
--- a/gcc/ada/lib-xref-spark_specific.adb
+++ b/gcc/ada/lib-xref-spark_specific.adb
@@ -608,9 +608,11 @@ package body SPARK_Specific is
               --  the analysis of the expanded body. We don't lose any globals
               --  by discarding them, because such loop parameters can only be
               --  accessed locally from within the expression function body.
+              --  Note: some loop parameters are expanded into variables; they
+              --  also must be ignored.
 
               and then not
-                (Ekind (Ref.Ent) = E_Loop_Parameter
+                (Ekind_In (Ref.Ent, E_Loop_Parameter, E_Variable)
                   and then Scope_Within
                              (Ref.Ent, Unique_Entity (Ref.Ref_Scope))
                   and then Is_Expression_Function (Ref.Ref_Scope))
diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb b/gcc/ada/libgnarl/s-taprop__qnx.adb
deleted file mode 100644
index 85ebed7..0000000
--- a/gcc/ada/libgnarl/s-taprop__qnx.adb
+++ /dev/null
@@ -1,1546 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                 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-2017, 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 QNX/Neutrino version of this package
-
---  This package contains all the GNULL primitives that interface directly with
---  the underlying OS.
-
---  Note: this file can only be used for POSIX compliant systems that implement
---  SCHED_FIFO and Ceiling Locking correctly.
-
---  For configurations where SCHED_FIFO and priority ceiling are not a
---  requirement, this file can also be used (e.g AiX threads)
-
-pragma Polling (Off);
---  Turn off polling, we do not want ATC polling to take place during tasking
---  operations. It causes infinite loops and other problems.
-
-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 mainly in Single_Lock mode, but also to protect All_Tasks_List
-
-   Environment_Task_Id : Task_Id;
-   --  A variable to hold Task_Id for the environment task
-
-   Unblocked_Signal_Mask : aliased sigset_t;
-   --  The set of signals that should be unblocked in all tasks
-
-   --  The followings are internal configuration constants needed
-
-   Next_Serial_Number : Task_Serial_Number := 100;
-   --  We start at 100 (reserve some special values for using in error checks)
-
-   Time_Slice_Val : Integer;
-   pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
-
-   Dispatching_Policy : Character;
-   pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
-
-   Locking_Policy : Character;
-   pragma Import (C, Locking_Policy, "__gl_locking_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
-
-   ----------------------------------
-   -- 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");
-
-   procedure Compute_Deadline
-     (Time       : Duration;
-      Mode       : ST.Delay_Modes;
-      Check_Time : out Duration;
-      Abs_Time   : out Duration;
-      Rel_Time   : out Duration);
-   --  Helper for Timed_Sleep and Timed_Delay: given a deadline specified by
-   --  Time and Mode, compute the current clock reading (Check_Time), and the
-   --  target absolute and relative clock readings (Abs_Time, Rel_Time). The
-   --  epoch for Time depends on Mode; the epoch for Check_Time and Abs_Time
-   --  is always that of CLOCK_RT_Ada.
-
-   -------------------
-   -- 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;
-
-      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 := pthread_sigmask (SIG_UNBLOCK,
-           Unblocked_Signal_Mask'Access, Old_Set'Access);
-         pragma Assert (Result = 0);
-
-         raise Standard'Abort_Signal;
-      end if;
-   end Abort_Handler;
-
-   ----------------------
-   -- Compute_Deadline --
-   ----------------------
-
-   procedure Compute_Deadline
-     (Time       : Duration;
-      Mode       : ST.Delay_Modes;
-      Check_Time : out Duration;
-      Abs_Time   : out Duration;
-      Rel_Time   : out Duration)
-   is
-   begin
-      Check_Time := Monotonic_Clock;
-
-      --  Relative deadline
-
-      if Mode = Relative then
-         Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
-
-         if Relative_Timed_Wait then
-            Rel_Time := Duration'Min (Max_Sensible_Delay, Time);
-         end if;
-
-         pragma Warnings (Off);
-         --  Comparison "OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME" is compile
-         --  time known.
-
-      --  Absolute deadline specified using the tasking clock (CLOCK_RT_Ada)
-
-      elsif Mode = Absolute_RT
-        or else OSC.CLOCK_RT_Ada = OSC.CLOCK_REALTIME
-      then
-         pragma Warnings (On);
-         Abs_Time := Duration'Min (Check_Time + Max_Sensible_Delay, Time);
-
-         if Relative_Timed_Wait then
-            Rel_Time := Duration'Min (Max_Sensible_Delay, Time - Check_Time);
-         end if;
-
-      --  Absolute deadline specified using the calendar clock, in the
-      --  case where it is not the same as the tasking clock: compensate for
-      --  difference between clock epochs (Base_Time - Base_Cal_Time).
-
-      else
-         declare
-            Cal_Check_Time : constant Duration := OS_Primitives.Clock;
-            RT_Time        : constant Duration :=
-                               Time + Check_Time - Cal_Check_Time;
-
-         begin
-            Abs_Time :=
-              Duration'Min (Check_Time + Max_Sensible_Delay, RT_Time);
-
-            if Relative_Timed_Wait then
-               Rel_Time :=
-                 Duration'Min (Max_Sensible_Delay, RT_Time - Check_Time);
-            end if;
-         end;
-      end if;
-   end Compute_Deadline;
-
-   -----------------
-   -- 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;
-      Global_Lock : Boolean := False)
-   is
-      Result : Interfaces.C.int;
-   begin
-      if not Single_Lock or else Global_Lock then
-         Result := pthread_mutex_lock (L);
-         pragma Assert (Result = 0);
-      end if;
-   end Write_Lock;
-
-   procedure Write_Lock (T : Task_Id) is
-      Result : Interfaces.C.int;
-   begin
-      if not Single_Lock then
-         Result := pthread_mutex_lock (T.Common.LL.L'Access);
-         pragma Assert (Result = 0);
-      end if;
-   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; Global_Lock : Boolean := False)
-   is
-      Result : Interfaces.C.int;
-   begin
-      if not Single_Lock or else Global_Lock then
-         Result := pthread_mutex_unlock (L);
-         pragma Assert (Result = 0);
-      end if;
-   end Unlock;
-
-   procedure Unlock (T : Task_Id) is
-      Result : Interfaces.C.int;
-   begin
-      if not Single_Lock then
-         Result := pthread_mutex_unlock (T.Common.LL.L'Access);
-         pragma Assert (Result = 0);
-      end if;
-   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 => (if Single_Lock
-                     then Single_RTS_Lock'Access
-                     else 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)
-   is
-      pragma Unreferenced (Reason);
-
-      Base_Time  : Duration;
-      Check_Time : Duration;
-      Abs_Time   : Duration;
-      Rel_Time   : Duration;
-
-      Request    : aliased timespec;
-      Result     : Interfaces.C.int;
-
-   begin
-      Timedout := True;
-      Yielded := False;
-
-      Compute_Deadline
-        (Time       => Time,
-         Mode       => Mode,
-         Check_Time => Check_Time,
-         Abs_Time   => Abs_Time,
-         Rel_Time   => Rel_Time);
-      Base_Time := Check_Time;
-
-      if Abs_Time > Check_Time then
-         Request :=
-           To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
-
-         loop
-            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
-
-            Result :=
-              pthread_cond_timedwait
-                (cond    => Self_ID.Common.LL.CV'Access,
-                 mutex   => (if Single_Lock
-                             then Single_RTS_Lock'Access
-                             else Self_ID.Common.LL.L'Access),
-                 abstime => Request'Access);
-
-            Check_Time := Monotonic_Clock;
-            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
-            if Result = 0 or Result = EINTR then
-
-               --  Somebody may have called Wakeup for us
-
-               Timedout := False;
-               exit;
-            end if;
-
-            pragma Assert (Result = ETIMEDOUT);
-         end loop;
-      end if;
-   end 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)
-   is
-      Base_Time  : Duration;
-      Check_Time : Duration;
-      Abs_Time   : Duration;
-      Rel_Time   : Duration;
-      Request    : aliased timespec;
-
-      Result : Interfaces.C.int;
-      pragma Warnings (Off, Result);
-
-   begin
-      if Single_Lock then
-         Lock_RTS;
-      end if;
-
-      Write_Lock (Self_ID);
-
-      Compute_Deadline
-        (Time       => Time,
-         Mode       => Mode,
-         Check_Time => Check_Time,
-         Abs_Time   => Abs_Time,
-         Rel_Time   => Rel_Time);
-      Base_Time := Check_Time;
-
-      if Abs_Time > Check_Time then
-         Request :=
-           To_Timespec (if Relative_Timed_Wait then Rel_Time else Abs_Time);
-         Self_ID.Common.State := Delay_Sleep;
-
-         loop
-            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
-
-            Result :=
-              pthread_cond_timedwait
-                (cond    => Self_ID.Common.LL.CV'Access,
-                 mutex   => (if Single_Lock
-                             then Single_RTS_Lock'Access
-                             else Self_ID.Common.LL.L'Access),
-                 abstime => Request'Access);
-
-            Check_Time := Monotonic_Clock;
-            exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
-
-            pragma Assert (Result = 0
-                             or else Result = ETIMEDOUT
-                             or else Result = EINTR);
-         end loop;
-
-         Self_ID.Common.State := Runnable;
-      end if;
-
-      Unlock (Self_ID);
-
-      if Single_Lock then
-         Unlock_RTS;
-      end if;
-
-      Result := sched_yield;
-   end Timed_Delay;
-
-   ---------------------
-   -- Monotonic_Clock --
-   ---------------------
-
-   function Monotonic_Clock return Duration is
-      TS     : aliased timespec;
-      Result : Interfaces.C.int;
-   begin
-      Result := clock_gettime
-        (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
-      pragma Assert (Result = 0);
-      return To_Duration (TS);
-   end Monotonic_Clock;
-
-   -------------------
-   -- RT_Resolution --
-   -------------------
-
-   function RT_Resolution return Duration is
-      TS     : aliased timespec;
-      Result : Interfaces.C.int;
-   begin
-      Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
-      pragma Assert (Result = 0);
-
-      return To_Duration (TS);
-   end 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);
-
-      if not Single_Lock then
-         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);
-      end if;
-
-      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
-         if not Single_Lock then
-            Result := pthread_mutex_destroy (Self_ID.Common.LL.L'Access);
-            pragma Assert (Result = 0);
-         end if;
-
-         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
-      if not Single_Lock then
-         Result := pthread_mutex_destroy (T.Common.LL.L'Access);
-         pragma Assert (Result = 0);
-      end if;
-
-      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, Global_Lock => True);
-   end Lock_RTS;
-
-   ----------------
-   -- Unlock_RTS --
-   ----------------
-
-   procedure Unlock_RTS is
-   begin
-      Unlock (Single_RTS_Lock'Access, Global_Lock => True);
-   end Unlock_RTS;
-
-   ------------------
-   -- Suspend_Task --
-   ------------------
-
-   function Suspend_Task
-     (T           : ST.Task_Id;
-      Thread_Self : Thread_Id) return Boolean
-   is
-   begin
-      if T.Common.LL.Thread /= Thread_Self then
-         return pthread_kill (T.Common.LL.Thread, SIGSTOP) = 0;
-      else
-         return True;
-      end if;
-   end Suspend_Task;
-
-   -----------------
-   -- Resume_Task --
-   -----------------
-
-   function Resume_Task
-     (T           : ST.Task_Id;
-      Thread_Self : Thread_Id) return Boolean
-   is
-   begin
-      if T.Common.LL.Thread /= Thread_Self then
-         return pthread_kill (T.Common.LL.Thread, SIGCONT) = 0;
-      else
-         return True;
-      end if;
-   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;
-
-      --  Prepare the set of signals that should unblocked in all tasks
-
-      Result := sigemptyset (Unblocked_Signal_Mask'Access);
-      pragma Assert (Result = 0);
-
-      for J in Interrupt_Management.Interrupt_ID loop
-         if System.Interrupt_Management.Keep_Unmasked (J) then
-            Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-            pragma Assert (Result = 0);
-         end if;
-      end loop;
-
-      --  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;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 317792a..33730ce 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -19536,9 +19536,9 @@ package body Sem_Util is
       N : constant Entity_Id := Make_Temporary (Sloc_Value, Id_Char);
 
    begin
-      Set_Ekind          (N, Kind);
-      Set_Is_Internal    (N, True);
-      Append_Entity      (N, Scope_Id);
+      Set_Ekind       (N, Kind);
+      Set_Is_Internal (N, True);
+      Append_Entity   (N, Scope_Id);
 
       if Kind in Type_Kind then
          Init_Size_Align (N);
diff --git a/gcc/ada/sigtramp-qnx.c b/gcc/ada/sigtramp-qnx.c
index 60c98e1..67081c9 100644
--- a/gcc/ada/sigtramp-qnx.c
+++ b/gcc/ada/sigtramp-qnx.c
@@ -74,14 +74,14 @@ void __gnat_sigtramp (int signo, void *si, void *ucontext,
 /* Trampoline body block
    ---------------------  */
 
+#define COMMON_CFI(REG) \
+  ".cfi_offset " S(REGNO_##REG) "," S(REG_OFFSET_##REG)
+
 #ifdef __x86_64__
 /*****************************************
  *               x86-64                  *
  *****************************************/
 
-#define COMMON_CFI(REG) \
-  ".cfi_offset " S(REGNO_##REG) "," S(REG_##REG)
-
 // CFI register numbers
 #define REGNO_RAX 0
 #define REGNO_RDX 1
@@ -98,27 +98,27 @@ void __gnat_sigtramp (int signo, void *si, void *ucontext,
 #define REGNO_R12 12
 #define REGNO_R13 13
 #define REGNO_R14 14
-#define REGNO_R15 15
+#define REGNO_R15 15 /* Used as CFA */
 #define REGNO_RPC 16 /* aka %rip */
 
 //  Registers offset from the regset structure
-#define REG_RDI 0x00
-#define REG_RSI 0x08
-#define REG_RDX 0x10
-#define REG_R10 0x18
-#define REG_R8  0x20
-#define REG_R9  0x28
-#define REG_RAX 0x30
-#define REG_RBX 0x38
-#define REG_RBP 0x40
-#define REG_RCX 0x48
-#define REG_R11 0x50
-#define REG_R12 0x58
-#define REG_R13 0x60
-#define REG_R14 0x68
-#define REG_R15 0x70
-#define REG_RPC 0x78 /* RIP */
-#define REG_RSP 0x90
+#define REG_OFFSET_RDI 0x00
+#define REG_OFFSET_RSI 0x08
+#define REG_OFFSET_RDX 0x10
+#define REG_OFFSET_R10 0x18
+#define REG_OFFSET_R8  0x20
+#define REG_OFFSET_R9  0x28
+#define REG_OFFSET_RAX 0x30
+#define REG_OFFSET_RBX 0x38
+#define REG_OFFSET_RBP 0x40
+#define REG_OFFSET_RCX 0x48
+#define REG_OFFSET_R11 0x50
+#define REG_OFFSET_R12 0x58
+#define REG_OFFSET_R13 0x60
+#define REG_OFFSET_R14 0x68
+#define REG_OFFSET_R15 0x70
+#define REG_OFFSET_RPC 0x78 /* RIP */
+#define REG_OFFSET_RSP 0x90
 
 #define CFI_COMMON_REGS \
 CR("# CFI for common registers\n") \
@@ -163,47 +163,20 @@ TCR("ret")
  *               Aarch64                 *
  *****************************************/
 
-#define UC_MCONTEXT_SS 16
-
+/* CFA reg: any callee saved register will do */
 #define CFA_REG  19
-#define BASE_REG 20
-
-#define DW_CFA_def_cfa    0x0c
-#define DW_CFA_expression 0x10
-
-#define DW_OP_breg(n)     0x70+(n)
 
-#define REG_REGNO_GR(n)   n
-#define REG_REGNO_PC      30
+/* General purpose registers */
+#define REG_OFFSET_GR(n)     (n * 8)
+#define REGNO_GR(n)   n
 
-/* The first byte of the SLEB128 value of the offset.  */
-#define REG_OFFSET_GR(n)         (UC_MCONTEXT_SS + n * 8)
-#define REG_OFFSET_LONG_GR(n)    (UC_MCONTEXT_SS + n * 8 + 128)
-#define REG_OFFSET_LONG128_GR(n) (UC_MCONTEXT_SS + (n - 16) * 8 + 128)
-#define REG_OFFSET_LONG256_GR(n) (UC_MCONTEXT_SS + (n - 32) * 8 + 128)
-
-#define REG_OFFSET_LONG256_PC    REG_OFFSET_LONG256_GR(32)
+/* point to the ELR value of the mcontext registers list */
+#define REG_OFFSET_ELR           (32 * 8)
+#define REGNO_PC      30
 
 #define CFI_DEF_CFA \
   TCR(".cfi_def_cfa " S(CFA_REG) ", 0")
 
-/* We need 4 variants depending on the offset: 0+, 64+, 128+, 256+.  */
-#define COMMON_CFI(REG) \
-  ".cfi_escape " S(DW_CFA_expression) "," S(REG_REGNO_##REG) ",2," \
-  S(DW_OP_breg(BASE_REG)) "," S(REG_OFFSET_##REG)
-
-#define COMMON_LONG_CFI(REG) \
-  ".cfi_escape " S(DW_CFA_expression) "," S(REG_REGNO_##REG) ",3," \
-  S(DW_OP_breg(BASE_REG)) "," S(REG_OFFSET_LONG_##REG) ",0"
-
-#define COMMON_LONG128_CFI(REG) \
-  ".cfi_escape " S(DW_CFA_expression) "," S(REG_REGNO_##REG) ",3," \
-  S(DW_OP_breg(BASE_REG)) "," S(REG_OFFSET_LONG128_##REG) ",1"
-
-#define COMMON_LONG256_CFI(REG) \
-  ".cfi_escape " S(DW_CFA_expression) "," S(REG_REGNO_##REG) ",3," \
-  S(DW_OP_breg(BASE_REG)) "," S(REG_OFFSET_LONG256_##REG) ",2"
-
 #define CFI_COMMON_REGS \
   CR("# CFI for common registers\n") \
   TCR(COMMON_CFI(GR(0)))  \
@@ -212,48 +185,47 @@ TCR("ret")
   TCR(COMMON_CFI(GR(3)))  \
   TCR(COMMON_CFI(GR(4)))  \
   TCR(COMMON_CFI(GR(5)))  \
-  TCR(COMMON_LONG_CFI(GR(6)))  \
-  TCR(COMMON_LONG_CFI(GR(7)))  \
-  TCR(COMMON_LONG_CFI(GR(8)))  \
-  TCR(COMMON_LONG_CFI(GR(9)))  \
-  TCR(COMMON_LONG_CFI(GR(10))) \
-  TCR(COMMON_LONG_CFI(GR(11))) \
-  TCR(COMMON_LONG_CFI(GR(12))) \
-  TCR(COMMON_LONG_CFI(GR(13))) \
-  TCR(COMMON_LONG128_CFI(GR(14))) \
-  TCR(COMMON_LONG128_CFI(GR(15))) \
-  TCR(COMMON_LONG128_CFI(GR(16))) \
-  TCR(COMMON_LONG128_CFI(GR(17))) \
-  TCR(COMMON_LONG128_CFI(GR(18))) \
-  TCR(COMMON_LONG128_CFI(GR(19))) \
-  TCR(COMMON_LONG128_CFI(GR(20))) \
-  TCR(COMMON_LONG128_CFI(GR(21))) \
-  TCR(COMMON_LONG128_CFI(GR(22))) \
-  TCR(COMMON_LONG128_CFI(GR(23))) \
-  TCR(COMMON_LONG128_CFI(GR(24))) \
-  TCR(COMMON_LONG128_CFI(GR(25))) \
-  TCR(COMMON_LONG128_CFI(GR(26))) \
-  TCR(COMMON_LONG128_CFI(GR(27))) \
-  TCR(COMMON_LONG128_CFI(GR(28))) \
-  TCR(COMMON_LONG128_CFI(GR(29))) \
-  TCR(COMMON_LONG256_CFI(PC))
+  TCR(COMMON_CFI(GR(6)))  \
+  TCR(COMMON_CFI(GR(7)))  \
+  TCR(COMMON_CFI(GR(8)))  \
+  TCR(COMMON_CFI(GR(9)))  \
+  TCR(COMMON_CFI(GR(10))) \
+  TCR(COMMON_CFI(GR(11))) \
+  TCR(COMMON_CFI(GR(12))) \
+  TCR(COMMON_CFI(GR(13))) \
+  TCR(COMMON_CFI(GR(14))) \
+  TCR(COMMON_CFI(GR(15))) \
+  TCR(COMMON_CFI(GR(16))) \
+  TCR(COMMON_CFI(GR(17))) \
+  TCR(COMMON_CFI(GR(18))) \
+  TCR(COMMON_CFI(GR(19))) \
+  TCR(COMMON_CFI(GR(20))) \
+  TCR(COMMON_CFI(GR(21))) \
+  TCR(COMMON_CFI(GR(22))) \
+  TCR(COMMON_CFI(GR(23))) \
+  TCR(COMMON_CFI(GR(24))) \
+  TCR(COMMON_CFI(GR(25))) \
+  TCR(COMMON_CFI(GR(26))) \
+  TCR(COMMON_CFI(GR(27))) \
+  TCR(COMMON_CFI(GR(28))) \
+  TCR(COMMON_CFI(GR(29))) \
+  TCR(".cfi_offset " S(REGNO_PC) "," S(REG_OFFSET_ELR)) \
+  TCR(".cfi_return_column " S(REGNO_PC))
 
 #define SIGTRAMP_BODY \
   CFI_DEF_CFA \
   CFI_COMMON_REGS \
   TCR("# Push FP and LR on stack") \
-  TCR("stp x29, x30, [sp, #-32]!") \
-  TCR("stp x" S(CFA_REG) ", x" S(BASE_REG) ", [sp, #16]") \
-  TCR("mov x29, sp") \
-  TCR("# Load the saved value of the stack pointer as CFA") \
-  TCR("ldr x" S(CFA_REG) ", [x2, #" S(REG_OFFSET_GR(31)) "]") \
-  TCR("# Use x" S(BASE_REG) " as base register for the CFI") \
-  TCR("mov x" S(BASE_REG) ", x2") \
+  TCR("stp x29, x30, [sp, #-16]!") \
+  TCR("# Push CFA register on stack") \
+  TCR("str x" S(CFA_REG) ", [sp, #-8]!" \
+  TCR("# Set the CFA register to x2 value") \
+  TCR("mov x" S(CFA_REG) ", x2") \
   TCR("# Call the handler") \
   TCR("blr x3") \
   TCR("# Release our frame and return (should never get here!).") \
-  TCR("ldp x" S(CFA_REG) ", x" S(BASE_REG)" , [sp, #16]") \
-  TCR("ldp x29, x30, [sp], 32") \
+  TCR("ldr x" S(CFA_REG) " , [sp], 8") \
+  TCR("ldp x29, x30, [sp], 16") \
   TCR("ret")
 
 #endif /* AARCH64 */