2009-04-16 Doug Rupp <rupp@adacore.com>

	* s-taprop-vxworks.adb, s-taprop-tru64.adb, s-taprop-mingw.adb,
	s-taprop-linux.adb, s-taprop-solaris.adb, s-taprop-irix.adb, 
	s-taprop-hpux-dce.adb, s-taprop-posix.adb
	(Enter_Task): Move Known_Tasks initialization to s-tassta.adb

	* s-taprop-vms.adb (Enter_Task): Likewise.
	(Initialize): Import DBEXT, Debug_Register. Register DBGEXT callback.

	* s-tassta.adb (Activate_Tasks): After task creation set state to
	Activating, vice Runnable. Initialize Known_Tasks, moved here from
	s-taprop.adb (Enter_Task). Set Debug_Event_Activating for debugger.
	Set state to Runnable after above.
	(Task_Wrapper): Set Debug_Event_Run. In exception block set
	Debug_Event_Terminated.

	* s-taskin.ads (Task_States): Add new states Activiting and
	Activator_Delay_Sleep.
	(Bit_Array, Debug_Event_Array): New types.
	(Global_Task_Debug_Event_Set: New flag.
	(Common_ATCB): New field Debug_Events.

	* s-taskin.adb (Initialize_ATCB): Initialize Debug_Events.

	* s-tasren.adb (Timed_Selective_Wait): Set Activator_Delay_Sleep vice
	Activator_Sleep.

	* s-tasini.adb (Locked_Abort_To_Level): Add case alternatives for when
	Activating and when Acceptor_Delay_Sleep.

	* s-tasdeb.ads: Add constants for Debug_Events.
	(Debug_Event_Kind_Type): New subtype.
	(Signal_Debug_Event): New subprogram.

	* s-tasdeb.adb (Signal_Debug_Event): New null subprogram.

From-SVN: r146155

17 files changed, 243 insertions, 193 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 92ae20a..7c10005 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,40 @@
+2009-04-16  Doug Rupp  <rupp@adacore.com>
+
+	* s-taprop-vxworks.adb, s-taprop-tru64.adb, s-taprop-mingw.adb,
+	s-taprop-linux.adb, s-taprop-solaris.adb, s-taprop-irix.adb, 
+	s-taprop-hpux-dce.adb, s-taprop-posix.adb
+	(Enter_Task): Move Known_Tasks initialization to s-tassta.adb
+
+	* s-taprop-vms.adb (Enter_Task): Likewise.
+	(Initialize): Import DBEXT, Debug_Register. Register DBGEXT callback.
+
+	* s-tassta.adb (Activate_Tasks): After task creation set state to
+	Activating, vice Runnable. Initialize Known_Tasks, moved here from
+	s-taprop.adb (Enter_Task). Set Debug_Event_Activating for debugger.
+	Set state to Runnable after above.
+	(Task_Wrapper): Set Debug_Event_Run. In exception block set
+	Debug_Event_Terminated.
+
+	* s-taskin.ads (Task_States): Add new states Activiting and
+	Activator_Delay_Sleep.
+	(Bit_Array, Debug_Event_Array): New types.
+	(Global_Task_Debug_Event_Set: New flag.
+	(Common_ATCB): New field Debug_Events.
+
+	* s-taskin.adb (Initialize_ATCB): Initialize Debug_Events.
+
+	* s-tasren.adb (Timed_Selective_Wait): Set Activator_Delay_Sleep vice
+	Activator_Sleep.
+
+	* s-tasini.adb (Locked_Abort_To_Level): Add case alternatives for when
+	Activating and when Acceptor_Delay_Sleep.
+
+	* s-tasdeb.ads: Add constants for Debug_Events.
+	(Debug_Event_Kind_Type): New subtype.
+	(Signal_Debug_Event): New subprogram.
+
+	* s-tasdeb.adb (Signal_Debug_Event): New null subprogram.
+
 2009-04-16  Thomas Quinot  <quinot@adacore.com>
 
 	* sem_elim.adb: Minor reformatting
diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb
index 21b393c..0afd56b 100644
--- a/gcc/ada/s-taprop-hpux-dce.adb
+++ b/gcc/ada/s-taprop-hpux-dce.adb
@@ -714,18 +714,6 @@ package body System.Task_Primitives.Operations is
    begin
       Self_ID.Common.LL.Thread := pthread_self;
       Specific.Set (Self_ID);
-
-      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;
    end Enter_Task;
 
    --------------
diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb
index e86badb..d3344b3 100644
--- a/gcc/ada/s-taprop-irix.adb
+++ b/gcc/ada/s-taprop-irix.adb
@@ -709,18 +709,6 @@ package body System.Task_Primitives.Operations is
            (To_Int (Self_ID.Common.Task_Info.Runon_CPU));
          pragma Assert (Result = 0);
       end if;
-
-      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;
    end Enter_Task;
 
    --------------
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index addffde..d3597a2 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -705,18 +705,6 @@ package body System.Task_Primitives.Operations is
 
       Specific.Set (Self_ID);
 
-      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;
-
       if Use_Alternate_Stack then
          declare
             Stack  : aliased stack_t;
diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb
index 89e7dc1..f32d426 100644
--- a/gcc/ada/s-taprop-mingw.adb
+++ b/gcc/ada/s-taprop-mingw.adb
@@ -807,18 +807,6 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Self_ID.Common.LL.Thread_Id := GetCurrentThreadId;
-
-      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;
    end Enter_Task;
 
    --------------
diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index 64bf28f..51f20a6 100644
--- a/gcc/ada/s-taprop-posix.adb
+++ b/gcc/ada/s-taprop-posix.adb
@@ -788,18 +788,6 @@ package body System.Task_Primitives.Operations is
 
       Specific.Set (Self_ID);
 
-      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;
-
       if Use_Alternate_Stack then
          declare
             Stack  : aliased stack_t;
diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb
index 16da81c..4156e36 100644
--- a/gcc/ada/s-taprop-solaris.adb
+++ b/gcc/ada/s-taprop-solaris.adb
@@ -900,18 +900,6 @@ package body System.Task_Primitives.Operations is
 
       --  We need the above code even if we do direct fetch of Task_Id in Self
       --  for the main task on Sun, x86 Solaris and for gcc 2.7.2.
-
-      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;
    end Enter_Task;
 
    --------------
diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index ce4195b..94649e2 100644
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/gcc/ada/s-taprop-tru64.adb
@@ -707,19 +707,8 @@ package body System.Task_Primitives.Operations is
    begin
       Hide_Unhide_Yellow_Zone (Hide => True);
       Self_ID.Common.LL.Thread := pthread_self;
-      Specific.Set (Self_ID);
-
-      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;
+      Specific.Set (Self_ID);
    end Enter_Task;
 
    --------------
diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb
index 4a36f8b..cc640a8 100644
--- a/gcc/ada/s-taprop-vms.adb
+++ b/gcc/ada/s-taprop-vms.adb
@@ -689,20 +689,7 @@ package body System.Task_Primitives.Operations is
    procedure Enter_Task (Self_ID : Task_Id) is
    begin
       Self_ID.Common.LL.Thread := pthread_self;
-
       Specific.Set (Self_ID);
-
-      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;
    end Enter_Task;
 
    --------------
@@ -1238,6 +1225,25 @@ package body System.Task_Primitives.Operations is
    ----------------
 
    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 Interface (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;
 
@@ -1249,6 +1255,15 @@ package body System.Task_Primitives.Operations is
 
       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
+       );
+
       Enter_Task (Environment_Task);
    end Initialize;
 
diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index 40ded21..5f6d8d4 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -833,18 +833,6 @@ package body System.Task_Primitives.Operations is
 
       Install_Signal_Handlers;
 
-      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;
-
       --  If stack checking is enabled, set the stack limit for this task
 
       if Set_Stack_Limit_Hook /= null then
diff --git a/gcc/ada/s-tasdeb.adb b/gcc/ada/s-tasdeb.adb
index 77d5478c..9fb0cd6 100644
--- a/gcc/ada/s-tasdeb.adb
+++ b/gcc/ada/s-tasdeb.adb
@@ -246,6 +246,18 @@ package body System.Tasking.Debug is
       STPO.Self.User_State := Value;
    end Set_User_State;
 
+   ------------------------
+   -- Signal_Debug_Event --
+   ------------------------
+
+   procedure Signal_Debug_Event
+     (Event_Kind : Event_Kind_Type;
+      Task_Value : Task_Id)
+   is
+   begin
+      null;
+   end Signal_Debug_Event;
+
    --------------------
    -- Stop_All_Tasks --
    --------------------
diff --git a/gcc/ada/s-tasdeb.ads b/gcc/ada/s-tasdeb.ads
index 1314e64..806fe0e 100644
--- a/gcc/ada/s-tasdeb.ads
+++ b/gcc/ada/s-tasdeb.ads
@@ -69,6 +69,26 @@ package System.Tasking.Debug is
    --  Global array of tasks read by gdb, and updated by Create_Task and
    --  Finalize_TCB
 
+   Debug_Event_Activating           : constant := 1;
+   Debug_Event_Run                  : constant := 2;
+   Debug_Event_Suspended            : constant := 3;
+   Debug_Event_Preempted            : constant := 4;
+   Debug_Event_Terminated           : constant := 5;
+   Debug_Event_Abort_Terminated     : constant := 6;
+   Debug_Event_Exception_Terminated : constant := 7;
+   Debug_Event_Rendezvous_Exception : constant := 8;
+   Debug_Event_Handled              : constant := 9;
+   Debug_Event_Dependents_Exception : constant := 10;
+   Debug_Event_Handled_Others       : constant := 11;
+
+   subtype Event_Kind_Type is Positive range 1 .. 11;
+   --  Event kinds currently defined for debugging, used globally
+   --  below and on a per taak basis.
+
+   procedure Signal_Debug_Event
+     (Event_Kind : Event_Kind_Type;
+      Task_Value : Task_Id);
+
    ----------------------------------
    -- VxWorks specific GDB support --
    ----------------------------------
diff --git a/gcc/ada/s-tasini.adb b/gcc/ada/s-tasini.adb
index 57d7dc6..0a97fb0 100644
--- a/gcc/ada/s-tasini.adb
+++ b/gcc/ada/s-tasini.adb
@@ -57,9 +57,9 @@ package body System.Tasking.Initialization is
    use Task_Primitives.Operations;
 
    Global_Task_Lock : aliased System.Task_Primitives.RTS_Lock;
-   --  This is a global lock; it is used to execute in mutual exclusion
-   --  from all other tasks. It is only used by Task_Lock,
-   --  Task_Unlock, and Final_Task_Unlock.
+   --  This is a global lock; it is used to execute in mutual exclusion from
+   --  all other tasks. It is only used by Task_Lock, Task_Unlock, and
+   --  Final_Task_Unlock.
 
    ----------------------------------------------------------------------
    -- Tasking versions of some services needed by non-tasking programs --
@@ -103,11 +103,10 @@ package body System.Tasking.Initialization is
    ----------------------------
 
    procedure Init_RTS;
-   --  This procedure completes the initialization of the GNARL. The first
-   --  part of the initialization is done in the body of System.Tasking.
-   --  It consists of initializing global locks, and installing tasking
-   --  versions of certain operations used by the compiler. Init_RTS is called
-   --  during elaboration.
+   --  This procedure completes the initialization of the GNARL. The first part
+   --  of the initialization is done in the body of System.Tasking. It consists
+   --  of initializing global locks, and installing tasking versions of certain
+   --  operations used by the compiler. Init_RTS is called during elaboration.
 
    --------------------------
    -- Change_Base_Priority --
@@ -130,7 +129,8 @@ package body System.Tasking.Initialization is
    function Check_Abort_Status return Integer is
       Self_ID : constant Task_Id := Self;
    begin
-      if Self_ID /= null and then Self_ID.Deferral_Level = 0
+      if Self_ID /= null
+        and then Self_ID.Deferral_Level = 0
         and then Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
       then
          return 1;
@@ -271,6 +271,7 @@ package body System.Tasking.Initialization is
                   pragma Assert (not Self_ID.ATC_Hack);
 
                elsif Self_ID.ATC_Hack then
+
                   --  The solution really belongs in the Abort_Signal handler
                   --  for async. entry calls.  The present hack is very
                   --  fragile. It relies that the very next point after
@@ -296,13 +297,14 @@ package body System.Tasking.Initialization is
    -- Final_Task_Unlock --
    -----------------------
 
-   --  This version is only for use in Terminate_Task, when the task
-   --  is relinquishing further rights to its own ATCB.
-   --  There is a very interesting potential race condition there, where
-   --  the old task may run concurrently with a new task that is allocated
-   --  the old tasks (now reused) ATCB.  The critical thing here is to
-   --  not make any reference to the ATCB after the lock is released.
-   --  See also comments on Terminate_Task and Unlock.
+   --  This version is only for use in Terminate_Task, when the task is
+   --  relinquishing further rights to its own ATCB.
+
+   --  There is a very interesting potential race condition there, where the
+   --  old task may run concurrently with a new task that is allocated the old
+   --  tasks (now reused) ATCB. The critical thing here is to not make any
+   --  reference to the ATCB after the lock is released. See also comments on
+   --  Terminate_Task and Unlock.
 
    procedure Final_Task_Unlock (Self_ID : Task_Id) is
    begin
@@ -334,16 +336,17 @@ package body System.Tasking.Initialization is
       Self_Id.Awake_Count := 1;
       Self_Id.Alive_Count := 1;
 
-      Self_Id.Master_Within := Library_Task_Level;
-      --  Normally, a task starts out with internal master nesting level
-      --  one larger than external master nesting level. It is incremented
-      --  to one by Enter_Master, which is called in the task body only if
-      --  the compiler thinks the task may have dependent tasks. There is no
+      --  Normally, a task starts out with internal master nesting level one
+      --  larger than external master nesting level. It is incremented to one
+      --  by Enter_Master, which is called in the task body only if the
+      --  compiler thinks the task may have dependent tasks. There is no
       --  corresponding call to Enter_Master for the environment task, so we
-      --  would need to increment it to 2 here.  Instead, we set it to 3.
-      --  By doing this we reserve the level 2 for server tasks of the runtime
+      --  would need to increment it to 2 here. Instead, we set it to 3. By
+      --  doing this we reserve the level 2 for server tasks of the runtime
       --  system. The environment task does not need to wait for these server
 
+      Self_Id.Master_Within := Library_Task_Level;
+
       --  Initialize lock used to implement mutual exclusion between all tasks
 
       Initialize_Lock (Global_Task_Lock'Access, STPO.Global_Task_Level);
@@ -368,8 +371,8 @@ package body System.Tasking.Initialization is
 
       SSL.Tasking.Init_Tasking_Soft_Links;
 
-      --  Abort is deferred in a new ATCB, so we need to undefer abort
-      --  at this stage to make the environment task abortable.
+      --  Abort is deferred in a new ATCB, so we need to undefer abort at this
+      --  stage to make the environment task abortable.
 
       Undefer_Abort (Environment_Task);
    end Init_RTS;
@@ -381,40 +384,37 @@ package body System.Tasking.Initialization is
    --  Abort a task to the specified ATC nesting level.
    --  Call this only with T locked.
 
-   --  An earlier version of this code contained a call to Wakeup. That
-   --  should not be necessary here, if Abort_Task is implemented correctly,
-   --  since Abort_Task should include the effect of Wakeup. However, the
-   --  above call was in earlier versions of this file, and at least for
-   --  some targets Abort_Task has not been doing Wakeup. It should not
-   --  hurt to uncomment the above call, until the error is corrected for
-   --  all targets.
+   --  An earlier version of this code contained a call to Wakeup. That should
+   --  not be necessary here, if Abort_Task is implemented correctly, since
+   --  Abort_Task should include the effect of Wakeup. However, the above call
+   --  was in earlier versions of this file, and at least for some targets
+   --  Abort_Task has not been doing Wakeup. It should not hurt to uncomment
+   --  the above call, until the error is corrected for all targets.
 
    --  See extended comments in package body System.Tasking.Abort for the
    --  overall design of the implementation of task abort.
    --  ??? there is no such package ???
 
-   --  If the task is sleeping it will be in an abort-deferred region, and
-   --  will not have Abort_Signal raised by Abort_Task. Such an "abort
-   --  deferral" is just to protect the RTS internals, and not necessarily
-   --  required to enforce Ada semantics. Abort_Task should wake the task up
-   --  and let it decide if it wants to complete the aborted construct
-   --  immediately.
+   --  If the task is sleeping it will be in an abort-deferred region, and will
+   --  not have Abort_Signal raised by Abort_Task. Such an "abort deferral" is
+   --  just to protect the RTS internals, and not necessarily required to
+   --  enforce Ada semantics. Abort_Task should wake the task up and let it
+   --  decide if it wants to complete the aborted construct immediately.
 
    --  Note that the effect of the low-level Abort_Task is not persistent.
    --  If the target task is not blocked, this wakeup will be missed.
 
    --  We don't bother calling Abort_Task if this task is aborting itself,
-   --  since we are inside the RTS and have abort deferred. Similarly, We
-   --  don't bother to call Abort_Task if T is terminated, since there is
-   --  no need to abort a terminated task, and it could be dangerous to try
-   --  if the task has stopped executing.
-
-   --  Note that an earlier version of this code had some false reasoning
-   --  about being able to reliably wake up a task that had suspended on
-   --  a blocking system call that does not atomically release the task's
-   --  lock (e.g., UNIX nanosleep, which we once thought could be used to
-   --  implement delays). That still left the possibility of missed
-   --  wakeups.
+   --  since we are inside the RTS and have abort deferred. Similarly, We don't
+   --  bother to call Abort_Task if T is terminated, since there is no need to
+   --  abort a terminated task, and it could be dangerous to try if the task
+   --  has stopped executing.
+
+   --  Note that an earlier version of this code had some false reasoning about
+   --  being able to reliably wake up a task that had suspended on a blocking
+   --  system call that does not atomically release the task's lock (e.g., UNIX
+   --  nanosleep, which we once thought could be used to implement delays).
+   --  That still left the possibility of missed wakeups.
 
    --  We cannot safely call Vulnerable_Complete_Activation here, since that
    --  requires locking Self_ID.Parent. The anti-deadlock lock ordering rules
@@ -436,7 +436,8 @@ package body System.Tasking.Initialization is
                pragma Assert (False);
                null;
 
-            when Runnable =>
+            when Activating | Runnable =>
+
                --  This is needed to cancel an asynchronous protected entry
                --  call during a requeue with abort.
 
@@ -454,7 +455,7 @@ package body System.Tasking.Initialization is
                  AST_Server_Sleep                         =>
                Wakeup (T, T.Common.State);
 
-            when Acceptor_Sleep =>
+            when Acceptor_Sleep | Acceptor_Delay_Sleep =>
                T.Open_Accepts := null;
                Wakeup (T, T.Common.State);
 
@@ -488,13 +489,17 @@ package body System.Tasking.Initialization is
             --  value will not be set to False except with T also locked,
             --  inside Exit_One_ATC_Level, so we should not miss wakeups.
 
-            if T.Common.State = Acceptor_Sleep then
+            if T.Common.State = Acceptor_Sleep
+                 or else
+               T.Common.State = Acceptor_Delay_Sleep
+            then
                T.Open_Accepts := null;
             end if;
 
          elsif T /= Self_ID and then
            (T.Common.State = Runnable
-            or else T.Common.State = Interrupt_Server_Blocked_On_Event_Flag)
+             or else T.Common.State = Interrupt_Server_Blocked_On_Event_Flag)
+
             --  The task is blocked on a system call waiting for the
             --  completion event. In this case Abort_Task may need to take
             --  special action in order to succeed. Example system: VMS.
@@ -519,7 +524,6 @@ package body System.Tasking.Initialization is
 
       Previous := Null_Task;
       C := All_Tasks_List;
-
       while C /= Null_Task loop
          if C = T then
             if Previous = Null_Task then
@@ -565,7 +569,6 @@ package body System.Tasking.Initialization is
 
    function Task_Name return String is
       Self_Id : constant Task_Id := STPO.Self;
-
    begin
       return Self_Id.Common.Task_Image (1 .. Self_Id.Common.Task_Image_Len);
    end Task_Name;
@@ -776,6 +779,7 @@ package body System.Tasking.Initialization is
       New_State  : Entry_Call_State)
    is
       Caller : constant Task_Id := Entry_Call.Self;
