2014-07-31 Robert Dewar <dewar@adacore.com>

	* sem_ch3.adb, sem_ch13.adb: Minor reformatting.

2014-07-31  Arnaud Charlet  <charlet@adacore.com>

	* a-intnam-linux.ads: Minor: update obsolete comments.
	* s-taasde.adb: Minor: fix comment header.

2014-07-31  Arnaud Charlet  <charlet@adacore.com>

	* s-auxdec-vms-ia64.adb, s-parame-vms-alpha.ads, s-asthan-vms-alpha.adb,
	s-tpopde-vms.adb, s-mastop-vms.adb, s-tpopde-vms.ads, s-taprop-vms.adb,
	mlib-tgt-vms_common.adb, mlib-tgt-vms_common.ads, s-inmaop-vms.adb,
	g-enblsp-vms-alpha.adb, s-ransee-vms.adb, s-osprim-vms.adb,
	s-osprim-vms.ads, g-socthi-vms.adb, g-socthi-vms.ads, system-vms_64.ads,
	s-osinte-vms.adb, s-osinte-vms.ads, g-eacodu-vms.adb,
	s-vaflop-vms-alpha.adb, s-parame-vms-ia64.ads, a-dirval-vms.adb,
	a-caldel-vms.adb, mlib-tgt-specific-vms-alpha.adb, s-tasdeb-vms.adb,
	symbols-vms.adb, a-intnam-vms.ads, g-expect-vms.adb,
	symbols-processing-vms-alpha.adb, mlib-tgt-specific-vms-ia64.adb,
	s-traent-vms.adb, s-traent-vms.ads, i-cstrea-vms.adb, a-numaux-vms.ads,
	symbols-processing-vms-ia64.adb, s-interr-vms.adb, s-memory-vms_64.adb,
	s-memory-vms_64.ads, g-enblsp-vms-ia64.adb, s-taspri-vms.ads,
	s-auxdec-vms_64.ads, s-intman-vms.adb, s-intman-vms.ads,
	s-tpopsp-vms.adb, s-asthan-vms-ia64.adb, a-calend-vms.adb,
	a-calend-vms.ads, system-vms-ia64.ads, s-auxdec-vms-alpha.adb: Removed.
	* namet.h (Is_Non_Ada_Error): Remove.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213368 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 0 insertions, 1278 deletions

diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb
deleted file mode 100644
index 53034cad012..00000000000
--- a/gcc/ada/s-taprop-vms.adb
+++ /dev/null
@@ -1,1278 +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-2012, 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 a OpenVMS/Alpha version of this package
-
---  This package contains all the GNULL primitives that interface directly with
---  the underlying OS.
-
-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.OS_Primitives;
-with System.Soft_Links;
-with System.Aux_DEC;
-
-package body System.Task_Primitives.Operations is
-
-   use System.Tasking.Debug;
-   use System.Tasking;
-   use Interfaces.C;
-   use System.OS_Interface;
-   use System.Parameters;
-   use System.OS_Primitives;
-   use type System.OS_Primitives.OS_Time;
-
-   package SSL renames System.Soft_Links;
-
-   ----------------
-   -- 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
-
-   ATCB_Key : aliased pthread_key_t;
-   --  Key used to find the Ada Task_Id associated with a thread
-
-   Environment_Task_Id : Task_Id;
-   --  A variable to hold Task_Id for the environment task
-
-   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");
-
-   Foreign_Task_Elaborated : aliased Boolean := True;
-   --  Used to identified fake tasks (i.e., non-Ada Threads)
-
-   --------------------
-   -- 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) return Task_Id;
-   --  Allocate and Initialize a new ATCB for the current Thread
-
-   function Register_Foreign_Thread
-     (Thread : Thread_Id) return Task_Id is separate;
-
-   -----------------------
-   -- Local Subprograms --
-   -----------------------
-
-   function To_Task_Id is
-     new Ada.Unchecked_Conversion
-       (System.Task_Primitives.Task_Address, Task_Id);
-
-   function To_Address is
-     new Ada.Unchecked_Conversion
-       (Task_Id, System.Task_Primitives.Task_Address);
-
-   procedure Timer_Sleep_AST (ID : Address);
-   pragma Convention (C, Timer_Sleep_AST);
-   --  Signal the condition variable when AST fires
-
-   procedure Timer_Sleep_AST (ID : Address) is
-      Result : Interfaces.C.int;
-      pragma Warnings (Off, Result);
-      Self_ID : constant Task_Id := To_Task_Id (ID);
-   begin
-      Self_ID.Common.LL.AST_Pending := False;
-      Result := pthread_cond_signal_int_np (Self_ID.Common.LL.CV'Access);
-      pragma Assert (Result = 0);
-   end Timer_Sleep_AST;
-
-   -----------------
-   -- Stack_Guard --
-   -----------------
-
-   --  The underlying thread system sets a guard page at the bottom of a thread
-   --  stack, so nothing is needed.
-   --  ??? Check the comment above
-
-   procedure Stack_Guard (T : ST.Task_Id; On : Boolean) is
-      pragma Unreferenced (T);
-      pragma Unreferenced (On);
-   begin
-      null;
-   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;
-
-      L.Prio_Save := 0;
-      L.Prio := Interfaces.C.int (Prio);
-
-      Result := pthread_mutex_init (L.L'Access, Attributes'Access);
-      pragma Assert (Result = 0 or else Result = ENOMEM);
-
-      if Result = ENOMEM then
-         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;
-
---      Don't use, see comment in s-osinte.ads about ERRORCHECK mutexes???
---      Result := pthread_mutexattr_settype_np
---        (Attributes'Access, PTHREAD_MUTEX_ERRORCHECK_NP);
---      pragma Assert (Result = 0);
-
---      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);
-
-      Result := pthread_mutex_init (L, Attributes'Access);
-
-      pragma Assert (Result = 0 or else Result = ENOMEM);
-
-      if Result = ENOMEM then
-         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.L'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
-      Self_ID        : constant Task_Id := Self;
-      All_Tasks_Link : constant Task_Id := Self.Common.All_Tasks_Link;
-      Current_Prio   : System.Any_Priority;
-      Result         : Interfaces.C.int;
-
-   begin
-      Current_Prio := Get_Priority (Self_ID);
-
-      --  If there is no other tasks, no need to check priorities
-
-      if All_Tasks_Link /= Null_Task
-        and then L.Prio < Interfaces.C.int (Current_Prio)
-      then
-         Ceiling_Violation := True;
-         return;
-      end if;
-
-      Result := pthread_mutex_lock (L.L'Access);
-      pragma Assert (Result = 0);
-
-      Ceiling_Violation := False;
---  Why is this commented out ???
---      L.Prio_Save := Interfaces.C.int (Current_Prio);
---      Set_Priority (Self_ID, System.Any_Priority (L.Prio));
-   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.L'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);
-
-      if Self_ID.Deferral_Level = 0
-        and then Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
-      then
-         Unlock (Self_ID);
-         raise Standard'Abort_Signal;
-      end if;
-   end Sleep;
-
-   -----------------
-   -- Timed_Sleep --
-   -----------------
-
-   procedure Timed_Sleep
-     (Self_ID  : Task_Id;
-      Time     : Duration;
-      Mode     : ST.Delay_Modes;
-      Reason   : System.Tasking.Task_States;
-      Timedout : out Boolean;
-      Yielded  : out Boolean)
-   is
-      pragma Unreferenced (Reason);
-
-      Sleep_Time : OS_Time;
-      Result     : Interfaces.C.int;
-      Status     : Cond_Value_Type;
-
-      --  The body below requires more comments ???
-
-   begin
-      Timedout := False;
-      Yielded := False;
-
-      Sleep_Time := To_OS_Time (Time, Mode);
-
-      if Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level then
-         return;
-      end if;
-
-      Self_ID.Common.LL.AST_Pending := True;
-
-      Sys_Setimr
-       (Status, 0, Sleep_Time,
-        Timer_Sleep_AST'Access, To_Address (Self_ID), 0);
-
-      if (Status and 1) /= 1 then
-         raise Storage_Error;
-      end if;
-
-      if Single_Lock then
-         Result :=
-           pthread_cond_wait
-             (Self_ID.Common.LL.CV'Access, Single_RTS_Lock'Access);
-         pragma Assert (Result = 0);
-
-      else
-         Result :=
-           pthread_cond_wait
-             (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
-         pragma Assert (Result = 0);
-      end if;
-
-      Yielded := True;
-
-      if not Self_ID.Common.LL.AST_Pending then
-         Timedout := True;
-      else
-         Sys_Cantim (Status, To_Address (Self_ID), 0);
-         pragma Assert ((Status and 1) = 1);
-      end if;
-   end Timed_Sleep;
-
-   -----------------
-   -- Timed_Delay --
-   -----------------
-
-   procedure Timed_Delay
-     (Self_ID : Task_Id;
-      Time    : Duration;
-      Mode    : ST.Delay_Modes)
-   is
-      Sleep_Time : OS_Time;
-      Result     : Interfaces.C.int;
-      Status     : Cond_Value_Type;
-      Yielded    : Boolean := False;
-
-   begin
-      if Single_Lock then
-         Lock_RTS;
-      end if;
-
-      --  More comments required in body below ???
-
-      Write_Lock (Self_ID);
-
-      if Time /= 0.0 or else Mode /= Relative then
-         Sleep_Time := To_OS_Time (Time, Mode);
-
-         if Mode = Relative or else OS_Clock <= Sleep_Time then
-            Self_ID.Common.State := Delay_Sleep;
-            Self_ID.Common.LL.AST_Pending := True;
-
-            Sys_Setimr
-             (Status, 0, Sleep_Time,
-              Timer_Sleep_AST'Access, To_Address (Self_ID), 0);
-
-            --  Comment following test
-
-            if (Status and 1) /= 1 then
-               raise Storage_Error;
-            end if;
-
-            loop
-               if Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level then
-                  Sys_Cantim (Status, To_Address (Self_ID), 0);
-                  pragma Assert ((Status and 1) = 1);
-                  exit;
-               end if;
-
-               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));
-               pragma Assert (Result = 0);
-
-               Yielded := True;
-
-               exit when not Self_ID.Common.LL.AST_Pending;
-            end loop;
-
-            Self_ID.Common.State := Runnable;
-         end if;
-      end if;
-
-      Unlock (Self_ID);
-
-      if Single_Lock then
-         Unlock_RTS;
-      end if;
-
-      if not Yielded then
-         Result := sched_yield;
-         pragma Assert (Result = 0);
-      end if;
-   end Timed_Delay;
-
-   ---------------------
-   -- Monotonic_Clock --
-   ---------------------
-
-   function Monotonic_Clock return Duration
-     renames System.OS_Primitives.Monotonic_Clock;
-
-   -------------------
-   -- RT_Resolution --
-   -------------------
-
-   function RT_Resolution return Duration is
-   begin
-      --  Document origin of this magic constant ???
-      return 10#1.0#E-3;
-   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 := Interfaces.C.int (Underlying_Priorities (Prio));
-
-      if 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
-         --  SCHED_OTHER priorities are restricted to the range 8 - 15.
-         --  Since the translation from Underlying priorities results
-         --  in a range of 16 - 31, dividing by 2 gives the correct result.
-
-         Param.sched_priority := Param.sched_priority / 2;
-         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;
-      Specific.Set (Self_ID);
-   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
-      --  More comments required in body below ???
-
-      if not Single_Lock then
-         Result := pthread_mutexattr_init (Mutex_Attr'Access);
-         pragma Assert (Result = 0 or else Result = ENOMEM);
-
-         if Result = 0 then
-            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 :=
-           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;
-      Result     : Interfaces.C.int;
-
-      function Thread_Body_Access is new
-        Ada.Unchecked_Conversion (System.Aux_DEC.Short_Address, Thread_Body);
-
-      Task_Name : String (1 .. System.Parameters.Max_Task_Image_Length + 1);
-
-   begin
-      --  Since the initial signal mask of a thread is inherited from the
-      --  creator, we need to set our local signal mask to mask all signals
-      --  during the creation operation, to make sure the new thread is
-      --  not disturbed by signals before it has set its own Task_Id.
-
-      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, Interfaces.C.size_t (Stack_Size));
-      pragma Assert (Result = 0);
-
-      --  This call may be unnecessary, not sure. ???
-
-      Result :=
-        pthread_attr_setinheritsched
-          (Attributes'Access, PTHREAD_EXPLICIT_SCHED);
-      pragma Assert (Result = 0);
-
-      if T.Common.Task_Image_Len > 0 then
-
-         --  Set thread name to ease debugging
-
-         Task_Name (1 .. T.Common.Task_Image_Len) :=
-           T.Common.Task_Image (1 .. T.Common.Task_Image_Len);
-         Task_Name (T.Common.Task_Image_Len + 1) := ASCII.NUL;
-
-         Result := pthread_attr_setname_np
-           (Attributes'Access, Task_Name'Address, Null_Address);
-         pragma Assert (Result = 0);
-      end if;
-
-      --  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));
-
-      --  ENOMEM is a valid run-time error -- do not shut down
-
-      pragma Assert (Result = 0
-        or else Result = EAGAIN or else Result = ENOMEM);
-
-      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
-      null;
-   end Exit_Task;
-
-   ----------------
-   -- Abort_Task --
-   ----------------
-
-   procedure Abort_Task (T : Task_Id) is
-   begin
-      --  Interrupt Server_Tasks may be waiting on an event flag
-
-      if T.Common.State = Interrupt_Server_Blocked_On_Event_Flag then
-         Wakeup (T, Interrupt_Server_Blocked_On_Event_Flag);
-      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 (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);
-
-         if Result = ENOMEM then
-            raise Storage_Error;
-         end if;
-      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);
-
-         if Result = ENOMEM then
-            Result := pthread_condattr_destroy (Cond_Attr'Access);
-            pragma Assert (Result = 0);
-
-            raise Storage_Error;
-         end if;
-      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 specified in (RM D.10(9)), otherwise leave state set 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
-      pragma Unreferenced (T);
-      pragma Unreferenced (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);
-      pragma Unreferenced (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
-
-      --  The DEC Ada facility code defined in Starlet
-      Ada_Facility : constant := 49;
-
-      function DBGEXT (Control_Block : System.Address)
-        return System.Aux_DEC.Unsigned_Word;
-      --  DBGEXT is imported  from s-tasdeb.adb and its parameter re-typed
-      --  as Address to avoid having a VMS specific s-tasdeb.ads.
-      pragma Import (C, DBGEXT);
-      pragma Import_Function (DBGEXT, "GNAT$DBGEXT");
-
-      type Facility_Type is range 0 .. 65535;
-
-      procedure Debug_Register
-        (ADBGEXT    : System.Address;
-         ATCB_Key   : pthread_key_t;
-         Facility   : Facility_Type;
-         Std_Prolog : Integer);
-      pragma Import (C, Debug_Register, "CMA$DEBUG_REGISTER");
-   begin
-      Environment_Task_Id := Environment_Task;
-
-      --  Initialize the lock used to synchronize chain of all ATCBs
-
-      Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
-
-      Specific.Initialize (Environment_Task);
-
-      --  Pass the context key on to CMA along with the other parameters
-      Debug_Register
-       (
-        DBGEXT'Address,    --  Our DEBUG handling entry point
-        ATCB_Key,          --  CMA context key for our Ada TCB's
-        Ada_Facility,      --  Out facility code
-        0                  --  False, we don't have the std TCB prolog
-       );
-
-      --  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);
-   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;