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

1 files changed, 28 insertions, 13 deletions

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;