+
    begin
       pragma Debug (Debug.Trace
         (Self_ID, "Wakeup_Entry_Caller", 'E', Caller));
@@ -787,8 +791,8 @@ package body System.Tasking.Initialization is
 
       if Entry_Call.Mode = Asynchronous_Call then
 
-         --  Abort the caller in his abortable part,
-         --  but do so only if call has been queued abortably
+         --  Abort the caller in his abortable part, but do so only if call has
+         --  been queued abortably.
 
          if Entry_Call.State >= Was_Abortable or else New_State = Done then
             Locked_Abort_To_Level (Self_ID, Caller, Entry_Call.Level - 1);
@@ -804,9 +808,9 @@ package body System.Tasking.Initialization is
    -----------------------
 
    --  These are dummies for subprograms that are only needed by certain
-   --  optional run-time system packages. If they are needed, the soft
-   --  links will be redirected to the real subprogram by elaboration of
-   --  the subprogram body where the real subprogram is declared.
+   --  optional run-time system packages. If they are needed, the soft links
+   --  will be redirected to the real subprogram by elaboration of the
+   --  subprogram body where the real subprogram is declared.
 
    procedure Finalize_Attributes (T : Task_Id) is
       pragma Unreferenced (T);
diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb
index 10ad198..8cc9d91 100644
--- a/gcc/ada/s-taskin.adb
+++ b/gcc/ada/s-taskin.adb
@@ -62,9 +62,9 @@ package body System.Tasking is
    function Detect_Blocking return Boolean is
       GL_Detect_Blocking : Integer;
       pragma Import (C, GL_Detect_Blocking, "__gl_detect_blocking");
