Renaming of target specific files for clarity

        * Makefile.in: Rename GNAT target specific files.

	* 31soccon.ads, 31soliop.ads 35soccon.ads, 3asoccon.ads,
	3bsoccon.ads, 3gsoccon.ads, 3hsoccon.ads, 3psoccon.ads,
	3ssoccon.ads, 3ssoliop.ads, 3veacodu.adb, 3vexpect.adb,
	3vsoccon.ads, 3vsocthi.adb, 3vsocthi.ads, 3vtrasym.adb,
	3wsoccon.ads, 3wsocthi.adb, 3wsocthi.ads, 3wsoliop.ads,
	3zsoccon.ads, 3zsocthi.adb, 3zsocthi.ads, 41intnam.ads,
	42intnam.ads, 45intnam.ads, 4aintnam.ads, 4cintnam.ads,
	4gintnam.ads, 4hexcpol.adb, 4hintnam.ads, 4lintnam.ads,
	4nintnam.ads, 4ointnam.ads, 4onumaux.ads, 4pintnam.ads,
	4sintnam.ads, 4vcaldel.adb, 4vcalend.adb, 4vcalend.ads,
	4vintnam.ads, 4wcalend.adb, 4wexcpol.adb, 4wintnam.ads,
	4zintnam.ads, 4znumaux.ads, 4zsytaco.adb, 4zsytaco.ads,
	51osinte.adb, 51osinte.ads, 51system.ads,
	52osinte.adb, 52osinte.ads, 53osinte.ads, 54osinte.ads,
	55osinte.adb, 55osinte.ads, 55system.ads, 56osinte.adb,
	56osinte.ads, 56system.ads, 56taprop.adb, 56taspri.ads,
	56tpopsp.adb, 57system.ads, 58system.ads,
	5amastop.adb, 5aml-tgt.adb, 5aosinte.adb, 5aosinte.ads,
	5asystem.ads, 5ataprop.adb, 5atasinf.ads, 5ataspri.ads,
	5atpopsp.adb, 5avxwork.ads, 5bml-tgt.adb, 5bosinte.adb,
	5bosinte.ads, 5bsystem.ads, 5cosinte.ads, 5csystem.ads,
	5dsystem.ads, 5esystem.ads, 5fintman.adb, 5fosinte.adb,
	5fosinte.ads, 5fsystem.ads, 5ftaprop.adb, 5ftasinf.ads,
	5ginterr.adb, 5gintman.adb, 5gmastop.adb, 5gml-tgt.adb,
	5gosinte.ads, 5gproinf.adb, 5gproinf.ads, 5gsystem.ads,
	5gtaprop.adb, 5gtasinf.adb, 5gtasinf.ads, 5gtpgetc.adb,
	5hml-tgt.adb, 5hosinte.adb, 5hosinte.ads, 5hparame.ads,
	5hsystem.ads, 5htaprop.adb, 5htaspri.ads, 5htraceb.adb,
	5iosinte.adb, 5iosinte.ads, 5itaprop.adb, 5itaspri.ads,
	5ksystem.ads, 5kvxwork.ads, 5lml-tgt.adb, 5losinte.ads,
	5lparame.adb, 5lsystem.ads, 5msystem.ads, 5mvxwork.ads,
	5ninmaop.adb, 5nintman.adb, 5nosinte.ads, 5nsystem.ads,
	5ntaprop.adb, 5ntaspri.ads, 5ointerr.adb, 5omastop.adb,
	5oosinte.adb, 5oosinte.ads, 5oosprim.adb, 5oparame.adb,
	5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5posinte.ads,
	5posprim.adb, 5psystem.ads, 5pvxwork.ads, 5sintman.adb,
	5sml-tgt.adb, 5sosinte.adb, 5sosinte.ads, 5sosprim.adb,
	5sparame.adb, 5ssystem.ads, 5staprop.adb, 5stasinf.adb,
	5stasinf.ads, 5staspri.ads, 5stpopsp.adb, 5svxwork.ads,
	5tosinte.ads, 5usystem.ads, 5vasthan.adb, 5vdirval.adb,
	5vinmaop.adb, 5vinterr.adb, 5vintman.adb, 5vintman.ads,
	5vmastop.adb, 5vml-tgt.adb, 5vosinte.adb, 5vosinte.ads,
	5vosprim.adb, 5vosprim.ads, 5vparame.ads, 5vsymbol.adb,
	5vsystem.ads, 5vtaprop.adb, 5vtaspri.ads, 5vtpopde.adb,
	5vtpopde.ads, 5vtraent.adb, 5vtraent.ads, 5vvaflop.adb,
	5wdirval.adb, 5wgloloc.adb, 5wintman.adb, 5wmemory.adb,
	5wml-tgt.adb, 5wosinte.ads, 5wosprim.adb, 5wsystem.ads,
	5wtaprop.adb, 5wtaspri.ads, 5xparame.ads, 5xsystem.ads,
	5xvxwork.ads, 5yparame.ads, 5ysystem.ads, 5zinterr.adb,
	5zintman.adb, 5zintman.ads, 5zml-tgt.adb, 5zosinte.adb,
	5zosinte.ads, 5zosprim.adb, 5zparame.ads, 5zstchop.adb,
	5zsystem.ads, 5ztaprop.adb, 5ztaspri.ads, 5ztfsetr.adb,
	5ztpopsp.adb, 6vcpp.adb, 6vcstrea.adb, 6vinterf.ads,
	7sinmaop.adb, 7sintman.adb, 7sosinte.adb, 7sosprim.adb,
	7staprop.adb, 7staspri.ads, 7stfsetr.adb, 7stpopsp.adb,
	7straceb.adb, 7straces.adb, 7strafor.adb, 7strafor.ads,
	7stratas.adb, 86numaux.adb, 86numaux.ads: Replaced by files below.

	* a-caldel-vms.adb, a-calend-mingw.adb, a-calend-vms.adb,
	a-calend-vms.ads, a-dirval-mingw.adb, a-dirval-vms.adb,
	a-excpol-abort.adb, a-excpol-interix.adb, a-intnam-aix.ads,
	a-intnam-dummy.ads, a-intnam-freebsd.ads, a-intnam-hpux.ads,
	a-intnam-interix.ads, a-intnam-irix.ads, a-intnam-linux.ads,
	a-intnam-lynxos.ads, a-intnam-mingw.ads, a-intnam-os2.ads,
	a-intnam-solaris.ads, a-intnam-tru64.ads, a-intnam-unixware.ads,
	a-intnam-vms.ads, a-intnam-vxworks.ads, a-numaux-libc-x86.ads,
	a-numaux-vxworks.ads, a-numaux-x86.adb, a-numaux-x86.ads,
	a-sytaco-vxworks.adb, a-sytaco-vxworks.ads, g-eacodu-vms.adb,
	g-expect-vms.adb, g-soccon-aix.ads, g-soccon-freebsd.ads,
	g-soccon-hpux.ads, g-soccon-interix.ads, g-soccon-irix.ads,
	g-soccon-mingw.ads, g-soccon-solaris.ads, g-soccon-tru64.ads,
	g-soccon-unixware.ads, g-soccon-vms.adb, g-soccon-vxworks.ads,
	g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi-vms.adb,
	g-socthi-vms.ads, g-socthi-vxworks.adb, g-socthi-vxworks.ads,
	g-soliop-mingw.ads, g-soliop-solaris.ads, g-soliop-unixware.ads,
	g-trasym-vms.adb, i-cpp-vms.adb, i-cstrea-vms.adb,
	interfac-vms.ads, mlib-tgt-aix.adb, mlib-tgt-hpux.adb,
	mlib-tgt-irix.adb, mlib-tgt-linux.adb, mlib-tgt-mingw.adb,
	mlib-tgt-solaris.adb, mlib-tgt-tru64.adb, mlib-tgt-vms.adb,
	mlib-tgt-vxworks.adb, s-asthan-vms.adb, s-gloloc-mingw.adb,
	s-inmaop-dummy.adb, s-inmaop-posix.adb, s-inmaop-vms.adb,
	s-interr-dummy.adb, s-interr-sigaction.adb, s-interr-vms.adb,
	s-interr-vxworks.adb, s-intman-dummy.adb, s-intman-irix.adb,
	s-intman-irix-athread.adb, s-intman-mingw.adb, s-intman-posix.adb,
	s-intman-solaris.adb, s-intman-vms.adb, s-intman-vms.ads,
	s-intman-vxworks.adb, s-intman-vxworks.ads, s-mastop-irix.adb,
	s-mastop-tru64.adb, s-mastop-vms.adb, s-mastop-x86.adb,
	s-memory-mingw.adb, s-osinte-aix.adb, s-osinte-aix.ads,
	s-osinte-aix-fsu.ads, s-osinte-dummy.ads, s-osinte-freebsd.adb,
	s-osinte-freebsd.ads, s-osinte-fsu.adb, s-osinte-hpux.ads,
	s-osinte-hpux-dce.adb, s-osinte-hpux-dce.ads, s-osinte-interix.ads,
	s-osinte-irix.adb, s-osinte-irix.ads, s-osinte-irix-athread.ads,
	s-osinte-linux.ads, s-osinte-linux-fsu.ads, s-osinte-linux-ia64.ads,
	s-osinte-lynxos-3.adb, s-osinte-lynxos-3.ads, s-osinte-lynxos.adb,
	s-osinte-lynxos.ads, s-osinte-mingw.ads, s-osinte-os2.adb,
	s-osinte-os2.ads, s-osinte-posix.adb, s-osinte-solaris.adb,
	s-osinte-solaris.ads, s-osinte-solaris-fsu.ads,
	s-osinte-solaris-posix.ads, s-osinte-tru64.adb, s-osinte-tru64.ads,
	s-osinte-unixware.adb, s-osinte-unixware.ads, s-osinte-vms.adb,
	s-osinte-vms.ads, s-osinte-vxworks.adb,
	s-osinte-vxworks.ads, s-osprim-mingw.adb,
	s-osprim-os2.adb, s-osprim-posix.adb, s-osprim-solaris.adb,
	s-osprim-unix.adb, s-osprim-vms.adb, s-osprim-vms.ads,
	s-osprim-vxworks.adb, s-parame-ae653.ads, s-parame-hpux.ads,
	s-parame-linux.adb, s-parame-os2.adb, s-parame-solaris.adb,
	s-parame-vms.ads, s-parame-vms-restrict.ads, s-parame-vxworks.ads,
	s-proinf-irix-athread.adb, s-proinf-irix-athread.ads,
	s-stchop-vxworks.adb, s-taprop-dummy.adb,
	s-taprop-hpux-dce.adb, s-taprop-irix.adb,
	s-taprop-irix-athread.adb, s-taprop-linux.adb, s-taprop-lynxos.adb,
	s-taprop-mingw.adb, s-taprop-os2.adb, s-taprop-posix.adb,
	s-taprop-solaris.adb, s-taprop-tru64.adb, s-taprop-vms.adb,
	s-taprop-vxworks.adb, s-tasinf-irix.ads, s-tasinf-irix-athread.adb,
	s-tasinf-irix-athread.ads, s-tasinf-solaris.adb, s-tasinf-solaris.ads,
	s-tasinf-tru64.ads, s-taspri-dummy.ads, s-taspri-hpux-dce.ads,
	s-taspri-linux.ads, s-taspri-lynxos.ads, s-taspri-mingw.ads,
	s-taspri-os2.ads, s-taspri-posix.ads, s-taspri-solaris.ads,
	s-taspri-tru64.ads, s-taspri-vms.ads, s-taspri-vxworks.ads,
	s-tfsetr-default.adb, s-tfsetr-vxworks.adb, s-tpopde-vms.adb,
	s-tpopde-vms.ads, s-tpopsp-lynxos.adb, s-tpopsp-posix.adb,
	s-tpopsp-posix-foreign.adb, s-tpopsp-solaris.adb, s-tpopsp-vxworks.adb,
	s-traceb-hpux.adb, s-traceb-mastop.adb, s-traces-default.adb,
	s-traent-vms.adb, s-traent-vms.ads, s-trafor-default.adb,
	s-trafor-default.ads, s-tratas-default.adb, s-vaflop-vms.adb,
	s-vxwork-alpha.ads, s-vxwork-m68k.ads, s-vxwork-mips.ads,
	s-vxwork-ppc.ads, s-vxwork-sparcv9.ads, s-vxwork-xscale.ads,
	symbols-vms.adb, system-aix.ads, system-freebsd-x86.ads,
	system-hpux.ads, system-interix.ads, system-irix-n32.ads,
	system-irix-o32.ads, system-linux-x86_64.ads,
	system-linux-x86.ads, system-lynxos-ppc.ads, system-lynxos-x86.ads,
	system-mingw.ads, system-os2.ads, system-solaris-sparc.ads,
	system-solaris-sparcv9.ads, system-solaris-x86.ads, system-tru64.ads,
	system-unixware.ads, system-vms.ads, system-vms-zcx.ads,
	system-vxworks-alpha.ads, system-vxworks-m68k.ads,
	system-vxworks-mips.ads, system-vxworks-ppc.ads,
	system-vxworks-sparcv9.ads, system-vxworks-xscale.ads: Replace files
	above.

