From 5e44c5eab4a57d237cc1078bc0b57018b4915b51 Mon Sep 17 00:00:00 2001 From: Doug Rupp Date: Thu, 16 Apr 2009 09:34:40 +0000 Subject: 2009-04-16 Doug Rupp * 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 --- gcc/ada/s-taprop-vms.adb | 41 ++++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) (limited to 'gcc/ada/s-taprop-vms.adb') 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; -- cgit v1.1