-      --  Global variable exported by the binder generated file.
-      --  A value equal to 1 indicates that pragma Detect_Blocking is active,
-      --  while 0 is used for the pragma not being present.
+      --  Global variable exported by the binder generated file. A value equal
+      --  to 1 indicates that pragma Detect_Blocking is active, while 0 is used
+      --  for the pragma not being present.
 
    begin
       return GL_Detect_Blocking = 1;
@@ -101,7 +101,8 @@ package body System.Tasking is
       Task_Info        : System.Task_Info.Task_Info_Type;
       Stack_Size       : System.Parameters.Size_Type;
       T                : Task_Id;
-      Success          : out Boolean) is
+      Success          : out Boolean)
+   is
    begin
       T.Common.State := Unactivated;
 
@@ -128,14 +129,18 @@ package body System.Tasking is
       T.Common.Global_Task_Lock_Nesting := 0;
       T.Common.Fall_Back_Handler := null;
       T.Common.Specific_Handler  := null;
+      T.Common.Debug_Events :=
+        (False, False, False, False, False, False, False, False,
+         False, False, False, False, False, False, False, False);
+      --  Wouldn't (others => False) be clearer ???
 
       if T.Common.Parent = null then
-         --  For the environment task, the adjusted stack size is
-         --  meaningless. For example, an unspecified Stack_Size means
-         --  that the stack size is determined by the environment, or
-         --  can grow dynamically. The Stack_Checking algorithm
-         --  therefore needs to use the requested size, or 0 in
-         --  case of an unknown size.
+
+         --  For the environment task, the adjusted stack size is meaningless.
+         --  For example, an unspecified Stack_Size means that the stack size
+         --  is determined by the environment, or can grow dynamically. The
+         --  Stack_Checking algorithm therefore needs to use the requested
+         --  size, or 0 in case of an unknown size.
 
          T.Common.Compiler_Data.Pri_Stack_Info.Size :=
             Storage_Elements.Storage_Offset (Stack_Size);