From-SVN: r81834

1 files changed, 1157 insertions, 0 deletions

diff --git a/gcc/ada/s-taprop-os2.adb b/gcc/ada/s-taprop-os2.adb
new file mode 100644
index 0000000..924f477
--- /dev/null
+++ b/gcc/ada/s-taprop-os2.adb
@@ -0,0 +1,1157 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNU ADA 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-2003, 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 2,  or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is an OS/2 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 System.Tasking.Debug;
+--  used for Known_Tasks
+
+with Interfaces.C;
+--  used for size_t
+
+with Interfaces.C.Strings;
+--  used for Null_Ptr
+
+with Interfaces.OS2Lib.Errors;
+with Interfaces.OS2Lib.Threads;
+with Interfaces.OS2Lib.Synchronization;
+
+with System.Parameters;
+--  used for Size_Type
+
+with System.Tasking;
+--  used for Task_ID
+
+with System.Parameters;
+--  used for Size_Type
+
+with System.Soft_Links;
+--  used for Defer/Undefer_Abort
+
+--  Note that we do not use System.Tasking.Initialization directly since
+--  this 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.Initialization
+
+with System.OS_Primitives;
+--  used for Delay_Modes
+--           Clock
+
+with Unchecked_Conversion;
+with Unchecked_Deallocation;
+
+package body System.Task_Primitives.Operations is
+
+   package IC  renames Interfaces.C;
+   package ICS renames Interfaces.C.Strings;
+   package OSP renames System.OS_Primitives;
+   package SSL renames System.Soft_Links;
+
+   use Interfaces.OS2Lib;
+   use Interfaces.OS2Lib.Errors;
+   use Interfaces.OS2Lib.Threads;
+   use Interfaces.OS2Lib.Synchronization;
+   use System.Parameters;
+   use System.Tasking.Debug;
+   use System.Tasking;
+   use System.OS_Interface;
+   use Interfaces.C;
+   use System.OS_Primitives;
+
+   ---------------------
+   -- Local Constants --
+   ---------------------
+
+   Max_Locks_Per_Task   : constant := 100;
+   Suppress_Owner_Check : constant Boolean := False;
+
+   -----------------
+   -- Local Types --
+   -----------------
+
+   subtype Lock_Range is Integer range 0 .. Max_Locks_Per_Task;
+
+   -----------------
+   -- Local Data  --
+   -----------------
+
+   --  The OS/2 DosAllocThreadLocalMemory API is used to allocate our TCB_Ptr.
+
+   --  This API reserves a small range of virtual addresses that is backed
+   --  by different physical memory for each running thread. In this case we
+   --  create a pointer at a fixed address that points to the TCB_Ptr for the
+   --  running thread. So all threads will be able to query and update their
+   --  own TCB_Ptr without destroying the TCB_Ptr of other threads.
+
+   type Thread_Local_Data is record
+      Self_ID           : Task_ID;    --  ID of the current thread
+      Lock_Prio_Level   : Lock_Range; --  Nr of priority changes due to locks
+
+      --  ... room for expansion here, if we decide to make access to
+      --  jump-buffer and exception stack more efficient in future
+   end record;
+
+   type Access_Thread_Local_Data is access all Thread_Local_Data;
+
+   --  Pointer to Thread Local Data
+   Thread_Local_Data_Ptr : aliased Access_Thread_Local_Data;
+
+   type PPTLD is access all Access_Thread_Local_Data;
+
+   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.
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   function To_PPVOID is new Unchecked_Conversion (PPTLD, PPVOID);
+   function To_Address is new Unchecked_Conversion (Task_ID, System.Address);
+   function To_PFNTHREAD is
+     new Unchecked_Conversion (System.Address, PFNTHREAD);
+
+   function To_MS (D : Duration) return ULONG;
+
+   procedure Set_Temporary_Priority
+     (T            : in Task_ID;
+      New_Priority : in System.Any_Priority);
+
+   -----------
+   -- To_MS --
+   -----------
+
+   function To_MS (D : Duration) return ULONG is
+   begin
+      return ULONG (D * 1_000);
+   end To_MS;
+
+   -----------
+   -- Clock --
+   -----------
+
+   function Monotonic_Clock return Duration renames OSP.Monotonic_Clock;
+
+   -------------------
+   -- RT_Resolution --
+   -------------------
+
+   function RT_Resolution return Duration is
+   begin
+      return 10#1.0#E-6;
+   end RT_Resolution;
+
+   -------------------
+   -- Abort_Handler --
+   -------------------
+
+   --  OS/2 only has limited support for asynchronous signals.
+   --  It seems not to be possible to jump out of an exception
+   --  handler or to change the execution context of the thread.
+   --  So asynchonous transfer of control is not supported.
+
+   -----------------
+   -- 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 OSI.Thread_Id (T.Common.LL.Thread);
+   end Get_Thread_Id;
+
+   ----------
+   -- Self --
+   ----------
+
+   function Self return Task_ID is
+      Self_ID : Task_ID renames Thread_Local_Data_Ptr.Self_ID;
+   begin
+      --  Check that the thread local data has been initialized.
+
+      pragma Assert
+        ((Thread_Local_Data_Ptr /= null
+          and then Thread_Local_Data_Ptr.Self_ID /= null));
+
+      return Self_ID;
+   end Self;
+
+   ---------------------
+   -- Initialize_Lock --
+   ---------------------
+
+   procedure Initialize_Lock
+     (Prio : System.Any_Priority;
+      L    : access Lock)
+   is
+   begin
+      if DosCreateMutexSem
+        (ICS.Null_Ptr, L.Mutex'Unchecked_Access, 0, False32) /= NO_ERROR
+      then
+         raise Storage_Error;
+      end if;
+
+      pragma Assert (L.Mutex /= 0, "Error creating Mutex");
+      L.Priority := Prio;
+      L.Owner_ID := Null_Address;
+   end Initialize_Lock;
+
+   procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level) is
+      pragma Unreferenced (Level);
+
+   begin
+      if DosCreateMutexSem
+        (ICS.Null_Ptr, L.Mutex'Unchecked_Access, 0, False32) /= NO_ERROR
+      then
+         raise Storage_Error;
+      end if;
+
+      pragma Assert (L.Mutex /= 0, "Error creating Mutex");
+
+      L.Priority := System.Any_Priority'Last;
+      L.Owner_ID := Null_Address;
+   end Initialize_Lock;
+
+   -------------------
+   -- Finalize_Lock --
+   -------------------
+
+   procedure Finalize_Lock (L : access Lock) is
+   begin
+      Must_Not_Fail (DosCloseMutexSem (L.Mutex));
+   end Finalize_Lock;
+
+   procedure Finalize_Lock (L : access RTS_Lock) is
+   begin
+      Must_Not_Fail (DosCloseMutexSem (L.Mutex));
+   end Finalize_Lock;
+
+   ----------------
+   -- Write_Lock --
+   ----------------
+
+   procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
+      Self_ID      : constant Task_ID := Thread_Local_Data_Ptr.Self_ID;
+      Old_Priority : constant Any_Priority :=
+                       Self_ID.Common.LL.Current_Priority;
+
+   begin
+      if L.Priority < Old_Priority then
+         Ceiling_Violation := True;
+         return;
+      end if;
+
+      Ceiling_Violation := False;
+
+      --  Increase priority before getting the lock
+      --  to prevent priority inversion
+
+      Thread_Local_Data_Ptr.Lock_Prio_Level :=
+        Thread_Local_Data_Ptr.Lock_Prio_Level + 1;
+      if L.Priority > Old_Priority then
+         Set_Temporary_Priority (Self_ID, L.Priority);
+      end if;
+
+      --  Request the lock and then update the lock owner data
+
+      Must_Not_Fail (DosRequestMutexSem (L.Mutex, SEM_INDEFINITE_WAIT));
+      L.Owner_Priority := Old_Priority;
+      L.Owner_ID := Self_ID.all'Address;
+   end Write_Lock;
+
+   procedure Write_Lock
+     (L           : access RTS_Lock;
+      Global_Lock : Boolean := False)
+   is
+      Self_ID      : Task_ID;
+      Old_Priority : Any_Priority;
+
+   begin
+      if not Single_Lock or else Global_Lock then
+         Self_ID := Thread_Local_Data_Ptr.Self_ID;
+         Old_Priority := Self_ID.Common.LL.Current_Priority;
+
+         --  Increase priority before getting the lock
+         --  to prevent priority inversion
+
+         Thread_Local_Data_Ptr.Lock_Prio_Level :=
+           Thread_Local_Data_Ptr.Lock_Prio_Level + 1;
+
+         if L.Priority > Old_Priority then
+            Set_Temporary_Priority (Self_ID, L.Priority);
+         end if;
+
+         --  Request the lock and then update the lock owner data
+
+         Must_Not_Fail (DosRequestMutexSem (L.Mutex, SEM_INDEFINITE_WAIT));
+         L.Owner_Priority := Old_Priority;
+         L.Owner_ID := Self_ID.all'Address;
+      end if;
+   end Write_Lock;
+
+   procedure Write_Lock (T : Task_ID) is
+   begin
+      if not Single_Lock then
+
+         --  Request the lock and then update the lock owner data
+
+         Must_Not_Fail
+           (DosRequestMutexSem (T.Common.LL.L.Mutex, SEM_INDEFINITE_WAIT));
+         T.Common.LL.L.Owner_ID := Null_Address;
+      end if;
+   end Write_Lock;
+
+   ---------------
+   -- Read_Lock --
+   ---------------
+
+   procedure Read_Lock
+     (L : access Lock; Ceiling_Violation : out Boolean) renames Write_Lock;
+
+   ------------
+   -- Unlock --
+   ------------
+
+   procedure Unlock (L : access Lock) is
+      Self_ID      : constant Task_ID := Thread_Local_Data_Ptr.Self_ID;
+      Old_Priority : constant Any_Priority := L.Owner_Priority;
+
+   begin
+      --  Check that this task holds the lock
+
+      pragma Assert (Suppress_Owner_Check
+        or else L.Owner_ID = Self_ID.all'Address);
+
+      --  Upate the owner data
+
+      L.Owner_ID := Null_Address;
+
+      --  Do the actual unlocking. No more references
+      --  to owner data of L after this point.
+
+      Must_Not_Fail (DosReleaseMutexSem (L.Mutex));
+
+      --  Reset priority after unlocking to avoid priority inversion
+
+      Thread_Local_Data_Ptr.Lock_Prio_Level :=
+        Thread_Local_Data_Ptr.Lock_Prio_Level - 1;
+      if L.Priority /= Old_Priority then
+         Set_Temporary_Priority (Self_ID, Old_Priority);
+      end if;
+   end Unlock;
+
+   procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
+      Self_ID      : Task_ID;
+      Old_Priority : Any_Priority;
+
+   begin
+      if not Single_Lock or else Global_Lock then
+         Self_ID := Thread_Local_Data_Ptr.Self_ID;
+         Old_Priority := L.Owner_Priority;
+         --  Check that this task holds the lock
+
+         pragma Assert (Suppress_Owner_Check
+           or else L.Owner_ID = Self_ID.all'Address);
+
+         --  Upate the owner data
+
+         L.Owner_ID := Null_Address;
+
+         --  Do the actual unlocking. No more references
+         --  to owner data of L after this point.
+
+         Must_Not_Fail (DosReleaseMutexSem (L.Mutex));
+
+         --  Reset priority after unlocking to avoid priority inversion
+
+         Thread_Local_Data_Ptr.Lock_Prio_Level :=
+           Thread_Local_Data_Ptr.Lock_Prio_Level - 1;
+
+         if L.Priority /= Old_Priority then
+            Set_Temporary_Priority (Self_ID, Old_Priority);
+         end if;
+      end if;
+   end Unlock;
+
+   procedure Unlock (T : Task_ID) is
+   begin
+      if not Single_Lock then
+
+         --  Check the owner data
+
+         pragma Assert (Suppress_Owner_Check
+           or else T.Common.LL.L.Owner_ID = Null_Address);
+
+         --  Do the actual unlocking. No more references
+         --  to owner data of T.Common.LL.L after this point.
+
+         Must_Not_Fail (DosReleaseMutexSem (T.Common.LL.L.Mutex));
+      end if;
+   end Unlock;
+
+   -----------
+   -- Sleep --
+   -----------
+
+   procedure Sleep
+     (Self_ID : Task_ID;
+      Reason  : System.Tasking.Task_States)
+   is
+      pragma Unreferenced (Reason);
+
+      Count : aliased ULONG; -- Used to store dummy result
+
+   begin
+      --  Must reset Cond BEFORE L is unlocked.
+
+      Sem_Must_Not_Fail
+        (DosResetEventSem (Self_ID.Common.LL.CV, Count'Unchecked_Access));
+
+      if Single_Lock then
+         Unlock_RTS;
+      else
+         Unlock (Self_ID);
+      end if;
+
+      --  No problem if we are interrupted here.
+      --  If the condition is signaled, DosWaitEventSem will simply not block.
+
+      Sem_Must_Not_Fail
+        (DosWaitEventSem (Self_ID.Common.LL.CV, SEM_INDEFINITE_WAIT));
+
+      --  Since L was previously accquired, lock operation should not fail.
+
+      if Single_Lock then
+         Lock_RTS;
+      else
+         Write_Lock (Self_ID);
+      end if;
+   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.
+
+   --  Pre-assertion: Cond is posted
+   --                 Self is locked.
+
+   --  Post-assertion: Cond is posted
+   --                  Self is locked.
+
+   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);
+
+      Check_Time : constant Duration := OSP.Monotonic_Clock;
+      Rel_Time   : Duration;
+      Abs_Time   : Duration;
+      Time_Out   : ULONG;
+      Result    : APIRET;
+      Count      : aliased ULONG;  --  Used to store dummy result
+
+   begin
+      --  Must reset Cond BEFORE Self_ID is unlocked.
+
+      Sem_Must_Not_Fail
+        (DosResetEventSem (Self_ID.Common.LL.CV,
+         Count'Unchecked_Access));
+
+      if Single_Lock then
+         Unlock_RTS;
+      else
+         Unlock (Self_ID);
+      end if;
+
+      Timedout := True;
+      Yielded := False;
+
+      if Mode = Relative then
+         Rel_Time := Time;
+         Abs_Time := Duration'Min (Time, Max_Sensible_Delay) + Check_Time;
+      else
+         Rel_Time := Time - Check_Time;
+         Abs_Time := Time;
+      end if;
+
+      if Rel_Time > 0.0 then
+         loop
+            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
+              or else Self_ID.Pending_Priority_Change;
+
+            Time_Out := To_MS (Rel_Time);
+            Result := DosWaitEventSem (Self_ID.Common.LL.CV, Time_Out);
+            pragma Assert
+             ((Result = NO_ERROR or Result = ERROR_TIMEOUT
+                or Result = ERROR_INTERRUPT));
+
+            --  ???
+            --  What to do with error condition ERROR_NOT_ENOUGH_MEMORY? Can
+            --  we raise an exception here?  And what about ERROR_INTERRUPT?
+            --  Should that be treated as a simple timeout?
+            --  For now, consider only ERROR_TIMEOUT to be a timeout.
+
+            exit when Abs_Time <= OSP.Monotonic_Clock;
+
+            if Result /= ERROR_TIMEOUT then
+               --  somebody may have called Wakeup for us
+               Timedout := False;
+               exit;
+            end if;
+
+            Rel_Time := Abs_Time - OSP.Monotonic_Clock;
+         end loop;
+      end if;
+
+      --  Ensure post-condition
+
+      if Single_Lock then
+         Lock_RTS;
+      else
+         Write_Lock (Self_ID);
+      end if;
+
+      if Timedout then
+         Sem_Must_Not_Fail (DosPostEventSem (Self_ID.Common.LL.CV));
+      end if;
+   end Timed_Sleep;
+
+   -----------------
+   -- Timed_Delay --
+   -----------------
+
+   procedure Timed_Delay
+     (Self_ID  : Task_ID;
+      Time     : Duration;
+      Mode     : ST.Delay_Modes)
+   is
+      Check_Time : constant Duration := OSP.Monotonic_Clock;
+      Rel_Time   : Duration;
+      Abs_Time   : Duration;
+      Timedout   : Boolean := True;
+      Time_Out   : ULONG;
+      Result     : APIRET;
+      Count      : aliased ULONG;  --  Used to store dummy result
+
+   begin
+      --  Only the little window between deferring abort and
+      --  locking Self_ID is the reason we need to
+      --  check for pending abort and priority change below! :(
+
+      SSL.Abort_Defer.all;
+
+      if Single_Lock then
+         Lock_RTS;
+      else
+         Write_Lock (Self_ID);
+      end if;
+
+      --  Must reset Cond BEFORE Self_ID is unlocked.
+
+      Sem_Must_Not_Fail
+        (DosResetEventSem (Self_ID.Common.LL.CV,
+         Count'Unchecked_Access));
+
+      if Single_Lock then
+         Unlock_RTS;
+      else
+         Unlock (Self_ID);
+      end if;
+
+      if Mode = Relative then
+         Rel_Time := Time;
+         Abs_Time := Time + Check_Time;
+      else
+         Rel_Time := Time - Check_Time;
+         Abs_Time := Time;
+      end if;
+
+      if Rel_Time > 0.0 then
+         Self_ID.Common.State := Delay_Sleep;
+
+         loop
+            if Self_ID.Pending_Priority_Change then
+               Self_ID.Pending_Priority_Change := False;
+               Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority;
+               Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
+            end if;
+
+            exit when Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level;
+
+            Time_Out := To_MS (Rel_Time);
+            Result := DosWaitEventSem (Self_ID.Common.LL.CV, Time_Out);
+
+            exit when Abs_Time <= OSP.Monotonic_Clock;
+
+            Rel_Time := Abs_Time - OSP.Monotonic_Clock;
+         end loop;
+
+         Self_ID.Common.State := Runnable;
+         Timedout := Result = ERROR_TIMEOUT;
+      end if;
+
+      if Single_Lock then
+         Lock_RTS;
+      else
+         Write_Lock (Self_ID);
+      end if;
+
+      if Timedout then
+         Sem_Must_Not_Fail (DosPostEventSem (Self_ID.Common.LL.CV));
+      end if;
+
+      if Single_Lock then
+         Unlock_RTS;
+      else
+         Unlock (Self_ID);
+      end if;
+
+      System.OS_Interface.Yield;
+      SSL.Abort_Undefer.all;
+   end Timed_Delay;
+
+   ------------
+   -- Wakeup --
+   ------------
+
+   procedure Wakeup (T : Task_ID; Reason : System.Tasking.Task_States) is
+      pragma Unreferenced (Reason);
+
+   begin
+      Sem_Must_Not_Fail (DosPostEventSem (T.Common.LL.CV));
+   end Wakeup;
+
+   -----------
+   -- Yield --
+   -----------
+
+   procedure Yield (Do_Yield : Boolean := True) is
+   begin
+      if Do_Yield then
+         System.OS_Interface.Yield;
+      end if;
+   end Yield;
+
+   ----------------------------
+   -- Set_Temporary_Priority --
+   ----------------------------
+
+   procedure Set_Temporary_Priority
+     (T            : Task_ID;
+      New_Priority : System.Any_Priority)
+   is
+      use Interfaces.C;
+      Delta_Priority : Integer;
+
+   begin
+      --  When Lock_Prio_Level = 0, we always need to set the
+      --  Active_Priority. In this way we can make priority changes
+      --  due to locking independent of those caused by calling
+      --  Set_Priority.
+
+      if Thread_Local_Data_Ptr.Lock_Prio_Level = 0
+        or else New_Priority < T.Common.Current_Priority
+      then
+         Delta_Priority := T.Common.Current_Priority -
+           T.Common.LL.Current_Priority;
+      else
+         Delta_Priority := New_Priority - T.Common.LL.Current_Priority;
+      end if;
+
+      if Delta_Priority /= 0 then
+         --  ??? There is a race-condition here
+         --  The TCB is updated before the system call to make
+         --  pre-emption in the critical section less likely.
+
+         T.Common.LL.Current_Priority :=
+           T.Common.LL.Current_Priority + Delta_Priority;
+         Must_Not_Fail
+           (DosSetPriority (Scope   => PRTYS_THREAD,
+                            Class   => PRTYC_NOCHANGE,
+                            Delta_P => IC.long (Delta_Priority),
+                            PorTid  => T.Common.LL.Thread));
+      end if;
+   end Set_Temporary_Priority;
+
+   ------------------
+   -- Set_Priority --
+   ------------------
+
+   procedure Set_Priority
+     (T                   : Task_ID;
+      Prio                : System.Any_Priority;
+      Loss_Of_Inheritance : Boolean := False)
+   is
+      pragma Unreferenced (Loss_Of_Inheritance);
+
+   begin
+      T.Common.Current_Priority := Prio;
+      Set_Temporary_Priority (T, Prio);
+   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
+      --  Initialize thread local data. Must be done first.
+
+      Thread_Local_Data_Ptr.Self_ID := Self_ID;
+      Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
+
+      Lock_RTS;
+
+      for J in Known_Tasks'Range loop
+         if Known_Tasks (J) = null then
+            Known_Tasks (J) := Self_ID;
+            Self_ID.Known_Tasks_Index := J;
+            exit;
+         end if;
+      end loop;
+
+      Unlock_RTS;
+
+      --  For OS/2, we can set Self_ID.Common.LL.Thread in
+      --  Create_Task, since the thread is created suspended.
+      --  That is, there is no danger of the thread racing ahead
+      --  and trying to reference Self_ID.Common.LL.Thread before it
+      --  has been initialized.
+
+      --  .... Do we need to do anything with signals for OS/2 ???
+   end Enter_Task;
+
+   --------------
+   -- New_ATCB --
+   --------------
+
+   function New_ATCB (Entry_Num : Task_Entry_Index) return Task_ID is
+   begin
+      return new Ada_Task_Control_Block (Entry_Num);
+   end New_ATCB;
+
+   -------------------
+   -- Is_Valid_Task --
+   -------------------
+
+   function Is_Valid_Task return Boolean is
+   begin
+      return False;
+   end Is_Valid_Task;
+
+   -----------------------------
+   -- Register_Foreign_Thread --
+   -----------------------------
+
+   function Register_Foreign_Thread return Task_ID is
+   begin
+      return null;
+   end Register_Foreign_Thread;
+
+   --------------------
+   -- Initialize_TCB --
+   --------------------
+
+   procedure Initialize_TCB (Self_ID : Task_ID; Succeeded : out Boolean) is
+   begin
+      if DosCreateEventSem (ICS.Null_Ptr,
+        Self_ID.Common.LL.CV'Unchecked_Access, 0, True32) = NO_ERROR
+      then
+         if not Single_Lock
+           and then DosCreateMutexSem
+             (ICS.Null_Ptr,
+              Self_ID.Common.LL.L.Mutex'Unchecked_Access,
+              0,
+              False32) /= NO_ERROR
+         then
+            Succeeded := False;
+            Must_Not_Fail (DosCloseEventSem (Self_ID.Common.LL.CV));
+         else
+            Succeeded := True;
+         end if;
+
+         --  We now want to do the equivalent of:
+
+         --  Initialize_Lock
+         --    (Self_ID.Common.LL.L'Unchecked_Access, ATCB_Level);
+
+         --  But we avoid that because the Initialize_TCB routine has an
+         --  exception handler, and it is too early for us to deal with
+         --  installing handlers (see comment below), so we do our own
+         --  Initialize_Lock operation manually.
+
+         Self_ID.Common.LL.L.Priority := System.Any_Priority'Last;
+         Self_ID.Common.LL.L.Owner_ID := Null_Address;
+
+      else
+         Succeeded := False;
+      end if;
+
+      --  Note: at one time we had an exception handler here, whose code
+      --  was as follows:
+
+      --  exception
+
+      --     Assumes any failure must be due to insufficient resources
+
+      --     when Storage_Error =>
+      --        Must_Not_Fail (DosCloseEventSem (Self_ID.Common.LL.CV));
+      --        Succeeded := False;
+
+      --  but that won't work with the old exception scheme, since it would
+      --  result in messing with Jmpbuf values too early. If and when we get
+      --  switched entirely to the new zero-cost exception scheme, we could
+      --  put this handler back in!
+   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
+      Result              : aliased APIRET;
+      Adjusted_Stack_Size : System.Parameters.Size_Type;
+      use System.Parameters;
+
+   begin
+      --  In OS/2 the allocated stack size should be based on the
+      --  amount of address space that should be reserved for the stack.
+      --  Actual memory will only be used when the stack is touched anyway.
+
+      --  The new minimum size is 12 kB, although the EMX docs
+      --  recommend a minimum size of 32 kB.  (The original was 4 kB)
+      --  Systems that use many tasks (say > 30) and require much
+      --  memory may run out of virtual address space, since OS/2
+      --  has a per-proces limit of 512 MB, of which max. 300 MB is
+      --  usable in practise.
+
+      if Stack_Size = Unspecified_Size then
+         Adjusted_Stack_Size := Default_Stack_Size;
+
+      elsif Stack_Size < Minimum_Stack_Size then
+         Adjusted_Stack_Size := Minimum_Stack_Size;
+
+      else
+         Adjusted_Stack_Size := Stack_Size;
+      end if;
+
+      --  GB970222:
+      --    Because DosCreateThread is called directly here, the
+      --    C RTL doesn't get initialized for the new thead. EMX by
+      --    default uses per-thread local heaps in addition to the
+      --    global heap. There might be other effects of by-passing the
+      --    C library here.
+
+      --    When using _beginthread the newly created thread is not
+      --    blocked initially. Does this matter or can I create the
+      --    thread running anyway? The LL.Thread variable will be set
+      --    anyway because the variable is passed by reference to OS/2.
+
+      T.Common.LL.Wrapper := To_PFNTHREAD (Wrapper);
+
+      --  The OS implicitly gives the new task the priority of this task.
+
+      T.Common.LL.Current_Priority := Self.Common.LL.Current_Priority;
+
+      --  If task was locked before activator task was
+      --  initialized, assume it has OS standard priority
+
+      if T.Common.LL.L.Owner_Priority not in Any_Priority'Range then
+         T.Common.LL.L.Owner_Priority := 1;
+      end if;
+
+      --  Create the thread, in blocked mode
+
+      Result := DosCreateThread
+        (F_ptid   => T.Common.LL.Thread'Unchecked_Access,
+         pfn      => T.Common.LL.Wrapper,
+         param    => To_Address (T),
+         flag     => Block_Child + Commit_Stack,
+         cbStack  => ULONG (Adjusted_Stack_Size));
+
+      Succeeded := (Result = NO_ERROR);
+
+      if not Succeeded then
+         return;
+      end if;
+
+      --  Set the new thread's priority
+      --  (child has inherited priority from parent)
+
+      Set_Priority (T, Priority);
+
+      --  Start the thread executing
+
+      Must_Not_Fail (DosResumeThread (T.Common.LL.Thread));
+
+   end Create_Task;
+
+   ------------------
+   -- Finalize_TCB --
+   ------------------
+
+   procedure Finalize_TCB (T : Task_ID) is
+      Tmp    : Task_ID := T;
+
+      procedure Free is new
+        Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID);
+
+   begin
+      Must_Not_Fail (DosCloseEventSem (T.Common.LL.CV));
+
+      if not Single_Lock then
+         Finalize_Lock (T.Common.LL.L'Unchecked_Access);
+      end if;
+
+      if T.Known_Tasks_Index /= -1 then
+         Known_Tasks (T.Known_Tasks_Index) := null;
+      end if;
+
+      Free (Tmp);
+   end Finalize_TCB;
+
+   ---------------
+   -- Exit_Task --
+   ---------------
+
+   procedure Exit_Task is
+   begin
+      Thread_Local_Data_Ptr := null;
+   end Exit_Task;
+
+   ----------------
+   -- Abort_Task --
+   ----------------
+
+   procedure Abort_Task (T : Task_ID) is
+      pragma Unreferenced (T);
+
+   begin
+      null;
+
+      --  Task abortion not implemented yet.
+      --  Should perform other action ???
+
+   end Abort_Task;
+
+   ----------------
+   -- Check_Exit --
+   ----------------
+
+   --  Dummy version
+
+   function Check_Exit (Self_ID : ST.Task_ID) return Boolean is
+   begin
+      return Check_No_Locks (Self_ID);
+   end Check_Exit;
+
+   --------------------
+   -- Check_No_Locks --
+   --------------------
+
+   function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean is
+      TLD : constant Access_Thread_Local_Data := Thread_Local_Data_Ptr;
+
+   begin
+      return Self_ID = TLD.Self_ID
+        and then TLD.Lock_Prio_Level = 0;
+   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 Thread_Id (T.Common.LL.Thread) /= Thread_Self then
+         return DosSuspendThread (T.Common.LL.Thread) = NO_ERROR;
+      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 Thread_Id (T.Common.LL.Thread) /= Thread_Self then
+         return DosResumeThread (T.Common.LL.Thread) = NO_ERROR;
+      else
+         return True;
+      end if;
+   end Resume_Task;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize (Environment_Task : Task_ID) is
+      Succeeded : Boolean;
+   begin
+      Environment_Task_ID := Environment_Task;
+
+      Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
+      --  Initialize the lock used to synchronize chain of all ATCBs.
+
+      --  Set ID of environment task.
+
+      Thread_Local_Data_Ptr.Self_ID := Environment_Task;
+      Environment_Task.Common.LL.Thread := 1; --  By definition
+
+      --  This priority is unknown in fact.
+      --  If actual current priority is different,
+      --  it will get synchronized later on anyway.
+
+      Environment_Task.Common.LL.Current_Priority :=
+        Environment_Task.Common.Current_Priority;
+
+      --  Initialize TCB for this task.
+      --  This includes all the normal task-external initialization.
+      --  This is also done by Initialize_ATCB, why ???
+
+      Initialize_TCB (Environment_Task, Succeeded);
+
+      --  Consider raising Storage_Error,
+      --  if propagation can be tolerated ???
+
+      pragma Assert (Succeeded);
+
+      --  Do normal task-internal initialization,
+      --  which depends on an initialized TCB.
+
+      Enter_Task (Environment_Task);
+
+      --  Insert here any other special
+      --  initialization needed for the environment task.
+   end Initialize;
+
+begin
+   --  Initialize pointer to task local data.
+   --  This is done once, for all tasks.
+
+   Must_Not_Fail (DosAllocThreadLocalMemory
+      ((Thread_Local_Data'Size + 31) / 32,  --  nr of 32-bit words
+       To_PPVOID (Thread_Local_Data_Ptr'Access)));
+
+   --  Initialize thread local data for main thread
+
+   Thread_Local_Data_Ptr.Self_ID := null;
+   Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
+end System.Task_Primitives.Operations;