@@ -161,9 +166,9 @@ package body System.Tasking is
 
    Main_Priority : Integer;
    pragma Import (C, Main_Priority, "__gl_main_priority");
-   --  Priority for main task. Note that this is of type Integer, not
-   --  Priority, because we use the value -1 to indicate the default
-   --  main priority, and that is of course not in Priority'range.
+   --  Priority for main task. Note that this is of type Integer, not Priority,
+   --  because we use the value -1 to indicate the default main priority, and
+   --  that is of course not in Priority'range.
 
    Initialized : Boolean := False;
    --  Used to prevent multiple calls to Initialize
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index 1041c03..5912eac 100644
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -128,18 +128,18 @@ package System.Tasking is
 
    type Task_States is
      (Unactivated,
-      --  Task has been created but has not been activated.
+      --  TCB initialized but not task has not been created.
       --  It cannot be executing.
 
+      Activating,
+      --  Task has been created and is being made Runnable.
+
       --  Active states
       --  For all states from here down, the task has been activated.
       --  For all states from here down, except for Terminated, the task
       --  may be executing.
       --  Activator = null iff it has not yet completed activating.
 
-      --  For all states from here down,
-      --  the task has been activated, and may be executing.
-
       Runnable,
       --  Task is not blocked for any reason known to Ada.
       --  (It may be waiting for a mutex, though.)
@@ -154,7 +154,10 @@ package System.Tasking is
       --  Task is waiting for created tasks to complete activation
 
       Acceptor_Sleep,
-      --  Task is waiting on an accept or selective wait statement
+      --  Task is waiting on an accept or select with terminate
+
+      Acceptor_Delay_Sleep,
+      --  Task is waiting on an selective wait statement
 
       Entry_Caller_Sleep,
       --  Task is waiting on an entry call
@@ -389,6 +392,15 @@ package System.Tasking is
    --  is in general a non-static value that can depend on discriminants
    --  of the task.
 
+   type Bit_Array is array (Integer range <>) of Boolean;
+   pragma Pack (Bit_Array);
+
+   subtype Debug_Event_Array is Bit_Array (1 .. 16);
+
+   Global_Task_Debug_Event_Set : Boolean := False;
+   --  Set True when running under debugger control and a task debug
+   --  event signal has been requested.
+
    ----------------------------------------------
    -- Ada_Task_Control_Block (ATCB) definition --
    ----------------------------------------------
@@ -608,6 +620,10 @@ package System.Tasking is
       --  any of its dependent tasks.
       --
       --  Protection: Self.L
+
+      Debug_Events : Debug_Event_Array;
+      --  Word length array of per task debug events, of which 11 kinds are
+      --  currently defined in System.Tasking.Debugging package.
    end record;
 
    ---------------------------------------
diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb
index bf5fd85..38f179d 100644
--- a/gcc/ada/s-tasren.adb
+++ b/gcc/ada/s-tasren.adb
@@ -1525,7 +1525,7 @@ package body System.Tasking.Rendezvous is
             --  Wait for a normal call and a pending action until the
             --  Wakeup_Time is reached.
 
-            Self_Id.Common.State := Acceptor_Sleep;
+            Self_Id.Common.State := Acceptor_Delay_Sleep;
 
             --  Try to remove calls to Sleep in the loop below by letting the
             --  caller a chance of getting ready immediately, using Unlock
@@ -1557,7 +1557,7 @@ package body System.Tasking.Rendezvous is
                exit when Self_Id.Open_Accepts = null;
 
                if Timedout then
-                  Sleep (Self_Id, Acceptor_Sleep);
+                  Sleep (Self_Id, Acceptor_Delay_Sleep);
                else
                   if Parameters.Runtime_Traces then
                      Send_Trace_Info (WT_Select,
@@ -1567,7 +1567,7 @@ package body System.Tasking.Rendezvous is
                   end if;
 
                   STPO.Timed_Sleep (Self_Id, Timeout, Mode,
-                    Acceptor_Sleep, Timedout, Yielded);
+                    Acceptor_Delay_Sleep, Timedout, Yielded);
                end if;
 
                if Timedout then
@@ -1613,9 +1613,9 @@ package body System.Tasking.Rendezvous is
             --  3) Spurious wakeup
 
             Self_Id.Open_Accepts := null;
-            Self_Id.Common.State := Acceptor_Sleep;
+            Self_Id.Common.State := Acceptor_Delay_Sleep;
 
-            STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Sleep,
+            STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Delay_Sleep,
               Timedout, Yielded);
 
             Self_Id.Common.State := Runnable;
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index 9a5ce9f..5d4e7cb 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -300,7 +300,7 @@ package body System.Tasking.Stages is
             --  racing ahead.
 
             if Success then
-               C.Common.State := Runnable;
+               C.Common.State := Activating;
                C.Awake_Count := 1;
                C.Alive_Count := 1;
                P.Awake_Count := P.Awake_Count + 1;
@@ -313,6 +313,21 @@ package body System.Tasking.Stages is
                   P.Common.Wait_Count := P.Common.Wait_Count + 1;
                end if;
 
+               for J in System.Tasking.Debug.Known_Tasks'Range loop
+                  if System.Tasking.Debug.Known_Tasks (J) = null then
+                     System.Tasking.Debug.Known_Tasks (J) := C;
+                     C.Known_Tasks_Index := J;
+                     exit;
+                  end if;
+               end loop;
+
+               if Global_Task_Debug_Event_Set then
+                  Debug.Signal_Debug_Event
+                   (Debug.Debug_Event_Activating, C);
+               end if;
+
+               C.Common.State := Runnable;
+
                Unlock (C);
                Unlock (P);
 
@@ -1130,6 +1145,11 @@ package body System.Tasking.Stages is
          Self_ID.Deferral_Level := 0;
       end if;
 
+      if Global_Task_Debug_Event_Set then
+         Debug.Signal_Debug_Event
+          (Debug.Debug_Event_Run, Self_ID);
+      end if;
+
       begin
          --  We are separating the following portion of the code in order to
          --  place the exception handlers in a different block. In this way,
@@ -1168,8 +1188,18 @@ package body System.Tasking.Stages is
 
             if Self_ID.Terminate_Alternative then
                Cause := Normal;
+
+               if Global_Task_Debug_Event_Set then
+                  Debug.Signal_Debug_Event
+                   (Debug.Debug_Event_Terminated, Self_ID);
+               end if;
             else
                Cause := Abnormal;
+
+               if Global_Task_Debug_Event_Set then
+                  Debug.Signal_Debug_Event
+                   (Debug.Debug_Event_Abort_Terminated, Self_ID);
+               end if;
             end if;
          when others =>
             --  ??? Using an E : others here causes CD2C11A to fail on Tru64
@@ -1194,7 +1224,13 @@ package body System.Tasking.Stages is
             --  procedure, as well as the associated Exception_Occurrence.
 
             Cause := Unhandled_Exception;
+
             Save_Occurrence (EO, SSL.Get_Current_Excep.all.all);
+
+            if Global_Task_Debug_Event_Set then
+               Debug.Signal_Debug_Event
+                 (Debug.Debug_Event_Exception_Terminated, Self_ID);
+            end if;
       end;
 
       --  Look for a task termination handler. This code is for all tasks but